Gruta/Source/DBI.pm

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