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 use Carp;
  95
  96 sub base { return Gruta::Data::FS::Topic::base() . $_[0]->get('topic_id') . '/'; }
  97
  98 sub fields { grep !/content/, $_[0]->SUPER::fields(); }
  99 sub vfields { return ($_[0]->SUPER::vfields(), 'content'); }
 100
 101 sub load {
 102         my $self        = shift;
 103         my $driver      = shift;
 104
 105         # save current topic id
 106         # (as it may be stored in the .META file and
 107         # be false, v.g. if archived)
 108         my $topic_id = $self->get('topic_id');
 109
 110         $self->SUPER::load( $driver );
 111
 112         # restore topic id
 113         $self->set('topic_id', $topic_id);
 114
 115         return $self;
 116 }
 117
 118
 119 sub _destroy_index {
 120         my $self        = shift;
 121
 122         my $filename = $self->_filename();
 123
 124         # destroy the topic index, to be rewritten
 125         # in the future by _topic_index()
 126         $filename =~ s!/[^/]+$!/.INDEX!;
 127         unlink $filename;
 128 }
 129
 130 sub save {
 131         my $self        = shift;
 132         my $driver      = shift;
 133
 134         $self->SUPER::save( $driver );
 135
 136         my $filename = $self->_filename();
 137         $filename =~ s/\.META$//;
 138
 139         open F, '>' . $filename or croak "Can't write " . $filename . ': ' . $!;
 140
 141         print F $self->get('content') || '';
 142         close F;
 143
 144         $self->_destroy_index();
 145
 146         return $self;
 147 }
 148
 149 sub touch {
 150         my $self = shift;
 151
 152         my $hits = $self->get('hits') + 1;
 153
 154         $self->set('hits', $hits);
 155
 156         # call $self->SUPER::save() instead of $self->save()
 157         # to avoid saving content (unnecessary) and deleting
 158         # the topic INDEX (even probably dangerous)
 159         $self->SUPER::save();
 160
 161         $self->source->_update_top_ten($hits, $self->get('topic_id'),
 162                 $self->get('id'));
 163
 164         return $self;
 165 }
 166
 167 sub tags {
 168         my $self        = shift;
 169         my @ret         = ();
 170
 171         my $filename = $self->_filename();
 172         $filename =~ s/\.META$/.TAGS/;
 173
 174         if (scalar(@_)) {
 175                 if (open F, '>' . $filename) {
 176                         print F join(', ', map { lc($_) } @_), "\n";
 177                         close F;
 178                 }
 179         }
 180         else {
 181                 if (open F, $filename) {
 182                         my $l = <F>;
 183                         close F;
 184
 185                         chomp($l);
 186                         @ret = split(/,\s+/, $l);
 187                 }
 188         }
 189
 190         return @ret;
 191 }
 192
 193 sub delete {
 194         my $self        = shift;
 195         my $driver      = shift;
 196
 197         my $file = $self->_filename();
 198
 199         $self->SUPER::delete($driver);
 200
 201         # also delete content and TAGS
 202         $file =~ s/\.META$//;
 203
 204         unlink $file;
 205         unlink $file . '.TAGS';
 206
 207         return $self;
 208 }
 209
 210
 211 package Gruta::Data::FS::Topic;
 212
 213 use base 'Gruta::Data::Topic';
 214 use base 'Gruta::Data::FS::BASE';
 215
 216 sub base { return '/topics/'; }
 217
 218 sub save {
 219         my $self        = shift;
 220         my $driver      = shift;
 221
 222         $self->SUPER::save( $driver );
 223
 224         my $filename = $self->_filename();
 225         $filename =~ s/\.META$//;
 226
 227         mkdir $filename;
 228
 229         return $self;
 230 }
 231
 232 package Gruta::Data::FS::User;
 233
 234 use base 'Gruta::Data::User';
 235 use base 'Gruta::Data::FS::BASE';
 236
 237 sub ext { return ''; }
 238 sub base { return '/users/'; }
 239
 240 package Gruta::Data::FS::Session;
 241
 242 use base 'Gruta::Data::Session';
 243 use base 'Gruta::Data::FS::BASE';
 244
 245 sub ext { return ''; }
 246 sub base { return '/sids/'; }
 247
 248 package Gruta::Source::FS;
 249
 250 use Carp;
 251
 252 sub _assert {
 253         my $self        = shift;
 254
 255         $self->{path} or croak "Invalid path";
 256
 257         return $self;
 258 }
 259
 260 sub _one {
 261         my $self        = shift;
 262         my $id          = shift;
 263         my $class       = shift;
 264
 265         my $o = ${class}->new( id => $id );
 266         $o->load( $self );
 267 }
 268
 269 sub topic { return _one( @_, 'Gruta::Data::FS::Topic' ); }
 270
 271 sub topics {
 272         my $self        = shift;
 273
 274         my @ret = ();
 275
 276         my $path = $self->{path} . Gruta::Data::FS::Topic::base();
 277
 278         if (opendir D, $path) {
 279                 while (my $id = readdir D) {
 280                         next unless -d $path . $id;
 281                         next if $id =~ /^\./;
 282
 283                         push @ret, $id;
 284                 }
 285
 286                 closedir D;
 287         }
 288
 289         return @ret;
 290 }
 291
 292 sub user { return _one( @_, 'Gruta::Data::FS::User' ); }
 293
 294 sub users {
 295         my $self        = shift;
 296
 297         my @ret = ();
 298
 299         my $path = $self->{path} . Gruta::Data::FS::User::base();
 300
 301         if (opendir D, $path) {
 302                 while (my $id = readdir D) {
 303                         next if -d $path . $id;
 304                         push @ret, $id;
 305                 }
 306
 307                 closedir D;
 308         }
 309
 310         return @ret;
 311 }
 312
 313 sub story {
 314         my $self        = shift;
 315         my $topic_id    = shift;
 316         my $id          = shift;
 317
 318         my $story = Gruta::Data::FS::Story->new( topic_id => $topic_id, id => $id );
 319         if (not $story->load( $self )) {
 320
 321                 $story = Gruta::Data::FS::Story->new( topic_id => $topic_id . '-arch',
 322                         id => $id );
 323
 324                 if (not $story->load( $self )) {
 325                         return undef;
 326                 }
 327         }
 328
 329         # now load the content
 330         my $file = $story->_filename();
 331         $file =~ s/\.META$//;
 332
 333         open F, $file or croak "Can't open $file content: $!";
 334
 335         $story->set('content', join('', <F>));
 336         close F;
 337
 338         return $story;
 339 }
 340
 341 sub stories {
 342         my $self        = shift;
 343         my $topic_id    = shift;
 344
 345         my @ret = ();
 346
 347         my $path = $self->{path} . Gruta::Data::FS::Topic::base() . $topic_id;
 348
 349         if (opendir D, $path) {
 350                 while (my $id = readdir D) {
 351                         if ($id =~ s/\.META$//) {
 352                                 push(@ret, $id);
 353                         }
 354                 }
 355
 356                 closedir D;
 357         }
 358
 359         return @ret;
 360 }
 361
 362
 363 sub _topic_index {
 364         my $self        = shift;
 365         my $topic_id    = shift;
 366
 367         my $index = $self->{path} . Gruta::Data::FS::Topic::base() .
 368                 $topic_id . '/.INDEX';
 369
 370         if (not open I, $index) {
 371
 372                 my @i = ();
 373                 foreach my $id ($self->stories($topic_id)) {
 374                         my $story = $self->story($topic_id, $id);
 375
 376                         push(@i, $story->get('date') . ':' . $id);
 377                 }
 378
 379                 open I, '>' . $index or croak "Can't create INDEX for $topic_id: $!";
 380                 flock I, 2;
 381
 382                 foreach my $l (reverse(sort(@i))) {
 383                         print I $l, "\n";
 384                 }
 385         }
 386
 387         close I;
 388
 389         return $index;
 390 }
 391
 392
 393 sub _update_top_ten {
 394         my $self        = shift;
 395         my $hits        = shift;
 396         my $topic_id    = shift;
 397         my $id          = shift;
 398
 399         my $index = $self->{path} . Gruta::Data::FS::Topic::base() . '/.top_ten';
 400
 401         my $u = 0;
 402         my @l = ();
 403
 404         if (open F, $index) {
 405                 flock F, 1;
 406                 while (my $l = <F>) {
 407                         chomp($l);
 408
 409                         my ($h, $t, $i) = split(':', $l);
 410
 411                         if ($u == 0 && $h < $hits) {
 412                                 $u = 1;
 413                                 push(@l, "$hits:$topic_id:$id");
 414                         }
 415
 416                         if ($t ne $topic_id or $i ne $id) {
 417                                 push(@l, $l);
 418                         }
 419                 }
 420
 421                 close F;
 422         }
 423
 424         if ($u == 0 && scalar(@l) < 100) {
 425                 $u = 1;
 426                 push(@l, "$hits:$topic_id:$id");
 427         }
 428
 429         if ($u) {
 430                 if (open F, '>' . $index) {
 431                         flock F, 2;
 432                         my $n = 0;
 433
 434                         foreach my $l (@l) {
 435                                 print F $l, "\n";
 436
 437                                 if (++$n == 100) {
 438                                         last;
 439                                 }
 440                         }
 441
 442                         close F;
 443                 }
 444         }
 445
 446         return undef;
 447 }
 448
 449
 450 sub stories_by_date {
 451         my $self        = shift;
 452         my $topic_id    = shift;
 453         my %args        = @_;
 454
 455         $args{offset} += 0;
 456         $args{offset} = 0 if $args{offset} < 0;
 457
 458         open I, $self->_topic_index($topic_id);
 459         flock I, 1;
 460
 461         my @r = ();
 462         my $o = 0;
 463
 464         while(<I>) {
 465                 chomp;
 466
 467                 my ($date, $id) = (/^(\d*):(.*)$/);
 468
 469                 # skip future stories
 470                 next if not $args{future} and
 471                         $args{today} and
 472                         $date > $args{today};
 473
 474                 # skip if date is above the threshold
 475                 next if $args{'to'} and $date > $args{'to'};
 476
 477                 # exit if date is below the threshold
 478                 last if $args{'from'} and $date < $args{'from'};
 479
 480                 # skip offset stories
 481                 next if $args{'offset'} and ++$o <= $args{'offset'};
 482
 483                 push(@r, $id);
 484
 485                 # exit if we have all we need
 486                 last if $args{'num'} and $args{'num'} == scalar(@r);
 487         }
 488
 489         close I;
 490
 491         return @r;
 492 }
 493
 494 sub search_stories {
 495         my $self        = shift;
 496         my $topic_id    = shift;
 497         my $query       = shift;
 498
 499         my @q = split(/\s+/,$query);
 500
 501         my @r = ();
 502
 503         foreach my $id ($self->stories_by_date( $topic_id )) {
 504
 505                 my $story = $self->story($topic_id, $id);
 506                 my $content = $story->get('content');
 507                 my $found = 0;
 508
 509                 # try complete query first
 510                 if($content =~ /\b$query\b/i) {
 511                         $found = 1;
 512                 }
 513                 else {
 514                         # try separate words
 515                         foreach my $q (@q) {
 516                                 if(length($q) > 1 and $content =~ /\b$q\b/i) {
 517                                         $found = 1;
 518                                         last;
 519                                 }
 520                         }
 521                 }
 522
 523                 push(@r, $id) if $found;
 524         }
 525
 526         return @r;
 527 }
 528
 529 sub stories_top_ten {
 530         my $self        = shift;
 531         my $num         = shift;
 532
 533         my @r = ();
 534
 535         my $index = $self->{path} . Gruta::Data::FS::Topic::base() . '/.top_ten';
 536
 537         if (open F, $index) {
 538                 flock F, 1;
 539
 540                 while (defined(my $l = <F>) and $num--) {
 541                         chomp($l);
 542                         push(@r, [ split(':', $l) ]);
 543                 }
 544
 545                 close F;
 546         }
 547
 548         return @r;
 549 }
 550
 551
 552 sub search_stories_by_tag {
 553         my $self        = shift;
 554         my @tags        = shift;
 555
 556         my @ret = ();
 557
 558         foreach my $topic_id ($self->topics()) {
 559
 560                 my $topic = $self->topic($topic_id);
 561
 562                 my $files = $topic->_filename();
 563                 $files =~ s/\.META$/\/*.TAGS/;
 564
 565                 my @ls = glob($files);
 566
 567                 foreach my $f (@ls) {
 568                         if (open F, $f) {
 569                                 my $tags = <F>;
 570                                 chomp $tags;
 571                                 close F;
 572
 573                                 foreach my $t (split(/,\s+/, $tags)) {
 574                                         if (grep(/$t/, @tags)) {
 575                                                 my ($id) = ($f =~ m{/([^/]+)\.TAGS});
 576
 577                                                 push(@ret, [ $topic_id, $id ]);
 578                                                 last;
 579                                         }
 580                                 }
 581                         }
 582                 }
 583         }
 584
 585         return @ret;
 586 }
 587
 588
 589 sub tags {
 590         my $self        = shift;
 591
 592         return ();
 593 }
 594
 595
 596 sub session { return _one( @_, 'Gruta::Data::FS::Session' ); }
 597
 598 sub purge_old_sessions {
 599         my $self         = shift;
 600
 601         my $path = $self->{path} . Gruta::Data::FS::Session::base();
 602
 603         if (opendir D, $path) {
 604                 while(my $s = readdir D) {
 605                         my $f = $path . $s;
 606
 607                         next if -d $f;
 608
 609                         if (-M $f > 1) {
 610                                 unlink $f;
 611                         }
 612                 }
 613
 614                 closedir D;
 615         }
 616
 617         return undef;
 618 }
 619
 620
 621 sub _insert {
 622         my $self        = shift;
 623         my $obj         = shift;
 624         my $class       = shift;
 625
 626         bless($obj, $class);
 627         $obj->save( $self );
 628
 629         return $obj;
 630 }
 631
 632 sub insert_topic { $_[0]->_insert($_[1], 'Gruta::Data::FS::Topic'); }
 633 sub insert_user { $_[0]->_insert($_[1], 'Gruta::Data::FS::User'); }
 634
 635 sub insert_story {
 636         my $self        = shift;
 637         my $story       = shift;
 638
 639         if (not $story->get('id')) {
 640                 # alloc an id for the story
 641                 my $id = time();
 642
 643                 while ($self->story($story->get('topic_id'), $id)) {
 644                         $id++;
 645                 }
 646
 647                 $story->set('id', $id);
 648         }
 649
 650         $self->_insert($story, 'Gruta::Data::FS::Story');
 651         return $story;
 652 }
 653
 654 sub insert_session { $_[0]->_insert($_[1], 'Gruta::Data::FS::Session'); }
 655
 656
 657 sub create {
 658         my $self        = shift;
 659
 660         mkdir $self->{path}, 0755;
 661         mkdir $self->{path} . Gruta::Data::FS::Topic::base(), 0755;
 662         mkdir $self->{path} . Gruta::Data::FS::User::base(), 0755;
 663         mkdir $self->{path} . Gruta::Data::FS::Session::base(), 0755;
 664 }
 665
 666
 667 sub new {
 668         my $class = shift;
 669
 670         my $s = bless( { @_ }, $class);
 671
 672         $s->_assert();
 673
 674         return $s;
 675 }
 676
 677 1;