Gruta/Source/FS.pm

   1 package Gruta::Source::FS;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Gruta::Data;
   7
   8 package Gruta::Data::FS::BASE;
   9
  10 use Carp;
  11
  12 sub ext { return '.META'; }
  13
  14 sub _filename {
  15         my $self        = shift;
  16
  17         $self->_assert();
  18         $self->source->_assert();
  19
  20         return $self->source->{path} . $self->base() .
  21                 $self->get('id') . $self->ext();
  22 }
  23
  24
  25 sub load {
  26         my $self        = shift;
  27         my $driver      = shift;
  28
  29         $self->source( $driver );
  30
  31         if (not open F, $self->_filename()) {
  32                 return undef;
  33         }
  34
  35         while (<F>) {
  36                 chop;
  37
  38                 if(/^([^:]*): (.*)$/) {
  39                         my ($key, $value) = ($1, $2);
  40
  41                         $key =~ s/-/_/g;
  42
  43                         if (grep (/^$key$/, $self->fields())) {
  44                                 $self->set($key, $value);
  45                         }
  46                 }
  47         }
  48
  49         close F;
  50
  51         return $self;
  52 }
  53
  54 sub save {
  55         my $self        = shift;
  56         my $driver      = shift;
  57
  58         $self->source( $driver ) if $driver;
  59
  60         my $filename = $self->_filename();
  61
  62         open F, '>' . $filename or croak "Can't write " . $filename . ': ' . $!;
  63
  64         foreach my $k ($self->fields()) {
  65                 my $f = $k;
  66
  67                 $f =~ s/_/-/g;
  68
  69                 print F $f . ': ' . ($self->get($k) || '') . "\n";
  70         }
  71
  72         close F;
  73
  74         return $self;
  75 }
  76
  77
  78 sub delete {
  79         my $self        = shift;
  80         my $driver      = shift;
  81
  82         $self->source( $driver ) if $driver;
  83
  84         unlink $self->_filename();
  85
  86         return $self;
  87 }
  88
  89 package Gruta::Data::FS::Story;
  90
  91 use base 'Gruta::Data::Story';
  92 use base 'Gruta::Data::FS::BASE';
  93
  94 sub base { return Gruta::Data::FS::Topic::base() . $_[0]->get('topic_id') . '/'; }
  95
  96 sub fields { grep !/content/, $_[0]->SUPER::fields(); }
  97 sub vfields { return ($_[0]->SUPER::vfields(), 'content'); }
  98
  99 sub save {
 100         my $self        = shift;
 101         my $driver      = shift;
 102
 103         $self->SUPER::save( $driver );
 104
 105         my $filename = $self->_filename();
 106         $filename =~ s/\.META$//;
 107
 108         open F, '>' . $filename or die "Can't write " . $filename . ': ' . $!;
 109
 110         print F $self->get('content') || '';
 111         close F;
 112
 113         # destroy the topic index, to be rewritten
 114         # in the future by _topic_index()
 115         $filename =~ s!/[^/]+$!/.INDEX!;
 116         unlink $filename;
 117
 118         return $self;
 119 }
 120
 121 sub touch {
 122         my $self = shift;
 123
 124         my $hits = $self->get('hits') + 1;
 125
 126         $self->set('hits', $hits);
 127         $self->save();
 128
 129         $self->source->_update_top_ten($hits, $self->get('topic_id'),
 130                 $self->get('id'));
 131
 132         return $self;
 133 }
 134
 135 sub tags {
 136         my $self        = shift;
 137         my @ret         = undef;
 138 }
 139
 140 package Gruta::Data::FS::Topic;
 141
 142 use base 'Gruta::Data::Topic';
 143 use base 'Gruta::Data::FS::BASE';
 144
 145 sub base { return '/topics/'; }
 146
 147 sub save {
 148         my $self        = shift;
 149         my $driver      = shift;
 150
 151         $self->SUPER::save( $driver );
 152
 153         my $filename = $self->_filename();
 154         $filename =~ s/\.META$//;
 155
 156         mkdir $filename;
 157
 158         return $self;
 159 }
 160
 161 package Gruta::Data::FS::User;
 162
 163 use base 'Gruta::Data::User';
 164 use base 'Gruta::Data::FS::BASE';
 165
 166 sub ext { return ''; }
 167 sub base { return '/users/'; }
 168
 169 package Gruta::Data::FS::Session;
 170
 171 use base 'Gruta::Data::Session';
 172 use base 'Gruta::Data::FS::BASE';
 173
 174 sub ext { return ''; }
 175 sub base { return '/sids/'; }
 176
 177 package Gruta::Source::FS;
 178
 179 sub _assert {
 180         my $self        = shift;
 181
 182         $self->{path} or die "Invalid path";
 183
 184         return $self;
 185 }
 186
 187 sub _one {
 188         my $self        = shift;
 189         my $id          = shift;
 190         my $class       = shift;
 191
 192         my $o = ${class}->new( id => $id );
 193         $o->load( $self );
 194 }
 195
 196 sub topic { return _one( @_, 'Gruta::Data::FS::Topic' ); }
 197
 198 sub topics {
 199         my $self        = shift;
 200
 201         my @ret = ();
 202
 203         my $path = $self->{path} . Gruta::Data::FS::Topic::base();
 204
 205         if (opendir D, $path) {
 206                 while (my $id = readdir D) {
 207                         next unless -d $path . $id;
 208                         next if $id =~ /^\./;
 209
 210                         push @ret, $id;
 211                 }
 212
 213                 closedir D;
 214         }
 215
 216         return @ret;
 217 }
 218
 219 sub user { return _one( @_, 'Gruta::Data::FS::User' ); }
 220
 221 sub users {
 222         my $self        = shift;
 223
 224         my @ret = ();
 225
 226         my $path = $self->{path} . Gruta::Data::FS::User::base();
 227
 228         if (opendir D, $path) {
 229                 while (my $id = readdir D) {
 230                         next if -d $path . $id;
 231                         push @ret, $id;
 232                 }
 233
 234                 closedir D;
 235         }
 236
 237         return @ret;
 238 }
 239
 240 sub story {
 241         my $self        = shift;
 242         my $topic_id    = shift;
 243         my $id          = shift;
 244
 245         my $story = Gruta::Data::FS::Story->new( topic_id => $topic_id, id => $id );
 246         if (not $story->load( $self )) {
 247
 248                 $story = Gruta::Data::FS::Story->new( topic_id => $topic_id . '-arch',
 249                         id => $id );
 250
 251                 if (not $story->load( $self )) {
 252                         return undef;
 253                 }
 254         }
 255
 256         # now load the content
 257         my $file = $story->_filename();
 258         $file =~ s/\.META$//;
 259
 260         open F, $file or die "Can't open $file content: $!";
 261
 262         $story->set('content', join('', <F>));
 263         close F;
 264
 265         return $story;
 266 }
 267
 268 sub stories {
 269         my $self        = shift;
 270         my $topic_id    = shift;
 271
 272         my @ret = ();
 273
 274         my $path = $self->{path} . Gruta::Data::FS::Topic::base() . $topic_id;
 275
 276         if (opendir D, $path) {
 277                 while (my $id = readdir D) {
 278                         if ($id =~ s/\.META$//) {
 279                                 push(@ret, $id);
 280                         }
 281                 }
 282
 283                 closedir D;
 284         }
 285
 286         return @ret;
 287 }
 288
 289
 290 sub _topic_index {
 291         my $self        = shift;
 292         my $topic_id    = shift;
 293
 294         my $index = $self->{path} . Gruta::Data::FS::Topic::base() .
 295                 $topic_id . '/.INDEX';
 296
 297         if (not open I, $index) {
 298
 299                 my @i = ();
 300                 foreach my $id ($self->stories($topic_id)) {
 301                         my $story = $self->story($topic_id, $id);
 302
 303                         push(@i, $story->get('date') . ':' . $id);
 304                 }
 305
 306                 open I, '>' . $index or die "Can't create INDEX for $topic_id: $!";
 307                 flock I, 2;
 308
 309                 foreach my $l (reverse(sort(@i))) {
 310                         print I $l, "\n";
 311                 }
 312         }
 313
 314         close I;
 315
 316         return $index;
 317 }
 318
 319
 320 sub _update_top_ten {
 321         my $self        = shift;
 322         my $hits        = shift;
 323         my $topic_id    = shift;
 324         my $id          = shift;
 325
 326         my $index = $self->{path} . Gruta::Data::FS::Topic::base() . '/.top_ten';
 327
 328         my $u = 0;
 329         my @l = ();
 330
 331         if (open F, $index) {
 332                 flock F, 1;
 333                 while (my $l = <F>) {
 334                         chomp($l);
 335
 336                         my ($h, $t, $i) = split(':', $l);
 337
 338                         if ($u == 0 && $h < $hits) {
 339                                 $u = 1;
 340                                 push(@l, "$hits:$topic_id:$id");
 341                         }
 342
 343                         if ($t ne $topic_id or $i ne $id) {
 344                                 push(@l, $l);
 345                         }
 346                 }
 347
 348                 close F;
 349         }
 350
 351         if ($u == 0 && scalar(@l) < 100) {
 352                 $u = 1;
 353                 push(@l, "$hits:$topic_id:$id");
 354         }
 355
 356         if ($u) {
 357                 if (open F, '>' . $index) {
 358                         flock F, 2;
 359                         my $n = 0;
 360
 361                         foreach my $l (@l) {
 362                                 print F $l, "\n";
 363
 364                                 if (++$n == 100) {
 365                                         last;
 366                                 }
 367                         }
 368
 369                         close F;
 370                 }
 371         }
 372
 373         return undef;
 374 }
 375
 376
 377 sub stories_by_date {
 378         my $self        = shift;
 379         my $topic_id    = shift;
 380         my %args        = @_;
 381
 382         $args{offset} += 0;
 383         $args{offset} = 0 if $args{offset} < 0;
 384
 385         open I, $self->_topic_index($topic_id);
 386         flock I, 1;
 387
 388         my @r = ();
 389         my $o = 0;
 390
 391         while(<I>) {
 392                 chomp;
 393
 394                 my ($date, $id) = (/^(\d*):(.*)$/);
 395
 396                 # skip future stories
 397                 next if not $args{future} and
 398                         $args{today} and
 399                         $date > $args{today};
 400
 401                 # skip if date is above the threshold
 402                 next if $args{'to'} and $date > $args{'to'};
 403
 404                 # exit if date is below the threshold
 405                 last if $args{'from'} and $date < $args{'from'};
 406
 407                 # skip offset stories
 408                 next if $args{'offset'} and ++$o <= $args{'offset'};
 409
 410                 push(@r, $id);
 411
 412                 # exit if we have all we need
 413                 last if $args{'num'} and $args{'num'} == scalar(@r);
 414         }
 415
 416         close I;
 417
 418         return @r;
 419 }
 420
 421 sub search_stories {
 422         my $self        = shift;
 423         my $topic_id    = shift;
 424         my $query       = shift;
 425
 426         my @q = split(/\s+/,$query);
 427
 428         my @r = ();
 429
 430         foreach my $id ($self->stories_by_date( $topic_id )) {
 431
 432                 my $story = $self->story($topic_id, $id);
 433                 my $content = $story->get('content');
 434                 my $found = 0;
 435
 436                 # try complete query first
 437                 if($content =~ /\b$query\b/i) {
 438                         $found = 1;
 439                 }
 440                 else {
 441                         # try separate words
 442                         foreach my $q (@q) {
 443                                 if(length($q) > 1 and $content =~ /\b$q\b/i) {
 444                                         $found = 1;
 445                                         last;
 446                                 }
 447                         }
 448                 }
 449
 450                 push(@r, $id) if $found;
 451         }
 452
 453         return @r;
 454 }
 455
 456 sub stories_top_ten {
 457         my $self        = shift;
 458         my $num         = shift;
 459
 460         my @r = ();
 461
 462         my $index = $self->{path} . Gruta::Data::FS::Topic::base() . '/.top_ten';
 463
 464         if (open F, $index) {
 465                 flock F, 1;
 466
 467                 while (defined(my $l = <F>) and $num--) {
 468                         chomp($l);
 469                         push(@r, [ split(':', $l) ]);
 470                 }
 471
 472                 close F;
 473         }
 474
 475         return @r;
 476 }
 477
 478
 479 sub stories_by_tag {
 480         my $self        = shift;
 481         my @tags        = shift;
 482
 483         return ();
 484 }
 485
 486
 487 sub tags {
 488         my $self        = shift;
 489
 490         return ();
 491 }
 492
 493
 494 sub session { return _one( @_, 'Gruta::Data::FS::Session' ); }
 495
 496 sub purge_old_sessions {
 497         my $self         = shift;
 498
 499         my $path = $self->{path} . Gruta::Data::FS::Session::Base();
 500
 501         if (opendir D, $path) {
 502                 while(my $s = readdir D) {
 503                         my $f = $path . $s;
 504
 505                         next if -d $f;
 506
 507                         if (-M $f) {
 508                                 unlink $f;
 509                         }
 510                 }
 511
 512                 closedir D;
 513         }
 514
 515         return undef;
 516 }
 517
 518
 519 sub _insert {
 520         my $self        = shift;
 521         my $obj         = shift;
 522         my $class       = shift;
 523
 524         bless($obj, $class);
 525         $obj->save( $self );
 526
 527         return $obj;
 528 }
 529
 530 sub insert_topic { $_[0]->_insert($_[1], 'Gruta::Data::FS::Topic'); }
 531 sub insert_user { $_[0]->_insert($_[1], 'Gruta::Data::FS::User'); }
 532
 533 sub insert_story {
 534         my $self        = shift;
 535         my $story       = shift;
 536
 537         if (not $story->get('id')) {
 538                 # alloc an id for the story
 539                 my $id = time();
 540
 541                 while ($self->story($story->get('topic_id'), $id)) {
 542                         $id++;
 543                 }
 544
 545                 $story->set('id', $id);
 546         }
 547
 548         $self->_insert($story, 'Gruta::Data::FS::Story');
 549         return $story;
 550 }
 551
 552 sub insert_session { $_[0]->_insert($_[1], 'Gruta::Data::FS::Session'); }
 553
 554
 555 sub create {
 556         my $self        = shift;
 557
 558         mkdir $self->{path}, 0755;
 559         mkdir $self->{path} . Gruta::Data::FS::Topic::base(), 0755;
 560         mkdir $self->{path} . Gruta::Data::FS::User::base(), 0755;
 561         mkdir $self->{path} . Gruta::Data::FS::Session::base(), 0755;
 562 }
 563
 564
 565 sub new {
 566         my $class = shift;
 567
 568         my $s = bless( { @_ }, $class);
 569
 570         $s->_assert();
 571
 572         return $s;
 573 }
 574
 575 1;