Gruta.pm

   1 package Gruta;
   2
   3 use strict;
   4 use warnings;
   5
   6 use locale;
   7
   8 use Gruta::Data;
   9
  10 $Gruta::VERSION = '2.0.0-rc3';
  11
  12 sub sources { return @{$_[0]->{sources}}; }
  13 sub template { return $_[0]->{template}; }
  14 sub cgi { return $_[0]->{cgi}; }
  15
  16 sub version { return $Gruta::VERSION; }
  17
  18 sub log {
  19         my $self        = shift;
  20         my $msg         = shift;
  21
  22         print STDERR $self->{id}, ' ', scalar(localtime), ': ', $msg, "\n";
  23 }
  24
  25
  26 sub _call {
  27         my $self        = shift;
  28         my $method      = shift;
  29         my $short       = shift;
  30
  31         my @r = ();
  32
  33         foreach my $s ($self->sources()) {
  34                 if (my $m = $s->can($method)) {
  35                         my @pr = $m->($s, @_);
  36
  37                         if (@pr && $pr[0]) {
  38                                 @r = (@r, @pr);
  39
  40                                 last if $short;
  41                         }
  42                 }
  43         }
  44
  45         return wantarray ? @r : $r[0];
  46 }
  47
  48 sub topic { my $self = shift; return $self->_call('topic', 1, @_); }
  49 sub topics { my $self = shift; return $self->_call('topics', 0); }
  50
  51 sub user { my $self = shift; return $self->_call('user', 1, @_); }
  52 sub users { my $self = shift; return $self->_call('users', 0); }
  53
  54 sub story {
  55         my $self        = shift;
  56         my $topic_id    = shift;
  57         my $id          = shift;
  58
  59         if (! $topic_id || ! $id) {
  60                 return undef;
  61         }
  62
  63         my $story = undef;
  64         my $ck = $topic_id . '/' . $id;
  65
  66         if ($story = $self->{story_cache}->{$ck}) {
  67                 return $story;
  68         }
  69
  70         if (not $story = $self->_call('story', 1, $topic_id, $id)) {
  71                 return undef;
  72         }
  73
  74         my $format = $story->get('format') || 'grutatxt';
  75
  76         if (my $rndr = $self->{renderers_h}->{$format}) {
  77                 $rndr->story($story);
  78         }
  79
  80         return $self->{story_cache}->{$ck} = $story;
  81 }
  82
  83
  84 sub stories { my $self = shift; return $self->_call('stories', 0, @_); }
  85
  86 sub stories_by_date {
  87         my $self        = shift;
  88         my $topics      = shift;
  89         my %opts        = @_;
  90
  91         if (!$topics) {
  92                 $topics = [ $self->topics() ];
  93         }
  94
  95         my @r = sort { $b->[2] cmp $a->[2] } $self->_call('stories_by_date', 0, $topics, %opts);
  96
  97         if (defined($opts{num}) && scalar(@r) > $opts{num}) {
  98                 @r = @r[0 .. $opts{num} - 1];
  99         }
 100
 101         return @r;
 102 }
 103
 104 sub search_stories {
 105         my $self        = shift;
 106         my $topic_id    = shift;
 107
 108         my @l = $self->_call('search_stories', 1, $topic_id, @_);
 109
 110         return sort { $self->story($topic_id, $a)->get('title') cmp
 111                         $self->story($topic_id, $b)->get('title') } @l;
 112 }
 113
 114 sub stories_top_ten {
 115         my $self = shift;
 116
 117         my @l = $self->_call('stories_top_ten', 0, @_);
 118
 119         return sort { $b->[0] <=> $a->[0] } @l;
 120 }
 121
 122 sub search_stories_by_tag {
 123         my $self = shift;
 124
 125         my @l = $self->_call('search_stories_by_tag', 0, @_);
 126
 127         return sort { $self->story($a->[0], $a->[1])->get('title') cmp
 128                         $self->story($b->[0], $b->[1])->get('title') } @l;
 129 }
 130
 131 sub tags {
 132         my $self = shift;
 133
 134         my @l = $self->_call('tags', 0, @_);
 135
 136         return sort { $a->[0] cmp $b->[0] } @l;
 137 }
 138
 139 sub insert_topic { my $self = shift; return $self->_call('insert_topic', 1, @_); }
 140 sub insert_user { my $self = shift; return $self->_call('insert_user', 1, @_); }
 141 sub insert_story { my $self = shift; return $self->_call('insert_story', 1, @_); }
 142
 143
 144 sub auth {
 145         my $self        = shift;
 146
 147         if (@_) { $self->{auth} = shift; }      # Gruta::Data::User
 148
 149         return $self->{auth};
 150 }
 151
 152
 153 sub auth_from_sid {
 154         my $self        = shift;
 155         my $sid         = shift;
 156
 157         my $u = undef;
 158
 159         if ($sid) {
 160                 $self->_call('purge_old_sessions', 0);
 161
 162                 if (my $session = $self->_call('session', 1, $sid)) {
 163                         $u = $session->source->user( $session->get('user_id') );
 164                         $u->set('sid', $sid);
 165                         $self->auth($u);
 166                 }
 167         }
 168
 169         return $u;
 170 }
 171
 172
 173 sub login {
 174         my $self        = shift;
 175         my $user_id     = shift;
 176         my $passwd      = shift;
 177
 178         my $sid = undef;
 179
 180         if (my $u = $self->user( $user_id )) {
 181
 182                 # account expired? go!
 183                 if (my $xdate = $u->get('xdate')) {
 184                         if (Gruta::Data::today() > $xdate) {
 185                                 return undef;
 186                         }
 187                 }
 188
 189                 my $p = $u->get('password');
 190
 191                 if (crypt($passwd, $p) eq $p) {
 192                         # create new sid
 193                         $sid = time() . $$;
 194
 195                         my $session = Gruta::Data::Session->new(
 196                                 id      => $sid,
 197                                 time    => time(),
 198                                 user_id => $user_id
 199                         );
 200
 201                         $u->source->insert_session( $session );
 202
 203                         $u->set('sid', $sid);
 204                         $self->auth($u);
 205                 }
 206         }
 207
 208         return $sid;
 209 }
 210
 211
 212 sub logout {
 213         my $self        = shift;
 214
 215         if (my $auth = $self->auth()) {
 216                 if( my $sid = $auth->get('sid')) {
 217                         if (my $session = $auth->source->session( $sid )) {
 218                                 $session->delete() if $session->can('delete');
 219                         }
 220                 }
 221         }
 222
 223         $self->auth( undef );
 224         return $self;
 225 }
 226
 227
 228 sub _topic_special_uri {
 229         my $self        = shift;
 230         my $topic_id    = shift;
 231
 232         my $ret = undef;
 233
 234         if (my $t = $self->topic($topic_id)) {
 235                 $ret = "<a href='?t=TOPIC;topic=$topic_id'>" .
 236                         $t->get('name') . '</a>';
 237         }
 238         else {
 239                 $ret = "Bad topic $topic_id";
 240         }
 241
 242         return $ret;
 243 }
 244
 245
 246 sub _story_special_uri {
 247         my $self        = shift;
 248         my $topic_id    = shift;
 249         my $story_id    = shift;
 250
 251         my $ret = undef;
 252
 253         if (my $s = $self->story($topic_id, $story_id)) {
 254                 $ret = "<a href='?t=STORY;topic=$topic_id;id=$story_id'>" .
 255                         $s->get('title') . '</a>';
 256         }
 257         else {
 258                 $ret = "Bad story '$topic_id/$story_id'";
 259         }
 260
 261         return $ret;
 262 }
 263
 264
 265 sub _img_special_uri {
 266         my $self        = shift;
 267         my $src         = shift;
 268         my $class       = shift;
 269
 270         my $r = "<img src = 'img/$src' />";
 271
 272         if ($class) {
 273                 $r = "<span class = '$class'>" . $r . '</span>';
 274         }
 275
 276         return $r;
 277 }
 278
 279 sub special_uris {
 280         my $self        = shift;
 281         my $string      = shift;
 282
 283         $string =~ s!topic://([\w\d_]+)!$self->_topic_special_uri($1)!ge;
 284         $string =~ s!story://([\w\d_]+)/([\w\d_]+)!$self->_story_special_uri($1,$2)!ge;
 285         $string =~ s!img://([\w\d_\.-]+)/?([\w\d_]*)!$self->_img_special_uri($1,$2)!ge;
 286
 287         return $string;
 288 }
 289
 290
 291 sub transfer_to_source {
 292         my $self        = shift;
 293         my $dst         = shift;
 294
 295         foreach my $id ($self->users()) {
 296                 my $u = $self->user($id);
 297                 $dst->insert_user($u);
 298         }
 299
 300         foreach my $topic_id (sort $self->topics()) {
 301                 my $t = $self->topic($topic_id);
 302
 303                 my $nti = $topic_id;
 304
 305                 # is it an archive?
 306                 if ($nti =~ /-arch$/) {
 307                         # don't insert topic, just rename
 308                         $nti =~ s/-arch$//;
 309                 }
 310                 else {
 311                         $dst->insert_topic($t);
 312                 }
 313
 314                 foreach my $id ($self->stories($topic_id)) {
 315
 316                         # get story and its tags
 317                         my $s = $self->story($topic_id, $id);
 318                         my @tags = $s->tags();
 319
 320                         # set new topic
 321                         $s->set('topic_id', $nti);
 322
 323                         my $ns = $dst->insert_story($s);
 324
 325                         if (@tags) {
 326                                 $ns->tags(@tags);
 327                         }
 328                 }
 329         }
 330
 331         return $self;
 332 }
 333
 334
 335 sub flush_story_cache {
 336         my $self        = shift;
 337
 338         $self->{story_cache} = {};
 339 }
 340
 341
 342 sub new {
 343         my $class       = shift;
 344
 345         my $g = bless( { @_ } , $class);
 346
 347         $g->{id} ||= 'Gruta';
 348         $g->{story_cache} = {};
 349         $g->{renderers_h} = {};
 350
 351         if (ref($g->{sources}) ne 'ARRAY') {
 352                 $g->{sources} = [ $g->{sources} ];
 353         }
 354
 355         if ($g->{renderers}) {
 356                 if (ref($g->{renderers}) ne 'ARRAY') {
 357                         $g->{renderers} = [ $g->{renderers} ];
 358                 }
 359
 360                 foreach my $r (@{$g->{renderers}}) {
 361                         $g->{renderers_h}->{$r->{renderer_id}} = $r;
 362                 }
 363         }
 364
 365         if ($g->{template}) {
 366                 $g->template->data($g);
 367         }
 368
 369         if ($g->{cgi}) {
 370                 $g->cgi->data($g);
 371         }
 372
 373         my @u;
 374
 375         if (not @u = $g->users()) {
 376                 my $u = Gruta::Data::User->new(
 377                         id              => 'admin',
 378                         is_admin        => 1,
 379                         can_upload      => 1,
 380                         username        => 'Admin',
 381                         email           => 'webmaster@localhost'
 382                 );
 383
 384                 $u->password('admin');
 385                 $g->insert_user($u);
 386         }
 387
 388         return $g;
 389 }
 390
 391 sub run {
 392         my $self        = shift;
 393
 394         if ($self->{cgi}) {
 395                 $self->cgi->run();
 396         }
 397 }
 398
 399 1;