0.14_35 commit r0_14_35
authorTony Cook <tony@develop-help.com>
Wed, 29 Sep 2004 00:49:02 +0000 (00:49 +0000)
committertony <tony@45cb6cf1-00bc-42d2-bb5a-07f51df49f94>
Wed, 29 Sep 2004 00:49:02 +0000 (00:49 +0000)
Makefile
site/cgi-bin/modules/BSE/Edit/Product.pm
site/cgi-bin/modules/BSE/UI/SubAdmin.pm
site/cgi-bin/modules/BSE/Util/Tags.pm
site/cgi-bin/modules/DevHelp/HTML.pm
site/cgi-bin/modules/Generate.pm
site/docs/bse.pod
site/htdocs/images/trans_pixel.gif
t/t080escape.t [new file with mode: 0644]
t/t20gen.t

index c016d3c..66b0d52 100755 (executable)
--- a/Makefile
+++ b/Makefile
@@ -1,4 +1,4 @@
-VERSION=0.14_34
+VERSION=0.14_35
 DISTNAME=bse-$(VERSION)
 DISTBUILD=$(DISTNAME)
 DISTTAR=../$(DISTNAME).tar
index 77de2a9..326ae87 100644 (file)
@@ -5,6 +5,7 @@ use Products;
 use HTML::Entities;
 use BSE::Template;
 use BSE::Util::Iterate;
+use DevHelp::HTML;
 
 my %money_fields =
   (
@@ -51,13 +52,27 @@ sub iter_subs {
   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),
index 0fde2ac..4edcbf9 100644 (file)
@@ -11,14 +11,14 @@ use DevHelp::HTML;
 
 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 }
index db41974..6030c54 100644 (file)
@@ -2,7 +2,7 @@ package BSE::Util::Tags;
 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);
@@ -91,7 +91,7 @@ sub static {
        $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 =>
@@ -127,6 +127,7 @@ sub static {
        return $gen->format_body($acts, 'Articles', $value, 'tr',
                                1, 0);
      },
+     nobodytext => [\&tag_nobodytext, $cfg ],
      ifEq =>
      sub {
        my ($arg, $acts, $name, $templater) = @_;
@@ -267,6 +268,9 @@ sub static {
        elsif ($fmt eq 'h') {
         return escape_html($value);
        }
+       elsif ($fmt eq 'x') {
+        return escape_xml(unescape_html($value));
+       }
        return $value;
      },
     );  
@@ -315,6 +319,26 @@ sub tag_arithmetic {
   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) = @_;
 
index 11eda46..6356feb 100644 (file)
@@ -4,7 +4,7 @@ use Carp qw(confess);
 
 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 =
   (
@@ -28,6 +28,16 @@ sub unescape_html {
   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
index 0d74f96..a4a155f 100644 (file)
@@ -364,7 +364,7 @@ sub embed {
 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");
@@ -377,7 +377,7 @@ sub iter_kids_of {
 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");
@@ -390,7 +390,7 @@ sub iter_all_kids_of {
 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");
@@ -714,74 +714,6 @@ sub remove_block {
                                      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 {
index 1028c66..3bd354b 100644 (file)
@@ -10,6 +10,43 @@ Maybe I'll add some other bits here.
 
 =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 &eacute;).  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
index c080147..d9c6a8f 100644 (file)
Binary files a/site/htdocs/images/trans_pixel.gif and b/site/htdocs/images/trans_pixel.gif differ
diff --git a/t/t080escape.t b/t/t080escape.t
new file mode 100644 (file)
index 0000000..55288be
--- /dev/null
@@ -0,0 +1,13 @@
+#!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"), '&lt;&amp;&#233;', "don't escape like html");
+}
index ef1d34d..82f3081 100644 (file)
@@ -1,7 +1,7 @@
 #!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');
@@ -15,7 +15,8 @@ require BSE::Util::SQL;
 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') {
@@ -177,6 +178,18 @@ TEMPLATE
 <: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};