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} && $args{today}) {
 276                 $sql .= ' AND date < ?';
 277                 push(@args, $args{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
 311         my @q = map { '%' . $_ . '%' } split(/\s+/, $query);
 312         my $like = 'AND content LIKE ? ' x scalar(@q);
 313
 314         my $sth = $self->_prepare(
 315                 'SELECT id FROM stories WHERE topic_id = ? ' . $like .
 316                 'ORDER BY date DESC');
 317
 318         $self->_execute($sth, $topic_id, @q);
 319
 320         my @r = ();
 321
 322         while(my $r = $sth->fetchrow_arrayref()) {
 323                 push(@r, $r->[0]);
 324         }
 325
 326         return @r;
 327 }
 328
 329
 330 sub stories_top_ten {
 331         my $self        = shift;
 332         my $num         = shift;
 333
 334         my $sql = 'SELECT hits, topic_id, id FROM stories ' .
 335                 'ORDER BY hits DESC LIMIT ?';
 336
 337         my $sth = $self->_prepare($sql);
 338         $self->_execute($sth, $num);
 339
 340         my @r = ();
 341
 342         while (my @a = $sth->fetchrow_array()) {
 343                 push(@r, [ @a ]);
 344         }
 345
 346         return @r;
 347 }
 348
 349
 350 sub search_stories_by_tag {
 351         my $self        = shift;
 352         my @tags        = @_;
 353
 354         my @r = ();
 355
 356         if (@tags) {
 357                 my $sql = 'SELECT DISTINCT topic_id, id FROM tags WHERE ' .
 358                         join(' OR ', map { 'tag = ?' } @tags);
 359
 360                 my $sth = $self->_prepare($sql);
 361                 $self->_execute($sth, map { lc($_) } @tags);
 362
 363                 while (my @a = $sth->fetchrow_array()) {
 364                         push(@r, [ @a ]);
 365                 }
 366         }
 367
 368         return @r;
 369 }
 370
 371
 372 sub tags {
 373         my $self        = shift;
 374
 375         my @r = ();
 376
 377         my $sth = $self->_prepare(
 378                 'SELECT tag, count(tag) FROM tags GROUP BY tag ORDER BY 2 DESC, 1');
 379         $self->_execute($sth);
 380
 381         while (my @a = $sth->fetchrow_array()) {
 382                 push(@r, [ @a ]);
 383         }
 384
 385         return @r;
 386 }
 387
 388 sub session { return _one( @_, 'Gruta::Data::DBI::Session' ); }
 389
 390 sub purge_old_sessions {
 391         my $self        = shift;
 392
 393         my $sth = $self->_prepare('DELETE FROM sids WHERE time < ?');
 394         $self->_execute($sth, time() - (60 * 60 * 24));
 395
 396         return undef;
 397 }
 398
 399
 400 sub _insert {
 401         my $self        = shift;
 402         my $obj         = shift;
 403         my $table       = shift;
 404         my $class       = shift;
 405
 406         my $sth;
 407
 408         bless($obj, $class);
 409         $obj->source($self);
 410
 411         if (not $sth = $self->{sth}->{insert}->{ref($obj)}) {
 412                 my $sql = 'INSERT INTO ' . $table .
 413                         ' (' . join(', ', $obj->fields()) . ')' .
 414                         ' VALUES (' . join(', ', map { '?' } $obj->fields()) . ')';
 415
 416                 $sth = $self->{sth}->{insert}->{ref($obj)} = $self->_prepare($sql);
 417         }
 418
 419         $self->_execute($sth, map { $obj->get($_) } $obj->fields());
 420
 421         return $obj;
 422 }
 423
 424 sub insert_topic { $_[0]->_insert($_[1], 'topics', 'Gruta::Data::DBI::Topic'); }
 425 sub insert_user { $_[0]->_insert($_[1], 'users', 'Gruta::Data::DBI::User'); }
 426
 427
 428 sub insert_story {
 429         my $self        = shift;
 430         my $story       = shift;
 431
 432         if (not $story->get('id')) {
 433                 # alloc an id for the story
 434                 my $id = undef;
 435
 436                 my $sth = $self->_prepare(
 437                         'SELECT 1 FROM stories WHERE topic_id = ? AND id = ?');
 438
 439                 do {
 440                         $id = $story->new_id();
 441                         $self->_execute($sth, $story->get('topic_id'), $id);
 442
 443                 } while $sth->fetchrow_arrayref();
 444
 445                 $story->set('id', $id);
 446         }
 447
 448         $self->_insert($story, 'stories', 'Gruta::Data::DBI::Story');
 449
 450         return $story;
 451 }
 452
 453 sub insert_session { $_[0]->_insert($_[1], 'sids', 'Gruta::Data::DBI::Session'); }
 454
 455 sub create {
 456         my $self        = shift;
 457
 458         my $sql = '';
 459
 460         while(<DATA>) {
 461                 chomp;
 462
 463                 if (/^;$/) {
 464                         $self->{dbh}->do($sql);
 465                         $sql = '';
 466                 }
 467                 else {
 468                         $sql .= $_;
 469                 }
 470         }
 471 }
 472
 473
 474 sub new {
 475         my $class = shift;
 476
 477         my $s = bless( { @_ }, $class);
 478
 479         $s->{dbh} = DBI->connect($s->{string},
 480                 $s->{user}, $s->{passwd}, { RaiseError => 1 });
 481
 482         return $s;
 483 }
 484
 485 1;
 486 __DATA__
 487 CREATE TABLE topics (
 488         id              VARCHAR PRIMARY KEY,
 489         name            VARCHAR,
 490         editors         VARCHAR,
 491         max_stories     INTEGER,
 492         internal        INTEGER
 493 )
 494 ;
 495 CREATE TABLE stories (
 496         id              VARCHAR NOT NULL,
 497         topic_id        VARCHAR NOT NULL,
 498         title           VARCHAR,
 499         date            VARCHAR,
 500         userid          VARCHAR,
 501         format          VARCHAR,
 502         hits            INTEGER,
 503         ctime           INTEGER,
 504         content         VARCHAR,
 505         PRIMARY KEY     (id, topic_id)
 506 )
 507 ;
 508 CREATE TABLE users (
 509         id              VARCHAR PRIMARY KEY,
 510         username        VARCHAR,
 511         email           VARCHAR,
 512         password        VARCHAR,
 513         can_upload      INTEGER,
 514         is_admin        INTEGER
 515 )
 516 ;
 517 CREATE TABLE sids (
 518         id              VARCHAR PRIMARY KEY,
 519         time            INTEGER,
 520         user_id         VARCHAR,
 521         ip              VARCHAR
 522 )
 523 ;
 524 CREATE TABLE tags (
 525         id              VARCHAR NOT NULL,
 526         topic_id        VARCHAR NOT NULL,
 527         tag             VARCHAR NOT NULL
 528 )
 529 ;
 530 CREATE INDEX stories_by_date ON stories (date)
 531 ;
 532 CREATE INDEX stories_by_hits ON stories (hits)
 533 ;