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.3.3-dev';
  11 $Gruta::VERSION_CODENAME        = '"Volterra"';
  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                 'RSS_COMMENTS'  => 'rss-comments.xml',
 172                 'SITEMAP'       => 'sitemap.xml',
 173                 'CSS'           => 'style.css',
 174                 'TAGS'          => 'tag/',
 175                 'TOP_TEN'       => 'top/'
 176             );
 177
 178             if (exists($p{$st})) {
 179                 return $ret . $p{$st};
 180             }
 181         }
 182
 183                 if ($kn == 1) {
 184                         if ($st eq 'INDEX' && $args{offset}) {
 185                                 return $ret . $args{offset} . '.html';
 186                         }
 187                         if ($st eq 'TOPIC' && $args{topic}) {
 188                                 return $ret . $args{topic} . '/';
 189                         }
 190                         if ($st eq 'SEARCH_BY_TAG' && $args{tag}) {
 191                                 return $ret . 'tag/' . $args{tag} . '.html';
 192                         }
 193                 }
 194
 195                 if ($kn == 2) {
 196                         if ($st eq 'STORY' && $args{topic} && $args{id}) {
 197                                 return $ret . $args{topic} . '/' . $args{id} . '.html';
 198                         }
 199                         if ($st eq 'TOPIC' && $args{topic} && $args{offset}) {
 200                                 return $ret . $args{topic} . '/~' . $args{offset} . '.html';
 201                         }
 202                         if ($st eq 'SEARCH_BY_DATE' && $args{from} && $args{to}) {
 203                 # special case: full day search
 204                 $args{from} =~ /^([0-9]{8})/;
 205                 my $d = $1;
 206
 207                 if ($d && $args{from} =~ /^${d}000000$/ && $args{to} =~ /^${d}235959$/) {
 208                     return $ret . $d . '/';
 209                 }
 210
 211                                 return $ret . $args{from} . '-' . $args{to} . '.html';
 212                         }
 213                 }
 214
 215         # if static_urls is 2, *never* return non-static
 216         if ($self->{args}->{static_urls} == 2) {
 217             return $ret;
 218         }
 219         }
 220
 221         if ($st) {
 222                 $args{t} = $st;
 223
 224                 $ret .= '?' . join(';', map { "$_=$args{$_}" } sort keys(%args));
 225         }
 226
 227         return $ret;
 228 }
 229
 230
 231 sub _topic_special_uri {
 232         my $self        = shift;
 233         my $topic_id    = shift;
 234
 235         my $ret = undef;
 236
 237         if (my $t = $self->source->topic($topic_id)) {
 238                 $ret = sprintf('<a href="%s">%s</a>',
 239                         $self->url('TOPIC', 'topic' => $topic_id),
 240                         $t->get('name')
 241                 );
 242         }
 243         else {
 244                 $ret = "Bad topic $topic_id";
 245         }
 246
 247         return $ret;
 248 }
 249
 250
 251 sub _story_special_uri {
 252         my $self        = shift;
 253         my $topic_id    = shift;
 254         my $story_id    = shift;
 255
 256         my $ret = undef;
 257
 258         if (my $s = $self->source->story($topic_id, $story_id)) {
 259
 260                 if ($s->is_visible($self->auth())) {
 261                         $ret = sprintf('<a href = "%s">%s</a>',
 262                                 $self->url('STORY',
 263                                         'topic' => $topic_id,
 264                                         'id' => $story_id
 265                                 ),
 266                                 $s->get('title')
 267                         );
 268                 }
 269                 else {
 270                         $ret = $s->get('title');
 271                 }
 272         }
 273         else {
 274                 my $topic = $self->source->topic($topic_id);
 275
 276                 if (!$topic) {
 277                         $ret = "Bad topic '$topic_id'";
 278                 }
 279                 else {
 280                         $ret = "Bad story '$topic_id/$story_id'";
 281
 282                         if ($topic->is_editor($self->auth())) {
 283                                 $ret .= sprintf(' <a href = "%s">[+]</a>',
 284                                         $self->url('EDIT_STORY',
 285                                                 'topic' => $topic_id,
 286                                                 'id'    => $story_id
 287                                         )
 288                                 );
 289                         }
 290                 }
 291         }
 292
 293         return $ret;
 294 }
 295
 296
 297 sub _img_special_uri {
 298         my $self        = shift;
 299         my $src         = shift;
 300         my $class       = shift;
 301
 302         my $more = '';
 303
 304         # try to load Image::Size
 305         eval("use Image::Size;");
 306
 307         if (!$@) {
 308                 # if available and image is found, add dimensions to <img>
 309                 my ($w, $h) = imgsize('img/' . $src);
 310
 311                 if ($w && $h) {
 312                         $more = sprintf('width = "%d" height = "%d"', $w, $h);
 313                 }
 314         }
 315
 316         my $r = sprintf('<img src = "%simg/%s" %s />',
 317                 $self->base_url(), $src, $more
 318         );
 319
 320         if ($class) {
 321                 $r = "<span class = '$class'>" . $r . '</span>';
 322         }
 323
 324         return $r;
 325 }
 326
 327
 328 sub _thumb_special_uri {
 329     my $self    = shift;
 330     my $src     = shift;
 331     my $class   = shift;
 332
 333     my $more = '';
 334
 335     my $r = sprintf(
 336         '<a href = "%simg/%s"><img src = "%simg/%s" width = "%d" /></a>',
 337         $self->base_url(),
 338         $src,
 339         $self->base_url(),
 340         $src,
 341         ($self->{args}->{thumbnail_size} || 400)
 342     );
 343
 344     if ($class) {
 345         $r = "<span class = '$class'>" . $r . '</span>';
 346     }
 347
 348     return $r;
 349 }
 350
 351
 352 sub _content_special_uri {
 353         my $self        = shift;
 354         my $topic_id    = shift;
 355         my $story_id    = shift;
 356         my $field       = shift;
 357
 358         my $ret = undef;
 359
 360         if (my $s = $self->source->story($topic_id, $story_id)) {
 361                 $ret = $self->special_uris($s->get($field));
 362         }
 363         else {
 364                 $ret = "Bad story '$topic_id/$story_id'";
 365         }
 366
 367         return $ret;
 368 }
 369
 370
 371
 372 sub special_uris {
 373     my $self    = shift;
 374     my $string  = shift;
 375
 376     $string =~ s!topic://([\w\d_-]+)!$self->_topic_special_uri($1)!ge;
 377     $string =~ s!story://([\w\d_-]+)/([\w\d_-]+)!$self->_story_special_uri($1,$2)!ge;
 378     $string =~ s!img://([\w\d_\.-]+)/?([\w\d_-]*)!$self->_img_special_uri($1,$2)!ge;
 379     $string =~ s!thumb://([\w\d_\.-]+)/?([\w\d_-]*)!$self->_thumb_special_uri($1,$2)!ge;
 380     $string =~ s!body://([\w\d_-]+)/([\w\d_-]+)!$self->_content_special_uri($1,$2,'body')!ge;
 381     $string =~ s!abstract://([\w\d_-]+)/([\w\d_-]+)!$self->_content_special_uri($1,$2,'abstract')!ge;
 382
 383     return $string;
 384 }
 385
 386
 387 sub transfer_to_source {
 388         my $self        = shift;
 389         my $dst         = shift;
 390
 391         foreach my $id ($self->source->users()) {
 392                 my $u = $self->source->user($id);
 393                 $dst->insert_user($u);
 394         }
 395
 396         foreach my $topic_id (sort $self->source->topics()) {
 397                 my $t = $self->source->topic($topic_id);
 398
 399                 my $nti = $topic_id;
 400
 401                 # is it an archive?
 402                 if ($nti =~ /-arch$/) {
 403                         # don't insert topic, just rename
 404                         $nti =~ s/-arch$//;
 405                 }
 406                 else {
 407                         $dst->insert_topic($t);
 408                 }
 409
 410                 foreach my $id ($self->source->stories($topic_id)) {
 411
 412                         # get story and its tags
 413                         my $s = $self->source->story($topic_id, $id);
 414                         my @tags = $s->tags();
 415
 416                         # set new topic
 417                         $s->set('topic_id', $nti);
 418
 419                         my $ns = $dst->insert_story($s);
 420
 421                         if (@tags) {
 422                                 $ns->tags(@tags);
 423                         }
 424                 }
 425         }
 426
 427         foreach my $id ($self->source->templates()) {
 428                 my $t = $self->source->template($id);
 429                 $dst->insert_template($t);
 430         }
 431
 432         return $self;
 433 }
 434
 435
 436 sub new {
 437         my $class       = shift;
 438
 439         my $g = bless( { @_ } , $class);
 440
 441         $g->{id}                ||= 'Gruta';
 442         $g->{args}              ||= {};
 443
 444         $g->{renderers_h}       = {};
 445
 446         if ($g->{sources}) {
 447                 if (ref($g->{sources}) ne 'ARRAY') {
 448                         $g->{sources} = [ $g->{sources} ];
 449                 }
 450
 451                 if (!$g->{source}) {
 452                         $g->{source} = (@{$g->{sources}})[0];
 453                 }
 454         }
 455
 456         if ($g->{source}) {
 457                 $g->source->data($g);
 458         }
 459
 460         if ($g->{renderers}) {
 461                 if (ref($g->{renderers}) ne 'ARRAY') {
 462                         $g->{renderers} = [ $g->{renderers} ];
 463                 }
 464
 465                 foreach my $r (@{$g->{renderers}}) {
 466                         $g->{renderers_h}->{$r->{renderer_id}} = $r;
 467                 }
 468         }
 469
 470         if ($g->{template}) {
 471                 $g->template->data($g);
 472         }
 473
 474         if ($g->{cgi}) {
 475                 $g->cgi->data($g);
 476         }
 477
 478     # ensure base_url has a final /
 479     if ($g->{args}->{base_url} && $g->{args}->{base_url} !~ /\/$/) {
 480         $g->{args}->{base_url} .= '/';
 481     }
 482
 483         return $g;
 484 }
 485
 486 sub run {
 487         my $self        = shift;
 488
 489         if ($self->{cgi}) {
 490                 $self->cgi->run();
 491         }
 492 }
 493
 494 1;