Gruta/Source/DBI.pm

   1 package Gruta::Source::DBI;
   2
   3 use strict;
   4 use warnings;
   5 use Carp;
   6
   7 use DBI;
   8 use Gruta::Data;
   9
  10 sub _prepare {
  11         my $self        = shift;
  12         my $sql         = shift;
  13
  14         my $sth = $self->{dbh}->prepare($sql) or
  15                 croak $self->{dbh}->errstr;
  16
  17         return $sth;
  18 }
  19
  20 sub _execute {
  21         my $self        = shift;
  22         my $sth         = shift;
  23
  24         return $sth->execute( @_ ) or croak $self->{dbh}->errstr;
  25 }
  26
  27
  28 package Gruta::Data::DBI::BASE;
  29
  30 sub pk { return qw(id); }
  31
  32 sub load {
  33         my $self        = shift;
  34         my $driver      = shift;
  35
  36         $self->source( $driver );
  37
  38         my $sth;
  39
  40         if (not $sth = $self->source->{sth}->{select}->{ref($self)}) {
  41                 my $sql = 'SELECT ' . join(', ', $self->fields()) .
  42                         ' FROM ' . $self->table() .
  43                         ' WHERE ' . join(' AND ', map { "$_ = ?" } $self->pk());
  44
  45                 $sth = $self->source->{sth}->{select}->{ref($self)} =
  46                         $self->source->_prepare($sql);
  47         }
  48
  49         $self->source->_execute($sth, map { $self->get($_) } $self->pk());
  50
  51         my $r = $sth->fetchrow_hashref();
  52
  53         if (not $r) {
  54                 return undef;
  55         }
  56
  57         foreach my $k ($self->fields()) {
  58                 $self->set($k, $r->{$k});
  59         }
  60
  61         return $self;
  62 }
  63
  64
  65 sub save {
  66         my $self        = shift;
  67         my $driver      = shift;
  68
  69         $self->source( $driver ) if $driver;
  70
  71         my $sth;
  72
  73         if (not $sth = $self->source->{sth}->{update}->{ref($self)}) {
  74                 my $sql = 'UPDATE ' . $self->table() .
  75                         ' SET ' . join(', ', map { "$_ = ?" } $self->fields()) .
  76                         ' WHERE ' . join(' AND ', map { "$_ = ?" } $self->pk());
  77
  78                 $sth = $self->source->{sth}->{update}->{ref($self)} =
  79                         $self->source->_prepare($sql);
  80         }
  81
  82         $self->source->_execute($sth,
  83                 (map { $self->get($_) } $self->fields()),
  84                 (map { $self->get($_) } $self->pk())
  85         );
  86
  87         return $self;
  88 }
  89
  90
  91 sub delete {
  92         my $self        = shift;
  93         my $driver      = shift;
  94
  95         $self->source( $driver ) if $driver;
  96
  97         my $sth;
  98
  99         if (not $sth = $self->source->{sth}->{delete}->{ref($self)}) {
 100                 my $sql = 'DELETE FROM ' . $self->table() .
 101                         ' WHERE ' . join(' AND ', map { "$_ = ?" } $self->pk());
 102
 103                 $sth = $self->source->{sth}->{delete}->{ref($self)} =
 104                         $self->source->_prepare($sql);
 105         }
 106
 107         $self->source->_execute($sth,
 108                 (map { $self->get($_) } $self->pk())
 109         );
 110
 111         return $self;
 112 }
 113
 114
 115 package Gruta::Data::DBI::Story;
 116
 117 use base 'Gruta::Data::Story';
 118 use base 'Gruta::Data::DBI::BASE';
 119
 120 sub table { return 'stories'; }
 121 sub pk { return qw(id topic_id); }
 122
 123 sub touch {
 124         my $self = shift;
 125
 126         my $sth = $self->source->_prepare(
 127                 'UPDATE stories SET hits = hits + 1 WHERE topic_id = ? AND id = ?');
 128         $self->source->_execute($sth, $self->get('topic_id'), $self->get('id'));
 129
 130         return $self;
 131 }
 132
 133 sub tags {
 134         my $self        = shift;
 135         my @ret         = ();
 136
 137         if (scalar(@_)) {
 138                 my @tags = @_;
 139
 140                 # first, delete all tags for this story
 141                 my $sth = $self->source->_prepare(
 142                         'DELETE FROM tags WHERE topic_id = ? AND id = ?');
 143                 $self->source->_execute($sth, $self->get('topic_id'), $self->get('id'));
 144
 145                 # second, add all the new ones
 146                 $sth = $self->source->_prepare(
 147                         'INSERT INTO tags (id, topic_id, tag) VALUES (?, ?, ?)');
 148
 149                 foreach my $t (@tags) {
 150                         $self->source->_execute($sth,
 151                                 $self->get('id'),
 152                                 $self->get('topic_id'),
 153                                 lc($t) );
 154                 }
 155         }
 156         else {
 157                 # read from database
 158                 my $sth = $self->source->_prepare(
 159                         'SELECT tag FROM tags WHERE topic_id = ? AND id = ?');
 160                 $self->source->_execute($sth, $self->get('topic_id'), $self->get('id'));
 161
 162                 while (my $r = $sth->fetchrow_arrayref()) {
 163                         push(@ret, $r->[0]);
 164                 }
 165         }
 166
 167         return @ret;
 168 }
 169
 170 package Gruta::Data::DBI::Topic;
 171
 172 use base 'Gruta::Data::Topic';
 173 use base 'Gruta::Data::DBI::BASE';
 174
 175 sub table { return 'topics'; }
 176
 177 package Gruta::Data::DBI::User;
 178
 179 use base 'Gruta::Data::User';
 180 use base 'Gruta::Data::DBI::BASE';
 181
 182 sub table { return 'users'; }
 183
 184 package Gruta::Data::DBI::Session;
 185
 186 use base 'Gruta::Data::Session';
 187 use base 'Gruta::Data::DBI::BASE';
 188
 189 sub table { return 'sids'; }
 190
 191 package Gruta::Source::DBI;
 192
 193 sub _assert { return $_[0]; }
 194
 195 sub _all {
 196         my $self        = shift;
 197         my $table       = shift;
 198
 199         my @ret = ();
 200
 201         my $sth = $self->_prepare("SELECT id FROM $table");
 202         $self->_execute($sth);
 203
 204         while(my @r = $sth->fetchrow_array()) {
 205                 push(@ret, $r[0]);
 206         }
 207
 208         return @ret;
 209 }
 210
 211 sub _one {
 212         my $self        = shift;
 213         my $id          = shift;
 214         my $class       = shift;
 215
 216         my $o = ${class}->new( id => $id );
 217         return $o->load( $self );
 218 }
 219
 220
 221 sub topic { return _one( @_, 'Gruta::Data::DBI::Topic' ); }
 222 sub topics { return $_[0]->_all('topics'); }
 223
 224 sub user { return _one( @_, 'Gruta::Data::DBI::User' ); }
 225 sub users { return $_[0]->_all('users'); }
 226
 227 sub story {
 228         my $self        = shift;
 229         my $topic_id    = shift;
 230         my $id          = shift;
 231
 232         my $s = Gruta::Data::DBI::Story->new( topic_id => $topic_id, id => $id );
 233         return $s->load( $self );
 234 }
 235
 236
 237 sub stories {
 238         my $self        = shift;
 239         my $topic_id    = shift;
 240
 241         my @ret = ();
 242
 243         my $sth = $self->_prepare("SELECT id FROM stories WHERE topic_id = ?");
 244         $self->_execute($sth, $topic_id);
 245
 246         while(my @r = $sth->fetchrow_array()) {
 247                 push(@ret, $r[0]);
 248         }
 249
 250         return @ret;
 251 }
 252
 253
 254 sub stories_by_date {
 255         my $self        = shift;
 256         my $topic_id    = shift;
 257         my %args        = @_;
 258
 259         $args{offset} += 0;
 260         $args{offset} = 0 if $args{offset} < 0;
 261
 262         my @args = ( $topic_id );
 263         my $sql = 'SELECT id FROM stories WHERE topic_id = ?';
 264
 265         if ($args{from}) {
 266                 $sql .= ' AND date > ?';
 267                 push(@args, $args{from});
 268         }
 269
 270         if ($args{to}) {
 271                 $sql .= ' AND date < ?';
 272                 push(@args, $args{to});
 273         }
 274
 275         if (!$args{future}) {
 276                 $sql .= ' AND date <= ?';
 277                 push(@args, Gruta::Data::today());
 278         }
 279
 280         $sql .= ' ORDER BY date DESC';
 281
 282         if ($args{num} || $args{offset}) {
 283
 284                 $sql .= ' LIMIT ?';
 285                 push(@args, $args{num} || -1);
 286
 287                 if ($args{offset}) {
 288                         $sql .= ' OFFSET ?';
 289                         push(@args, $args{offset});
 290                 }
 291         }
 292
 293         my $sth = $self->_prepare($sql);
 294         $self->_execute($sth, @args);
 295
 296         my @r = ();
 297
 298         while(my $r = $sth->fetchrow_arrayref()) {
 299                 push(@r, $r->[0]);
 300         }
 301
 302         return @r;
 303 }
 304
 305
 306 sub search_stories {
 307         my $self        = shift;
 308         my $topic_id    = shift;
 309         my $query       = shift;
 310         my $future      = shift;
 311
 312         my @q = map { '%' . $_ . '%' } split(/\s+/, $query);
 313         my $cond = 'AND content LIKE ? ' x scalar(@q);
 314
 315         unless ($future) {
 316                 $cond .= 'AND date <= ';
 317                 push(@q, Gruta::Data::today());
 318         }
 319
 320         my $sth = $self->_prepare(
 321                 'SELECT id FROM stories WHERE topic_id = ? ' . $cond .
 322                 'ORDER BY date DESC');
 323
 324         $self->_execute($sth, $topic_id, @q);
 325
 326         my @r = ();
 327
 328         while(my $r = $sth->fetchrow_arrayref()) {
 329                 push(@r, $r->[0]);
 330         }
 331
 332         return @r;
 333 }
 334
 335
 336 sub stories_top_ten {
 337         my $self        = shift;
 338         my $num         = shift;
 339
 340         my $sql = 'SELECT hits, topic_id, id FROM stories ' .
 341                 'ORDER BY hits DESC LIMIT ?';
 342
 343         my $sth = $self->_prepare($sql);
 344         $self->_execute($sth, $num);
 345
 346         my @r = ();
 347
 348         while (my @a = $sth->fetchrow_array()) {
 349                 push(@r, [ @a ]);
 350         }
 351
 352         return @r;
 353 }
 354
 355
 356 sub search_stories_by_tag {
 357         my $self        = shift;
 358         my @tags        = @_;
 359
 360         my @r = ();
 361
 362         if (@tags) {
 363                 my $sql = 'SELECT DISTINCT topic_id, id FROM tags WHERE ' .
 364                         join(' OR ', map { 'tag = ?' } @tags);
 365
 366                 my $sth = $self->_prepare($sql);
 367                 $self->_execute($sth, map { lc($_) } @tags);
 368
 369                 while (my @a = $sth->fetchrow_array()) {
 370                         push(@r, [ @a ]);
 371                 }
 372         }
 373
 374         return @r;
 375 }
 376
 377
 378 sub tags {
 379         my $self        = shift;
 380
 381         my @r = ();
 382
 383         my $sth = $self->_prepare(
 384                 'SELECT tag, count(tag) FROM tags GROUP BY tag ORDER BY 2 DESC, 1');
 385         $self->_execute($sth);
 386
 387         while (my @a = $sth->fetchrow_array()) {
 388                 push(@r, [ @a ]);
 389         }
 390
 391         return @r;
 392 }
 393
 394 sub session { return _one( @_, 'Gruta::Data::DBI::Session' ); }
 395
 396 sub purge_old_sessions {
 397         my $self        = shift;
 398
 399         my $sth = $self->_prepare('DELETE FROM sids WHERE time < ?');
 400         $self->_execute($sth, time() - (60 * 60 * 24));
 401
 402         return undef;
 403 }
 404
 405
 406 sub _insert {
 407         my $self        = shift;
 408         my $obj         = shift;
 409         my $table       = shift;
 410         my $class       = shift;
 411
 412         my $sth;
 413
 414         bless($obj, $class);
 415         $obj->source($self);
 416
 417         if (not $sth = $self->{sth}->{insert}->{ref($obj)}) {
 418                 my $sql = 'INSERT INTO ' . $table .
 419                         ' (' . join(', ', $obj->fields()) . ')' .
 420                         ' VALUES (' . join(', ', map { '?' } $obj->fields()) . ')';
 421
 422                 $sth = $self->{sth}->{insert}->{ref($obj)} = $self->_prepare($sql);
 423         }
 424
 425         $self->_execute($sth, map { $obj->get($_) } $obj->fields());
 426
 427         return $obj;
 428 }
 429
 430 sub insert_topic { $_[0]->_insert($_[1], 'topics', 'Gruta::Data::DBI::Topic'); }
 431 sub insert_user { $_[0]->_insert($_[1], 'users', 'Gruta::Data::DBI::User'); }
 432
 433
 434 sub insert_story {
 435         my $self        = shift;
 436         my $story       = shift;
 437
 438         if (not $story->get('id')) {
 439                 # alloc an id for the story
 440                 my $id = undef;
 441
 442                 my $sth = $self->_prepare(
 443                         'SELECT 1 FROM stories WHERE topic_id = ? AND id = ?');
 444
 445                 do {
 446                         $id = $story->new_id();
 447                         $self->_execute($sth, $story->get('topic_id'), $id);
 448
 449                 } while $sth->fetchrow_arrayref();
 450
 451                 $story->set('id', $id);
 452         }
 453
 454         $self->_insert($story, 'stories', 'Gruta::Data::DBI::Story');
 455
 456         return $story;
 457 }
 458
 459 sub insert_session { $_[0]->_insert($_[1], 'sids', 'Gruta::Data::DBI::Session'); }
 460
 461 sub create {
 462         my $self        = shift;
 463
 464         my $sql = '';
 465
 466         while(<DATA>) {
 467                 chomp;
 468
 469                 if (/^;$/) {
 470                         $self->{dbh}->do($sql);
 471                         $sql = '';
 472                 }
 473                 else {
 474                         $sql .= $_;
 475                 }
 476         }
 477 }
 478
 479
 480 sub new {
 481         my $class = shift;
 482
 483         my $s = bless( { @_ }, $class);
 484
 485         $s->{dbh} = DBI->connect($s->{string},
 486                 $s->{user}, $s->{passwd}, { RaiseError => 1 });
 487
 488         return $s;
 489 }
 490
 491 1;
 492 __DATA__
 493 CREATE TABLE topics (
 494         id              VARCHAR PRIMARY KEY,
 495         name            VARCHAR,
 496         editors         VARCHAR,
 497         max_stories     INTEGER,
 498         internal        INTEGER
 499 )
 500 ;
 501 CREATE TABLE stories (
 502         id              VARCHAR NOT NULL,
 503         topic_id        VARCHAR NOT NULL,
 504         title           VARCHAR,
 505         date            CHAR(14),
 506         userid          VARCHAR,
 507         format          VARCHAR,
 508         hits            INTEGER DEFAULT 0,
 509         ctime           INTEGER,
 510         content         VARCHAR,
 511         PRIMARY KEY     (id, topic_id)
 512 )
 513 ;
 514 CREATE TABLE users (
 515         id              VARCHAR PRIMARY KEY,
 516         username        VARCHAR,
 517         email           VARCHAR,
 518         password        VARCHAR,
 519         can_upload      INTEGER,
 520         is_admin        INTEGER,
 521         xdate           CHAR(14)
 522 )
 523 ;
 524 CREATE TABLE sids (
 525         id              VARCHAR PRIMARY KEY,
 526         time            INTEGER,
 527         user_id         VARCHAR,
 528         ip              VARCHAR
 529 )
 530 ;
 531 CREATE TABLE tags (
 532         id              VARCHAR NOT NULL,
 533         topic_id        VARCHAR NOT NULL,
 534         tag             VARCHAR NOT NULL
 535 )
 536 ;
 537 CREATE INDEX stories_by_date ON stories (date)
 538 ;
 539 CREATE INDEX stories_by_hits ON stories (hits)
 540 ;
 541 CREATE INDEX tags_by_tag ON tags (tag)
 542 ;