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