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