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 { 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() .
 352                 $topic_id . '/.INDEX';
 353
 354         if (not open I, $index) {
 355
 356                 my @i = ();
 357                 foreach my $id ($self->stories($topic_id)) {
 358                         my $story = $self->story($topic_id, $id);
 359
 360                         push(@i, $story->get('date') . ':' . $id);
 361                 }
 362
 363                 open I, '>' . $index or croak "Can't create INDEX for $topic_id: $!";
 364                 flock I, 2;
 365
 366                 foreach my $l (reverse(sort(@i))) {
 367                         print I $l, "\n";
 368                 }
 369         }
 370
 371         close I;
 372
 373         return $index;
 374 }
 375
 376
 377 sub _update_top_ten {
 378         my $self        = shift;
 379         my $hits        = shift;
 380         my $topic_id    = shift;
 381         my $id          = shift;
 382
 383         my $index = $self->{path} . Gruta::Data::FS::Topic::base() . '/.top_ten';
 384
 385         my $u = 0;
 386         my @l = ();
 387
 388         if (open F, $index) {
 389                 flock F, 1;
 390                 while (my $l = <F>) {
 391                         chomp($l);
 392
 393                         my ($h, $t, $i) = split(':', $l);
 394
 395                         if ($u == 0 && $h < $hits) {
 396                                 $u = 1;
 397                                 push(@l, "$hits:$topic_id:$id");
 398                         }
 399
 400                         if ($t ne $topic_id or $i ne $id) {
 401                                 push(@l, $l);
 402                         }
 403                 }
 404
 405                 close F;
 406         }
 407
 408         if ($u == 0 && scalar(@l) < 100) {
 409                 $u = 1;
 410                 push(@l, "$hits:$topic_id:$id");
 411         }
 412
 413         if ($u) {
 414                 if (open F, '>' . $index) {
 415                         flock F, 2;
 416                         my $n = 0;
 417
 418                         foreach my $l (@l) {
 419                                 print F $l, "\n";
 420
 421                                 if (++$n == 100) {
 422                                         last;
 423                                 }
 424                         }
 425
 426                         close F;
 427                 }
 428         }
 429
 430         return undef;
 431 }
 432
 433
 434 sub stories_by_date {
 435         my $self        = shift;
 436         my $topic_id    = shift;
 437         my %args        = @_;
 438
 439         $args{offset} += 0;
 440         $args{offset} = 0 if $args{offset} < 0;
 441
 442         open I, $self->_topic_index($topic_id);
 443         flock I, 1;
 444
 445         my @r = ();
 446         my $o = 0;
 447
 448         while(<I>) {
 449                 chomp;
 450
 451                 my ($date, $id) = (/^(\d*):(.*)$/);
 452
 453                 # skip future stories
 454                 next if not $args{future} and $date > Gruta::Data::today();
 455
 456                 # skip if date is above the threshold
 457                 next if $args{'to'} and $date > $args{'to'};
 458
 459                 # exit if date is below the threshold
 460                 last if $args{'from'} and $date < $args{'from'};
 461
 462                 # skip offset stories
 463                 next if $args{'offset'} and ++$o <= $args{'offset'};
 464
 465                 push(@r, $id);
 466
 467                 # exit if we have all we need
 468                 last if $args{'num'} and $args{'num'} == scalar(@r);
 469         }
 470
 471         close I;
 472
 473         return @r;
 474 }
 475
 476 sub search_stories {
 477         my $self        = shift;
 478         my $topic_id    = shift;
 479         my $query       = shift;
 480         my $future      = shift;
 481
 482         my @q = split(/\s+/,$query);
 483
 484         my @r = ();
 485
 486         foreach my $id ($self->stories_by_date( $topic_id, future => $future )) {
 487
 488                 my $story = $self->story($topic_id, $id);
 489                 my $content = $story->get('content');
 490                 my $found = 0;
 491
 492                 # try complete query first
 493                 if($content =~ /\b$query\b/i) {
 494                         $found = scalar(@q);
 495                 }
 496                 else {
 497                         # try separate words
 498                         foreach my $q (@q) {
 499                                 if(length($q) > 1 and $content =~ /\b$q\b/i) {
 500                                         $found++;
 501                                 }
 502                         }
 503                 }
 504
 505                 push(@r, $id) if $found == scalar(@q);
 506         }
 507
 508         return @r;
 509 }
 510
 511 sub stories_top_ten {
 512         my $self        = shift;
 513         my $num         = shift;
 514
 515         my @r = ();
 516
 517         my $index = $self->{path} . Gruta::Data::FS::Topic::base() . '/.top_ten';
 518
 519         if (open F, $index) {
 520                 flock F, 1;
 521
 522                 while (defined(my $l = <F>) and $num--) {
 523                         chomp($l);
 524                         push(@r, [ split(':', $l) ]);
 525                 }
 526
 527                 close F;
 528         }
 529
 530         return @r;
 531 }
 532
 533
 534 sub _collect_tags {
 535         my $self = shift;
 536
 537         my @ret = ();
 538
 539         foreach my $topic_id ($self->topics()) {
 540
 541                 my $topic = $self->topic($topic_id);
 542
 543                 my $files = $topic->_filename();
 544                 $files =~ s/\.META$/\/*.TAGS/;
 545
 546                 my @ls = glob($files);
 547
 548                 foreach my $f (@ls) {
 549                         if (open F, $f) {
 550                                 my $tags = <F>;
 551                                 chomp $tags;
 552                                 close F;
 553
 554                                 my ($id) = ($f =~ m{/([^/]+)\.TAGS});
 555
 556                                 push(@ret,
 557                                         [ $topic_id, $id, [ split(/\s*,\s*/, $tags) ] ]
 558                                 );
 559                         }
 560                 }
 561         }
 562
 563         return @ret;
 564 }
 565
 566
 567 sub search_stories_by_tag {
 568         my $self        = shift;
 569         my $tag         = shift;
 570         my $future      = shift;
 571
 572         my @tags        = map { lc($_) } split(/\s*,\s*/, $tag);
 573
 574         my @ret = ();
 575
 576         foreach my $tr ($self->_collect_tags()) {
 577
 578                 foreach my $t (@{$tr->[2]}) {
 579                         if (grep(/^$t$/, @tags)) {
 580
 581                                 # if no future stories are to be shown,
 582                                 # discard them
 583                                 if (!$future) {
 584                                         my $story = $self->story(
 585                                                 $tr->[0], $tr->[1]
 586                                         );
 587
 588                                         if ($story->get('date') >
 589                                                 Gruta::Data::today()) {
 590                                                 last;
 591                                         }
 592                                 }
 593
 594                                 push(@ret, [ $tr->[0], $tr->[1] ]);
 595                                 last;
 596                         }
 597                 }
 598         }
 599
 600         return @ret;
 601 }
 602
 603
 604 sub tags {
 605         my $self        = shift;
 606
 607         my @ret = ();
 608         my %h = ();
 609
 610         foreach my $tr ($self->_collect_tags()) {
 611
 612                 foreach my $t (@{$tr->[2]}) {
 613                         $h{$t}++;
 614                 }
 615         }
 616
 617         foreach my $k (keys(%h)) {
 618                 push(@ret, [ $k, $h{$k} ]);
 619         }
 620
 621         return @ret;
 622 }
 623
 624
 625 sub session { return _one( @_, 'Gruta::Data::FS::Session' ); }
 626
 627 sub purge_old_sessions {
 628         my $self         = shift;
 629
 630         my $path = $self->{path} . Gruta::Data::FS::Session::base();
 631
 632         if (opendir D, $path) {
 633                 while(my $s = readdir D) {
 634                         my $f = $path . $s;
 635
 636                         next if -d $f;
 637
 638                         if (-M $f > 1) {
 639                                 unlink $f;
 640                         }
 641                 }
 642
 643                 closedir D;
 644         }
 645
 646         return undef;
 647 }
 648
 649
 650 sub _insert {
 651         my $self        = shift;
 652         my $obj         = shift;
 653         my $class       = shift;
 654
 655         bless($obj, $class);
 656         $obj->save( $self );
 657
 658         return $obj;
 659 }
 660
 661 sub insert_topic { $_[0]->_insert($_[1], 'Gruta::Data::FS::Topic'); }
 662 sub insert_user { $_[0]->_insert($_[1], 'Gruta::Data::FS::User'); }
 663
 664 sub insert_story {
 665         my $self        = shift;
 666         my $story       = shift;
 667
 668         if (not $story->get('id')) {
 669                 # alloc an id for the story
 670                 my $id = undef;
 671
 672                 do {
 673                         $id = $story->new_id();
 674
 675                 } while $self->story($story->get('topic_id'), $id);
 676
 677                 $story->set('id', $id);
 678         }
 679
 680         $self->_insert($story, 'Gruta::Data::FS::Story');
 681         return $story;
 682 }
 683
 684 sub insert_session { $_[0]->_insert($_[1], 'Gruta::Data::FS::Session'); }
 685
 686
 687 sub create {
 688         my $self        = shift;
 689
 690         mkdir $self->{path}, 0755;
 691         mkdir $self->{path} . Gruta::Data::FS::Topic::base(), 0755;
 692         mkdir $self->{path} . Gruta::Data::FS::User::base(), 0755;
 693         mkdir $self->{path} . Gruta::Data::FS::Session::base(), 0755;
 694 }
 695
 696
 697 sub new {
 698         my $class = shift;
 699
 700         my $s = bless( { @_ }, $class);
 701
 702         $s->_assert();
 703
 704         return $s;
 705 }
 706
 707 1;