use BSE::Template;
use Constants qw(%LEVEL_DEFAULTS $CGI_URI $ADMIN_URI $IMAGES_URI
$UNLISTED_LEVEL1_IN_CRUMBS);
-use Images;
+use BSE::TB::Images;
use vars qw(@ISA);
use Generate;
-use Util qw(generate_button);
+use BSE::Regen qw(generate_button);
use BSE::Util::Tags qw(tag_article);
-use ArticleFiles;
+use BSE::TB::ArticleFiles;
@ISA = qw/Generate/;
-use DevHelp::HTML;
+use BSE::Util::HTML;
use BSE::Arrows;
use Carp 'confess';
use BSE::Util::Iterate;
+our $VERSION = "1.004";
+
my $excerptSize = 300;
my %level_names = map { $_, $LEVEL_DEFAULTS{$_}{display} }
my %acts;
%acts = $self -> baseActs($articles, \%acts, $article, $embedded);
- my $page = BSE::Template->replace($template, $self->{cfg}, \%acts);
+ my $page = BSE::Template->replace($template, $self->{cfg}, \%acts,
+ $self->variables);
%acts = (); # try to destroy any circular refs
}
sub tag_title {
- my ($article, $images, $args, $acts, $funcname, $templater) = @_;
+ my ($cfg, $article, $images, $args, $acts, $funcname, $templater) = @_;
my $which = $args || 'article';
my $title = $templater->perform($acts, $which, 'title');
my $imagename = $which eq 'article' ? $article->{titleImage} :
$templater->perform($acts, $which, 'titleImage');
- $imagename and
- return qq!<img src="/images/titles/$imagename"!
- .qq! border="0" alt="$title" />! ;
+ my $xhtml = $cfg->entry("basic", "xhtml", 1);
+ if ($imagename) {
+ my $html = qq!<img src="/images/titles/$imagename"!;
+ $html .= ' border="0"' unless $xhtml;
+ $html .= qq! class="bse_image_title" alt="$title" />!;
+ }
my $im;
if ($which eq 'article') {
($im) = grep lc $_->{name} eq 'bse_title', @$images;
}
else {
my $id = $templater->perform($acts, $which, 'id');
- require Images;
- my @images = Images->getBy(articleId=>$id);
+ require BSE::TB::Images;
+ my @images = BSE::TB::Images->getBy(articleId=>$id);
($im) = grep lc $_->{name} eq 'bse_title', @$images;
}
if ($im) {
- return qq!<img src="/images/$im->{image}" width="$im->{width}"!
- . qq! height="$im->{height}" alt="$title" />!;
+ my $src = $im->{src} || "/images/$im->{image}";
+ $src = escape_html($src);
+ return qq!<img src="$src" width="$im->{width}"!
+ . qq! height="$im->{height}" alt="$title" class="bse_image_title" />!;
}
else {
return $title;
my %acts;
%acts =
(
- BSE::Util::Tags->static(\%acts, $cfg),
- BSE::Util::Tags->admin(\%acts, $cfg),
- BSE::Util::Tags->secure($self->{request}),
+ $self->{request}->admin_tags,
article => [ \&tag_article, $article, $cfg ],
parent => [ \&tag_article, $parent, $cfg ],
ifParent => $parent,
}
sub tag_thumbimage {
- my ($self, $rcurrent, $images, $args) = @_;
+ my ($self, $rcurrent, $images, $args, $acts, $funcname, $templater) = @_;
- my ($geometry_id, $id, $field) = split ' ', $args;
+ my ($geometry_id, $id, $field) =
+ DevHelp::Tags->get_parms($args, $acts, $templater);
return $self->do_thumbimage($geometry_id, $id, $field, $images, $$rcurrent);
}
+sub iter_images {
+ my ($self, $images, $arg) = @_;
+
+ if ($arg eq 'all') {
+ return @$images;
+ }
+ elsif ($arg eq 'named') {
+ return grep $_->{name} ne '', @$images;
+ }
+ elsif ($arg =~ m!^named\s+/([^/]+)/$!) {
+ my $re = $1;
+ return grep $_->{name} =~ /$re/i, @$images;
+ }
+ else {
+ return grep $_->{name} eq '', @$images;
+ }
+}
+
+=item filen name
+
+=item filen name field
+
+=item filen -
+
+=item filen - field
+
+Reference an article attached file by name.
+
+C<filen name> will display a link to the file.
+
+C<<filen name I<field> >> will display the given field from the file
+record. A I<field> of C<url> will be a URL to the file.
+
+If the file identifier given doesn't exist for the current article the
+empty string is returned, allowing use as ifFilen.
+
+The result is unspecified if the I<field> specified isn't one of the
+image record field names and isn't C<url>.
+
+=cut
+
+sub tag_filen {
+ my ($self, $files, $current, $arg, $acts, $funcname, $templater) = @_;
+
+ my ($name, $field, @rest) =
+ DevHelp::Tags->get_parms($arg, $acts, $templater);
+
+ length $name
+ or return '* name cannot be an empty string *';
+
+ my $file;
+ if ($name eq '-') {
+ $$current
+ or return "* filen - can only be used inside a files iterator *";
+
+ $file = $$current;
+ }
+ else {
+ ($file) = grep $_->{name} eq $name, @$files
+ or return '';
+ }
+
+ return $self->_format_file($file, $field, "@rest");
+}
+
+=item iterator begin files
+
+=item iterator begin files named /foo/
+
+=item iterator begin files filter: FILE[file_handler] eq 'flv'
+
+=item file field
+
+Iterate over files attached to the current article.
+
+<:file field:> can only access simple attributes.
+
+<:filen - field:> can also access any inline representations.
+
+=cut
+
+sub iter_files {
+ my ($self, $files, $arg, $acts, $funcname, $templater) = @_;
+
+ $arg =~ /\S/
+ or return @$files;
+
+ if ($arg =~ m(^named\s+/([^/]+)/$)) {
+ my $re = $1;
+ return grep $_->{name} =~ /$re/i, @$files;
+ }
+ if ($arg =~ 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->($_), @$files;
+ }
+
+ die "* Unknown type of file filter expression *";
+}
+
+=item iterator: crumbs/crumb
+
+Iterators over the ancestor tree from the article parent to the root.
+
+Parameters include:
+
+=over
+
+=item *
+
+showtop - the top level article is included even if unlisted
+
+=item *
+
+listedonly - only listed articles in the tree are included
+
+=back
+
+The default depends on the value of $Constants::UNLISTED_LEVEL1_IN_CRUMBS.
+
+=cut
+
+sub iter_crumbs {
+ my ($self, $crumbs, $args) = @_;
+
+ $args ||= $UNLISTED_LEVEL1_IN_CRUMBS ? 'showtop' : 'listedonly';
+ if ($args eq 'showtop') {
+ return @$crumbs;
+ }
+ else {
+ return grep $_->{listed}, @$crumbs;
+ }
+}
+
+sub tag_ifUnderThreshold {
+ my ($self, $article, $args) = @_;
+
+ my $count;
+ my $what = $args || '';
+ if ($self->{kids}{$article->{id}}{$what}) {
+ $count = @{$self->{kids}{$article->{id}}{$what}};
+ }
+ else {
+ $count = @{$self->{kids}{$article->{id}}{children}};
+ }
+
+ return $count <= $article->{threshold};
+}
+
sub baseActs {
my ($self, $articles, $acts, $article, $embedded) = @_;
- my $cfg = $self->{cfg} || BSE::Cfg->new;
+ my $cfg = $self->{cfg} || BSE::Cfg->single;
+ $self->set_variable(article => $article);
+ $self->set_variable(embedded => $embedded);
# used to generate the list (or not) of children to this article
my $child_index = -1;
my @children = $articles->listedChildren($article->{id});
unshift(@crumbs, $crumb) if $crumb->{listed} == 1 || $crumb->{level} == 1;
$temp = $crumb;
}
- my $crumb_index = -1;
- my @work_crumbs; # set by the crumbs iterator
+ #my $crumb_index = -1;
+ #my @work_crumbs; # set by the crumbs iterator
+ my $current_crumb;
my $parent = $articles->getByPkey($article->{parentid});
my $section = @crumbs ? $crumbs[0] : $article;
- my @images = Images->getBy('articleId', $article->{id});
+ my @images = BSE::TB::Images->getBy('articleId', $article->{id});
my @unnamed_images = grep $_->{name} eq '', @images;
my @iter_images;
my $image_index = -1;
my $had_image_tags = 0;
my @all_files = sort { $b->{displayOrder} <=> $a->{displayOrder} }
- ArticleFiles->getBy(articleId=>$article->{id});
+ BSE::TB::ArticleFiles->getBy(articleId=>$article->{id});
my @files = grep !$_->{hide_from_list}, @all_files;
my $blank = qq!<img src="$IMAGES_URI/trans_pixel.gif" width="17" height="13" border="0" align="absbottom" alt="" />!;
@allkids = $article->all_visible_kids;
@stepparents = $article->visible_step_parents;
}
+ $self->{kids}{$article->{id}}{stepkids} = \@stepkids;
+ $self->{kids}{$article->{id}}{allkids} = \@allkids;
+ $self->{kids}{$article->{id}}{children} = \@children;
+
my $allkids_index;
my $current_image;
- my $art_it = BSE::Util::Iterate::Article->new(cfg =>$cfg);
+ my $current_file;
+ my $art_it = BSE::Util::Iterate::Article->new(cfg =>$cfg, admin => $self->{admin}, top => $self->{top});
+ my $it = BSE::Util::Iterate->new;
# separate these so the closures can see %acts
my %acts =
(
my $which = shift || 'article';
return $acts->{$which} && $acts->{$which}->('titleImage')
},
- title => [ \&tag_title, $article, \@images ],
+ title => [ \&tag_title, $cfg, $article, \@images ],
thumbnail =>
sub {
my ($args, $acts, $name, $templater) = @_;
$templater->perform($acts, $which, 'thumbImage');
},
ifUnderThreshold =>
- sub {
- if ($article->{threshold} !~ /\d/) {
- use Data::Dumper;
- use Carp qw/cluck/;
- print STDERR Dumper($article);
- cluck 'Why is a template name in \$article->{threshold}?';
- }
-
- my $count;
- my $what = $_[0] || '';
- if ($what eq 'stepkids') {
- $count = @stepkids;
- }
- elsif ($what eq 'allkids') {
- $count = @allkids;
- }
- else {
- $count = @children;
- }
- $count <= $article->{threshold};
- },
+ [ tag_ifUnderThreshold => $self, $article ],
ifChildren => sub { scalar @children },
iterate_children_reset => sub { $child_index = -1; },
iterate_children =>
},
# used to display a navigation path of parent sections
- iterate_crumbs_reset =>
- sub {
- my $args = $_[0];
- $args ||= $UNLISTED_LEVEL1_IN_CRUMBS ? 'showtop' : 'listedonly';
- if ($args eq 'showtop') {
- @work_crumbs = @crumbs;
- }
- else {
- @work_crumbs = grep $_->{listed}, @crumbs;
- }
- $crumb_index = -1;
- },
- iterate_crumbs =>
- sub {
- return ++$crumb_index < @work_crumbs;
- },
+ $art_it->make_iterator([ iter_crumbs => $self, \@crumbs ],
+ 'crumb', 'crumbs', undef, undef,
+ 'nocache', \$current_crumb),
crumbs =>
sub {
- # obsolete me
- return tag_article($work_crumbs[$crumb_index], $cfg, $_[0]);
- },
- crumb =>
- sub {
- return tag_article($work_crumbs[$crumb_index], $cfg, $_[0]);
+ # this is obsolete
+ $cfg->entry('basic', 'warn_obsolete', 0)
+ and print STDERR "* crumbs tag obsolete *\n";
+ return tag_article($current_crumb, $cfg, $_[0]);
},
- ifCrumbs =>
- sub {
- my $args = $_[0];
- $args ||= $UNLISTED_LEVEL1_IN_CRUMBS ? 'showtop' : 'listedonly';
-
- my @temp;
- if ($args eq 'showtop') {
- return scalar @crumbs;
- }
- else {
- return scalar grep $_->{listed}, @crumbs;
- }
- },
-
+
# access to parent
ifParent => sub { $parent },
parent =>
},
ifStepAncestor => [ \&tag_ifStepAncestor, $article ],
# access to images, if any
- iterate_images_reset =>
- sub {
- my ($arg) = @_;
- $image_index = -1;
- if ($arg eq 'all') {
- @iter_images = @images;
- }
- elsif ($arg eq 'named') {
- @iter_images = grep $_->{name} ne '', @images;
- }
- elsif ($arg =~ m!^named\s+/([^/]+)/$!) {
- my $re = $1;
- @iter_images = grep $_->{name} =~ /$re/i, @images;
- }
- else {
- @iter_images = @unnamed_images;
- }
- $current_image = undef;
- },
- iterate_images =>
- sub {
- if (++$image_index < @iter_images) {
- $current_image = $iter_images[$image_index];
- }
- else {
- $current_image = undef;
- }
- $current_image;
- },
+ $it->make_iterator([ iter_images => $self, \@images ], 'image', 'images', \@iter_images, \$image_index, 'nocache', \$current_image),
+ # override the generated image tag
image =>
sub {
my ($which, $align, $rest) = split ' ', $_[0], 3;
$self->_format_image($im, $align, $rest);
},
ifImage => sub { $_[0] >= 1 && $_[0] <= @images },
- ifImages =>
- sub {
- my ($arg) = @_;
- if ($arg eq 'all' or $arg eq '') {
- return @images;
- }
- elsif ($arg eq 'named') {
- return grep $_->{name} ne '', @images;
- }
- elsif ($arg =~ m!^named\s+/([^/]+)/$!) {
- my $re = $1;
- return grep $_->{name} =~ /$re/i, @images;
- }
- elsif ($arg eq 'unnamed') {
- return @unnamed_images;
- }
- else {
- return 0;
- }
- },
- image_index => sub { $image_index },
thumbimage => [ tag_thumbimage => $self, \$current_image, \@images ],
- BSE::Util::Tags->make_iterator(\@files, 'file', 'files'),
+ $it->make
+ (
+ plural => "files",
+ single => "file",
+ code => [ iter_files => $self, \@files ],
+ nocache => 1,
+ store => \$current_file,
+ ),
+ filen => [ tag_filen => $self, \@files, \$current_file ],
BSE::Util::Tags->make_iterator(\@stepkids, 'stepkid', 'stepkids'),
$art_it->make_iterator(undef, 'allkid', 'allkids', \@allkids, \$allkids_index),
$art_it->make_iterator(undef, 'stepparent', 'stepparents', \@stepparents),
top => [ \&tag_article, $self->{top} || $article, $cfg ],
ifDynamic => $dynamic,
+ ifStatic => !$dynamic,
ifAccessControlled => [ \&tag_ifAccessControlled, $article ],
);
}
sub tag_ifAccessControlled {
- my ($article, $arg, $acts, $templater) = @_;
+ my ($article, $arg, $acts, $funcname, $templater) = @_;
if ($arg) {
if ($acts->{$arg}) {
$article->is_access_controlled : 0;
}
+sub get_image {
+ my ($self, $image_id, $images) = @_;
+
+ my $im;
+ if ($image_id =~ /^\d+$/) {
+ $image_id >= 1 && $image_id <= @$images
+ or return ( undef, "* Out of range image index '$image_id' *" );
+
+ $im = $images->[$image_id-1];
+ }
+ elsif ($image_id =~ /^[^\W\d]\w*$/) {
+ ($im) = grep $_->{name} eq $image_id, @$images
+ or return ( undef, "* Unknown image identifier '$image_id' *" );
+ }
+ else {
+ return ( undef, "* Unrecognized image '$image_id' *" );
+ }
+
+ return $im;
+}
+
+sub do_popimage {
+ my ($self, $image_id, $class, $images) = @_;
+
+ my ($im, $msg) = $self->get_image($image_id, $images);
+ $im
+ or return $msg;
+
+ return $self->do_popimage_low($im, $class);
+}
+
# note: this is called by BSE::Formatter::thumbimage(), update that if
# this is changed
sub do_thumbimage {
- my ($self, $geo_id, $image_id, $field, $images, $rcurrent) = @_;
+ my ($self, $geo_id, $image_id, $field, $images, $current) = @_;
my $im;
- if ($image_id eq '-' && $rcurrent) {
- $im = $rcurrent
+ if ($image_id eq '-' && $current) {
+ $im = $current
or return "** No current image in images iterator **"
}
- elsif ($image_id =~ /^\d+$/) {
- $image_id >= 1 || $image_id <= @$images
- or return "** Out of range image index **";
-
- $im = $images->[$image_id-1];
- }
- elsif ($image_id =~ /^[^\W\d]\w*$/) {
- ($im) = grep $_->{name} eq $image_id, @$images
- or return "** Unknown images identifier $image_id **";
+ else {
+ ($im, my $msg) = $self->get_image($image_id, $images);
+ $im
+ or return $msg;
}
- return $self->_thumbimage_low($geo_id, $im, $field, $self->{cfg});
+ return $self->_sthumbimage_low($geo_id, $im, $field);
}
sub generate {
return make_arrows($self->{cfg}, $down_url, $up_url, $refreshto, $img_prefix);
}
+sub _find_articles {
+ my ($self, $article_id, $article, @rest) = @_;
+
+ if ($article_id eq 'article') {
+ return $article;
+ }
+ elsif ($article_id eq 'children') {
+ return $article->all_visible_kids;
+ }
+ elsif ($article_id eq 'parent') {
+ return $article->parent;
+ }
+ else {
+ return $self->SUPER::_find_articles($article_id, $article, @rest);
+ }
+}
+
1;
__END__
projects / bse.git / blobdiff