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