-VERSION=0.14_34
+VERSION=0.14_35
DISTNAME=bse-$(VERSION)
DISTBUILD=$(DISTNAME)
DISTTAR=../$(DISTNAME).tar
use HTML::Entities;
use BSE::Template;
use BSE::Util::Iterate;
+use DevHelp::HTML;
my %money_fields =
(
BSE::TB::Subscriptions->all;
}
+sub tag_hash_mbcs {
+ my ($object, $args) = @_;
+
+ my $value = $object->{$args};
+ defined $value or $value = '';
+ if ($value =~ /\cJ/ && $value =~ /\cM/) {
+ $value =~ tr/\cM//d;
+ }
+ escape_html($value, '<>&"');
+}
+
sub low_edit_tags {
my ($self, $acts, $req, $article, $articles, $msg, $errors) = @_;
-
+
+ my $cfg = $req->cfg;
+ my $mbcs = $cfg->entry('html', 'mbcs', 0);
+ my $tag_hash = $mbcs ? \&tag_hash_mbcs : \&hash_tag;
my $it = BSE::Util::Iterate->new;
return
(
- product => [ \&hash_tag, $article ],
+ product => [ $tag_hash, $article ],
$self->SUPER::low_edit_tags($acts, $req, $article, $articles, $msg,
$errors),
alloptions => join(",", sort keys %Constants::SHOP_PRODUCT_OPTS),
my %rights =
(
- list => 'bse_subs_list',
- addform => 'bse_subs_add',
- add => 'bse_subs_add',
- edit => 'bse_subs_edit',
- save => 'bse_subs_edit',
- detail => 'bse_subs_detail',
- remove => 'bse_subs_delete',
- update => 'bse_subs_update',
+ list => 'bse_subscr_list',
+ addform => 'bse_subscr_add',
+ add => 'bse_subscr_add',
+ edit => 'bse_subscr_edit',
+ save => 'bse_subscr_edit',
+ detail => 'bse_subscr_detail',
+ remove => 'bse_subscr_delete',
+ update => 'bse_subscr_update',
);
sub actions { \%rights }
use strict;
use HTML::Entities;
use DevHelp::Tags;
-use DevHelp::HTML;
+use DevHelp::HTML qw(:default escape_xml);
use vars qw(@EXPORT_OK @ISA);
@EXPORT_OK = qw(tag_error_img tag_hash tag_hash_plain);
@ISA = qw(Exporter);
$hour = $min = $sec = 0 unless defined $sec;
$year -= 1900;
--$month;
- return POSIX::strftime($fmt, $sec, $min, $hour, $day, $month, $year, 0, 0);
+ return POSIX::strftime($fmt, $sec, $min, $hour, $day, $month, $year);
},
today => \&tag_today,
money =>
return $gen->format_body($acts, 'Articles', $value, 'tr',
1, 0);
},
+ nobodytext => [\&tag_nobodytext, $cfg ],
ifEq =>
sub {
my ($arg, $acts, $name, $templater) = @_;
elsif ($fmt eq 'h') {
return escape_html($value);
}
+ elsif ($fmt eq 'x') {
+ return escape_xml(unescape_html($value));
+ }
return $value;
},
);
return escape_html($result);
}
+sub tag_nobodytext {
+ my ($cfg, $arg, $acts, $name, $templater) = @_;
+ my ($func, $args) = split ' ', $arg, 2;
+
+ $args = '' unless defined $args;
+ exists $acts->{$func}
+ or return "<: nobodytext $func $args :>";
+ my $value = $templater->perform($acts, $func, $args);
+ defined $value
+ or return '';
+
+ $value = decode_entities($value);
+
+ require Generate;
+ my $gen = Generate->new(cfg=>$cfg);
+ $gen->remove_block('Articles', $acts, \$value);
+
+ return escape_html($value);
+}
+
sub tag_old {
my ($cgi, $args, $acts, $name, $templater) = @_;
require Exporter;
use vars qw(@EXPORT_OK @EXPORT @ISA %EXPORT_TAGS);
-@EXPORT_OK = qw(escape_html escape_uri unescape_html unescape_uri popup_menu);
+@EXPORT_OK = qw(escape_html escape_uri unescape_html unescape_uri popup_menu escape_xml);
@EXPORT = qw(escape_html escape_uri unescape_html unescape_uri);
%EXPORT_TAGS =
(
HTML::Entities::decode(shift);
}
+my %xml_entities = qw(< lt > gt & amp " quot);
+
+sub escape_xml {
+ my ($text) = @_;
+
+ $text =~ s/([<>&\"\x7F])/$xml_entities{$1} ? "&$xml_entities{$1};" : "&#".ord($1).";"/ge;
+
+ return $text;
+}
+
sub escape_uri {
# older versions of uri_escape() acted differently without the
# second argument, so supply one to make sure we escape what
sub iter_kids_of {
my ($args, $acts, $name, $templater) = @_;
- my @ids = split ' ', $args;
+ 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");
sub iter_all_kids_of {
my ($args, $acts, $name, $templater) = @_;
- my @ids = split ' ', $args;
+ 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");
sub iter_inlines {
my ($args, $acts, $name, $templater) = @_;
- my @ids = split ' ', $args;
+ my @ids = map { split } DevHelp::Tags->get_parms($args, $acts, $templater);
for my $id (@ids) {
unless ($id =~ /^\d+$/) {
$id = $templater->perform($acts, $id, "id");
1, \0, []);
$$body = $formatter->remove_format($$body);
-
-# if ($$body =~ /^<html>/i) {
-# $$body =_strip_html(substr($$body, 6));
-# return;
-# }
-
-# my $out = '';
-# for my $part (split /((?:html\[(?:[^\[\]]*(?:(?:\[[^\[\]]*\])[^\[\]]*)*)\])
-# |embed\[(?:[^,\[\]]*)(?:,(?:[^,\[\]]*))?\])/ix, $$body) {
-# #print STDERR "Part is $part\n";
-# if ($part =~ /^html\[([^\[\]]*(?:(?:\[[^\[\]]*\])[^\[\]]*)*)\]$/i) {
-# $out .= _strip_html($1);
-# }
-# elsif ($part =~ /^embed\[([^,\[\]]*),([^,\[\]]*)\]$/i) {
-# $out .= ""; # what would you do here?
-# }
-# elsif ($part =~ /^embed\[([^,\[\]]*)\]$/i) {
-# $out .= ""; # $self->_body_embed($acts, $articles, $1, "")
-# }
-# else {
-# TRY: while (1) {
-# $LOCAL_FORMAT and $LOCAL_FORMAT->clean(\$part)
-# and next TRY;
-# $part =~ s#a\[([^,\]\[]+),([^\]\[]+)\]#$2#ig
-# and next TRY;
-# $part =~ s#link\[([^|\]\[]+)\|([^\]\[]+)\]#$2#ig
-# and next TRY;
-# $part =~ s#([bi])\[([^\]\[]+)\]#$1\001$2\002#ig
-# and next TRY;
-# $part =~ s#align\[([^|\]\[]+)\|([^\]\[]+)\]#$2#ig
-# and next TRY;
-# $part =~ s#font\[([^|\]\[]+)\|([^\]\[]+)\]#$2#ig
-# and next TRY;
-# $part =~ s#hr\[([^|\]\[]*)\|([^\]\[]*)\]##ig
-# and next TRY;
-# $part =~ s#hr\[([^|\]\[]*)\]##ig
-# and next TRY;
-# $part =~ s#anchor\[([^|\]\[]*)\]##ig
-# and next TRY;
-# $part =~ s#table\[([^\n\[\]]*)\n([^\[\]]+)\n\s*\]#_cleanup_table($1, $2)#ieg
-# and next TRY;
-# $part =~ s#table\[([^\]\[]+)\|([^\]\[|]+)\]#_cleanup_table($1, "|$2")#ieg
-# and next TRY;
-# $part =~ s#\*\*([^\n]+)#$1#g
-# and next TRY;
-# $part =~ s!##([^\n]+)!$1!g
-# and next TRY;
-# $part =~ s#fontcolor\[([^|\]\[]+)\|([^\]\[]+)\|([^\]\[]+)\]#$3#ig
-# and next TRY;
-# $part =~ s#(?:indent|center)\[([^\]\[]+)\]#$1#ig
-# and next TRY;
-# $part =~ s#hrcolor\[([^|\]\[]+)\|([^\]\[]+)\|([^\]\[]+)\]##ig
-# and next TRY;
-# $part =~ s#image\[([^\]\[]+)\]##ig
-# and next TRY;
-# $part =~ s#(?<=\W)\[([^\]\[]+)\]#\003$1\004#g
-# and next TRY;
-
-# last TRY;
-# }
-# 1 while $part =~ s#([bi])\001([^\001\002]*)\002#$1\[$2\]#ig;
-# $part =~ tr/\003\004/[]/;
-# $out .= $part;
-# }
-# }
-
-# $$body = $out;
-
}
sub get_gimage {
=head1 CHANGES
+=head2 0.14_35
+
+This is a release candidate for 0.15.
+
+=over
+
+=item *
+
+you can now use the |x flag on a tag to re-encode the value suitably
+for XML (to avoid HTML entities like é). Note: since most BSE
+tags already HTML escape their data, this tag will convert HTML
+entities to characters before re-encoding as XML.
+
+=item *
+
+the allkids_of, kids_of and inlines iterators now support the [tag
+...] syntax for their arguments. Any values returned by the [...]
+constructs are further split on spaces, so you can have a single tag
+return more than one value here. This is convenient if you want to
+use the cfg tag to specify article numbers from bse.cfg.
+
+=item *
+
+the <:date ...:> tag now presents the correct day of week. (#450)
+
+=item *
+
+added a new tag C<nobodytext> which strips all bodytext markup from
+its argument.
+
+=item *
+
+subadmin.pl now uses the bse_subscr_* prefix for it's various security
+checks
+
+=back
+
=head2 0.14_34
=over
--- /dev/null
+#!perl -w
+use strict;
+use Test::More tests=>2;
+
+my $gotmodule = require_ok('DevHelp::HTML');
+
+SKIP: {
+ skip "couldn't load module", 9 unless $gotmodule;
+
+ DevHelp::HTML->import('escape_xml');
+
+ is(escape_xml("<&\xE9"), '<&é', "don't escape like html");
+}
#!perl -w
use strict;
use BSE::Test ();
-use Test::More tests=>52;
+use Test::More tests=>58;
use File::Spec;
use FindBin;
my $cgidir = File::Spec->catdir(BSE::Test::base_dir, 'cgi-bin');
BSE::Util::SQL->import(qw/sql_datetime/);
sub template_test($$$$);
-my $parent = add_article(title=>'Parent', body=>'parent article');
+my $parent = add_article(title=>'Parent', body=>'parent article',
+ lastModified => '2004-09-23 06:00:00');
ok($parent, "create section");
my @kids;
for my $name ('One', 'Two', 'Three') {
<:arithmetic 2+3+[undefinedtag x]+2+[undefinedtag2]:>
EXPECTED
+template_test "nobodytext", $kids[0], <<'TEMPLATE', <<EXPECTED;
+<:nobodytext article body:>
+TEMPLATE
+One
+EXPECTED
+
+template_test "date", $parent, <<'TEMPLATE', <<EXPECTED;
+<:date "%a %d/%m/%Y" article lastModified:>
+TEMPLATE
+Thu 23/09/2004
+EXPECTED
+
BSE::Admin::StepParents->del($parent, $parent);
for my $kid (reverse @kids) {
my $name = $kid->{title};
projects / bse.git / commitdiff
