site/cgi-bin/modules/Generate/Article.pm

   1 package Generate::Article;
   2 use strict;
   3 use BSE::Template;
   4 use Constants qw(%LEVEL_DEFAULTS $CGI_URI $ADMIN_URI $IMAGES_URI
   5                  $UNLISTED_LEVEL1_IN_CRUMBS);
   6 use BSE::TB::Images;
   7 use vars qw(@ISA);
   8 use Generate;
   9 use BSE::Regen qw(generate_button);
  10 use BSE::Util::Tags qw(tag_article);
  11 use BSE::TB::ArticleFiles;
  12 @ISA = qw/Generate/;
  13 use BSE::Util::HTML;
  14 use BSE::Arrows;
  15 use Carp 'confess';
  16 use BSE::Util::Iterate;
  17
  18 our $VERSION = "1.003";
  19
  20 my $excerptSize = 300;
  21
  22 my %level_names = map { $_, $LEVEL_DEFAULTS{$_}{display} }
  23   grep { $LEVEL_DEFAULTS{$_}{display} } keys %LEVEL_DEFAULTS;
  24
  25 sub new {
  26   my ($class, %opts) = @_;
  27
  28   $opts{top} or confess "Please supply 'top' to $class->new";
  29
  30   return $class->SUPER::new(%opts);
  31 }
  32
  33 sub edit_link {
  34   my ($self, $id) = @_;
  35   return "$CGI_URI/admin/add.pl?id=$id";
  36 }
  37
  38 sub link_to_form {
  39   my ($self, $link, $text, $target) = @_;
  40
  41   my ($url, $query) = split /\?/, $link;
  42   my $form = qq!<form action="$url"!;
  43   $form .= qq! target="$target"! if $target;
  44   $form .= '>';
  45   if (defined $query && length $query) {
  46     for my $attr (split /&/, $query) {
  47       my ($name, $value) = split /=/, $attr, 2;
  48       # I'm assuming none of the values are uri escaped
  49       $value = escape_html($value);
  50       $form .= qq!<input type=hidden name="$name" value="$value" />!
  51     }
  52   }
  53   $form .= qq!<input type=submit value="!.escape_html($text).'" />';
  54   $form .= "</form>";
  55
  56   return $form;
  57 }
  58
  59 sub generate_low {
  60   my ($self, $template, $article, $articles, $embedded) = @_;
  61   my %acts;
  62   %acts = $self -> baseActs($articles, \%acts, $article, $embedded);
  63
  64   my $page = BSE::Template->replace($template, $self->{cfg}, \%acts);
  65
  66   %acts = (); # try to destroy any circular refs
  67
  68   return $page;
  69 }
  70
  71 sub tag_title {
  72   my ($cfg, $article, $images, $args, $acts, $funcname, $templater) = @_;
  73
  74   my $which = $args || 'article';
  75
  76   exists $acts->{$which}
  77     or return "** no such object $which **";
  78
  79   my $title = $templater->perform($acts, $which, 'title');
  80   my $imagename = $which eq 'article' ? $article->{titleImage} :
  81     $templater->perform($acts, $which, 'titleImage');
  82   my $xhtml = $cfg->entry("basic", "xhtml", 1);
  83   if ($imagename) {
  84     my $html = qq!<img src="/images/titles/$imagename"!;
  85     $html .= ' border="0"' unless $xhtml;
  86     $html .= qq! class="bse_image_title" alt="$title" />!;
  87   }
  88   my $im;
  89   if ($which eq 'article') {
  90     ($im) = grep lc $_->{name} eq 'bse_title', @$images;
  91   }
  92   else {
  93     my $id = $templater->perform($acts, $which, 'id');
  94     require BSE::TB::Images;
  95     my @images = BSE::TB::Images->getBy(articleId=>$id);
  96     ($im) = grep lc $_->{name} eq 'bse_title', @$images;
  97   }
  98
  99   if ($im) {
 100     my $src = $im->{src} || "/images/$im->{image}";
 101     $src = escape_html($src);
 102     return qq!<img src="$src" width="$im->{width}"!
 103       . qq! height="$im->{height}" alt="$title" class="bse_image_title" />!;
 104   }
 105   else {
 106     return $title;
 107   }
 108 }
 109
 110 sub _default_admin {
 111   my ($self, $article, $embedded) = @_;
 112
 113   my $req = $self->{request};
 114   my $html = <<HTML;
 115 <table><tr>
 116 <td><form action="$CGI_URI/admin/add.pl" name="edit">
 117 <input type=submit value="Edit $level_names{$article->{level}}">
 118 <input type=hidden name=id value="$article->{id}">
 119 </form></td>
 120 <td><form action="$ADMIN_URI">
 121 <input type=submit value="Admin menu">
 122 </form></td>
 123 HTML
 124   if (exists $level_names{1+$article->{level}}
 125       && $req->user_can(edit_add_child=>$article)) {
 126     $html .= <<HTML;
 127 <td><form action="$CGI_URI/admin/add.pl" name="addchild">
 128 <input type=submit value="Add $level_names{1+$article->{level}}">
 129 <input type=hidden name=parentid value="$article->{id}">
 130 </form></td>
 131 HTML
 132   }
 133   if (generate_button() && $req->user_can(regen_article=>$article)) {
 134     $html .= <<HTML;
 135 <td><form action="$CGI_URI/admin/generate.pl" name="regen">
 136 <input type=hidden name=id value="$article->{id}">
 137 <input type=submit value="Regenerate">
 138 </form></td>
 139 HTML
 140   }
 141   $html .= "<td>".$self->link_to_form($article->{admin}."&admin=0",
 142                                       "Display", "_blank")."</td>";
 143   my $parent = $article->parent;
 144   if ($article->{link}) {
 145     $html .= "<td>"
 146       . $self->link_to_form($article->{link}, "On site", "_blank")
 147         . "</td>";
 148   } elsif ($parent && $parent->{link}) {
 149     $html .= "<td>"
 150       . $self->link_to_form($parent->{link}, "On site", "_blank")
 151         . "</td>";
 152   }
 153   if ($parent && $parent->{admin} ne $article->{admin} && !$embedded) {
 154     $html .= "<td>"
 155       .$self->link_to_form($parent->{admin}, "Parent")."</td>";
 156   }
 157   $html .= <<HTML;
 158 </tr></table>
 159 HTML
 160   return $html;
 161 }
 162
 163 sub abs_urls {
 164   my ($self, $article) = @_;
 165
 166   my $top = $self->{top} || $article;
 167
 168   $article->{link} =~ /^\w+:/ || $top->{link} =~ /^\w+:/;
 169 }
 170
 171 sub tag_admin {
 172   my ($self, $article, $default, $embedded, $arg) = @_;
 173
 174   $self->{admin} or return '';
 175   $self->{request} or return '';
 176   my $cfg = $self->{cfg};
 177
 178   my $name = $arg || $default;
 179   my $template = "admin/adminmenu/$name";
 180
 181   unless (BSE::Template->find_source($template, $cfg)) {
 182     return $self->_default_admin($article, $embedded);
 183   }
 184
 185   my $parent = $article->parent;
 186   my %acts;
 187   %acts =
 188     (
 189      $self->{request}->admin_tags,
 190      article => [ \&tag_article, $article, $cfg ],
 191      parent => [ \&tag_article, $parent, $cfg ],
 192      ifParent => $parent,
 193      ifEmbedded => $embedded,
 194     );
 195
 196   return BSE::Template->get_page($template, $cfg, \%acts);
 197 }
 198
 199 sub tag_thumbimage {
 200   my ($self, $rcurrent, $images, $args, $acts, $funcname, $templater) = @_;
 201
 202   my ($geometry_id, $id, $field) =
 203     DevHelp::Tags->get_parms($args, $acts, $templater);
 204
 205   return $self->do_thumbimage($geometry_id, $id, $field, $images, $$rcurrent);
 206 }
 207
 208 sub iter_images {
 209   my ($self, $images, $arg) = @_;
 210
 211   if ($arg eq 'all') {
 212     return @$images;
 213   }
 214   elsif ($arg eq 'named') {
 215     return grep $_->{name} ne '', @$images;
 216   }
 217   elsif ($arg =~ m!^named\s+/([^/]+)/$!) {
 218     my $re = $1;
 219     return grep $_->{name} =~ /$re/i, @$images;
 220   }
 221   else {
 222     return grep $_->{name} eq '', @$images;
 223   }
 224 }
 225
 226 =item filen name
 227
 228 =item filen name field
 229
 230 =item filen -
 231
 232 =item filen - field
 233
 234 Reference an article attached file by name.
 235
 236 C<filen name> will display a link to the file.
 237
 238 C<<filen name I<field> >> will display the given field from the file
 239 record.  A I<field> of C<url> will be a URL to the file.
 240
 241 If the file identifier given doesn't exist for the current article the
 242 empty string is returned, allowing use as ifFilen.
 243
 244 The result is unspecified if the I<field> specified isn't one of the
 245 image record field names and isn't C<url>.
 246
 247 =cut
 248
 249 sub tag_filen {
 250   my ($self, $files, $current, $arg, $acts, $funcname, $templater) = @_;
 251
 252   my ($name, $field, @rest) =
 253     DevHelp::Tags->get_parms($arg, $acts, $templater);
 254
 255   length $name
 256     or return '* name cannot be an empty string *';
 257
 258   my $file;
 259   if ($name eq '-') {
 260     $$current
 261       or return "* filen - can only be used inside a files iterator *";
 262
 263     $file = $$current;
 264   }
 265   else {
 266     ($file) = grep $_->{name} eq $name, @$files
 267       or return '';
 268   }
 269
 270   return $self->_format_file($file, $field, "@rest");
 271 }
 272
 273 =item iterator begin files
 274
 275 =item iterator begin files named /foo/
 276
 277 =item iterator begin files filter: FILE[file_handler] eq 'flv'
 278
 279 =item file field
 280
 281 Iterate over files attached to the current article.
 282
 283 <:file field:> can only access simple attributes.
 284
 285 <:filen - field:> can also access any inline representations.
 286
 287 =cut
 288
 289 sub iter_files {
 290   my ($self, $files, $arg, $acts, $funcname, $templater) = @_;
 291
 292   $arg =~ /\S/
 293     or return @$files;
 294
 295   if ($arg =~ m(^named\s+/([^/]+)/$)) {
 296     my $re = $1;
 297     return grep $_->{name} =~ /$re/i, @$files;
 298   }
 299   if ($arg =~ m(^filter: (.*)$)s) {
 300     my $expr = $1;
 301     $expr =~ s/FILE\[(\w+)\]/\$file->$1/g;
 302     my $sub = eval 'sub { my $file = shift; ' . $expr . '; }';
 303     $sub
 304       or die "* Cannot compile sub from filter $expr: $@ *";
 305     return grep $sub->($_), @$files;
 306   }
 307
 308   die "* Unknown type of file filter expression *";
 309 }
 310
 311 =item iterator: crumbs/crumb
 312
 313 Iterators over the ancestor tree from the article parent to the root.
 314
 315 Parameters include:
 316
 317 =over
 318
 319 =item *
 320
 321 showtop - the top level article is included even if unlisted
 322
 323 =item *
 324
 325 listedonly - only listed articles in the tree are included
 326
 327 =back
 328
 329 The default depends on the value of $Constants::UNLISTED_LEVEL1_IN_CRUMBS.
 330
 331 =cut
 332
 333 sub iter_crumbs {
 334   my ($self, $crumbs, $args) = @_;
 335
 336   $args ||= $UNLISTED_LEVEL1_IN_CRUMBS ? 'showtop' : 'listedonly';
 337   if ($args eq 'showtop') {
 338     return @$crumbs;
 339   }
 340   else {
 341     return grep $_->{listed}, @$crumbs;
 342   }
 343 }
 344
 345 sub tag_ifUnderThreshold {
 346   my ($self, $article, $args) = @_;
 347
 348   my $count;
 349   my $what = $args || '';
 350   if ($self->{kids}{$article->{id}}{$what}) {
 351     $count = @{$self->{kids}{$article->{id}}{$what}};
 352   }
 353   else {
 354     $count = @{$self->{kids}{$article->{id}}{children}};
 355   }
 356
 357   return $count <= $article->{threshold};
 358 }
 359
 360 sub baseActs {
 361   my ($self, $articles, $acts, $article, $embedded) = @_;
 362
 363   my $cfg = $self->{cfg} || BSE::Cfg->single;
 364
 365   # used to generate the list (or not) of children to this article
 366   my $child_index = -1;
 367   my @children = $articles->listedChildren($article->{id});
 368
 369   # used to generate a navigation list for the article
 370   # generate a list of ancester articles/sections
 371   # Jason calls these breadcrumbs
 372   my @crumbs;
 373   my @ancestors;
 374   my $temp = $article;
 375   while ($temp->{parentid} > 0
 376         and my $crumb = $articles->getByPkey($temp->{parentid})) {
 377     unshift(@ancestors, $crumb);
 378     unshift(@crumbs, $crumb) if $crumb->{listed} == 1 || $crumb->{level} == 1;
 379     $temp = $crumb;
 380   }
 381   #my $crumb_index = -1;
 382   #my @work_crumbs; # set by the crumbs iterator
 383   my $current_crumb;
 384
 385   my $parent = $articles->getByPkey($article->{parentid});
 386   my $section = @crumbs ? $crumbs[0] : $article;
 387
 388   my @images = BSE::TB::Images->getBy('articleId', $article->{id});
 389   my @unnamed_images = grep $_->{name} eq '', @images;
 390   my @iter_images;
 391   my $image_index = -1;
 392   my $had_image_tags = 0;
 393   my @all_files = sort { $b->{displayOrder} <=> $a->{displayOrder} }
 394     BSE::TB::ArticleFiles->getBy(articleId=>$article->{id});
 395   my @files = grep !$_->{hide_from_list}, @all_files;
 396
 397   my $blank = qq!<img src="$IMAGES_URI/trans_pixel.gif"  width="17" height="13" border="0" align="absbottom" alt="" />!;
 398
 399   my $top = $self->{top} || $article;
 400   my $abs_urls = $self->abs_urls($article);
 401
 402   my $dynamic = $self->{force_dynamic}
 403     || (UNIVERSAL::isa($top, 'Article') ? $top->is_dynamic : 0);
 404
 405   my @stepkids;
 406   my @allkids;
 407   my @stepparents;
 408   if (UNIVERSAL::isa($article, 'Article')) {
 409     @stepkids     = $article->visible_stepkids;
 410     @allkids      = $article->all_visible_kids;
 411     @stepparents  = $article->visible_step_parents;
 412   }
 413   $self->{kids}{$article->{id}}{stepkids} = \@stepkids;
 414   $self->{kids}{$article->{id}}{allkids} = \@allkids;
 415   $self->{kids}{$article->{id}}{children} = \@children;
 416
 417   my $allkids_index;
 418   my $current_image;
 419   my $current_file;
 420   my $art_it = BSE::Util::Iterate::Article->new(cfg =>$cfg, admin => $self->{admin}, top => $self->{top});
 421   my $it = BSE::Util::Iterate->new;
 422   # separate these so the closures can see %acts
 423   my %acts =
 424     (
 425      $self->SUPER::baseActs($articles, $acts, $article, $embedded),
 426      article=>[ \&tag_article, $article, $cfg ],
 427      ifTitleImage =>
 428      sub {
 429        my $which = shift || 'article';
 430        return $acts->{$which} && $acts->{$which}->('titleImage')
 431      },
 432      title => [ \&tag_title, $cfg, $article, \@images ],
 433      thumbnail =>
 434      sub {
 435        my ($args, $acts, $name, $templater) = @_;
 436        my ($which, $class) = split ' ', $args;
 437        $which ||= 'article';
 438        if ($acts->{$which} &&
 439            (my $image = $templater->perform($acts, $which, 'thumbImage'))) {
 440          my $width = $templater->perform($acts, $which, 'thumbWidth');
 441          my $height = $templater->perform($acts, $which, 'thumbHeight');
 442          my $result = '<img src="/images/'.$image
 443            .'" width="'.$width
 444              .'" height="'.$height.'"';
 445          $result .= qq! class="$class"! if $class;
 446          $result .= ' border="0" alt="" />';
 447          return $result;
 448        }
 449        else {
 450          return '';
 451        }
 452      },
 453      ifThumbnail =>
 454      sub {
 455        my ($which, $acts, $name, $templater) = @_;
 456        $which ||= 'article';
 457        return $acts->{$which} &&
 458          $templater->perform($acts, $which, 'thumbImage');
 459      },
 460      ifUnderThreshold =>
 461      [ tag_ifUnderThreshold => $self, $article ],
 462      ifChildren => sub { scalar @children },
 463      iterate_children_reset => sub { $child_index = -1; },
 464      iterate_children =>
 465      sub {
 466        return ++$child_index < @children;
 467      },
 468      child =>
 469      sub {
 470        return tag_article($children[$child_index], $cfg, $_[0]);
 471      },
 472
 473      section=> [ \&tag_article, $section, $cfg ],
 474
 475      # these are mostly obsolete, use moveUp and moveDown instead
 476      # where possible
 477      ifPrevChild => sub { $child_index > 0 },
 478      ifNextChild => sub { $child_index < $#children },
 479
 480      # generate buttons for administration (only for admin generation)
 481      admin=> [ tag_admin=>$self, $article, 'article', $embedded ],
 482
 483      # transform the article or response body (entities, images)
 484      body=>sub {
 485        my ($args, $acts, $funcname, $templater) = @_;
 486        return $self->format_body(acts => $acts,
 487                                  article => $articles,
 488                                  text => $article->{body},
 489                                  imagepos => $article->{imagePos},
 490                                  abs_urls => $abs_urls,
 491                                  auto_images => !$had_image_tags,
 492                                  templater => $templater,
 493                                  images => \@images,
 494                                  files => \@all_files,
 495                                  articles => $articles);
 496      },
 497
 498      # used to display a navigation path of parent sections
 499      $art_it->make_iterator([ iter_crumbs => $self, \@crumbs ],
 500                             'crumb', 'crumbs', undef, undef,
 501                             'nocache', \$current_crumb),
 502      crumbs =>
 503      sub {
 504        # this is obsolete
 505        $cfg->entry('basic', 'warn_obsolete', 0)
 506          and print STDERR "* crumbs tag obsolete *\n";
 507        return tag_article($current_crumb, $cfg, $_[0]);
 508      },
 509
 510      # access to parent
 511      ifParent => sub { $parent },
 512      parent =>
 513      sub { return $parent && tag_article($parent, $cfg, $_[0]) },
 514      # for rearranging order in admin mode
 515      moveDown=>
 516      sub {
 517        @children > 1 or return '';
 518        if ($self->{admin} && $child_index < $#children) {
 519          my $html = <<HTML;
 520 <a href="$CGI_URI/admin/move.pl?id=$children[$child_index]{id}&amp;d=down"><img src="$IMAGES_URI/admin/move_down.gif" width="17" height="13" border="0" alt="Move Down" align="bottom" /></a>
 521 HTML
 522          chop $html;
 523          return $html;
 524        } else {
 525          return $blank;
 526        }
 527      },
 528      moveUp=>
 529      sub {
 530        @children > 1 or return '';
 531        if ($self->{admin} && $child_index > 0) {
 532          my $html = <<HTML;
 533 <a href="$CGI_URI/admin/move.pl?id=$children[$child_index]{id}&amp;d=up"><img src="$IMAGES_URI/admin/move_up.gif" width="17" height="13" border="0" alt="Move Up" align="bottom" /></a>
 534 HTML
 535          chop $html;
 536          return $html;
 537        } else {
 538          return $blank;
 539        }
 540      },
 541      movekid => [ \&tag_movekid, $self, \$child_index, \@children, $article ],
 542      movestepkid =>
 543      sub {
 544        my ($arg, $acts, $funcname, $templater) = @_;
 545        my $html = '';
 546        return '' unless $self->{admin};
 547        return '' unless @allkids > 1;
 548        defined $allkids_index && $allkids_index >= 0 && $allkids_index < @allkids
 549          or return '** movestepkid must be inside iterator allkids **';
 550        my ($img_prefix, $urladd) =
 551          DevHelp::Tags->get_parms($arg, $acts, $templater);
 552        $img_prefix = '' unless defined $img_prefix;
 553        $urladd = '' unless defined $urladd;
 554        my $top = $self->{top} || $article;
 555        my $refreshto = $ENV{SCRIPT_NAME} . "?id=$top->{id}$urladd";
 556        my $down_url = "";
 557        if ($allkids_index < $#allkids) {
 558          $down_url = "$CGI_URI/admin/move.pl?stepparent=$article->{id}&d=swap&id=$allkids[$allkids_index]{id}&other=$allkids[$allkids_index+1]{id}";
 559        }
 560        my $up_url = "";
 561        if ($allkids_index > 0) {
 562          $up_url = "$CGI_URI/admin/move.pl?stepparent=$article->{id}&d=swap&id=$allkids[$allkids_index]{id}&other=$allkids[$allkids_index-1]{id}";
 563        }
 564
 565        return make_arrows($self->{cfg}, $down_url, $up_url, $refreshto, $img_prefix);
 566      },
 567      ifCurrentPage=>
 568      sub {
 569        my $arg = shift;
 570        $arg && $acts->{$arg} && $acts->{$arg}->('id') == $article->{id};
 571      },
 572      ifAncestor =>
 573      sub {
 574        my ($arg, $acts, $name, $templater) = @_;
 575        unless ($arg =~ /^\d+$/) {
 576          $acts->{$arg} or die "ENOIMPL\n";
 577          $arg = $acts->{$arg} && $templater->perform($acts, $arg, 'id')
 578            or return;
 579        }
 580        scalar grep $_->{id} == $arg, @ancestors, $article;
 581      },
 582      ifStepAncestor => [ \&tag_ifStepAncestor, $article ],
 583      # access to images, if any
 584      $it->make_iterator([ iter_images => $self, \@images ], 'image', 'images', \@iter_images, \$image_index, 'nocache', \$current_image),
 585      # override the generated image tag
 586      image =>
 587      sub {
 588        my ($which, $align, $rest) = split ' ', $_[0], 3;
 589
 590        $had_image_tags = 1;
 591        my $im;
 592        if (defined $which && $which =~ /^\d+$/ && $which >=1
 593            && $which <= @images) {
 594          $im = $images[$which-1];
 595        }
 596        else {
 597          $im = $current_image;
 598        }
 599
 600        return $self->_format_image($im, $align, $rest);
 601      },
 602      imagen =>
 603      sub {
 604        my ($arg, $acts, $funcname, $templater) = @_;
 605        my ($name, $align, @rest) =
 606          DevHelp::Tags->get_parms($arg, $acts, $templater);
 607        my $rest = "@rest";
 608
 609        my ($im) = grep lc $name eq lc $_->{name}, @images
 610          or return '';
 611
 612        $self->_format_image($im, $align, $rest);
 613      },
 614      ifImage => sub { $_[0] >= 1 && $_[0] <= @images },
 615      thumbimage => [ tag_thumbimage => $self, \$current_image, \@images ],
 616      $it->make
 617      (
 618       plural => "files",
 619       single => "file",
 620       code => [ iter_files => $self, \@files ],
 621       nocache => 1,
 622       store => \$current_file,
 623      ),
 624      filen => [ tag_filen => $self, \@files, \$current_file ],
 625      BSE::Util::Tags->make_iterator(\@stepkids, 'stepkid', 'stepkids'),
 626      $art_it->make_iterator(undef, 'allkid', 'allkids', \@allkids, \$allkids_index),
 627      $art_it->make_iterator(undef, 'stepparent', 'stepparents', \@stepparents),
 628      top => [ \&tag_article, $self->{top} || $article, $cfg ],
 629      ifDynamic => $dynamic,
 630      ifStatic => !$dynamic,
 631      ifAccessControlled => [ \&tag_ifAccessControlled, $article ],
 632     );
 633
 634   if ($abs_urls) {
 635     my $oldurl = $acts{url};
 636     my $urlbase = $cfg->entryErr('site', 'url');
 637     $acts{url} =
 638       sub {
 639         my $value = $oldurl->(@_);
 640         return $value if $value =~ /^<:/; # handle "can't do it"
 641         unless ($value =~ /^\w+:/) {
 642           # put in the base site url
 643           $value = $urlbase . $value;
 644         }
 645         return $value;
 646       };
 647   }
 648   if ($dynamic && $cfg->entry('basic', 'ajax', 0)) {
 649     # make sure the ajax tags are left until we do dynamic replacement
 650     delete @acts{qw/ajax ifAjax/};
 651   }
 652
 653   return %acts;
 654 }
 655
 656 sub tag_ifStepAncestor {
 657   my ($article, $arg, $acts, $name, $templater) = @_;
 658
 659   unless ($arg =~ /^\d+$/) {
 660     $acts->{$arg} or die "ENOIMPL\n";
 661     $arg = $acts->{$arg} && $templater->perform($acts, $arg, 'id')
 662       or return;
 663   }
 664   return 0 if $article->{id} < 0;
 665   return $article->{id} == $arg || $article->is_step_ancestor($arg);
 666 }
 667
 668 sub tag_ifDynamic {
 669   my ($self, $top) = @_;
 670
 671   # this is to support pregenerated pages being handled as dynamic pages
 672   $self->{force_dynamic} and return 1;
 673
 674   UNIVERSAL::isa($top, 'Article') ? $top->is_dynamic : 0;
 675 }
 676
 677 sub tag_ifAccessControlled {
 678   my ($article, $arg, $acts, $funcname, $templater) = @_;
 679
 680   if ($arg) {
 681     if ($acts->{$arg}) {
 682       my $id = $templater->perform($acts, $arg, 'id');
 683       $article = Articles->getByPkey($id);
 684       unless ($article) {
 685         print STDERR "** Unknown article $id from $arg in ifAccessControlled\n";
 686         return 0;
 687       }
 688     }
 689     else {
 690       print STDERR "** Unknown article $arg in ifAccessControlled\n";
 691       return 0;
 692     }
 693   }
 694
 695   return UNIVERSAL::isa($article, 'Article') ?
 696     $article->is_access_controlled : 0;
 697 }
 698
 699 sub get_image {
 700   my ($self, $image_id, $images) = @_;
 701
 702   my $im;
 703   if ($image_id =~ /^\d+$/) {
 704     $image_id >= 1 && $image_id <= @$images
 705       or return ( undef, "* Out of range image index '$image_id' *" );
 706
 707     $im = $images->[$image_id-1];
 708   }
 709   elsif ($image_id =~ /^[^\W\d]\w*$/) {
 710     ($im) = grep $_->{name} eq $image_id, @$images
 711       or return ( undef, "* Unknown image identifier '$image_id' *" );
 712   }
 713   else {
 714     return ( undef, "* Unrecognized image '$image_id' *" );
 715   }
 716
 717   return $im;
 718 }
 719
 720 sub do_popimage {
 721   my ($self, $image_id, $class, $images) = @_;
 722
 723   my ($im, $msg) = $self->get_image($image_id, $images);
 724   $im
 725     or return $msg;
 726
 727   return $self->do_popimage_low($im, $class);
 728 }
 729
 730 # note: this is called by BSE::Formatter::thumbimage(), update that if
 731 # this is changed
 732 sub do_thumbimage {
 733   my ($self, $geo_id, $image_id, $field, $images, $current) = @_;
 734
 735   my $im;
 736   if ($image_id eq '-' && $current) {
 737     $im = $current
 738       or return "** No current image in images iterator **"
 739   }
 740   else {
 741     ($im, my $msg) = $self->get_image($image_id, $images);
 742     $im
 743       or return $msg;
 744   }
 745
 746   return $self->_sthumbimage_low($geo_id, $im, $field);
 747 }
 748
 749 sub generate {
 750   my ($self, $article, $articles) = @_;
 751
 752   my $html = BSE::Template->get_source($article->{template}, $self->{cfg});
 753   $html =~ s/<:\s*embed\s+(?:start|end)\s*:>//g;
 754
 755   return $self->generate_low($html, $article, $articles, 0);
 756 }
 757
 758 sub tag_movekid {
 759   my ($self, $rindex, $rchildren, $article, $args, $acts,
 760       $funcname, $templater) = @_;
 761
 762   $self->{admin} or return '';
 763   @$rchildren or return '';
 764
 765   my ($img_prefix, $urladd) =
 766     DevHelp::Tags->get_parms($args, $acts, $templater);
 767   defined $img_prefix or $img_prefix = '';
 768   defined $urladd or $urladd = '';
 769
 770   my $top = $self->{top} || $article;
 771   my $refreshto = $ENV{SCRIPT_NAME} . "?id=$top->{id}$urladd";
 772   my $down_url = "";
 773   if ($$rindex < $#$rchildren) {
 774     $down_url = "$CGI_URI/admin/move.pl?id=$rchildren->[$$rindex]{id}&d=down";
 775   }
 776   my $up_url = "";
 777   if ($$rindex > 0) {
 778     $up_url = "$CGI_URI/admin/move.pl?id=$rchildren->[$$rindex]{id}&d=up";
 779   }
 780
 781   return make_arrows($self->{cfg}, $down_url, $up_url, $refreshto, $img_prefix);
 782 }
 783
 784 sub _find_articles {
 785   my ($self, $article_id, $article, @rest) = @_;
 786
 787   if ($article_id eq 'article') {
 788     return $article;
 789   }
 790   elsif ($article_id eq 'children') {
 791     return $article->all_visible_kids;
 792   }
 793   elsif ($article_id eq 'parent') {
 794     return $article->parent;
 795   }
 796   else {
 797     return $self->SUPER::_find_articles($article_id, $article, @rest);
 798   }
 799 }
 800
 801 1;
 802
 803 __END__
 804
 805 =head1 NAME
 806
 807   Generate::Article - generates articles.
 808
 809 =head1 SYNOPSIS
 810
 811 =head1 DESCRIPTION
 812
 813 =head1 TAGS
 814
 815
 816 =head2 Tag notes
 817
 818 In your HTML each tag will be preceded by <: and followed by :>
 819
 820 Tags marked as conditional will require a little more.  Conditional
 821 tags can be used in two ways:
 822
 823 <:ifName args:>true text<:or:>false text<:eif:>
 824
 825 or:
 826
 827 <:if Name args:>true text<:or Name:>false text<:eif Name:>
 828
 829 Tags starting iterator ... are used as iterators, like:
 830
 831 <:iterator begin name:>
 832 repeated text
 833 <:iterator separator name:>
 834 separator text
 835 <:iterator end name:>
 836
 837 In general, a parameter I<which> can be any one of 'article', 'parent'
 838 or 'section'.  In a child iterator it can also be 'child'.  In a
 839 crumbs iterator it can also be 'crumbs'.  If I<which> is missing it
 840 means the current article.
 841
 842 =head2 Normal tags
 843
 844 =over 4
 845
 846 =item article I<name>
 847
 848 Access to fields of the article. See L<Article attributes>.
 849
 850 =item parent I<name>
 851
 852 Access to fields of the parent article. See L<Article attributes>.
 853
 854 =item ifParent
 855
 856 Conditional tag, true if there is a parent.
 857
 858 =item section I<name>
 859
 860 Access to the fields of the section containing the article.  See
 861 L<Article attributes>.
 862
 863 =item title I<which>
 864
 865 The title of the article presented as an image if there is a
 866 titleImage or as text.  See L<Tag notes> for values for which.
 867
 868 =item ifTitleImage I<which>
 869
 870 Conditional tag, true if the given article has a titleImage,
 871
 872 =item thumbnail I<which> I<class>
 873
 874 The thumbnail image as an <img> tag for object I<which> where I<which>
 875 is one of the article objects defined.  The optional I<class> adds a
 876 class attribute to the tag with that class.
 877
 878 =item ifThumbnail I<which>
 879
 880 Conditional tag, true if the article specified by I<which> has a
 881 thumbnail.
 882
 883 =item ifUnderThreshold
 884
 885 =item ifUnderThreshold stepkids
 886
 887 =item ifUnderThreshold allkids
 888
 889 Conditional tag, true if the number of children/stepkids/allkids is
 890 less or equal to the article's threshold.
 891
 892 =item body
 893
 894 The formatted body of the article.
 895
 896 =item keywords
 897
 898 Ignore this one.
 899
 900 =item iterator ... crumbs [option]
 901
 902 Iterates over the ancestors of the article.  See the L</item crumbs>.
 903
 904 I<option> can be empty, "listedonly" or "showtop".  If empty the
 905 display of an unlisted level1 ancestor is controlled by
 906 $UNLISTED_LEVEL1_IN_CRUMBS, if "listedonly" then an unlisted level1
 907 article isn't shown in the crumbs, and it is if "showtop" is the
 908 I<option>.  This can be used in <: ifCrumbs :> too.
 909
 910 =item crumbs I<name>
 911
 912 Access to the fields of the specific ancestor.  I<name> can be any of
 913 the L<Article attributes>.
 914
 915 =item ifCrumbs [options]
 916
 917 Conditional tag, true if there are any crumbs.
 918
 919 See L</iterator ... crumbs [option]> for information on I<option>.
 920
 921 =item ifChildren
 922
 923 Conditional tag, true if the article has any children.
 924
 925 =item iterator ... children
 926
 927 Iterates over the children of the article.  See the L</item child>.
 928
 929 =item child I<name>
 930
 931 Access to the fields of the current child.
 932
 933 =item summary
 934
 935 Produces a processed summary of the current child's body.
 936
 937 =item ifPrevChild
 938
 939 Conditional tag, true if there is a previous child.  Originally used
 940 for generating a move up link, but you can use the moveUp tag for
 941 that now.
 942
 943 =item ifNextChild
 944
 945 Conditional tag, true if there is a next child.  Originally used to
 946 generating a move down link, but you can use the moveDown tag for that
 947 now.
 948
 949 =item ifCurrentPage I<which>
 950
 951 Conditional tag, true if the given I<which> is the page currently
 952 being generated.  This can be used to apply special formatting if a
 953 C<level1> or C<level2> article is the current page.
 954
 955 =item iterator ... images
 956
 957 Iterates over the unnamed images for the given article.
 958
 959 =item iterator ... images all
 960
 961 Iterates over all images for the article.
 962
 963 =item iterator ... images named
 964
 965 Iterates over the named images for the article.
 966
 967 =item iterator ... images named /regexp/
 968
 969 Iterates over images with names matching the given regular expression.
 970 Note that if the expression matches an empty string then unnamed
 971 images will be included.
 972
 973 =item image which field
 974
 975 Extracts the given field from the specified image.
 976
 977 I<which> in this can be either an image index to access a specific
 978 image, or "-" to access the current image in the images iterator.
 979
 980 The image fields are:
 981
 982 =over
 983
 984 =item articleId
 985
 986 The identifier of the article the image belongs to.
 987
 988 =item image
 989
 990 A partial url of the image, relative to /images/.
 991
 992 =item alt
 993
 994 Alternative text of the image.
 995
 996 =item width
 997
 998 =item height
 999
1000 dimensions of the image.
1001
1002 =item url
1003
1004 the url if any associated with the image
1005
1006 =back
1007
1008 =item image which align
1009
1010 =item image which
1011
1012 =item image
1013
1014 Produces HTML to render the given image.
1015
1016 I<which> can be an image index (1, 2, 3...) to select one of the
1017 images from the current article, or '-' or omitted to select the
1018 current image from the images iterator.  If align is present then the
1019 C<align> attribute of the image is set.
1020
1021 If the image has a URL that <a href="...">...</a> will also be
1022 generated.
1023
1024 =item ifImage imageindex
1025
1026 Condition tag, true if an image exists at the given index.
1027
1028 =item ifImages
1029
1030 =item ifImages all
1031
1032 Conditional tag, true if the article has any images.
1033
1034 =item ifImages named
1035
1036 Conditional tag, true if the article has any named images.
1037
1038 =item ifImages named /regexp/
1039
1040 Conditional tag, true if the article has any named images, where the
1041 name matches the regular expression.
1042
1043 =item ifImages unnamed
1044
1045 Conditional tag, true if the article has any unnamed images.
1046
1047 =item embed child
1048
1049 This has been made more general and been moved, see L<Generate/embed child>.
1050
1051 =item ifDynamic
1052
1053 Tests if the article is dynamically generated.
1054
1055 =item top I<field>
1056
1057 Toplevel article being generated.  This is the page that any articles
1058 are being embedded in.
1059
1060 =item iterator ... files
1061
1062 Iterates over the files attached to the article, setting the file tag.
1063
1064 =item file I<field>
1065
1066 Information from the current file in the files iterator.
1067
1068 The file fields are:
1069
1070 =over
1071
1072 =item *
1073
1074 id - identifier for this file
1075
1076 =item *
1077
1078 articleId - article this file belongs to
1079
1080 =item *
1081
1082 displayName - the filename of the file as displayed
1083
1084 =item *
1085
1086 filename - filename of the file as stored on disk,
1087
1088 =item *
1089
1090 sizeInBytes - size of the file in bytes.
1091
1092 =item *
1093
1094 description - the entered description of the file
1095
1096 =item *
1097
1098 contentType - the MIME content type of the file
1099
1100 =item *
1101
1102 displayOrder - number used to control the listing order.
1103
1104 =item *
1105
1106 forSale - non-zero if the file needs to be paid for to be downloaded.
1107
1108 =item *
1109
1110 download - if this is non-zero BSE will attempt to make the browser
1111 download the file rather than display it.
1112
1113 =item *
1114
1115 whenUploaded - date/time when the file was uploaded.
1116
1117 =item *
1118
1119 requireUser - if non-zero the user must be logged on to download this
1120 file.
1121
1122 =item *
1123
1124 notes - longer descriptive text.
1125
1126 =item *
1127
1128 name - identifier for the file for filelink[]
1129
1130 =item *
1131
1132 hide_from_list - if non-zero the file won't be listed by the files
1133 iterator, but will still be available to filelink[].
1134
1135 =back
1136
1137 =back
1138
1139 =head2 Article attributes
1140
1141 =over 4
1142
1143 =item id
1144
1145 Identifies the article.
1146
1147 =item parentId
1148
1149 The identifier of the parent article.
1150
1151 =item title
1152
1153 The title of the article.  See the title tag
1154
1155 =item titleImage
1156
1157 The name of the title image for the article, if any.  See the title
1158 and ifTitleImage tags.
1159
1160 =item body
1161
1162 The body of the article.  See the body tag.
1163
1164 =item thumbImage
1165
1166 =item thumbWidth
1167
1168 =item thumbHeight
1169
1170 The thumbnail image for the article, if any.  See the thumbnail tag.
1171
1172 =item release
1173
1174 =item expire
1175
1176 The release and expiry dates of the article.
1177
1178 =item keyword
1179
1180 Any keywords for the article.  Indexed by the search engine.
1181
1182 =item link
1183
1184 =item admin
1185
1186 Links to the normal and adminstrative versions of the article.  The
1187 url tag defined by Generate.pm will select the appropriate tag for the
1188 current mode.
1189
1190 =item threshold
1191
1192 The maximum number of articles that should be embeded into the current
1193 article for display.  See the ifUnderThreshold tag.
1194
1195 =item summaryLength
1196
1197 The maximum amount of text displayed in the summary of an article.
1198 See the summary tag.
1199
1200 =item generator
1201
1202 The class used to generate the article.  Should be one of
1203 Generate::Article, Generate::Catalog or Generate::Product.
1204
1205 =item level
1206
1207 The level of the article.  Sections are level1, etc
1208
1209 =item listed
1210
1211 How the article is listed.  If zero then the article can only be found
1212 in a search.  If 1 then the article is listed in menus and article
1213 contents, if 2 then the article is only listed in article contents.
1214
1215 =item lastModified
1216
1217 When the article was last modified.  Currently only used for display
1218 in search results.
1219
1220 =item lastModifiedBy
1221
1222 Set the the current admin user logon if access_control is enabled in the cfg.
1223
1224 =item created
1225
1226 Set to the current date time when a new article is created.
1227
1228 =item createdBy
1229
1230 Set to the current admin user logon if access_control is enabled in
1231 the cfg.
1232
1233 =item author
1234
1235 A user definable field for attributing the article author.
1236
1237 =item pageTitle
1238
1239 An alternate article title which can be used to make search engine
1240 baited oage titles.
1241
1242 =item metaDescription
1243
1244 Article metadata description, used as metadata in the generated HTML
1245 output.
1246
1247 =item metaKeywords
1248
1249 Article metadata keywords, used as metadata in the generated HTML
1250 output.
1251
1252 =back
1253
1254 The following attributes are unlikely to be used in a page:
1255
1256 =over 4
1257
1258 =item displayOrder
1259
1260 Used internally to control the ordering of articles within a section.
1261
1262 =item imagePos
1263
1264 The position of the first image in the body.  The body tag will format
1265 images into the body as specified by this tag.
1266
1267 =item template
1268
1269 The template used to format the article.
1270
1271 =item flags
1272
1273 Flags which can be checked by code or template tags to control behaviours
1274 specific the the article.
1275
1276 =item force_dynamic
1277
1278 Forces a page to be displayed dynamically with page.pl regardless of
1279 access control.
1280
1281 =item inherit_siteuser_rights
1282
1283 Controls whether the article inherits its parents access controls.
1284
1285 =back
1286
1287 =head2 Admin tags
1288
1289 =over 4
1290
1291 The following tags produce output only in admin mode.
1292
1293 =item admin
1294
1295 Produces buttons and links used for administering the article.
1296
1297 =item moveUp
1298
1299 Generates a move up link if there is a previous child for the current
1300 child.
1301
1302 =item moveDown
1303
1304 Generates a move down link if there is a next child for the current child.
1305
1306 =item admin
1307
1308 Produces buttons and links used for administering the article.
1309
1310 This tag can use a specialized template if it's available.  If you
1311 call it with a parameter, <:admin I<template>:> then it will use
1312 template C<< admin/adminmenu/I<template>.tmpl >>.  When used in an
1313 article template C<< <:admin:> >> behaves like C<< <:admin article:>
1314 >>, when used in a catalog template C<< <:admin:> >> behaves like C<<
1315 <:admin catalog:> >>, when used in a product template C<< <:admin:> >>
1316 behaves like C<< <:admin product:> >>.  See L<Admin Menu Templates>
1317 for the tags available in admin menu templates.
1318
1319 If the template doesn't exist then the old behaviour applies.
1320
1321 =back
1322
1323 =head2 Admin Menu Templates
1324
1325 These tags can be used in the templates included by the C<< <:admin:>
1326 >> tag.
1327
1328 The basic template tags and ifUserCan tag can be used in admin menu
1329 templates.
1330
1331 =over
1332
1333 =item article field
1334
1335 Retrieves a field from the current article.
1336
1337 =item parent field
1338
1339 Retrieves a field from the parent of the current article.
1340
1341 =item ifParent
1342
1343 Conditional tag, true if the current article has a parent.
1344
1345 =item ifEmbedded
1346
1347 Conditional tag, true if the current article is embedded in another
1348 article, in this context.
1349
1350 =back
1351
1352 =cut