Gruta.pm

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