Gruta/Template/Artemus.pm

   1 package Gruta::Template::Artemus;
   2
   3 use strict;
   4 use warnings;
   5 use Carp;
   6
   7 use base 'Gruta::Template::BASE';
   8
   9 use Artemus;
  10 use Gruta::Data;
  11
  12 sub new {
  13         my $class       = shift;
  14         my %args        = @_;
  15
  16         my $a = bless( {}, $class );
  17
  18         $a->{_artemus} = undef;
  19         $a->{path} = $args{path};
  20
  21         $a->create();
  22
  23         return $a;
  24 }
  25
  26
  27 sub _artemus {
  28         my $self        = shift;
  29
  30         if (not $self->{_artemus}) {
  31                 my $data = $self->data();
  32
  33                 my %f = ();
  34                 my %v = ();
  35
  36                 $f{l} = sub {
  37                         my $t = shift;
  38
  39                         return '?t=' . $t . ';' . join(';', @_);
  40                 };
  41
  42                 $f{'add'} = sub { $_[0] + $_[1]; };
  43                 $f{'sub'} = sub { $_[0] - $_[1]; };
  44                 $f{'gt'} = sub { $_[0] > $_[1]; };
  45                 $f{'lt'} = sub { $_[0] < $_[1]; };
  46                 $f{'eq'} = sub { $_[0] eq $_[1] ? 1 : 0; };
  47
  48                 $f{date} = sub { Gruta::Data::today(); };
  49                 $f{random} = sub { $_[rand(scalar(@_))]; };
  50
  51                 foreach my $p (Gruta::Data::Topic->new->afields()) {
  52                         $f{'topic_' . $p} = sub {
  53                                 my $topic = shift;
  54                                 my $ret = '';
  55
  56                                 if ($topic ne '[]') {
  57                                         $ret = $data->topic($topic)->get($p) || '';
  58                                 }
  59
  60                                 return $ret;
  61                         };
  62                 }
  63
  64                 foreach my $p (Gruta::Data::Story->new->afields()) {
  65                         $f{'story_' . $p} = sub {
  66                                 my $topic_id    = shift;
  67                                 my $id          = shift;
  68                                 my $ret         = '';
  69
  70                                 if ($id ne '[]') {
  71                                         $ret = $data->story($topic_id, $id)->get($p);
  72                                 }
  73
  74                                 return $ret;
  75                         };
  76                 }
  77
  78                 $f{story_abstract} = sub {
  79                         my $story = $data->story($_[0], $_[1]);
  80
  81                         return $data->special_uris($story->get('abstract'));
  82                 };
  83
  84                 $f{story_body} = sub {
  85                         my $topic_id    = shift;
  86                         my $id          = shift;
  87                         my $ret         = '{-404}';
  88
  89                         if (my $topic = $data->topic($topic_id)) {
  90                                 if (my $story = $data->story($topic_id, $id)) {
  91                                         my $date2 = $story->get('date2');
  92
  93                                         # if no user and story is not freed, bounce
  94                                         if (!$data->auth() && $date2 && $date2 > Gruta::Data::today()) {
  95                                                 $ret = '{-restricted_access}';
  96                                         }
  97                                         else {
  98                                                 # touch the story if user is not
  99                                                 # (potentially) involved on it
 100                                                 if (! $topic->is_editor($data->auth())) {
 101                                                         $story->touch();
 102                                                 }
 103
 104                                                 $ret = $data->special_uris($story->get('body'));
 105                                         }
 106                                 }
 107                         }
 108
 109                         return $ret;
 110                 };
 111
 112                 $f{story_date} = sub {
 113                         my $format      = shift;
 114                         my $topic_id    = shift;
 115                         my $id          = shift;
 116                         my $ret         = '';
 117
 118                         if ($id ne '[]') {
 119                                 $ret = $data->story($topic_id, $id)->date($format);
 120                         }
 121
 122                         return $ret;
 123                 };
 124
 125                 $f{story_date2} = sub {
 126                         my $format      = shift;
 127                         my $topic_id    = shift;
 128                         my $id          = shift;
 129                         my $ret         = '';
 130
 131                         if ($id ne '[]') {
 132                                 $ret = $data->story($topic_id, $id)->date2($format);
 133                         }
 134
 135                         return $ret;
 136                 };
 137
 138                 foreach my $p (Gruta::Data::User->new->afields()) {
 139                         $f{'user_' . $p} = sub {
 140                                 my $id  = shift;
 141                                 my $ret = '';
 142
 143                                 if ($id ne '[]') {
 144                                         $ret = $data->user($id)->get($p);
 145                                 }
 146
 147                                 return $ret;
 148                         };
 149                 }
 150
 151                 $f{user_xdate} = sub {
 152                         my $format      = shift;
 153                         my $id          = shift;
 154                         my $ret         = '';
 155
 156                         if ($id ne '[]') {
 157                                 $ret = $data->user($id)->xdate($format);
 158                         }
 159
 160                         return $ret;
 161                 };
 162
 163                 $f{template} = sub {
 164                         my $t = shift;
 165                         my $ret = '';
 166
 167                         if ($t ne '[]') {
 168                                 $t = $data->template->template($t);
 169                                 $ret = $self->{_artemus}->armor($t);
 170                         }
 171
 172                         return $ret;
 173                 };
 174
 175                 $f{save_template} = sub {
 176                         my $template    = shift;
 177                         my $content     = shift;
 178                         my $msg         = shift;
 179
 180                         $content = $self->{_artemus}->unarmor($content);
 181                         $data->template->save_template($template, $content);
 182
 183                         return $msg || "Template saved.";
 184                 };
 185
 186                 $f{loop_topics} = sub {
 187                         my $template    = shift;
 188                         my $sep         = shift;
 189
 190                         return join($sep, map {
 191                                 my $t = $data->topic($_);
 192                                 sprintf('{-%s|%s|%s}',
 193                                         $template, $t->get('name'),
 194                                         $t->get('id')
 195                                 );
 196                         } $data->topics());
 197                 };
 198
 199                 $f{loop_users} = sub {
 200                         return join($_[1], map { "{-$_[0]|$_}" } $data->users());
 201                 };
 202
 203                 $f{loop_renderers} = sub {
 204                         return join($_[1], map { "{-$_[0]|$_}" }
 205                                 sort(keys(%{$data->{renderers_h}})));
 206                 };
 207
 208                 $f{loop_templates} = sub {
 209                         return join($_[1], map { "{-$_[0]|$_}" }
 210                                 $data->template->templates());
 211                 };
 212
 213                 $f{loop_upload_dirs} = sub {
 214                         return join($_[1], map { "{-$_[0]|$_}" }
 215                                 $data->cgi->upload_dirs());
 216                 };
 217
 218                 $f{loop_story_tags} = sub {
 219                         my $topic_id    = shift;
 220                         my $id          = shift;
 221
 222                         return join($_[1], map { "{-$_[0]|$_}" }
 223                                 $data->story($topic_id, $id)->tags());
 224                 };
 225
 226                 $f{story_loop_by_date} = sub {
 227                         my $topic       = shift;
 228                         my $num         = shift;
 229                         my $offset      = shift;
 230                         my $template    = shift;
 231                         my $sep         = shift;
 232                         my $from        = shift;
 233                         my $to          = shift;
 234                         my $future      = shift;
 235
 236                         return join($sep, map { "{-$template|$topic|$_}" }
 237                                 $data->stories_by_date(
 238                                         $topic,
 239                                         num     => $num,
 240                                         offset  => $offset,
 241                                         from    => $from,
 242                                         to      => $to,
 243                                         future  => $future
 244                                 )
 245                         );
 246                 };
 247
 248                 $f{is_logged_in} = sub {
 249                         return $data->auth() ? 1 : 0;
 250                 };
 251
 252                 $f{is_admin} = sub {
 253                         return $data->auth() && $data->auth->get('is_admin') ? 1 : 0;
 254                 };
 255
 256                 $f{is_topic_editor} = sub {
 257                         if (my $topic = $data->topic($_[0])) {
 258                                 return $topic->is_editor($data->auth()) ? 1 : 0;
 259                         }
 260
 261                         return 0;
 262                 };
 263
 264                 $f{login} = sub {
 265                         my $user_id     = shift;
 266                         my $password    = shift;
 267                         my $error_msg   = shift;
 268
 269                         if ($user_id eq '' || $user_id eq 'cgi-userid') {
 270                                 $error_msg = '{-login_box}';
 271                         }
 272                         elsif (my $sid = $data->login($user_id, $password)) {
 273                                 $data->cgi->cookie("sid=$sid");
 274                                 $data->cgi->redirect('?t=INDEX');
 275                                 $self->{abort} = 1;
 276                         }
 277
 278                         return $error_msg || 'Login incorrect.';
 279                 };
 280
 281                 $f{logout} = sub {
 282                         $data->logout();
 283                         $data->cgi->redirect('?t=INDEX');
 284                         $self->{abort} = 1;
 285                 };
 286
 287                 $f{assert} = sub {
 288                         my $cond        = shift;
 289                         my $redir       = shift || 'ADMIN';
 290
 291                         if (! $cond) {
 292                                 $data->cgi->redirect('?t=' . $redir);
 293                                 $self->{abort} = 1;
 294                         }
 295
 296                         return '';
 297                 };
 298
 299                 $f{username} = sub {
 300                         return $data->auth() && $data->auth->get('username') || '';
 301                 };
 302
 303                 $f{userid} = sub {
 304                         return $data->auth() && $data->auth->get('id') || '';
 305                 };
 306
 307                 $f{search_stories} = sub {
 308                         my $topic_id    = shift;
 309                         my $query       = shift;
 310                         my $future      = shift;
 311                         my $template    = shift || '_story_link_as_item_with_edit';
 312                         my $sep         = shift || '';
 313
 314                         my $ret = '';
 315                         my @l = $data->search_stories($topic_id, $query, $future);
 316
 317                         if (@l) {
 318                                 $ret = "<p><b>{-topic_name|$topic_id}</b><br>\n";
 319
 320                                 $ret .= join($sep, map { "{-$template|$topic_id|$_}" } @l);
 321
 322                                 $self->{search_count} += scalar(@l);
 323                         }
 324
 325                         return $ret;
 326                 };
 327
 328                 $f{story_loop_top_ten} = sub {
 329                         my $num         = shift;
 330                         my $internal    = shift; # ignored
 331                         my $template    = shift;
 332                         my $sep         = shift;
 333
 334                         return join($sep, map { "{-$template|$_->[1]|$_->[2]}" }
 335                                 $data->stories_top_ten($num)
 336                         );
 337                 };
 338
 339                 $f{is_visible_story} = sub {
 340                         if (my $story = $data->story($_[0], $_[1])) {
 341                                 return $story->is_visible($data->auth()) ? 1 : 0;
 342                         }
 343
 344                         return 0;
 345                 };
 346
 347                 $f{redir_if_archived} = sub {
 348                         my $template    = shift;
 349                         my $topic_id    = shift;
 350                         my $id          = shift;
 351
 352                         if ($topic_id =~ /-arch$/) {
 353                                 return '';
 354                         }
 355
 356                         my $story = $data->story($topic_id, $id);
 357
 358                         if ($story->get('topic_id') =~ /-arch$/) {
 359                                 $data->cgi->redirect(
 360                                         sprintf('?t=%s;topic=%s;id=%s',
 361                                         $template,
 362                                         $story->get('topic_id'),
 363                                         $id)
 364                                 );
 365                                 $self->{abort} = 1;
 366                         }
 367
 368                         return '';
 369                 };
 370
 371                 $f{topic_has_archive} = sub {
 372                         return $data->topic($_[0] . '-arch') ? 1 : 0;
 373                 };
 374
 375                 $f{save_topic} = sub {
 376                         my $topic_id    = shift || return 'Error 1';
 377
 378                         my $topic = undef;
 379
 380                         if (not $topic = $data->topic($topic_id)) {
 381                                 $topic = Gruta::Data::Topic->new (
 382                                         id => $topic_id );
 383                         }
 384
 385                         $topic->set('name',             shift);
 386                         $topic->set('editors',          shift);
 387                         $topic->set('internal',         shift eq 'on' ? 1 : 0);
 388                         $topic->set('max_stories',      shift);
 389
 390                         # update or insert
 391                         if ($topic->source()) {
 392                                 $topic = $topic->save();
 393                         }
 394                         else {
 395                                 $topic = $data->insert_topic($topic);
 396                         }
 397
 398                         return $topic ? 'OK' : 'Error 2';
 399                 };
 400
 401                 $f{save_story} = sub {
 402                         my $topic_id    = shift || return 'Error 1';
 403                         my $id          = shift;
 404
 405                         my $story = undef;
 406
 407                         if (not $story = $data->story($topic_id, $id)) {
 408                                 $story = Gruta::Data::Story->new (
 409                                         topic_id        => $topic_id,
 410                                         id              => $id
 411                                 );
 412                         }
 413
 414                         my $content = shift;
 415                         $content = $self->{_artemus}->unarmor($content);
 416
 417                         $story->set('content',  $content);
 418
 419                         # pick date and drop time
 420                         my $y = shift;
 421                         my $m = shift;
 422                         my $d = shift;
 423                         shift; shift; shift;
 424                         my $date = Gruta::Data::today();
 425
 426                         if ($y && $m && $d) {
 427                                 $date = sprintf("%04d%02d%02d000000", $y, $m, $d);
 428                         }
 429
 430                         $story->set('date',     $date);
 431                         $story->set('format',   shift || 'grutatxt');
 432
 433                         # get the tags
 434                         my $tags = shift;
 435
 436                         # get date2
 437                         $y = shift;
 438                         $m = shift;
 439                         $d = shift;
 440
 441                         if ($y && $m && $d) {
 442                                 $date = sprintf("%04d%02d%02d000000", $y, $m, $d);
 443                         }
 444                         else {
 445                                 $date = '';
 446                         }
 447
 448                         $story->set('date2', $date);
 449
 450                         # drop all cached stories
 451                         $data->flush_story_cache();
 452
 453                         if ($story->source()) {
 454                                 $story = $story->save();
 455                         }
 456                         else {
 457                                 $story = $data->insert_story($story);
 458                         }
 459
 460                         if ($tags ne 'cgi-tags') {
 461                                 $story->tags(split(/\s*,\s*/, $tags));
 462                         }
 463
 464                         return $story ? $story->get('id') : 'Error 2';
 465                 };
 466
 467                 $f{save_user} = sub {
 468                         shift;  # new (ignored)
 469                         my $id          = shift || return 'Error 1';
 470                         my $username    = shift;
 471                         my $email       = shift;
 472                         my $is_admin    = shift;
 473                         my $can_upload  = shift;
 474                         my $pass1       = shift;
 475                         my $pass2       = shift;
 476                         my $xy          = shift;
 477                         my $xm          = shift;
 478                         my $xd          = shift;
 479
 480                         if ($data->auth->get('username') ne $username &&
 481                                 ! $data->auth->get('is_admin')) {
 482                                 $data->cgi->redirect('?t=LOGIN');
 483                                 $self->{abort} = 1;
 484                                 return '';
 485                         }
 486
 487                         my $user = undef;
 488
 489                         if (not $user = $data->user($id)) {
 490                                 $user = Gruta::Data::User->new (
 491                                         id              => $id,
 492                                         is_admin        => 0,
 493                                         can_upload      => 0,
 494                                         xdate           => ''
 495                                 );
 496                         }
 497
 498                         $user->set('username',          $username);
 499                         $user->set('email',             $email);
 500
 501                         # these params can only be set by an admin
 502                         if ($data->auth->get('is_admin')) {
 503
 504                                 $user->set('is_admin', $is_admin eq 'on' ? 1 : 0);
 505                                 $user->set('can_upload', $can_upload eq 'on' ? 1 : 0);
 506
 507                                 if ($xy and $xm and $xd) {
 508                                         $user->set('xdate',
 509                                                 sprintf('%04d%02d%02d000000',
 510                                                         $xy, $xm, $xd));
 511                                 }
 512                                 else {
 513                                         $user->set('xdate', '');
 514                                 }
 515                         }
 516
 517                         if ($pass1 and $pass2) {
 518                                 if ($pass1 ne $pass2) {
 519                                         croak "Passwords are different";
 520                                 }
 521
 522                                 $user->password($pass1);
 523                         }
 524
 525                         if ($user->source()) {
 526                                 $user = $user->save();
 527                         }
 528                         else {
 529                                 $user = $data->insert_user($user);
 530                         }
 531
 532                         return $user ? 'OK' : 'Error 2';
 533                 };
 534
 535                 $f{upload} = sub {
 536
 537                         $data->cgi->upload($_[0], $_[1]);
 538                         return 'OK';
 539                 };
 540
 541                 $f{delete_story} = sub {
 542                         my $topic_id    = shift || return 'Error 1';
 543                         my $id          = shift;
 544
 545                         $data->story($topic_id, $id)->delete();
 546
 547                         # drop all cached stories
 548                         $data->flush_story_cache();
 549
 550                         return 'OK';
 551                 };
 552
 553                 $f{search_stories_by_tag} = sub {
 554                         my $tag         = shift;
 555                         my $template    = shift;
 556                         my $sep         = shift;
 557                         my $future      = shift;
 558
 559                         my @ret = $data->search_stories_by_tag($tag, $future);
 560                         $self->{search_count} = scalar(@ret);
 561
 562                         return join($sep, map { "{-$template|$_->[0]|$_->[1]}" } @ret);
 563                 };
 564
 565                 $f{search_count} = sub { $self->{search_count}; };
 566
 567                 $f{content_type} = sub {
 568                         $data->cgi->http_headers('Content-Type' => $_[0]);
 569                         return '';
 570                 };
 571
 572                 $f{loop_tags} = sub {
 573                         return join($_[1], map { "{-$_[0]|$_->[0]|$_->[1]}" }
 574                                 $data->tags());
 575                 };
 576
 577                 $f{topics}      = sub { join(':', $data->topics()); };
 578                 $f{templates}   = sub { join(':', $data->template->templates()); };
 579                 $f{users}       = sub { join(':', $data->users()); };
 580
 581                 $f{renderers}   = sub { join(':', sort(keys(%{$data->{renderers_h}}))); };
 582                 $f{upload_dirs} = sub { join(':', $data->cgi->upload_dirs()); };
 583                 $f{tags}        = sub { join(':', $data->tags()); };
 584
 585                 $f{var}         = sub {
 586                         my $ret = $self->{cgi_vars}->{$_[0]} || $_[1] || '';
 587
 588                         return $self->{_artemus}->armor($ret);
 589                 };
 590
 591                 $f{story_tags} = sub {
 592                         my $topic_id    = shift;
 593                         my $id          = shift;
 594                         my $ret         = '';
 595
 596                         if ($id ne '[]') {
 597                                 my $story = $data->story($topic_id, $id);
 598
 599                                 $ret = join(':', $story->tags());
 600                         }
 601
 602                         return $ret;
 603                 };
 604
 605                 $self->{abort}          = 0;
 606                 $self->{unresolved}     = [];
 607                 $self->{search_count}   = 0;
 608
 609                 $self->{_artemus} = Artemus->new(
 610                         'include-path'  =>      $self->{path},
 611                         'funcs'         =>      \%f,
 612                         'vars'          =>      \%v,
 613                         'unresolved'    =>      $self->{unresolved},
 614                         'abort'         =>      \$self->{abort},
 615                 );
 616
 617                 if ($self->{cgi_vars}) {
 618                         foreach my $k (keys(%{ $self->{cgi_vars} })) {
 619                                 my $c = $self->{_artemus}->
 620                                         armor($self->{cgi_vars}->{$k});
 621                                 $c =~ s/\r//g;
 622
 623                                 $v{"cgi-${k}"} = $c;
 624                         }
 625                 }
 626         }
 627
 628         return $self->{_artemus};
 629 }
 630
 631
 632 sub data {
 633         my $self        = shift;
 634         my $data        = shift;
 635
 636         if (defined($data)) {
 637                 $self->{data} = $data;
 638                 $self->{_artemus} = undef;
 639         }
 640
 641         return $self->{data};
 642 }
 643
 644
 645 sub cgi_vars {
 646         my $self        = shift;
 647
 648         if (@_) {
 649                 $self->{cgi_vars} = shift;
 650                 $self->{_artemus} = undef;
 651         }
 652
 653         return $self->{cgi_vars};
 654 }
 655
 656
 657 sub process { $_[0]->_artemus->process('{-' . $_[1] . '}'); }
 658
 659 1;