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