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