[interchange-cvs] interchange - heins modified lib/Vend/Interpolate.pm
interchange-core@interchange.redhat.com
interchange-core@interchange.redhat.com
Wed Oct 10 20:20:01 2001
User: heins
Date: 2001-10-11 00:19:04 GMT
Modified: lib/Vend Interpolate.pm
Log:
* Add restrict_html filter which allows only passed tags to be
used. Called with:
[filter restrict_html.a.b.i.u.blockquote.li.ol.ul.p]
<A HREF="junk.html"> this </A>
<SCRIPT> Some stuff </SCRIPT>
[/filter]
Outputs:
<A HREF="junk.html"> this </A>
<SCRIPT> Some stuff </SCRIPT>
* Fix my braindamaged use of tag_attr_list() in [on-match ...]
and [no-match ...] areas. Now instead do an
iterate_hash_list(0,0,0,$onmatch_area, $opt)
which allows [item-param parm] to pull stuff from $opt
of [loop ...], [query ...], etc.
* Add mv_spacer argument to [tree ...], which is
$opt->{spacer} x $item->{mv_spacing}. So:
[tree
.....
spacer=" "
spacing=4
]
[item-param mv_spacer]
==
[calc] ' ' x [item-param mv_spacing] [/calc]
[/tree]
* Not for stable branch except filter, which I will commit.
Revision Changes Path
2.19 +49 -12 interchange/lib/Vend/Interpolate.pm
rev 2.19, prev_rev 2.18
Index: Interpolate.pm
===================================================================
RCS file: /anon_cvs/repository/interchange/lib/Vend/Interpolate.pm,v
retrieving revision 2.18
retrieving revision 2.19
diff -u -r2.18 -r2.19
--- Interpolate.pm 2001/10/10 19:45:23 2.18
+++ Interpolate.pm 2001/10/11 00:19:04 2.19
@@ -1,6 +1,6 @@
# Vend::Interpolate - Interpret Interchange tags
#
-# $Id: Interpolate.pm,v 2.18 2001/10/10 19:45:23 racke Exp $
+# $Id: Interpolate.pm,v 2.19 2001/10/11 00:19:04 mheins Exp $
#
# Copyright (C) 1996-2001 Red Hat, Inc. <interchange@redhat.com>
#
@@ -27,7 +27,7 @@
require Exporter;
@ISA = qw(Exporter);
-$VERSION = substr(q$Revision: 2.18 $, 10);
+$VERSION = substr(q$Revision: 2.19 $, 10);
@EXPORT = qw (
@@ -1183,6 +1183,16 @@
return ::errmsg($val);
},
+ restrict_html => sub {
+ my $val = shift;
+ shift;
+ my %allowed;
+ @allowed{@_} = @_;
+ $val =~ s{<(/?(\w[-\w]*)[\s>])}
+ { ($allowed{lc $2} ? '<' : '<') . $1 }ge;
+ return $val;
+ },
+
);
$Filter{upper} = $Filter{uc};
@@ -2310,11 +2320,11 @@
#::logDebug("item in tag_accessories: " . ::uneval_it($item));
if(exists $item->{$attribute}) {
-::logDebug("default from attribute=$attribute, value=$item->{$attribute}");
+#::logDebug("default from attribute=$attribute, value=$item->{$attribute}");
$default = $item->{$attribute};
}
elsif (exists $opt->{default}) {
-::logDebug("default from opt");
+#::logDebug("default from opt");
$default = $opt->{default};
}
elsif ($name) {
@@ -4772,6 +4782,14 @@
my ($i, $end, $count, $text, $ary, $opt_select, $fh) = @_;
my $r = '';
+ # Optimize for no-match, on-match, etc
+ if($text !~ /\[(?:if-)?$Prefix-/) {
+ for(; $i <= $end; $i++) {
+ $r .= $text;
+ }
+ return $r;
+ }
+
my ($run, $row, $code, $return);
my $once = 0;
#::logDebug("iterating array $i to $end. count=$count opt_select=$opt_select ary=" . ::uneval($ary));
@@ -4883,9 +4901,18 @@
sub iterate_hash_list {
my($i, $end, $count, $text, $hash, $opt_select, $opt) = @_;
+ my $r = '';
+
+ # Optimize for no-match, on-match, etc
+ if($text !~ /\[(?:if-)?$Prefix-/) {
+ for(; $i <= $end; $i++) {
+ $r .= $text;
+ }
+ return $r;
+ }
+
$opt = {} if ! $opt;
my $code_field = $opt->{code_field} || 'mv_sku';
- my $r = '';
my ($run, $code, $return, $item);
#::logDebug("iterating hash $i to $end. count=$count opt_select=$opt_select hash=" . ::uneval($hash));
@@ -5121,9 +5148,9 @@
#::logDebug("tree-list: valid parent=$parent sub=$sub start=$start_item mult=$mult");
- my @ary_stack = ( $ary );
- my @above_stack = { $start_item => 1 };
- my @inc_stack = ($outline[0]);
+ my @ary_stack = ( $ary ); # Stacks the rows
+ my @above_stack = { $start_item => 1 }; # Holds the previous levels
+ my @inc_stack = ($outline[0]); # Holds the increment characters
my @rows;
my $row;
@@ -5136,10 +5163,13 @@
my $increment = pop(@inc_stack);
ROW: for(;;) {
#::logDebug("next row level=$level increment=$increment");
+ my $prev = $row;
$row = shift @$ary
- or last ROW;
+ or ($prev and $prev->{mv_last} = 1), last ROW;
$row->{mv_level} = $level;
$row->{mv_spacing} = $level * $mult;
+ $row->{mv_spacer} = $opt->{spacer} x $row->{mv_spacing}
+ if $opt->{mv_spacer};
$row->{mv_increment} = $increment++;
push(@rows, $row);
my $code = $row->{$keyfield};
@@ -5201,7 +5231,7 @@
} # END ROW
#::logDebug("last row");
} # END ARY
-#::logDebug("last ary");
+#::logDebug("last ary, results =" . ::uneval(\@rows));
return labeled_list($opt, $text, {mv_results => \@rows});
}
@@ -5482,20 +5512,27 @@
$opt->{prefix} = $obj->{prefix} if $obj->{prefix};
+ $Orig_prefix = $Prefix = $opt->{prefix} || 'item';
+
+ $B = qr(\[$Prefix)i;
+ $E = qr(\[/$Prefix)i;
+ $IB = qr(\[if[-_]$Prefix)i;
+ $IE = qr(\[/if[-_]$Prefix)i;
+
$page =~ s!$QR{more_list}! tag_more_list($1,$2,$3,$4,$5,$opt,$6)!ge;
$page =~ s!
\[ ( $mprefix on[-_]match )\]
($Some)
\[/\1\]
!
- $obj->{matches} > 0 ? tag_attr_list($2, $opt) : ''
+ $obj->{matches} > 0 ? iterate_hash_list(0,0,1,$2,[$opt]) : ''
!xige;
$page =~ s!
\[ ( $mprefix no[-_]match )\]
($Some)
\[/\1\]
!
- $obj->{matches} > 0 ? '' : tag_attr_list($2, $opt)
+ $obj->{matches} > 0 ? '' : iterate_hash_list(0,0,1,$2,[$opt])
!xige;
$page =~ s:\[($lprefix)\]($Some)\[/\1\]:labeled_list($opt,$2,$obj):ige
or $page = labeled_list($opt,$page,$obj);