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                         $t =~ s/^\s+//;
 151                         $t =~ s/\s+$//;
 152
 153                         $self->source->_execute($sth,
 154                                 $self->get('id'),
 155                                 $self->get('topic_id'),
 156                                 lc($t) );
 157                 }
 158         }
 159         else {
 160                 # read from database
 161                 my $sth = $self->source->_prepare(
 162                         'SELECT tag FROM tags WHERE topic_id = ? AND id = ?');
 163                 $self->source->_execute($sth, $self->get('topic_id'), $self->get('id'));
 164
 165                 while (my $r = $sth->fetchrow_arrayref()) {
 166                         push(@ret, $r->[0]);
 167                 }
 168         }
 169
 170         return @ret;
 171 }
 172
 173 package Gruta::Data::DBI::Topic;
 174
 175 use base 'Gruta::Data::Topic';
 176 use base 'Gruta::Data::DBI::BASE';
 177
 178 sub table { return 'topics'; }
 179
 180 package Gruta::Data::DBI::User;
 181
 182 use base 'Gruta::Data::User';
 183 use base 'Gruta::Data::DBI::BASE';
 184
 185 sub table { return 'users'; }
 186
 187 package Gruta::Data::DBI::Session;
 188
 189 use base 'Gruta::Data::Session';
 190 use base 'Gruta::Data::DBI::BASE';
 191
 192 sub table { return 'sids'; }
 193
 194 package Gruta::Source::DBI;
 195
 196 sub _assert { return $_[0]; }
 197
 198 sub _all {
 199         my $self        = shift;
 200         my $table       = shift;
 201
 202         my @ret = ();
 203
 204         my $sth = $self->_prepare("SELECT id FROM $table");
 205         $self->_execute($sth);
 206
 207         while(my @r = $sth->fetchrow_array()) {
 208                 push(@ret, $r[0]);
 209         }
 210
 211         return @ret;
 212 }
 213
 214 sub _one {
 215         my $self        = shift;
 216         my $id          = shift;
 217         my $class       = shift;
 218
 219         my $o = ${class}->new( id => $id );
 220         return $o->load( $self );
 221 }
 222
 223
 224 sub topic { return _one( @_, 'Gruta::Data::DBI::Topic' ); }
 225 sub topics { return $_[0]->_all('topics'); }
 226
 227 sub user { return _one( @_, 'Gruta::Data::DBI::User' ); }
 228 sub users { return $_[0]->_all('users'); }
 229
 230 sub story {
 231         my $self        = shift;
 232         my $topic_id    = shift;
 233         my $id          = shift;
 234
 235         my $s = Gruta::Data::DBI::Story->new( topic_id => $topic_id, id => $id );
 236         return $s->load( $self );
 237 }
 238
 239
 240 sub stories {
 241         my $self        = shift;
 242         my $topic_id    = shift;
 243
 244         my @ret = ();
 245
 246         my $sth = $self->_prepare("SELECT id FROM stories WHERE topic_id = ?");
 247         $self->_execute($sth, $topic_id);
 248
 249         while(my @r = $sth->fetchrow_array()) {
 250                 push(@ret, $r[0]);
 251         }
 252
 253         return @ret;
 254 }
 255
 256
 257 sub stories_by_date {
 258         my $self        = shift;
 259         my $topic_id    = shift;
 260         my %args        = @_;
 261
 262         $args{offset} += 0;
 263         $args{offset} = 0 if $args{offset} < 0;
 264
 265         my @args = ( $topic_id );
 266         my $sql = 'SELECT id FROM stories WHERE topic_id = ?';
 267
 268         if ($args{from}) {
 269                 $sql .= ' AND date > ?';
 270                 push(@args, $args{from});
 271         }
 272
 273         if ($args{to}) {
 274                 $sql .= ' AND date < ?';
 275                 push(@args, $args{to});
 276         }
 277
 278         if (!$args{future}) {
 279                 $sql .= ' AND date <= ?';
 280                 push(@args, Gruta::Data::today());
 281         }
 282
 283         $sql .= ' ORDER BY date DESC';
 284
 285         if ($args{num} || $args{offset}) {
 286
 287                 $sql .= ' LIMIT ?';
 288                 push(@args, $args{num} || -1);
 289
 290                 if ($args{offset}) {
 291                         $sql .= ' OFFSET ?';
 292                         push(@args, $args{offset});
 293                 }
 294         }
 295
 296         my $sth = $self->_prepare($sql);
 297         $self->_execute($sth, @args);
 298
 299         my @r = ();
 300
 301         while(my $r = $sth->fetchrow_arrayref()) {
 302                 push(@r, $r->[0]);
 303         }
 304
 305         return @r;
 306 }
 307
 308
 309 sub search_stories {
 310         my $self        = shift;
 311         my $topic_id    = shift;
 312         my $query       = shift;
 313         my $future      = shift;
 314
 315         my @q = map { '%' . $_ . '%' } split(/\s+/, $query);
 316         my $cond = 'AND content LIKE ? ' x scalar(@q);
 317
 318         unless ($future) {
 319                 $cond .= 'AND date <= ? ';
 320                 push(@q, Gruta::Data::today());
 321         }
 322
 323         my $sql = 'SELECT id FROM stories WHERE topic_id = ? ' . $cond .
 324                 'ORDER BY date DESC';
 325
 326         my $sth = $self->_prepare($sql);
 327
 328         $self->_execute($sth, $topic_id, @q);
 329
 330         my @r = ();
 331
 332         while(my $r = $sth->fetchrow_arrayref()) {
 333                 push(@r, $r->[0]);
 334         }
 335
 336         return @r;
 337 }
 338
 339
 340 sub stories_top_ten {
 341         my $self        = shift;
 342         my $num         = shift;
 343
 344         my $sql = 'SELECT hits, topic_id, id FROM stories ' .
 345                 'ORDER BY hits DESC LIMIT ?';
 346
 347         my $sth = $self->_prepare($sql);
 348         $self->_execute($sth, $num);
 349
 350         my @r = ();
 351
 352         while (my @a = $sth->fetchrow_array()) {
 353                 push(@r, [ @a ]);
 354         }
 355
 356         return @r;
 357 }
 358
 359
 360 sub search_stories_by_tag {
 361         my $self        = shift;
 362         my $tag         = shift;
 363         my $future      = shift;
 364
 365         my @tags        = map { lc($_) } split(/\s*,\s*/, $tag);
 366
 367         my @r = ();
 368
 369         if (@tags) {
 370                 my $sql;
 371
 372                 if ($future) {
 373                         $sql = 'SELECT DISTINCT topic_id, id FROM tags WHERE ' .
 374                                 join(' OR ', map { 'tag = ?' } @tags);
 375                 }
 376                 else {
 377                         $sql = 'SELECT DISTINCT tags.topic_id, tags.id FROM tags, stories WHERE ' .
 378                                 'tags.topic_id = stories.topic_id AND tags.id = stories.id AND ' .
 379                                 "stories.date <= '" . Gruta::Data::today() . "' AND (" .
 380                                 join(' OR ', map { 'tag = ?' } @tags) . ')';
 381                 }
 382
 383                 my $sth = $self->_prepare($sql);
 384                 $self->_execute($sth, map { lc($_) } @tags);
 385
 386                 while (my @a = $sth->fetchrow_array()) {
 387                         push(@r, [ @a ]);
 388                 }
 389         }
 390
 391         return @r;
 392 }
 393
 394
 395 sub tags {
 396         my $self        = shift;
 397
 398         my @r = ();
 399
 400         my $sth = $self->_prepare(
 401                 'SELECT tag, count(tag) FROM tags GROUP BY tag');
 402         $self->_execute($sth);
 403
 404         while (my @a = $sth->fetchrow_array()) {
 405                 push(@r, [ @a ]);
 406         }
 407
 408         return @r;
 409 }
 410
 411 sub session { return _one( @_, 'Gruta::Data::DBI::Session' ); }
 412
 413 sub purge_old_sessions {
 414         my $self        = shift;
 415
 416         my $sth = $self->_prepare('DELETE FROM sids WHERE time < ?');
 417         $self->_execute($sth, time() - (60 * 60 * 24));
 418
 419         return undef;
 420 }
 421
 422
 423 sub _insert {
 424         my $self        = shift;
 425         my $obj         = shift;
 426         my $table       = shift;
 427         my $class       = shift;
 428
 429         my $sth;
 430
 431         bless($obj, $class);
 432         $obj->source($self);
 433
 434         if (not $sth = $self->{sth}->{insert}->{ref($obj)}) {
 435                 my $sql = 'INSERT INTO ' . $table .
 436                         ' (' . join(', ', $obj->fields()) . ')' .
 437                         ' VALUES (' . join(', ', map { '?' } $obj->fields()) . ')';
 438
 439                 $sth = $self->{sth}->{insert}->{ref($obj)} = $self->_prepare($sql);
 440         }
 441
 442         $self->_execute($sth, map { $obj->get($_) } $obj->fields());
 443
 444         return $obj;
 445 }
 446
 447 sub insert_topic { $_[0]->_insert($_[1], 'topics', 'Gruta::Data::DBI::Topic'); }
 448 sub insert_user { $_[0]->_insert($_[1], 'users', 'Gruta::Data::DBI::User'); }
 449
 450
 451 sub insert_story {
 452         my $self        = shift;
 453         my $story       = shift;
 454
 455         if (not $story->get('id')) {
 456                 # alloc an id for the story
 457                 my $id = undef;
 458
 459                 my $sth = $self->_prepare(
 460                         'SELECT 1 FROM stories WHERE topic_id = ? AND id = ?');
 461
 462                 do {
 463                         $id = $story->new_id();
 464                         $self->_execute($sth, $story->get('topic_id'), $id);
 465
 466                 } while $sth->fetchrow_arrayref();
 467
 468                 $story->set('id', $id);
 469         }
 470
 471         $self->_insert($story, 'stories', 'Gruta::Data::DBI::Story');
 472
 473         return $story;
 474 }
 475
 476 sub insert_session { $_[0]->_insert($_[1], 'sids', 'Gruta::Data::DBI::Session'); }
 477
 478 sub create {
 479         my $self        = shift;
 480
 481         eval {
 482                 my $sth = $self->_prepare('SELECT 1 FROM users');
 483         };
 484
 485         if (! $@) {
 486                 return $self;
 487         }
 488
 489         my $sql = '';
 490
 491         while(<DATA>) {
 492                 chomp;
 493
 494                 if (/^;$/) {
 495                         $self->{dbh}->do($sql);
 496                         $sql = '';
 497                 }
 498                 else {
 499                         $sql .= $_;
 500                 }
 501         }
 502
 503         return $self;
 504 }
 505
 506
 507 sub new {
 508         my $class = shift;
 509
 510         my $s = bless( { @_ }, $class);
 511
 512         $s->{dbh} = DBI->connect($s->{string},
 513                 $s->{user}, $s->{passwd}, { RaiseError => 1 });
 514
 515         return $s;
 516 }
 517
 518 1;
 519 __DATA__
 520 CREATE TABLE topics (
 521         id              VARCHAR PRIMARY KEY,
 522         name            VARCHAR,
 523         editors         VARCHAR,
 524         max_stories     INTEGER,
 525         internal        INTEGER
 526 )
 527 ;
 528 CREATE TABLE stories (
 529         id              VARCHAR NOT NULL,
 530         topic_id        VARCHAR NOT NULL,
 531         title           VARCHAR,
 532         date            CHAR(14),
 533         date2           CHAR(14),
 534         userid          VARCHAR,
 535         format          VARCHAR,
 536         hits            INTEGER DEFAULT 0,
 537         ctime           INTEGER,
 538         content         VARCHAR,
 539         PRIMARY KEY     (id, topic_id)
 540 )
 541 ;
 542 CREATE TABLE users (
 543         id              VARCHAR PRIMARY KEY,
 544         username        VARCHAR,
 545         email           VARCHAR,
 546         password        VARCHAR,
 547         can_upload      INTEGER,
 548         is_admin        INTEGER,
 549         xdate           CHAR(14)
 550 )
 551 ;
 552 CREATE TABLE sids (
 553         id              VARCHAR PRIMARY KEY,
 554         time            INTEGER,
 555         user_id         VARCHAR,
 556         ip              VARCHAR
 557 )
 558 ;
 559 CREATE TABLE tags (
 560         id              VARCHAR NOT NULL,
 561         topic_id        VARCHAR NOT NULL,
 562         tag             VARCHAR NOT NULL
 563 )
 564 ;
 565 CREATE INDEX stories_by_date ON stories (date)
 566 ;
 567 CREATE INDEX stories_by_hits ON stories (hits)
 568 ;
 569 CREATE INDEX tags_by_tag ON tags (tag)
 570 ;