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_body} = sub {
  91                         my $story = $data->story($_[0], $_[1]);
  92                         my $ret = $story->get('body');
  93
  94                         if (not $data->auth()) {
  95                                 $story->touch();
  96                         }
  97
  98                         return $ret;
  99                 };
 100
 101                 $f{story_date} = sub {
 102                         my $format      = shift;
 103                         my $topic_id    = shift;
 104                         my $id          = shift;
 105                         my $ret         = '';
 106
 107                         if ($id ne '[]') {
 108                                 $ret = $data->story($topic_id, $id)->date($format);
 109                         }
 110
 111                         return $ret;
 112                 };
 113
 114                 foreach my $p (Gruta::Data::User->new->afields()) {
 115                         $f{'user_' . $p} = sub {
 116                                 my $id  = shift;
 117                                 my $ret = '';
 118
 119                                 if ($id ne '[]') {
 120                                         $ret = $data->user($id)->get($p);
 121                                 }
 122
 123                                 return $ret;
 124                         };
 125                 }
 126
 127                 $f{user_xdate} = sub {
 128                         my $format      = shift;
 129                         my $id          = shift;
 130                         my $ret         = '';
 131
 132                         if ($id ne '[]') {
 133                                 $ret = $data->user($id)->xdate($format);
 134                         }
 135
 136                         return $ret;
 137                 };
 138
 139                 $f{template} = sub {
 140                         my $t = shift;
 141                         my $ret = '';
 142
 143                         if ($t ne '[]') {
 144                                 $t = $data->template->template($t);
 145                                 $ret = $self->{_artemus}->armor($t);
 146                         }
 147
 148                         return $ret;
 149                 };
 150
 151                 $f{save_template} = sub {
 152                         my $template    = shift;
 153                         my $content     = shift;
 154                         my $msg         = shift;
 155
 156                         $content = $self->{_artemus}->unarmor($content);
 157                         $data->template->save_template($template, $content);
 158
 159                         return $msg || "Template saved.";
 160                 };
 161
 162                 $f{loop_topics} = sub {
 163                         my $template    = shift;
 164                         my $sep         = shift;
 165
 166                         return join($sep, map {
 167                                 my $t = $data->topic($_);
 168                                 sprintf('{-%s|%s|%s}',
 169                                         $template, $t->get('name'),
 170                                         $t->get('id')
 171                                 );
 172                         } $data->topics());
 173                 };
 174
 175                 $f{loop_users} = sub {
 176                         return join($_[1], map { "{-$_[0]|$_}" } $data->users());
 177                 };
 178
 179                 $f{loop_renderers} = sub {
 180                         return join($_[1], map { "{-$_[0]|$_}" }
 181                                 sort(keys(%{$data->{renderers_h}})));
 182                 };
 183
 184                 $f{loop_templates} = sub {
 185                         return join($_[1], map { "{-$_[0]|$_}" }
 186                                 $data->template->templates());
 187                 };
 188
 189                 $f{loop_upload_dirs} = sub {
 190                         return join($_[1], map { "{-$_[0]|$_}" }
 191                                 $data->cgi->upload_dirs());
 192                 };
 193
 194                 $f{loop_story_tags} = sub {
 195                         my $topic_id    = shift;
 196                         my $id          = shift;
 197
 198                         return join($_[1], map { "{-$_[0]|$_}" }
 199                                 $data->story($topic_id, $id)->tags());
 200                 };
 201
 202                 $f{story_loop_by_date} = sub {
 203                         my $topic       = shift;
 204                         my $num         = shift;
 205                         my $offset      = shift;
 206                         my $template    = shift;
 207                         my $sep         = shift;
 208                         my $from        = shift;
 209                         my $to          = shift;
 210                         my $future      = shift;
 211
 212                         return join($sep, map { "{-$template|$topic|$_}" }
 213                                 $data->stories_by_date(
 214                                         $topic,
 215                                         num     => $num,
 216                                         offset  => $offset,
 217                                         from    => $from,
 218                                         to      => $to,
 219                                         future  => $future
 220                                 )
 221                         );
 222                 };
 223
 224                 $f{is_logged_in} = sub {
 225                         return $data->auth() ? 1 : 0;
 226                 };
 227
 228                 $f{is_admin} = sub {
 229                         if ($data->auth() and $data->auth->get('is_admin')) {
 230                                 return 1;
 231                         }
 232                         return 0;
 233                 };
 234
 235                 $f{is_topic_editor} = sub {
 236                         my $auth;
 237
 238                         if (not $auth = $data->auth()) {
 239                                 return 0;
 240                         }
 241
 242                         if ($auth->get('is_admin')) {
 243                                 return 1;
 244                         }
 245
 246                         my $topic;
 247
 248                         if (not $topic = $data->topic($_[0])) {
 249                                 return 0;
 250                         }
 251
 252                         if (my $editors = $topic->get('editors') and
 253                                 my $user_id = $auth->get('id')) {
 254                                 return 1 if $editors =~/\b$user_id\b/;
 255                         }
 256
 257                         return 0;
 258                 };
 259
 260                 $f{login} = sub {
 261                         my $user_id     = shift;
 262                         my $password    = shift;
 263                         my $error_msg   = shift;
 264
 265                         if ($user_id eq '' || $user_id eq 'cgi-userid') {
 266                                 $error_msg = '{-login_box}';
 267                         }
 268                         elsif (my $sid = $data->login($user_id, $password)) {
 269                                 $data->cgi->cookie("sid=$sid");
 270                                 $data->cgi->redirect('?t=INDEX');
 271                                 $self->{abort} = 1;
 272                         }
 273
 274                         return $error_msg || 'Login incorrect.';
 275                 };
 276
 277                 $f{logout} = sub {
 278                         $data->logout();
 279                         $data->cgi->redirect('?t=INDEX');
 280                         $self->{abort} = 1;
 281                 };
 282
 283                 $f{assert} = sub {
 284                         my $cond        = shift;
 285                         my $redir       = shift || 'ADMIN';
 286
 287                         if (! $cond) {
 288                                 $data->cgi->redirect('?t=' . $redir);
 289                                 $self->{abort} = 1;
 290                         }
 291
 292                         return '';
 293                 };
 294
 295                 $f{username} = sub {
 296                         my $ret = '';
 297
 298                         if ($data->auth()) {
 299                                 $ret = $data->auth->get('username');
 300                         }
 301
 302                         return $ret;
 303                 };
 304
 305                 $f{search_stories} = sub {
 306                         my $topic_id    = shift;
 307                         my $query       = shift;
 308                         my $future      = shift;
 309                         my $template    = shift || '_story_link_as_item_with_edit';
 310                         my $sep         = shift || '';
 311
 312                         my $ret = '';
 313                         my @l = $data->search_stories($topic_id, $query, $future);
 314
 315                         if (@l) {
 316                                 $ret = "<p><b>{-topic_name|$topic_id}</b><br>\n";
 317
 318                                 $ret .= join($sep, map { "{-$template|$topic_id|$_}" } @l);
 319
 320                                 $self->{search_count} += scalar(@l);
 321                         }
 322
 323                         return $ret;
 324                 };
 325
 326                 $f{story_loop_top_ten} = sub {
 327                         my $num         = shift;
 328                         my $internal    = shift; # ignored
 329                         my $template    = shift;
 330                         my $sep         = shift;
 331
 332                         return join($sep, map { "{-$template|$_->[1]|$_->[2]}" }
 333                                 $data->stories_top_ten($num)
 334                         );
 335                 };
 336
 337                 $f{is_visible_story} = sub {
 338                         my $story = $data->story($_[0], $_[1]);
 339
 340                         if (!$data->auth() && $story->get('date') > Gruta::Data::today()) {
 341                                 return 0;
 342                         }
 343
 344                         return 1;
 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                         # drop all cached stories
 434                         $data->flush_story_cache();
 435
 436                         if ($story->source()) {
 437                                 $story = $story->save();
 438                         }
 439                         else {
 440                                 $story = $data->insert_story($story);
 441                         }
 442
 443                         # store the tags
 444                         my $tags = shift;
 445
 446                         if ($tags ne 'cgi-tags') {
 447                                 $story->tags(split(/\s*,\s*/, $tags));
 448                         }
 449
 450                         return $story ? $story->get('id') : 'Error 2';
 451                 };
 452
 453                 $f{save_user} = sub {
 454                         shift;  # new (ignored)
 455                         my $id          = shift || return 'Error 1';
 456                         my $username    = shift;
 457                         my $email       = shift;
 458                         my $is_admin    = shift;
 459                         my $can_upload  = shift;
 460                         my $pass1       = shift;
 461                         my $pass2       = shift;
 462                         my $xy          = shift;
 463                         my $xm          = shift;
 464                         my $xd          = shift;
 465
 466                         my $user = undef;
 467
 468                         if (not $user = $data->user($id)) {
 469                                 $user = Gruta::Data::User->new (
 470                                         id              => $id,
 471                                         is_admin        => 0,
 472                                         can_upload      => 0,
 473                                         xdate           => ''
 474                                 );
 475                         }
 476
 477                         $user->set('username',          $username);
 478                         $user->set('email',             $email);
 479
 480                         # these params can only be set by an admin
 481                         if ($data->auth() && $data->auth->get('is_admin')) {
 482
 483                                 $user->set('is_admin', $is_admin eq 'on' ? 1 : 0);
 484                                 $user->set('can_upload', $can_upload eq 'on' ? 1 : 0);
 485
 486                                 if ($xy and $xm and $xd) {
 487                                         $user->set('xdate',
 488                                                 sprintf('%04d%02d%02d000000',
 489                                                         $xy, $xm, $xd));
 490                                 }
 491                                 else {
 492                                         $user->set('xdate', '');
 493                                 }
 494                         }
 495
 496                         if ($pass1 and $pass2) {
 497                                 if ($pass1 ne $pass2) {
 498                                         croak "Passwords are different";
 499                                 }
 500
 501                                 my $salt = sprintf('%02d', rand(100));
 502                                 my $pw = crypt($pass1, $salt);
 503
 504                                 $user->set('password', $pw);
 505                         }
 506
 507                         if ($user->source()) {
 508                                 $user = $user->save();
 509                         }
 510                         else {
 511                                 $user = $data->insert_user($user);
 512                         }
 513
 514                         return $user ? 'OK' : 'Error 2';
 515                 };
 516
 517                 $f{upload} = sub {
 518
 519                         $data->cgi->upload($_[0], $_[1]);
 520                         return 'OK';
 521                 };
 522
 523                 $f{delete_story} = sub {
 524                         my $topic_id    = shift || return 'Error 1';
 525                         my $id          = shift;
 526
 527                         $data->story($topic_id, $id)->delete();
 528
 529                         # drop all cached stories
 530                         $data->flush_story_cache();
 531
 532                         return 'OK';
 533                 };
 534
 535                 $f{search_stories_by_tag} = sub {
 536                         my $tag         = shift;
 537                         my $template    = shift;
 538                         my $sep         = shift;
 539                         my $future      = shift;
 540
 541                         my @ret = $data->search_stories_by_tag($tag, $future);
 542                         $self->{search_count} = scalar(@ret);
 543
 544                         return join($sep, map { "{-$template|$_->[0]|$_->[1]}" } @ret);
 545                 };
 546
 547                 $f{search_count} = sub { $self->{search_count}; };
 548
 549                 $self->{abort}          = 0;
 550                 $self->{unresolved}     = [];
 551                 $self->{search_count}   = 0;
 552
 553                 $self->{_artemus} = Artemus->new(
 554                         'include-path'  =>      $self->{path},
 555                         'funcs'         =>      \%f,
 556                         'vars'          =>      \%v,
 557                         'unresolved'    =>      $self->{unresolved},
 558                         'abort'         =>      \$self->{abort},
 559                 );
 560
 561                 if ($self->{cgi_vars}) {
 562                         foreach my $k (keys(%{ $self->{cgi_vars} })) {
 563                                 my $c = $self->{_artemus}->
 564                                         armor($self->{cgi_vars}->{$k});
 565                                 $c =~ s/\r//g;
 566
 567                                 $v{"cgi-${k}"} = $c;
 568                         }
 569                 }
 570         }
 571
 572         return $self->{_artemus};
 573 }
 574
 575
 576 sub data {
 577         my $self        = shift;
 578         my $data        = shift;
 579
 580         if (defined($data)) {
 581                 $self->{data} = $data;
 582                 $self->{_artemus} = undef;
 583         }
 584
 585         return $self->{data};
 586 }
 587
 588
 589 sub cgi_vars {
 590         my $self        = shift;
 591
 592         if (@_) {
 593                 $self->{cgi_vars} = shift;
 594                 $self->{_artemus} = undef;
 595         }
 596
 597         return $self->{cgi_vars};
 598 }
 599
 600
 601 sub process { $_[0]->_artemus->process('{-' . $_[1] . '}'); }
 602
 603 1;