Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

reorganize documentation in Generate.pm

  • Loading branch information...
commit b3e1109ca3162e12335e96625665cd235d667ff3 1 parent e9a4658
@tonycoz authored
Showing with 1,217 additions and 1,190 deletions.
  1. +1,217 −1,190 site/cgi-bin/modules/Generate.pm
View
2,407 site/cgi-bin/modules/Generate.pm
@@ -14,1222 +14,802 @@ use Scalar::Util ();
use base 'BSE::ThumbLow';
use base 'BSE::TagFormats';
-our $VERSION = "1.018";
+=head1 NAME
-my $excerptSize = 300;
+Generate - provides base Squirel::Template actions for use in generating
+pages.
-sub new {
- my ($class, %opts) = @_;
- unless ($opts{cfg}) {
- require Carp;
- Carp->import('confess');
- confess("cfg missing on generator->new call");
- }
- $opts{maxdepth} = $EMBED_MAX_DEPTH unless exists $opts{maxdepth};
- $opts{depth} = 0 unless $opts{depth};
- $opts{vars} =
- {
- cfg => $opts{cfg},
- bse => BSE::Variables->variables(%opts),
- };
- $opts{varstack} = [];
- my $self = bless \%opts, $class;
- $self->set_variable_class(articles => "Articles");
- $opts{vars}{generator} = $self;
- Scalar::Util::weaken($opts{vars}{generator});
+=head1 SYNOPSIS
- return $self;
-}
+=head1 DESCRIPTION
-sub cfg {
- $_[0]{cfg};
-}
+This is probably better documented in L<templates.pod>.
-sub url {
- my ($self, $article, $force_abs) = @_;
+=head1 VARIABLES
- my $url = $self->{admin_links} ? $article->admin : $article->link;
- if (!$self->{admin} && $self->{admin_links}) {
- $url .= $url =~ /\?/ ? "&" : "?";
- $url .= "admin=0&admin_links=1";
- }
+Template variables:
- if (($force_abs || $self->abs_urls($article)) && $url !~ /^\w+:/) {
- $url = $self->cfg->entryErr("site", "url") . $url;
- }
+=over
- return $url;
-}
+=item *
-sub site {
- my $self = shift;
- $self->{site} ||= BSE::TB::Site->new;
- return $self->{site};
-}
+url(article)
-sub set_variable {
- my ($self, $name, $value) = @_;
+=item *
- $self->{vars}{$name} = $value;
+url(article, 1)
- return 1;
-}
+Return a URL for the given article, depending on admin_links mode. If
+the page is being generated with absolute URLs or a second true
+parameter is supplied, the URL is convrted to an absolute URL if
+necessary.
-sub set_variable_class {
- my ($self, $name, $class) = @_;
+=item *
- require Squirrel::Template;
- $self->set_variable($name => Squirrel::Template::Expr::WrapClass->new($class));
-}
+articles - the articles class.
-sub variables {
- my ($self) = @_;
+=item *
- return $self->{vars};
-}
+generator - the generator object itself.
-# replace commonly used characters
-# like MS dumb-quotes
-# unfortunately some browsers^W^Wnetscape don't support the entities yet <sigh>
-sub make_entities {
- my $text = shift;
+=back
- $text =~ s/\226/-/g; # "--" looks ugly
- $text =~ s/\222/'/g;
- $text =~ s/\221/`/g;
- $text =~ s/\&#8217;/'/g;
+=head1 COMMON TAGS
- return $text;
-}
+These tags can be used anywhere, including in admin templates. It's
+possible some admin code has been missed, if you find a place where
+these cannot be used let us know.
-sub summarize {
- my ($self, $articles, $text, $acts, $length) = @_;
+=over
- # remove any block level formatting
- $self->remove_block($articles, $acts, \$text);
+=item kb I<data tag>
- $text =~ tr/\n\r / /s;
+Formats the give value in kI<whatevers>. If you have a number that
+could go over 1000 and you want it to use the 'k' metric prefix when
+it does, use this tag. eg. <:kb file sizeInBytes:>
- if (length $text > $length) {
- $text = substr($text, 0, $length);
- $text =~ s/\s+\S+$//;
+=item date I<data tag>
- # roughly balance [ and ]
- my $temp = $text;
- 1 while $temp =~ s/\s\[[^\]]*\]//; # eliminate matched
- my $count = 0;
- ++$count while $temp =~ s/\w\[[^\]]*$//; # count unmatched
+=item date "I<format>" I<data tag>
- $text .= ']' x $count;
- $text .= '...';
- }
+Formats a date or date/time value from the database into something
+more human readable. If you don't supply a format then the default
+format of "%d-%b-%Y" is used ("20-Mar-2002").
- # the formatter now adds <p></p> around the text, but we don't
- # want that here
- my $result = $self->format_body(articles => $articles,
- text => $text);
- $result =~ s!<p>|</p>!!g;
+The I<format> is a strftime() format specification, if that means
+anything to you. If it doesn't, each code starts with % and are
+replaced as follows:
- return $result;
-}
+=over
-sub summary {
- my ($self, $article, $limit) = @_;
+=item %a
- $limit ||= $article->summaryLength;
+abbreviated weekday name
- return $self->summarize("Articles", $article->body, $self->{acts}, $limit);
-}
+=item %A
-# attempts to move the given position forward if it's within a HTML tag,
-# entity or just a word
-sub adjust_for_html {
- my ($self, $text, $pos) = @_;
+full weekday name
- # advance if in a tag
- return $pos + length $1
- if substr($text, 0, $pos) =~ /<[^<>]*$/
- && substr($text, $pos) =~ /^([^<>]*>)/;
- return $pos + length $1
- if substr($text, 0, $pos) =~ /&[^;&]*$/
- && substr($text, $pos) =~ /^([^;&]*;)/;
- return $pos + length $1
- if $pos <= length $text
- && substr($text, $pos-1, 1) =~ /\w$/
- && substr($text, $pos) =~ /^(\w+)/;
+=item %b
- return $pos;
-}
+abbreviated month name
-# raw html - this has some limitations
-# the input text has already been escaped, so we need to unescape it
-# too bad if you want [] in your html (but you can use entities)
-sub _make_html {
- return unescape_html($_[0]);
-}
+=item %B
-sub _embed_low {
- my ($self, $acts, $articles, $what, $template, $maxdepth, $templater) = @_;
+full month name
- $maxdepth = $self->{maxdepth}
- if !$maxdepth || $maxdepth > $self->{maxdepth};
- #if ($self->{depth}) {
- # print STDERR "Embed depth $self->{depth}\n";
- #}
- if ($self->{depth} > $self->{maxdepth}) {
- if ($self->{maxdepth} == $EMBED_MAX_DEPTH) {
- return "** too many embedding levels **";
- }
- else {
- return '';
- }
- }
+=item %c
- my $embed;
- if ($what =~ /^alias:([a-z]\w*)$/) {
- my $alias = $1;
- ($embed) = $articles->getBy(linkAlias => $alias)
- or return "** Cannot find article aliased $alias to be embedded **";;
- }
- else {
- my $id;
- if ($what !~ /^\d+$/) {
- # not an article id, assume there's an article here we can use
- $id = $acts->{$what} && $templater->perform($acts, $what, 'id');
- unless ($id && $id =~ /^\d+$/) {
- # save it for later
- defined $template or $template = "-";
- return "<:embed $what $template $maxdepth:>";
- }
- }
- else {
- $id = $what;
- }
+"preferred" date and time representation
- $embed = $articles->getByPkey($id)
- or return "** Cannot find article $id to be embedded **";;
- }
+=item %d
- my $gen = $self;
- if (ref($self) ne $embed->{generator}) {
- my $genname = $embed->{generator};
- $genname =~ s#::#/#g; # broken on MacOS I suppose
- $genname .= ".pm";
- eval {
- require $genname;
- };
- if ($@) {
- print STDERR "Cannot load generator $embed->{generator}: $@\n";
- return "** Cannot load generator $embed->{generator} for article $embed->{id} **";
- }
- my $top = $self->{top} || $embed;
- $gen = $embed->{generator}->new
- (
- admin=>$self->{admin},
- admin_links => $self->{admin_links},
- cfg=>$self->{cfg},
- request=>$self->{request},
- top=>$top
- );
- }
+day of the month as a 2 digit number
- my $olddepth = $gen->{depth};
- $gen->{depth} = $self->{depth}+1;
- my $oldmaxdepth = $gen->{maxdepth};
- $gen->{maxdepth} = $maxdepth;
- $template = "" if defined($template) && $template eq "-";
- my $result = $gen->embed($embed, $articles, $template);
- $gen->{depth} = $olddepth;
- $gen->{maxdepth} = $oldmaxdepth;
+=item %H
- return $result;
-}
+hour (24-hour clock)
-sub _body_embed {
- my ($self, $acts, $articles, $which, $template, $maxdepth) = @_;
+=item %I
- my $text = $self->_embed_low($acts, $articles, $which, $template, $maxdepth);
+hour (12-hour clock)
- return $text;
-}
+=item %j
-sub formatter_class {
- require BSE::Formatter::Article;
- return 'BSE::Formatter::Article'
-}
+day of year as a 3-digit number
-# replace markup, insert img tags
-sub format_body {
- my $self = shift;
- my (%opts) =
- (
- abs_urls => 0,
- imagepos => 'tr',
- auto_images => 1,
- images => [],
- files => [],
- acts => {},
- @_
- );
+=item %m
- my $acts = $opts{acts};
- my $articles = $opts{articles};
- my $body = $opts{text};
- my $imagePos = $opts{imagepos};
- my $abs_urls = $opts{abs_urls};
- my $auto_images = $opts{auto_images};
- my $templater = $opts{templater};
- my $images = $opts{images};
- my $files = $opts{files};
+month as a 2 digit number
- return substr($body, 6) if $body =~ /^<html>/i;
+=item %M
- my $formatter_class = $self->formatter_class;
+minute as a 2 digit number
- my $formatter = $formatter_class->new(gen => $self,
- acts => $acts,
- articles => $articles,
- abs_urls => $abs_urls,
- auto_images => \$auto_images,
- images => $images,
- files => $files,
- templater => $templater);
+=item %p
- $body = $formatter->format($body);
+AM or PM or their equivalents
- my $xhtml = $self->{cfg}->entry('basic', 'xhtml', 1);
+=item %S
- # we don't format named images
- my @images = grep $_->{name} eq '', @$images;
- if ($auto_images
- && @images
- && $self->{cfg}->entry('basic', 'auto_images', 1)
- && $imagePos ne 'xx') {
- # the first image simply goes where we're told to put it
- # the imagePos is [tb][rl] (top|bottom)(right|left)
- my $align = $imagePos =~ /r/ ? 'right' : 'left';
+seconds as a 2 digit number
- # Offset the end a bit so we don't get an image hanging as obviously
- # off the end.
- # Numbers determined by trial - it can still look pretty rough.
- my $len = length $body;
- if ($len > 1000) {
- $len -= 500;
- }
- elsif ($len > 800) {
- $len -= 200;
- }
+=item %U
- #my $incr = @images > 1 ? 2*$len / (2*@images+1) : 0;
- my $incr = $len / @images;
- # inserting the image tags moves character positions around
- # so we need the temp buffer
- if ($imagePos =~ /b/) {
- @images = reverse @images;
- if (@images % 2 == 0) {
- # starting at the bottom, swap it around
- $align = $align eq 'right' ? 'left' : 'right';
- }
- }
- my $output = '';
- for my $image (@images) {
- # adjust to make sure this isn't in the middle of a tag or entity
- my $pos = $self->adjust_for_html($body, $incr);
-
- my $img = $image->inline(cfg => $self->{cfg}, align => $align);
- $output .= $img;
- $output .= substr($body, 0, $pos);
- substr($body, 0, $pos) = '';
- $align = $align eq 'right' ? 'left' : 'right';
- }
- $body = $output . $body; # don't forget the rest of it
- }
-
- return make_entities($body);
-}
+week number as a 2 digit number (first Sunday as the first day of week 1)
-sub embed {
- my ($self, $article, $articles, $template) = @_;
+=item %w
- if (defined $template && $template =~ /\$/) {
- $template =~ s/\$/$article->{template}/;
- }
- else {
- $template = $article->{template}
- unless defined($template) && $template =~ /\S/;
- }
+weekday as a decimal number (0-6)
- my $html = BSE::Template->get_source($template, $self->{cfg});
+=item %W
- # the template will hopefully contain <:embed start:> and <:embed end:>
- # tags
- # otherwise pull out the body content
- if ($html =~ /<:\s*embed\s*start\s*:>(.*)<:\s*embed\s*end\s*:>/s
- || $html =~ m"<\s*body[^>]*>(.*)<\s*/\s*body>"s) {
- $html = $1;
- }
- return $self->generate_low($html, $article, $articles, 1);
-}
+week number as a 2 digit number (first Monday as the first day of week 1)
-sub vembed {
- my ($self, $article, $template) = @_;
+=item %x
- return $self->embed($article, "Articles", $template);
-}
+the locale's appropriate date representation
-sub iter_kids_of {
- my ($self, $state, $args, $acts, $name, $templater) = @_;
+=item %X
- my $filter = $self->_get_filter(\$args);
+the locale's appropriate time representation
- $state->{parentid} = undef;
- my @ids = map { split } DevHelp::Tags->get_parms($args, $acts, $templater);
- for my $id (@ids) {
- unless ($id =~ /^\d+$|^-1$/) {
- $id = $templater->perform($acts, $id, "id");
- }
- }
- @ids = grep /^\d+$|^-1$/, @ids;
- if (@ids == 1) {
- $state->{parentid} = $ids[0];
- }
- $self->_do_filter($filter, map Articles->listedChildren($_), @ids);
-}
+=item %y
-my $cols_re; # cache for below
+2-digit year without century
-{
- my %expr_cache;
+=item %Y
- sub _get_filter {
- my ($self, $rargs) = @_;
-
- if ($$rargs =~ s/filter:\s+(.*)\z//s) {
- my $expr = $1;
- my $orig_expr = $expr;
- unless ($cols_re) {
- my $cols_expr = '(' . join('|', Article->columns) . ')';
- $cols_re = qr/\[$cols_expr\]/;
- }
- $expr =~ s/$cols_re/\$article->{$1}/g;
- $expr =~ s/ARTICLE/\$article/g;
- #print STDERR "Expr $expr\n";
- my $filter = $expr_cache{$expr};
- unless ($filter) {
- $filter = eval 'sub { my $article = shift; '.$expr.'; }';
- if ($@) {
- print STDERR "** Failed to compile filter expression >>$expr<< built from >>$orig_expr<<\n";
- return;
- }
- $expr_cache{$expr} = $filter;
- }
-
- return $filter;
- }
- else {
- return;
- }
- }
-}
+the full year
-sub _do_filter {
- my ($self, $filter, @articles) = @_;
+=item %Z
- $filter
- or return @articles;
+time zone name or abbreviation
- return grep $filter->($_), @articles;
-}
+=item %%
-sub iter_all_kids_of {
- my ($self, $state, $args, $acts, $name, $templater) = @_;
+just '%'
- my $filter = $self->_get_filter(\$args);
+=back
- $state->{parentid} = undef;
- my @ids = map { split } DevHelp::Tags->get_parms($args, $acts, $templater);
- for my $id (@ids) {
- unless ($id =~ /^\d+$|^-1$/) {
- $id = $templater->perform($acts, $id, "id");
- }
- }
- @ids = grep /^\d+$|^-1$/, @ids;
- @ids == 1 and $state->{parentid} = $ids[0];
-
- $self->_do_filter($filter, map Articles->all_visible_kids($_), @ids);
-}
+Your local strftime() implementation may implement some extensions to
+the above, if your server is on a Unix system try running "man
+strftime" for more information.
-sub iter_inlines {
- my ($self, $state, $args, $acts, $name, $templater) = @_;
+=item bodytext I<data tag>
- my $filter = $self->_get_filter(\$args);
+Formats the text from the given tag in the same way that body text is.
- $state->{parentid} = undef;
- my @ids = map { split } DevHelp::Tags->get_parms($args, $acts, $templater);
- for my $id (@ids) {
- unless ($id =~ /^\d+$/) {
- $id = $templater->perform($acts, $id, "id");
- }
- }
- @ids = grep /^\d+$/, @ids;
- @ids == 1 and $state->{parentid} = $ids[0];
+=item ifEq I<data1> I<data2>
- $self->_do_filter($filter, map Articles->getByPkey($_), @ids);
-}
+Checks if the 2 values are exactly equal. This is a string
+comparison.
-sub iter_gimages {
- my ($self, $args) = @_;
+The 2 data parameters can either be a tag reference in [], a literal
+string inside "" or a single word.
- unless ($self->{gimages}) {
- $self->_init_gimages;
- }
+=item ifMatch I<data1> I<data2>
- if ($args =~ m!^named\s+/([^/]+)/$!) {
- my $re = $1;
- return grep $_->{name} =~ /$re/i, @{$self->{gimages_a}};
- }
- else {
- return @{$self->{gimages_a}};
- }
-}
+Treats I<data2> as a perl regular expression and attempts to match
+I<data1> against it.
-sub iter_gfiles {
- my ($self, $args) = @_;
+The 2 data parameters can either be a tag reference in [], a literal
+string inside "" or a single word.
- unless ($self->{gfiles}) {
- my @gfiles = Articles->global_files;
- my %gfiles = map { $_->{name} => $_ } @gfiles;
- $self->{gfiles} = \%gfiles;
- }
+=item cfg I<section> I<key>
- my @gfiles =
- sort { $a->{name} cmp $b->{name} } values %{$self->{gfiles}};
- if ($args =~ m!^named\s+/([^/]+)/$!) {
- my $re = $1;
- return grep $_->{name} =~ /$re/i, @gfiles;
- }
- elsif ($args =~ m(^filter: (.*)$)s) {
- my $expr = $1;
- $expr =~ s/FILE\[(\w+)\]/\$file->$1/g;
- my $sub = eval 'sub { my $file = shift; ' . $expr . '; }';
- $sub
- or die "* Cannot compile sub from filter $expr: $@ *";
- return grep $sub->($_), @gfiles;
- }
- else {
- return @gfiles;
- }
-}
-
-sub admin_tags {
- my ($self) = @_;
-
- $self->{admin} or return;
+=item cfg I<section> I<key> I<default>
- return BSE::Util::Tags->secure($self->{request});
-}
+Retrieves a value from the BSE configuration file.
-sub _static_images {
- my ($self) = @_;
+If you don't supply a default then a default will be the empty string.
- my $static = $self->{cfg}->entry('basic', 'static_thumbnails', 1);
- $self->{admin} and $static = 0;
- $self->{dynamic} and $static = 0;
+=item release
- return $static;
-}
+The release number of BSE.
-# implements popimage and gpopimage
-sub do_popimage_low {
- my ($self, $im, $class) = @_;
+=back
- return $im->popimage
- (
- cfg => $self->cfg,
- class => $class,
- static => $self->_static_images,
- );
+=head1 TAGS
-}
+=over 4
-sub do_gpopimage {
- my ($self, $image_id, $class) = @_;
+=item ifAdmin
- my $im = $self->get_gimage($image_id)
- or return "* Unknown global image '$image_id' *";
+Conditional tag, true if generating in admin mode.
- return $self->do_popimage_low($im, $class);
-}
+=item iterator ... level1
-sub _sthumbimage_low {
- my ($self, $geometry, $im, $field) = @_;
+Iterates over the listed level 1 articles.
- return $self->_thumbimage_low($geometry, $im, $field, $self->{cfg}, $self->_static_images);
-}
+=item level1 I<name>
-sub tag_gthumbimage {
- my ($self, $rcurrent, $args, $acts, $name, $templater) = @_;
+The value of the I<name> field of the current level 1 article.
- my ($geometry_id, $id, $field) = DevHelp::Tags->get_parms($args, $acts, $templater);
+=item iterator ... level2
- return $self->do_gthumbimage($geometry_id, $id, $field, $$rcurrent);
-}
+Iterates over the listed level 2 children of the current level 1 article.
-sub _find_image {
- my ($self, $acts, $templater, $article_id, $image_tags, $msg) = @_;
+=item level2 I<name>
- my $article;
- if ($article_id =~ /^\d+$/) {
- require Articles;
- $article = Articles->getByPkey($article_id);
- unless ($article) {
- $$msg = "* no article $article_id found *";
- return;
- }
- }
- elsif ($acts->{$article_id}) {
- my $id = $templater->perform($acts, $article_id, "id");
- $article = Articles->getByPkey($id);
- unless ($article) {
- $$msg = "* article $article_id/$id not found *";
- return;
- }
- }
- else {
- ($article) = Articles->getBy(linkAlias => $article_id);
- unless ($article) {
- $$msg = "* no article $article_id found *";
- return;
- }
- }
- $article
- or return;
+The value of the I<name> field of the current level 2 article.
- my @images = $article->images;
- my $im;
- for my $tag (split /,/, $image_tags) {
- if ($tag =~ m!^/(.*)/$!) {
- my $re = $1;
- ($im) = grep $_->{name} =~ /$re/i, @images
- and last;
- }
- elsif ($tag =~ /^\d+$/) {
- if ($tag >= 1 && $tag <= @images) {
- $im = $images[$tag-1];
- last;
- }
- }
- elsif ($tag =~ /^[^\W\d]\w*$/) {
- ($im) = grep $_->{name} eq $tag, @images
- and last;
- }
- }
- unless ($im) {
- $$msg = "* no image matching $image_tags found *";
- return;
- }
+=item ifLevel2 I<name>
- return $im;
-}
+Conditional tag, true if the current level 1 article has any listed
+level 2 children.
-sub tag_sthumbimage {
- my ($self, $args, $acts, $name, $templater) = @_;
+=item iterator ... level3
- my ($article_id, $geometry, $image_tags, $field) = split ' ', $args;
+Iterates over the listed level 3 children of the current level 2 article.
- my $msg;
- my $im = $self->_find_image($acts, $templater, $article_id, $image_tags, \$msg)
- or return $msg;
-
- return $self->_sthumbimage_low($geometry, $im, $field);
-}
+=item level3 I<name>
-sub tag_simage {
- my ($self, $args, $acts, $name, $templater) = @_;
+The value of the I<name> field of the current level 3 article.
- my ($article_id, $image_tags, $field, $rest) = split ' ', $args, 4;
+=item ifLevel3 I<name>
- my $msg;
- my $im = $self->_find_image($acts, $templater, $article_id, $image_tags, \$msg)
- or return $msg;
+Conditional tag, true if the current level 2 article has any listed
+level 3 children.
- return $self->_format_image($im, $field, $rest);
-}
+=item url I<which>
-=item iterator vimages I<articles> I<filter>
+Returns a link to the specified article . Due to the way the action
+list is built, this can be article types defined in derived classes of
+Generate, like the C<parent> article in Generate::Article.
-=item iterator vimages I<articles>
+=item money I<data tag>
-Iterates over the images belonging to the articles specified.
+Formats the given value as a monetary value. This does not include a
+currency symbol. Internally BSE stores monetary values as integers to
+prevent the loss of accuracy inherent in floating point numbers. You
+need to use this tag to display any monetary value.
-I<articles> can be any of:
+=item ifInMenu I<which>
-=over
+Conditional tag, true if the given item can appear in a menu.
-=item *
+=item titleImage I<imagename> I<text>
-article - the current article
+Generates an IMG tag if the given I<imagename> is in the title image
+directory (F<titles> in the managed images directory). If it doesn't
+exist, produce I<text>.
-=item *
+=item embed I<which>
-children - all visible children (including stepkids) of the current
-article
+=item embed I<which> I<template>
-=item *
+=item embed I<which> I<template> I<maxdepth>
-parent - the parent of the current article
+=item embed child
-=item *
+Embeds the article specified by which using either the specified
+template or the articles template.
-I<number> - a numeric article id, such as C<10>.
+In this case I<which> can also be an article ID.
-=item *
+I<template> is a filename relative to the templates directory. If
+this is "-" then the articles template is used (so you can set
+I<maxdepth> without setting the template.) If I<template> contains a
+C<$> sign it will be replaced with the name of the original template.
-alias(I<alias>) - a link alias of an article
+If I<maxdepth> is supplied and is less than the current maximum depth
+then it becomes the new maximum depth. This can be used with ifCanEmbed.
-=item *
+=item embed start ... embed end
-childrenof(I<articles>) - an articles that are children of
-I<articles>. I<articles> can be any normal article spec, so
-C<childrenof(childrenof(-1))> is valid.
+Marks the range of text that would be embedded in a parent that used
+C<embed child>.
-=item *
+=item ifEmbedded
-I<tagname> - a tag name referring to an article.
+Conditional tag, true if the current article is being embedded.
=back
-I<articles> has [] replacement done before parsing.
-
-I<filter> can be missing, or either of:
+=head1 C<generator> METHODS
=over
-=item *
+=cut
-named /I<regexp>/ - images with names matching the given regular
-expression
+our $VERSION = "1.019";
-=item *
+my $excerptSize = 300;
-numbered I<number> - images with the given index.
+sub new {
+ my ($class, %opts) = @_;
+ unless ($opts{cfg}) {
+ require Carp;
+ Carp->import('confess');
+ confess("cfg missing on generator->new call");
+ }
+ $opts{maxdepth} = $EMBED_MAX_DEPTH unless exists $opts{maxdepth};
+ $opts{depth} = 0 unless $opts{depth};
+ $opts{vars} =
+ {
+ cfg => $opts{cfg},
+ bse => BSE::Variables->variables(%opts),
+ };
+ $opts{varstack} = [];
+ my $self = bless \%opts, $class;
+ $self->set_variable_class(articles => "Articles");
+ $opts{vars}{generator} = $self;
+ Scalar::Util::weaken($opts{vars}{generator});
-=back
+ return $self;
+}
-Items for this iterator are vimage and vthumbimage.
+sub cfg {
+ $_[0]{cfg};
+}
-=cut
+sub url {
+ my ($self, $article, $force_abs) = @_;
-sub iter_vimages {
- my ($self, $article, $args, $acts, $name, $templater) = @_;
+ my $url = $self->{admin_links} ? $article->admin : $article->link;
+ if (!$self->{admin} && $self->{admin_links}) {
+ $url .= $url =~ /\?/ ? "&" : "?";
+ $url .= "admin=0&admin_links=1";
+ }
- my $re;
- my $num;
- if ($args =~ s!\s+named\s+/([^/]+)/$!!) {
- $re = $1;
- }
- elsif ($args =~ s!\s+numbered\s+(\d+)$!!) {
- $num = $1;
- }
- my @args = DevHelp::Tags->get_parms($args, $acts, $templater);
- my @images;
- for my $article_id (map { split /[, ]/ } @args) {
- my @articles = $self->_find_articles($article_id, $article, $acts, $name, $templater);
- for my $article (@articles) {
- my @aimages = $article->images;
- if (defined $re) {
- push @images, grep $_->{name} =~ /$re/, @aimages;
- }
- elsif (defined $num) {
- if ($num >= 0 && $num <= @aimages) {
- push @images, $aimages[$num-1];
- }
- }
- else {
- push @images, @aimages;
- }
- }
+ if (($force_abs || $self->abs_urls($article)) && $url !~ /^\w+:/) {
+ $url = $self->cfg->entryErr("site", "url") . $url;
}
- return @images;
+ return $url;
}
-=item vimage field
+sub site {
+ my $self = shift;
+ $self->{site} ||= BSE::TB::Site->new;
+ return $self->{site};
+}
-=item vimage
+sub set_variable {
+ my ($self, $name, $value) = @_;
-Retrieve the given field from the current vimage, or display the image.
+ $self->{vars}{$name} = $value;
-=cut
+ return 1;
+}
-sub tag_vimage {
- my ($self, $rvimage, $args) = @_;
+sub set_variable_class {
+ my ($self, $name, $class) = @_;
- $$rvimage or return '** no current vimage **';
+ require Squirrel::Template;
+ $self->set_variable($name => Squirrel::Template::Expr::WrapClass->new($class));
+}
- my ($field, $rest) = split ' ', $args, 2;
+sub variables {
+ my ($self) = @_;
- return $self->_format_image($$rvimage, $field, $rest);
+ return $self->{vars};
}
-=item vthumbimage geometry field
+# replace commonly used characters
+# like MS dumb-quotes
+# unfortunately some browsers^W^Wnetscape don't support the entities yet <sigh>
+sub make_entities {
+ my $text = shift;
-=item vthumbimage geometry
+ $text =~ s/\226/-/g; # "--" looks ugly
+ $text =~ s/\222/'/g;
+ $text =~ s/\221/`/g;
+ $text =~ s/\&#8217;/'/g;
-Retrieve the given field from the thumbnail of the current vimage or
-display the thumbnail.
+ return $text;
+}
-=cut
+sub summarize {
+ my ($self, $articles, $text, $acts, $length) = @_;
-sub tag_vthumbimage {
- my ($self, $rvimage, $args) = @_;
+ # remove any block level formatting
+ $self->remove_block($articles, $acts, \$text);
- $$rvimage or return '** no current vimage **';
- my ($geo, $field) = split ' ', $args;
+ $text =~ tr/\n\r / /s;
- return $self->_sthumbimage_low($geo, $$rvimage, $field);
+ if (length $text > $length) {
+ $text = substr($text, 0, $length);
+ $text =~ s/\s+\S+$//;
+
+ # roughly balance [ and ]
+ my $temp = $text;
+ 1 while $temp =~ s/\s\[[^\]]*\]//; # eliminate matched
+ my $count = 0;
+ ++$count while $temp =~ s/\w\[[^\]]*$//; # count unmatched
+
+ $text .= ']' x $count;
+ $text .= '...';
+ }
+
+ # the formatter now adds <p></p> around the text, but we don't
+ # want that here
+ my $result = $self->format_body(articles => $articles,
+ text => $text);
+ $result =~ s!<p>|</p>!!g;
+
+ return $result;
}
-sub _find_articles {
- my ($self, $article_id, $article, $acts, $name, $templater) = @_;
+sub summary {
+ my ($self, $article, $limit) = @_;
- if ($article_id =~ /^\d+$/) {
- my $result = Articles->getByPkey($article_id);
- $result or print STDERR "** Unknown article id $article_id **\n";
- return $result ? $result : ();
+ $limit ||= $article->summaryLength;
+
+ return $self->summarize("Articles", $article->body, $self->{acts}, $limit);
+}
+
+# attempts to move the given position forward if it's within a HTML tag,
+# entity or just a word
+sub adjust_for_html {
+ my ($self, $text, $pos) = @_;
+
+ # advance if in a tag
+ return $pos + length $1
+ if substr($text, 0, $pos) =~ /<[^<>]*$/
+ && substr($text, $pos) =~ /^([^<>]*>)/;
+ return $pos + length $1
+ if substr($text, 0, $pos) =~ /&[^;&]*$/
+ && substr($text, $pos) =~ /^([^;&]*;)/;
+ return $pos + length $1
+ if $pos <= length $text
+ && substr($text, $pos-1, 1) =~ /\w$/
+ && substr($text, $pos) =~ /^(\w+)/;
+
+ return $pos;
+}
+
+# raw html - this has some limitations
+# the input text has already been escaped, so we need to unescape it
+# too bad if you want [] in your html (but you can use entities)
+sub _make_html {
+ return unescape_html($_[0]);
+}
+
+sub _embed_low {
+ my ($self, $acts, $articles, $what, $template, $maxdepth, $templater) = @_;
+
+ $maxdepth = $self->{maxdepth}
+ if !$maxdepth || $maxdepth > $self->{maxdepth};
+ #if ($self->{depth}) {
+ # print STDERR "Embed depth $self->{depth}\n";
+ #}
+ if ($self->{depth} > $self->{maxdepth}) {
+ if ($self->{maxdepth} == $EMBED_MAX_DEPTH) {
+ return "** too many embedding levels **";
+ }
+ else {
+ return '';
+ }
}
- elsif ($article_id =~ /^alias\((\w+)\)$/) {
- my $result = Articles->getBy(linkAlias => $1);
- $result or print STDERR "** Unknown article alias $article_id **\n";
- return $result ? $result : ();
+
+ my $embed;
+ if ($what =~ /^alias:([a-z]\w*)$/) {
+ my $alias = $1;
+ ($embed) = $articles->getBy(linkAlias => $alias)
+ or return "** Cannot find article aliased $alias to be embedded **";;
}
- elsif ($article_id =~ /^childrenof\((.*)\)$/) {
- my $id = $1;
- if ($id eq '-1') {
- return Articles->all_visible_kids(-1);
+ else {
+ my $id;
+ if ($what !~ /^\d+$/) {
+ # not an article id, assume there's an article here we can use
+ $id = $acts->{$what} && $templater->perform($acts, $what, 'id');
+ unless ($id && $id =~ /^\d+$/) {
+ # save it for later
+ defined $template or $template = "-";
+ return "<:embed $what $template $maxdepth:>";
+ }
}
else {
- my @parents = $self->_find_articles($id, $article, $acts, $name, $templater)
- or return;
- return map $_->all_visible_kids, @parents;
+ $id = $what;
}
+
+ $embed = $articles->getByPkey($id)
+ or return "** Cannot find article $id to be embedded **";;
}
- elsif ($acts->{$article_id}) {
- my $id = $templater->perform($acts, $article_id, 'id');
- if ($id && $id =~ /^\d+$/) {
- return Articles->getByPkey($id);
+
+ my $gen = $self;
+ if (ref($self) ne $embed->{generator}) {
+ my $genname = $embed->{generator};
+ $genname =~ s#::#/#g; # broken on MacOS I suppose
+ $genname .= ".pm";
+ eval {
+ require $genname;
+ };
+ if ($@) {
+ print STDERR "Cannot load generator $embed->{generator}: $@\n";
+ return "** Cannot load generator $embed->{generator} for article $embed->{id} **";
}
+ my $top = $self->{top} || $embed;
+ $gen = $embed->{generator}->new
+ (
+ admin=>$self->{admin},
+ admin_links => $self->{admin_links},
+ cfg=>$self->{cfg},
+ request=>$self->{request},
+ top=>$top
+ );
}
- print STDERR "** Unknown article identifier $article_id **\n";
- return;
-}
+ my $olddepth = $gen->{depth};
+ $gen->{depth} = $self->{depth}+1;
+ my $oldmaxdepth = $gen->{maxdepth};
+ $gen->{maxdepth} = $maxdepth;
+ $template = "" if defined($template) && $template eq "-";
+ my $result = $gen->embed($embed, $articles, $template);
+ $gen->{depth} = $olddepth;
+ $gen->{maxdepth} = $oldmaxdepth;
-sub baseActs {
- my ($self, $articles, $acts, $article, $embedded) = @_;
+ return $result;
+}
- # used to generate the side menu
- my $section_index = -1;
- my @sections = $articles->listedChildren(-1);
- #sort { $a->{displayOrder} <=> $b->{displayOrder} }
- #grep $_->{listed}, $articles->sections;
- my $subsect_index = -1;
- my @subsections; # filled as we move through the sections
- my @level3; # filled as we move through the subsections
- my $level3_index = -1;
+sub _body_embed {
+ my ($self, $acts, $articles, $which, $template, $maxdepth) = @_;
- my $cfg = $self->{cfg} || BSE::Cfg->single;
- my %extras = $cfg->entriesCS('extra tags');
- for my $key (keys %extras) {
- # follow any links
- my $data = $cfg->entryVar('extra tags', $key);
- $extras{$key} = sub { $data };
- }
+ my $text = $self->_embed_low($acts, $articles, $which, $template, $maxdepth);
- my $current_gimage;
- my $current_vimage;
- my $it = BSE::Util::Iterate->new;
- my $art_it = BSE::Util::Iterate::Article->new(cfg => $cfg,
- admin => $self->{admin},
- top => $self->{top});
- my $weak_self = $self;
- Scalar::Util::weaken($weak_self);
- $self->set_variable(url => sub { $weak_self->url(@_) });
- return
- (
- %extras,
+ return $text;
+}
- custom_class($cfg)->base_tags($articles, $acts, $article, $embedded, $cfg, $self),
- $self->admin_tags(),
- BSE::Util::Tags->static($acts, $self->{cfg}),
- # for embedding the content from children and other sources
- ifEmbedded=> sub { $embedded },
- embed => sub {
- my ($args, $acts, $name, $templater) = @_;
- return '' if $args eq 'start' || $args eq 'end';
- my ($what, $template, $maxdepth) = split ' ', $args;
- undef $maxdepth if defined $maxdepth && $maxdepth !~ /^\d+/;
- return $self->_embed_low($acts, $articles, $what, $template, $maxdepth, $templater);
- },
- ifCanEmbed=> sub { $self->{depth} <= $self->{maxdepth} },
+sub formatter_class {
+ require BSE::Formatter::Article;
+ return 'BSE::Formatter::Article'
+}
- summary =>
- sub {
- my ($args, $acts, $name, $templater) = @_;
- my ($which, $limit) = DevHelp::Tags->get_parms($args, $acts, $templater);
- $which or $which = "child";
- $limit or $limit = $article->{summaryLength};
- $acts->{$which}
- or return "<:summary $which Cannot find $which:>";
- my $id = $templater->perform($acts, $which, "id")
- or return "<:summary $which No id returned :>";
- my $article = $articles->getByPkey($id)
- or return "<:summary $which Cannot find article $id:>";
- return $self->summarize($articles, $article->{body}, $acts, $limit);
- },
- ifAdmin => sub { $self->{admin} },
- ifAdminLinks => sub { $self->{admin_links} },
-
- # for generating the side menu
- iterate_level1_reset => sub { $section_index = -1 },
- iterate_level1 => sub {
- ++$section_index;
- if ($section_index < @sections) {
- #@subsections = grep $_->{listed},
- # $articles->children($sections[$section_index]->{id});
- @subsections = grep { $_->{listed} != 2 }
- $articles->listedChildren($sections[$section_index]->{id});
- $subsect_index = -1;
- return 1;
- }
- else {
- return 0;
- }
- },
- level1 => sub {
- return tag_article($sections[$section_index], $cfg, $_[0]);
- },
+# replace markup, insert img tags
+sub format_body {
+ my $self = shift;
+ my (%opts) =
+ (
+ abs_urls => 0,
+ imagepos => 'tr',
+ auto_images => 1,
+ images => [],
+ files => [],
+ acts => {},
+ @_
+ );
- # used to generate a list of subsections for the side-menu
- iterate_level2 => sub {
- ++$subsect_index;
- if ($subsect_index < @subsections) {
- @level3 = grep { $_->{listed} != 2 }
- $articles->listedChildren($subsections[$subsect_index]{id});
- $level3_index = -1;
- return 1;
- }
- return 0;
- },
- level2 => sub {
- return tag_article($subsections[$subsect_index], $cfg, $_[0]);
- },
- ifLevel2 =>
- sub {
- return scalar @subsections;
- },
-
- # possibly level3 items
- iterate_level3 => sub {
- return ++$level3_index < @level3;
- },
- level3 => sub {
- tag_article($level3[$level3_index], $cfg, $_[0])
- },
- ifLevel3 => sub { scalar @level3 },
+ my $acts = $opts{acts};
+ my $articles = $opts{articles};
+ my $body = $opts{text};
+ my $imagePos = $opts{imagepos};
+ my $abs_urls = $opts{abs_urls};
+ my $auto_images = $opts{auto_images};
+ my $templater = $opts{templater};
+ my $images = $opts{images};
+ my $files = $opts{files};
- # generate an admin or link url, depending on admin state
- url=>
- sub {
- my ($name, $acts, $func, $templater) = @_;
- my $item = $self->{admin_links} ? 'admin' : 'link';
- $acts->{$name}
- or die "ENOIMPL\n";
- my $url = $templater->perform($acts, $name, $item);
- if (!$self->{admin} && $self->{admin_links}) {
- $url .= $url =~ /\?/ ? "&" : "?";
- $url .= "admin=0&admin_links=1";
- }
- return $url;
- },
- ifInMenu =>
- sub {
- $acts->{$_[0]} or return 0;
- return $acts->{$_[0]}->('listed') == 1;
- },
- titleImage=>
- sub {
- my ($image, $text) = split ' ', $_[0];
+ return substr($body, 6) if $body =~ /^<html>/i;
- my $image_dir = cfg_image_dir();
- if (-e "$image_dir/titles/$image") {
- my $image_uri = cfg_image_uri();
- return qq!<img src="$image_uri/titles/!.$image .qq!" border=0>!
- }
- else {
- return escape_html($text);
- }
- },
- $art_it->make( code => [ iter_kids_of => $self ],
- single => 'ofchild',
- plural => 'children_of',
- nocache => 1,
- state => 1 ),
- $art_it->make( code => [ iter_kids_of => $self ],
- single => 'ofchild2',
- plural => 'children_of2',
- nocache => 1,
- state => 1 ),
- $art_it->make( code => [ iter_kids_of => $self ],
- single => 'ofchild3',
- plural => 'children_of3',
- nocache => 1,
- state => 1 ),
- $art_it->make( code => [ iter_all_kids_of => $self ],
- single => 'ofallkid',
- plural => 'allkids_of',
- state => 1 ),
- $art_it->make( code => [ iter_all_kids_of => $self ],
- single => 'ofallkid2',
- plural => 'allkids_of2',
- nocache => 1,
- state => 1 ),
- $art_it->make( code => [ iter_all_kids_of => $self ],
- single => 'ofallkid3',
- plural => 'allkids_of3',
- nocache => 1,
- state => 1 ),
- $art_it->make( code => [ iter_all_kids_of => $self ],
- single => 'ofallkid4',
- plural => 'allkids_of4',
- nocache => 1,
- state => 1 ),
- $art_it->make( code => [ iter_all_kids_of => $self ],
- single => 'ofallkid5',
- plural => 'allkids_of5',
- nocache => 1,
- state => 1 ),
- $art_it->make( code => [ iter_inlines => $self ],
- single => 'inline',
- plural => 'inlines',
- nocache => 1,
- state => 1 ),
- gimage =>
- sub {
- my ($args, $acts, $func, $templater) = @_;
- my ($name, $align, @rest) =
- DevHelp::Tags->get_parms($args, $acts, $templater);
- my $rest = "@rest";
+ my $formatter_class = $self->formatter_class;
- my $im;
- defined $name && length $name
- or return '* missing or empty name parameter for gimage *';
- if ($name eq '-') {
- $im = $current_gimage
- or return '';
- }
- else {
- $im = $self->get_gimage($name)
- or return '';
- }
+ my $formatter = $formatter_class->new(gen => $self,
+ acts => $acts,
+ articles => $articles,
+ abs_urls => $abs_urls,
+ auto_images => \$auto_images,
+ images => $images,
+ files => $files,
+ templater => $templater);
- $self->_format_image($im, $align, $rest);
- },
- $it->make_iterator( [ \&iter_gimages, $self ], 'gimagei', 'gimages',
- undef, undef, undef, \$current_gimage),
- gfile =>
- sub {
- my ($name, $field) = split ' ', $_[0], 3;
+ $body = $formatter->format($body);
- my $file = $self->get_gfile($name)
- or return '';
+ my $xhtml = $self->{cfg}->entry('basic', 'xhtml', 1);
- $self->_format_file($file, $field);
- },
- $it->make_iterator( [ \&iter_gfiles, $self ], 'gfilei', 'gfiles'),
- gthumbimage => [ tag_gthumbimage => $self, \$current_gimage ],
- sthumbimage => [ tag_sthumbimage => $self ],
- simage => [ tag_simage => $self ],
- $it->make_iterator( [ iter_vimages => $self, $article ], 'vimage', 'vimages', undef, undef, undef, \$current_vimage),
- vimage => [ tag_vimage => $self, \$current_vimage ],
- vthumbimage => [ tag_vthumbimage => $self, \$current_vimage ],
- );
-}
+ # we don't format named images
+ my @images = grep $_->{name} eq '', @$images;
+ if ($auto_images
+ && @images
+ && $self->{cfg}->entry('basic', 'auto_images', 1)
+ && $imagePos ne 'xx') {
+ # the first image simply goes where we're told to put it
+ # the imagePos is [tb][rl] (top|bottom)(right|left)
+ my $align = $imagePos =~ /r/ ? 'right' : 'left';
-sub find_terms {
- my ($body, $case_sensitive, $terms) = @_;
-
- # locate the terms
- my @found;
- if ($case_sensitive) {
- for my $term (@$terms) {
- if ($$body =~ /^(.*?)\Q$term/s) {
- push(@found, [ length($1), $term ]);
- }
+ # Offset the end a bit so we don't get an image hanging as obviously
+ # off the end.
+ # Numbers determined by trial - it can still look pretty rough.
+ my $len = length $body;
+ if ($len > 1000) {
+ $len -= 500;
}
- }
- else {
- for my $term (@$terms) {
- if ($$body =~ /^(.*?)\Q$term/is) {
- push(@found, [ length($1), $term ]);
- }
+ elsif ($len > 800) {
+ $len -= 200;
}
- }
- return @found;
-}
-
-# this takes the same inputs as _make_table(), but eliminates any
-# markup instead
-sub _cleanup_table {
- my ($opts, $data) = @_;
- my @lines = split /\n/, $data;
- for (@lines) {
- s/^[^|]*\|//;
- tr/|/ /s;
+ #my $incr = @images > 1 ? 2*$len / (2*@images+1) : 0;
+ my $incr = $len / @images;
+ # inserting the image tags moves character positions around
+ # so we need the temp buffer
+ if ($imagePos =~ /b/) {
+ @images = reverse @images;
+ if (@images % 2 == 0) {
+ # starting at the bottom, swap it around
+ $align = $align eq 'right' ? 'left' : 'right';
+ }
+ }
+ my $output = '';
+ for my $image (@images) {
+ # adjust to make sure this isn't in the middle of a tag or entity
+ my $pos = $self->adjust_for_html($body, $incr);
+
+ my $img = $image->inline(cfg => $self->{cfg}, align => $align);
+ $output .= $img;
+ $output .= substr($body, 0, $pos);
+ substr($body, 0, $pos) = '';
+ $align = $align eq 'right' ? 'left' : 'right';
+ }
+ $body = $output . $body; # don't forget the rest of it
}
- return join(' ', @lines);
+
+ return make_entities($body);
}
-# produce a nice excerpt for a found article
-sub excerpt {
- my ($self, $article, $found, $case_sensitive, $terms, $type, $body) = @_;
-
- if (!$body) {
- $body = $article->{body};
-
- # we remove any formatting tags here, otherwise we get wierd table
- # rubbish or other formatting in the excerpt.
- my @files = $article->files;
- $self->remove_block('Articles', [], \$body, \@files);
- 1 while $body =~ s/[bi]\[([^\]\[]+)\]/$1/g;
- }
-
- $body = escape_html($body);
-
- $type ||= 'body';
-
- my @found = find_terms(\$body, $case_sensitive, $terms);
+sub embed {
+ my ($self, $article, $articles, $template) = @_;
- my @reterms = @$terms;
- for (@reterms) {
- tr/ / /s;
- $_ = quotemeta;
- s/\\?\s+/\\s+/g;
- }
- # do a reverse sort so that the longer terms (and composite
- # terms) are replaced first
- my $re_str = join("|", reverse sort @reterms);
- my $re;
- my $cfg = $self->{cfg};
- if ($cfg->entryBool('search', 'highlight_partial', 1)) {
- $re = $case_sensitive ? qr/\b($re_str)/ : qr/\b($re_str)/i;
+ if (defined $template && $template =~ /\$/) {
+ $template =~ s/\$/$article->{template}/;
}
else {
- $re = $case_sensitive ? qr/\b($re_str)\b/ : qr/\b($re_str)\b/i;
+ $template = $article->{template}
+ unless defined($template) && $template =~ /\S/;
}
- # this used to try searching children as well, but it broke more
- # than it fixed
- if (!@found) {
- # we tried hard and failed
- # return a generic article
- if (length $body > $excerptSize) {
- $body = substr($body, 0, $excerptSize);
- $body =~ s/\S+\s*$/.../;
- }
- $$found = 0;
- return $body;
+ my $html = BSE::Template->get_source($template, $self->{cfg});
+
+ # the template will hopefully contain <:embed start:> and <:embed end:>
+ # tags
+ # otherwise pull out the body content
+ if ($html =~ /<:\s*embed\s*start\s*:>(.*)<:\s*embed\s*end\s*:>/s
+ || $html =~ m"<\s*body[^>]*>(.*)<\s*/\s*body>"s) {
+ $html = $1;
}
+ return $self->generate_low($html, $article, $articles, 1);
+}
- # only the first 5
- splice(@found, 5,-1) if @found > 5;
- my $itemSize = $excerptSize / @found;
+=item vembed(article)
- # try to combine any that are close
- @found = sort { $a->[0] <=> $b->[0] } @found;
- for my $i (reverse 0 .. $#found-1) {
- if ($found[$i+1][0] - $found[$i][0] < $itemSize) {
- my @losing = @{$found[$i+1]};
- shift @losing;
- push(@{$found[$i]}, @losing);
- splice(@found, $i+1, 1); # remove it
+=item vembed(article, template)
+
+Embed the specified article using either the article template or the
+specified template.
+
+=back
+
+=head1 GENERATOR TAGS
+
+=over
+
+=cut
+
+
+sub vembed {
+ my ($self, $article, $template) = @_;
+
+ return $self->embed($article, "Articles", $template);
+}
+
+sub iter_kids_of {
+ my ($self, $state, $args, $acts, $name, $templater) = @_;
+
+ my $filter = $self->_get_filter(\$args);
+
+ $state->{parentid} = undef;
+ my @ids = map { split } DevHelp::Tags->get_parms($args, $acts, $templater);
+ for my $id (@ids) {
+ unless ($id =~ /^\d+$|^-1$/) {
+ $id = $templater->perform($acts, $id, "id");
}
}
+ @ids = grep /^\d+$|^-1$/, @ids;
+ if (@ids == 1) {
+ $state->{parentid} = $ids[0];
+ }
+ $self->_do_filter($filter, map Articles->listedChildren($_), @ids);
+}
- my $highlight_prefix =
- $cfg->entry('search highlight', "${type}_prefix", "<b>");
- my $highlight_suffix =
- $cfg->entry('search highlight', "${type}_suffix", "</b>");
- my $termSize = $excerptSize / @found;
- my $result = '';
- for my $term (@found) {
- my ($pos, @terms) = @$term;
- my $start = $pos - $termSize/2;
- my $part;
- if ($start < 0) {
- $start = 0;
- $part = substr($body, 0, $termSize);
+my $cols_re; # cache for below
+
+{
+ my %expr_cache;
+
+ sub _get_filter {
+ my ($self, $rargs) = @_;
+
+ if ($$rargs =~ s/filter:\s+(.*)\z//s) {
+ my $expr = $1;
+ my $orig_expr = $expr;
+ unless ($cols_re) {
+ my $cols_expr = '(' . join('|', Article->columns) . ')';
+ $cols_re = qr/\[$cols_expr\]/;
+ }
+ $expr =~ s/$cols_re/\$article->{$1}/g;
+ $expr =~ s/ARTICLE/\$article/g;
+ #print STDERR "Expr $expr\n";
+ my $filter = $expr_cache{$expr};
+ unless ($filter) {
+ $filter = eval 'sub { my $article = shift; '.$expr.'; }';
+ if ($@) {
+ print STDERR "** Failed to compile filter expression >>$expr<< built from >>$orig_expr<<\n";
+ return;
+ }
+ $expr_cache{$expr} = $filter;
+ }
+
+ return $filter;
}
else {
- $result .= "...";
- $part = substr($body, $start, $termSize);
- $part =~ s/^\w+//;
- }
- if ($start + $termSize < length $body) {
- $part =~ s/\s*\S*$/... /;
+ return;
}
- $result .= $part;
}
- $result =~ s{$re}{$highlight_prefix$1$highlight_suffix}ig;
- $$found = 1;
-
- return $result;
-}
-
-sub visible {
- return 1;
}
+sub _do_filter {
+ my ($self, $filter, @articles) = @_;
-# make whatever text $body points at safe for summarizing by removing most
-# block level formatting
-sub remove_block {
- my ($self, $articles, $acts, $body, $files) = @_;
+ $filter
+ or return @articles;
- my $formatter_class = $self->formatter_class;
+ return grep $filter->($_), @articles;
+}
- $files ||= [];
+sub iter_all_kids_of {
+ my ($self, $state, $args, $acts, $name, $templater) = @_;
- my $formatter = $formatter_class->new(gen => $self,
- acts => $acts,
- article => $articles,
- articles => $articles,
- files => $files);
+ my $filter = $self->_get_filter(\$args);
- $$body = $formatter->remove_format($$body);
+ $state->{parentid} = undef;
+ my @ids = map { split } DevHelp::Tags->get_parms($args, $acts, $templater);
+ for my $id (@ids) {
+ unless ($id =~ /^\d+$|^-1$/) {
+ $id = $templater->perform($acts, $id, "id");
+ }
+ }
+ @ids = grep /^\d+$|^-1$/, @ids;
+ @ids == 1 and $state->{parentid} = $ids[0];
+
+ $self->_do_filter($filter, map Articles->all_visible_kids($_), @ids);
}
-sub _init_gimages {
- my ($self) = @_;
+sub iter_inlines {
+ my ($self, $state, $args, $acts, $name, $templater) = @_;
- my @gimages = $self->site->images;
- $self->{gimages} = { map { $_->{name} => $_ } @gimages };
- $self->{gimages_a} = \@gimages;
+ my $filter = $self->_get_filter(\$args);
+
+ $state->{parentid} = undef;
+ my @ids = map { split } DevHelp::Tags->get_parms($args, $acts, $templater);
+ for my $id (@ids) {
+ unless ($id =~ /^\d+$/) {
+ $id = $templater->perform($acts, $id, "id");
+ }
+ }
+ @ids = grep /^\d+$/, @ids;
+ @ids == 1 and $state->{parentid} = $ids[0];
+
+ $self->_do_filter($filter, map Articles->getByPkey($_), @ids);
}
-sub get_gimage {
- my ($self, $name) = @_;
+sub iter_gimages {
+ my ($self, $args) = @_;
unless ($self->{gimages}) {
$self->_init_gimages;
}
- return $self->{gimages}{$name};
+ if ($args =~ m!^named\s+/([^/]+)/$!) {
+ my $re = $1;
+ return grep $_->{name} =~ /$re/i, @{$self->{gimages_a}};
+ }
+ else {
+ return @{$self->{gimages_a}};
+ }
}
-sub get_gfile {
- my ($self, $name) = @_;
+sub iter_gfiles {
+ my ($self, $args) = @_;
unless ($self->{gfiles}) {
my @gfiles = Articles->global_files;
@@ -1237,344 +817,791 @@ sub get_gfile {
$self->{gfiles} = \%gfiles;
}
- return $self->{gfiles}{$name};
-}
-
-# note: this is called by BSE::Formatter::thumbimage(), update that if
-# this is changed
-sub do_gthumbimage {
- my ($self, $geo_id, $image_id, $field, $current) = @_;
-
- my $im;
- if ($image_id eq '-' && $current) {
- $im = $current;
+ my @gfiles =
+ sort { $a->{name} cmp $b->{name} } values %{$self->{gfiles}};
+ if ($args =~ m!^named\s+/([^/]+)/$!) {
+ my $re = $1;
+ return grep $_->{name} =~ /$re/i, @gfiles;
+ }
+ elsif ($args =~ m(^filter: (.*)$)s) {
+ my $expr = $1;
+ $expr =~ s/FILE\[(\w+)\]/\$file->$1/g;
+ my $sub = eval 'sub { my $file = shift; ' . $expr . '; }';
+ $sub
+ or die "* Cannot compile sub from filter $expr: $@ *";
+ return grep $sub->($_), @gfiles;
}
else {
- $im = $self->get_gimage($image_id);
+ return @gfiles;
}
- $im
- or return '** unknown global image id **';
-
- return $self->_sthumbimage_low($geo_id, $im, $field);
-}
-
-sub get_real_article {
- my ($self, $article) = @_;
-
- return $article;
}
-sub localize {
+sub admin_tags {
my ($self) = @_;
- my $vars = $self->{vars};
- my %copy = %$vars;
- for my $key (keys %$vars) {
- if (ref $vars->{$key} && Scalar::Util::isweak($vars->{$key})) {
- Scalar::Util::weaken($copy{$key});
- }
- }
- push @{$self->{varstack}}, $vars;
- $self->{vars} = \%copy;
-}
-
-sub unlocalize {
- my ($self) = @_;
+ $self->{admin} or return;
- $self->{vars} = pop @{$self->{varstack}};
+ return BSE::Util::Tags->secure($self->{request});
}
-1;
-
-__END__
-
-=head1 NAME
+sub _static_images {
+ my ($self) = @_;
-Generate - provides base Squirel::Template actions for use in generating
-pages.
+ my $static = $self->{cfg}->entry('basic', 'static_thumbnails', 1);
+ $self->{admin} and $static = 0;
+ $self->{dynamic} and $static = 0;
-=head1 SYNOPSIS
+ return $static;
+}
-=head1 DESCRIPTION
+# implements popimage and gpopimage
+sub do_popimage_low {
+ my ($self, $im, $class) = @_;
-This is probably better documented in L<templates.pod>.
+ return $im->popimage
+ (
+ cfg => $self->cfg,
+ class => $class,
+ static => $self->_static_images,
+ );
-=head1 COMMON TAGS
+}
-These tags can be used anywhere, including in admin templates. It's
-possible some admin code has been missed, if you find a place where
-these cannot be used let us know.
+sub do_gpopimage {
+ my ($self, $image_id, $class) = @_;
+ my $im = $self->get_gimage($image_id)
+ or return "* Unknown global image '$image_id' *";
-=over
+ return $self->do_popimage_low($im, $class);
+}
-=item kb I<data tag>
+sub _sthumbimage_low {
+ my ($self, $geometry, $im, $field) = @_;
-Formats the give value in kI<whatevers>. If you have a number that
-could go over 1000 and you want it to use the 'k' metric prefix when
-it does, use this tag. eg. <:kb file sizeInBytes:>
+ return $self->_thumbimage_low($geometry, $im, $field, $self->{cfg}, $self->_static_images);
+}
-=item date I<data tag>
+sub tag_gthumbimage {
+ my ($self, $rcurrent, $args, $acts, $name, $templater) = @_;
-=item date "I<format>" I<data tag>
+ my ($geometry_id, $id, $field) = DevHelp::Tags->get_parms($args, $acts, $templater);
-Formats a date or date/time value from the database into something
-more human readable. If you don't supply a format then the default
-format of "%d-%b-%Y" is used ("20-Mar-2002").
+ return $self->do_gthumbimage($geometry_id, $id, $field, $$rcurrent);
+}
-The I<format> is a strftime() format specification, if that means
-anything to you. If it doesn't, each code starts with % and are
-replaced as follows:
+sub _find_image {
+ my ($self, $acts, $templater, $article_id, $image_tags, $msg) = @_;
-=over
+ my $article;
+ if ($article_id =~ /^\d+$/) {
+ require Articles;
+ $article = Articles->getByPkey($article_id);
+ unless ($article) {
+ $$msg = "* no article $article_id found *";
+ return;
+ }
+ }
+ elsif ($acts->{$article_id}) {
+ my $id = $templater->perform($acts, $article_id, "id");
+ $article = Articles->getByPkey($id);
+ unless ($article) {
+ $$msg = "* article $article_id/$id not found *";
+ return;
+ }
+ }
+ else {
+ ($article) = Articles->getBy(linkAlias => $article_id);
+ unless ($article) {
+ $$msg = "* no article $article_id found *";
+ return;
+ }
+ }
+ $article
+ or return;
-=item %a
+ my @images = $article->images;
+ my $im;
+ for my $tag (split /,/, $image_tags) {
+ if ($tag =~ m!^/(.*)/$!) {
+ my $re = $1;
+ ($im) = grep $_->{name} =~ /$re/i, @images
+ and last;
+ }
+ elsif ($tag =~ /^\d+$/) {
+ if ($tag >= 1 && $tag <= @images) {
+ $im = $images[$tag-1];
+ last;
+ }
+ }
+ elsif ($tag =~ /^[^\W\d]\w*$/) {
+ ($im) = grep $_->{name} eq $tag, @images
+ and last;
+ }
+ }
+ unless ($im) {
+ $$msg = "* no image matching $image_tags found *";
+ return;
+ }
-abbreviated weekday name
+ return $im;
+}
-=item %A
+sub tag_sthumbimage {
+ my ($self, $args, $acts, $name, $templater) = @_;
-full weekday name
+ my ($article_id, $geometry, $image_tags, $field) = split ' ', $args;
-=item %b
+ my $msg;
+ my $im = $self->_find_image($acts, $templater, $article_id, $image_tags, \$msg)
+ or return $msg;
+
+ return $self->_sthumbimage_low($geometry, $im, $field);
+}
-abbreviated month name
+sub tag_simage {
+ my ($self, $args, $acts, $name, $templater) = @_;
-=item %B
+ my ($article_id, $image_tags, $field, $rest) = split ' ', $args, 4;
-full month name
+ my $msg;
+ my $im = $self->_find_image($acts, $templater, $article_id, $image_tags, \$msg)
+ or return $msg;
-=item %c
+ return $self->_format_image($im, $field, $rest);
+}
-"preferred" date and time representation
+=item iterator vimages I<articles> I<filter>
-=item %d
+=item iterator vimages I<articles>
-day of the month as a 2 digit number
+Iterates over the images belonging to the articles specified.
-=item %H
+I<articles> can be any of:
-hour (24-hour clock)
+=over
-=item %I
+=item *
-hour (12-hour clock)
+article - the current article
-=item %j
+=item *
-day of year as a 3-digit number
+children - all visible children (including stepkids) of the current
+article
-=item %m
+=item *
-month as a 2 digit number
+parent - the parent of the current article
-=item %M
+=item *
-minute as a 2 digit number
+I<number> - a numeric article id, such as C<10>.
-=item %p
+=item *
-AM or PM or their equivalents
+alias(I<alias>) - a link alias of an article
-=item %S
+=item *
-seconds as a 2 digit number
+childrenof(I<articles>) - an articles that are children of
+I<articles>. I<articles> can be any normal article spec, so
+C<childrenof(childrenof(-1))> is valid.
-=item %U
+=item *
-week number as a 2 digit number (first Sunday as the first day of week 1)
+I<tagname> - a tag name referring to an article.
-=item %w
+=back
-weekday as a decimal number (0-6)
+I<articles> has [] replacement done before parsing.
-=item %W
+I<filter> can be missing, or either of:
-week number as a 2 digit number (first Monday as the first day of week 1)
+=over
-=item %x
+=item *
-the locale's appropriate date representation
+named /I<regexp>/ - images with names matching the given regular
+expression
-=item %X
+=item *
-the locale's appropriate time representation
+numbered I<number> - images with the given index.
-=item %y
+=back
-2-digit year without century
+Items for this iterator are vimage and vthumbimage.
-=item %Y
+=cut
-the full year
+sub iter_vimages {
+ my ($self, $article, $args, $acts, $name, $templater) = @_;
-=item %Z
+ my $re;
+ my $num;
+ if ($args =~ s!\s+named\s+/([^/]+)/$!!) {
+ $re = $1;
+ }
+ elsif ($args =~ s!\s+numbered\s+(\d+)$!!) {
+ $num = $1;
+ }
+ my @args = DevHelp::Tags->get_parms($args, $acts, $templater);
+ my @images;
+ for my $article_id (map { split /[, ]/ } @args) {
+ my @articles = $self->_find_articles($article_id, $article, $acts, $name, $templater);
+ for my $article (@articles) {
+ my @aimages = $article->images;
+ if (defined $re) {
+ push @images, grep $_->{name} =~ /$re/, @aimages;
+ }
+ elsif (defined $num) {
+ if ($num >= 0 && $num <= @aimages) {
+ push @images, $aimages[$num-1];
+ }
+ }
+ else {
+ push @images, @aimages;
+ }
+ }
+ }
-time zone name or abbreviation
+ return @images;
+}
-=item %%
+=item vimage field
-just '%'
+=item vimage
-=back
+Retrieve the given field from the current vimage, or display the image.
-Your local strftime() implementation may implement some extensions to
-the above, if your server is on a Unix system try running "man
-strftime" for more information.
+=cut
-=item bodytext I<data tag>
+sub tag_vimage {
+ my ($self, $rvimage, $args) = @_;
-Formats the text from the given tag in the same way that body text is.
+ $$rvimage or return '** no current vimage **';
-=item ifEq I<data1> I<data2>
+ my ($field, $rest) = split ' ', $args, 2;
-Checks if the 2 values are exactly equal. This is a string
-comparison.
+ return $self->_format_image($$rvimage, $field, $rest);
+}
-The 2 data parameters can either be a tag reference in [], a literal
-string inside "" or a single word.
+=item vthumbimage geometry field
-=item ifMatch I<data1> I<data2>
+=item vthumbimage geometry
-Treats I<data2> as a perl regular expression and attempts to match
-I<data1> against it.
+Retrieve the given field from the thumbnail of the current vimage or
+display the thumbnail.
-The 2 data parameters can either be a tag reference in [], a literal
-string inside "" or a single word.
+=cut
-=item cfg I<section> I<key>
+sub tag_vthumbimage {
+ my ($self, $rvimage, $args) = @_;
-=item cfg I<section> I<key> I<default>
+ $$rvimage or return '** no current vimage **';
+ my ($geo, $field) = split ' ', $args;
-Retrieves a value from the BSE configuration file.
+ return $self->_sthumbimage_low($geo, $$rvimage, $field);
+}
-If you don't supply a default then a default will be the empty string.
+sub _find_articles {
+ my ($self, $article_id, $article, $acts, $name, $templater) = @_;
-=item release
+ if ($article_id =~ /^\d+$/) {
+ my $result = Articles->getByPkey($article_id);
+ $result or print STDERR "** Unknown article id $article_id **\n";
+ return $result ? $result : ();
+ }
+ elsif ($article_id =~ /^alias\((\w+)\)$/) {
+ my $result = Articles->getBy(linkAlias => $1);
+ $result or print STDERR "** Unknown article alias $article_id **\n";
+ return $result ? $result : ();
+ }
+ elsif ($article_id =~ /^childrenof\((.*)\)$/) {
+ my $id = $1;
+ if ($id eq '-1') {
+ return Articles->all_visible_kids(-1);
+ }
+ else {
+ my @parents = $self->_find_articles($id, $article, $acts, $name, $templater)
+ or return;
+ return map $_->all_visible_kids, @parents;
+ }
+ }
+ elsif ($acts->{$article_id}) {
+ my $id = $templater->perform($acts, $article_id, 'id');
+ if ($id && $id =~ /^\d+$/) {
+ return Articles->getByPkey($id);
+ }
+ }
+ print STDERR "** Unknown article identifier $article_id **\n";
-The release number of BSE.
+ return;
+}
-=back
+sub baseActs {
+ my ($self, $articles, $acts, $article, $embedded) = @_;
-=head1 TAGS
+ # used to generate the side menu
+ my $section_index = -1;
+ my @sections = $articles->listedChildren(-1);
+ #sort { $a->{displayOrder} <=> $b->{displayOrder} }
+ #grep $_->{listed}, $articles->sections;
+ my $subsect_index = -1;
+ my @subsections; # filled as we move through the sections
+ my @level3; # filled as we move through the subsections
+ my $level3_index = -1;
-=over 4
+ my $cfg = $self->{cfg} || BSE::Cfg->single;
+ my %extras = $cfg->entriesCS('extra tags');
+ for my $key (keys %extras) {
+ # follow any links
+ my $data = $cfg->entryVar('extra tags', $key);
+ $extras{$key} = sub { $data };
+ }
-=item ifAdmin
+ my $current_gimage;
+ my $current_vimage;
+ my $it = BSE::Util::Iterate->new;
+ my $art_it = BSE::Util::Iterate::Article->new(cfg => $cfg,
+ admin => $self->{admin},
+ top => $self->{top});
+ my $weak_self = $self;
+ Scalar::Util::weaken($weak_self);
+ $self->set_variable(url => sub { $weak_self->url(@_) });
+ return
+ (
+ %extras,
-Conditional tag, true if generating in admin mode.
+ custom_class($cfg)->base_tags($articles, $acts, $article, $embedded, $cfg, $self),
+ $self->admin_tags(),