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.1';
  11 $Gruta::VERSION_CODENAME        = '"Sienna"';
  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                 my $topic = $self->source->topic($topic_id);
 261
 262                 if (!$topic) {
 263                         $ret = "Bad topic '$topic_id'";
 264                 }
 265                 else {
 266                         $ret = "Bad story '$topic_id/$story_id'";
 267
 268                         if ($topic->is_editor($self->auth())) {
 269                                 $ret .= sprintf(' <a href = "%s">[+]</a>',
 270                                         $self->url('EDIT_STORY',
 271                                                 'topic' => $topic_id,
 272                                                 'id'    => $story_id
 273                                         )
 274                                 );
 275                         }
 276                 }
 277         }
 278
 279         return $ret;
 280 }
 281
 282
 283 sub _img_special_uri {
 284         my $self        = shift;
 285         my $src         = shift;
 286         my $class       = shift;
 287
 288         my $more = '';
 289
 290         # try to load Image::Size
 291         eval("use Image::Size;");
 292
 293         if (!$@) {
 294                 # if available and image is found, add dimensions to <img>
 295                 my ($w, $h) = imgsize('img/' . $src);
 296
 297                 if ($w && $h) {
 298                         $more = sprintf('width = "%d" height = "%d"', $w, $h);
 299                 }
 300         }
 301
 302         my $r = sprintf('<img src = "%simg/%s" %s />',
 303                 $self->base_url(), $src, $more
 304         );
 305
 306         if ($class) {
 307                 $r = "<span class = '$class'>" . $r . '</span>';
 308         }
 309
 310         return $r;
 311 }
 312
 313
 314 sub _content_special_uri {
 315         my $self        = shift;
 316         my $topic_id    = shift;
 317         my $story_id    = shift;
 318         my $field       = shift;
 319
 320         my $ret = undef;
 321
 322         if (my $s = $self->source->story($topic_id, $story_id)) {
 323                 $ret = $self->special_uris($s->get($field));
 324         }
 325         else {
 326                 $ret = "Bad story '$topic_id/$story_id'";
 327         }
 328
 329         return $ret;
 330 }
 331
 332
 333
 334 sub special_uris {
 335         my $self        = shift;
 336         my $string      = shift;
 337
 338         $string =~ s!topic://([\w\d_-]+)!$self->_topic_special_uri($1)!ge;
 339         $string =~ s!story://([\w\d_-]+)/([\w\d_-]+)!$self->_story_special_uri($1,$2)!ge;
 340         $string =~ s!img://([\w\d_\.-]+)/?([\w\d_-]*)!$self->_img_special_uri($1,$2)!ge;
 341         $string =~ s!body://([\w\d_-]+)/([\w\d_-]+)!$self->_content_special_uri($1,$2,'body')!ge;
 342         $string =~ s!abstract://([\w\d_-]+)/([\w\d_-]+)!$self->_content_special_uri($1,$2,'abstract')!ge;
 343
 344         return $string;
 345 }
 346
 347
 348 sub transfer_to_source {
 349         my $self        = shift;
 350         my $dst         = shift;
 351
 352         foreach my $id ($self->source->users()) {
 353                 my $u = $self->source->user($id);
 354                 $dst->insert_user($u);
 355         }
 356
 357         foreach my $topic_id (sort $self->source->topics()) {
 358                 my $t = $self->source->topic($topic_id);
 359
 360                 my $nti = $topic_id;
 361
 362                 # is it an archive?
 363                 if ($nti =~ /-arch$/) {
 364                         # don't insert topic, just rename
 365                         $nti =~ s/-arch$//;
 366                 }
 367                 else {
 368                         $dst->insert_topic($t);
 369                 }
 370
 371                 foreach my $id ($self->source->stories($topic_id)) {
 372
 373                         # get story and its tags
 374                         my $s = $self->source->story($topic_id, $id);
 375                         my @tags = $s->tags();
 376
 377                         # set new topic
 378                         $s->set('topic_id', $nti);
 379
 380                         my $ns = $dst->insert_story($s);
 381
 382                         if (@tags) {
 383                                 $ns->tags(@tags);
 384                         }
 385                 }
 386         }
 387
 388         foreach my $id ($self->source->templates()) {
 389                 my $t = $self->source->template($id);
 390                 $dst->insert_template($t);
 391         }
 392
 393         return $self;
 394 }
 395
 396
 397 sub new {
 398         my $class       = shift;
 399
 400         my $g = bless( { @_ } , $class);
 401
 402         $g->{id}                ||= 'Gruta';
 403         $g->{args}              ||= {};
 404
 405         $g->{renderers_h}       = {};
 406
 407         if ($g->{sources}) {
 408                 if (ref($g->{sources}) ne 'ARRAY') {
 409                         $g->{sources} = [ $g->{sources} ];
 410                 }
 411
 412                 if (!$g->{source}) {
 413                         $g->{source} = (@{$g->{sources}})[0];
 414                 }
 415         }
 416
 417         if ($g->{source}) {
 418                 $g->source->data($g);
 419         }
 420
 421         if ($g->{renderers}) {
 422                 if (ref($g->{renderers}) ne 'ARRAY') {
 423                         $g->{renderers} = [ $g->{renderers} ];
 424                 }
 425
 426                 foreach my $r (@{$g->{renderers}}) {
 427                         $g->{renderers_h}->{$r->{renderer_id}} = $r;
 428                 }
 429         }
 430
 431         if ($g->{template}) {
 432                 $g->template->data($g);
 433         }
 434
 435         if ($g->{cgi}) {
 436                 $g->cgi->data($g);
 437         }
 438
 439         return $g;
 440 }
 441
 442 sub run {
 443         my $self        = shift;
 444
 445         if ($self->{cgi}) {
 446                 $self->cgi->run();
 447         }
 448 }
 449
 450 1;