r45794 - in /branches/upstream/libhtml-template-expr-perl/current: ./ t/ t/templates/
emhn-guest at users.alioth.debian.org
emhn-guest at users.alioth.debian.org
Wed Oct 14 15:58:15 UTC 2009
Author: emhn-guest
Date: Wed Oct 14 15:58:09 2009
New Revision: 45794
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=45794
Log:
[svn-upgrade] Integrating new upstream version, libhtml-template-expr-perl (0.07)
Added:
branches/upstream/libhtml-template-expr-perl/current/t/05cache.t
branches/upstream/libhtml-template-expr-perl/current/t/06extra_attributes.t
branches/upstream/libhtml-template-expr-perl/current/t/templates/extra_attributes.tmpl
Modified:
branches/upstream/libhtml-template-expr-perl/current/ANNOUNCE
branches/upstream/libhtml-template-expr-perl/current/Changes
branches/upstream/libhtml-template-expr-perl/current/Expr.pm
branches/upstream/libhtml-template-expr-perl/current/MANIFEST
branches/upstream/libhtml-template-expr-perl/current/META.yml
branches/upstream/libhtml-template-expr-perl/current/t/01parse.t
branches/upstream/libhtml-template-expr-perl/current/t/03complex.t
branches/upstream/libhtml-template-expr-perl/current/t/04register.t
branches/upstream/libhtml-template-expr-perl/current/t/templates/complex.tmpl
branches/upstream/libhtml-template-expr-perl/current/t/templates/register.tmpl
Modified: branches/upstream/libhtml-template-expr-perl/current/ANNOUNCE
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libhtml-template-expr-perl/current/ANNOUNCE?rev=45794&op=diff
==============================================================================
--- branches/upstream/libhtml-template-expr-perl/current/ANNOUNCE (original)
+++ branches/upstream/libhtml-template-expr-perl/current/ANNOUNCE Wed Oct 14 15:58:09 2009
@@ -1,8 +1,14 @@
-ANNOUNCEMENT: HTML::Template::Expr 0.05
+ANNOUNCEMENT: HTML::Template::Expr 0.07
CHANGES
- - Added a compatibility fix required by HTML::Template v2.8.
+ - Added support for ESCAPE attribute in combination with EXPR.
+ (Michael Peters)
+
+ - Fixed a bug where functions which returned 0 or more than one
+ return value would cause a stack under or overflow. Functions
+ are now called in scalar context, eliminating the problem.
+ Thanks to Jamie Krasnoo for the spot.
DESCRIPTION
Modified: branches/upstream/libhtml-template-expr-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libhtml-template-expr-perl/current/Changes?rev=45794&op=diff
==============================================================================
--- branches/upstream/libhtml-template-expr-perl/current/Changes (original)
+++ branches/upstream/libhtml-template-expr-perl/current/Changes Wed Oct 14 15:58:09 2009
@@ -1,22 +1,18 @@
-Revision history for HTML::Template::Expr.
+0.07
+ - Added support for ESCAPE attribute in combination with EXPR.
+ (Michael Peters)
-0.01
- - Initial Release.
+ - Fixed a bug where functions which returned 0 or more than one
+ return value would cause a stack under or overflow. Functions
+ are now called in scalar context, eliminating the problem.
+ Thanks to Jamie Krasnoo for the spot.
-0.02
- - Fixed bug where numeric functions all returned 1.
- (reported by Peter Leonard)
+0.06
+ - Rewrote grammar to support expressions with less parenthesis.
+ For example, "foo || bar || baz" now works.
- - Improved performance over 300% with a new grammar and expression
- evaluator.
-
- - Enhanced grammar to support call(foo > 10) syntax.
-
-0.03
- - Added register_function() class method add functions globally.
- (Tatsuhiko Miyagawa)
-
- - Fixed broken cache mode.
+0.05 Wed Dec 21 18:56:49 EST 2005
+ - Added a compatibility fix required by HTML::Template v2.8.
0.04 Thu Aug 29 12:00:00 2002
- Fixed parser to recognize negative numbers. Thanks to Fran
@@ -28,5 +24,21 @@
- Updated mailing-list information to reflect move from vm.com to
sourceforge.net
-0.05 Wed Dec 21 18:56:49 EST 2005
- - Added a compatibility fix required by HTML::Template v2.8.
+0.03
+ - Added register_function() class method add functions globally.
+ (Tatsuhiko Miyagawa)
+
+ - Fixed broken cache mode.
+
+0.02
+ - Fixed bug where numeric functions all returned 1.
+ (reported by Peter Leonard)
+
+ - Improved performance over 300% with a new grammar and expression
+ evaluator.
+
+ - Enhanced grammar to support call(foo > 10) syntax.
+
+0.01
+ - Initial Release.
+
Modified: branches/upstream/libhtml-template-expr-perl/current/Expr.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libhtml-template-expr-perl/current/Expr.pm?rev=45794&op=diff
==============================================================================
--- branches/upstream/libhtml-template-expr-perl/current/Expr.pm (original)
+++ branches/upstream/libhtml-template-expr-perl/current/Expr.pm Wed Oct 14 15:58:09 2009
@@ -3,7 +3,7 @@
use strict;
use vars qw($VERSION);
-$VERSION = '0.05';
+$VERSION = '0.07';
use HTML::Template 2.4;
use Carp qw(croak confess carp);
@@ -11,46 +11,44 @@
use base 'HTML::Template';
-# constants used in the expression tree
-use constant BIN_OP => 1;
-use constant FUNCTION_CALL => 2;
-
use vars qw($GRAMMAR);
-$GRAMMAR = <<END;
-expression : subexpression /^\$/ { \$return = \$item[1]; }
-
-subexpression : binary_op { \$item[1] }
- | function_call { \$item[1] }
- | var { \$item[1] }
- | literal { \$item[1] }
- | '(' subexpression ')' { \$item[2] }
+$GRAMMAR = <<'END';
+expression : paren /^$/ { $return = $item[1] }
+
+paren : '(' binary_op ')' { $item[2] }
+ | '(' subexpression ')' { $item[2] }
+ | subexpression { $item[1] }
+ | '(' paren ')' { $item[2] }
+
+subexpression : function_call
+ | var
+ | literal
| <error>
-binary_op : '(' subexpression op subexpression ')'
- { [ \$item[3][0], \$item[3][1], \$item[2], \$item[4] ] }
-
-op : />=?|<=?|!=|==/ { [ ${\BIN_OP}, \$item[1] ] }
- | /le|ge|eq|ne|lt|gt/ { [ ${\BIN_OP}, \$item[1] ] }
- | /\\|\\||or|&&|and/ { [ ${\BIN_OP}, \$item[1] ] }
- | /[-+*\\/\%]/ { [ ${\BIN_OP}, \$item[1] ] }
+binary_op : paren (op paren { [ $item[2], $item[1] ] })(s)
+ { $return = [ 'SUB_EXPR', $item[1], map { @$_ } @{$item[2]} ] }
+
+op : />=?|<=?|!=|==/ { [ 'BIN_OP', $item[1] ] }
+ | /le|ge|eq|ne|lt|gt/ { [ 'BIN_OP', $item[1] ] }
+ | /\|\||or|&&|and/ { [ 'BIN_OP', $item[1] ] }
+ | /[-+*\/%]/ { [ 'BIN_OP', $item[1] ] }
function_call : function_name '(' args ')'
- { [ ${\FUNCTION_CALL}, \$item[1], \$item[3] ] }
- | function_name ...'(' subexpression
- { [ ${\FUNCTION_CALL}, \$item[1], [ \$item[3] ] ] }
+ { [ 'FUNCTION_CALL', $item[1], $item[3] ] }
+ | function_name ...'(' paren
+ { [ 'FUNCTION_CALL', $item[1], [ $item[3] ] ] }
| function_name '(' ')'
- { [ ${\FUNCTION_CALL}, \$item[1] ] }
+ { [ 'FUNCTION_CALL', $item[1] ] }
function_name : /[A-Za-z_][A-Za-z0-9_]*/
- { \$item[1] }
-
-args : <leftop: subexpression ',' subexpression>
-
-var : /[A-Za-z_][A-Za-z0-9_]*/ { \\\$item[1] }
-
-literal : /-?\\d*\\.\\d+/ { \$item[1] }
- | /-?\\d+/ { \$item[1] }
- | <perl_quotelike> { \$item[1][2] }
+
+args : <leftop: paren ',' paren>
+
+var : /[A-Za-z_][A-Za-z0-9_]*/ { [ 'VAR', $item[1] ] }
+
+literal : /-?\d*\.\d+/ { [ 'LITERAL', $item[1] ] }
+ | /-?\d+/ { [ 'LITERAL', $item[1] ] }
+ | <perl_quotelike> { [ 'LITERAL', $item[1][2] ] }
END
@@ -149,11 +147,21 @@
my $text = shift;
# find expressions and create parse trees
- my ($ref, $tree, $expr_text, $vars, $which, $out);
- $$text =~ s/<(?:!--\s*)?[Tt][Mm][Pp][Ll]_([Ii][Ff]|[Uu][Nn][Ll][Ee][Ss][Ss]|[Vv][Aa][Rr])\s+[Ee][Xx][Pp][Rr]="(.*?)"\s*(?:--)?>
+ my ($ref, $tree, $before_expr, $expr_text, $after_expr, $vars, $which, $out);
+ $$text =~ s/
+ <(?:!--\s*)?
+ [Tt][Mm][Pp][Ll]_
+ ([Ii][Ff]|[Uu][Nn][Ll][Ee][Ss][Ss]|[Vv][Aa][Rr]) # $1 => which tag
+ (\s+[^<]+)? # $2 => before expr
+ \s+[Ee][Xx][Pp][Rr]=
+ "([^"]*)" # $3 => the actual expr
+ (\s+[^>-]+)? # $4 => after expr
+ \s*(?:--)?>
/
- $which = $1;
- $expr_text = $2;
+ $which = $1;
+ $before_expr = $2 || '';
+ $expr_text = $3;
+ $after_expr = $4 || '';
# add enclosing parens to keep grammar simple
$expr_text = "($expr_text)";
@@ -176,7 +184,7 @@
push(@$expr, $tree);
# add the expression placeholder and replace
- $out . "<\/tmpl_if><tmpl_$which __expr_" . $#{$expr} . "__>";
+ $out . "<\/tmpl_if><tmpl_$which ${before_expr}__expr_" . $#{$expr} . "__$after_expr>";
/xeg;
# stupid emacs - /
@@ -185,25 +193,22 @@
# find all variables in a parse tree
sub _expr_vars {
- my %vars;
-
- while(@_) {
- my $node = shift;
- if (ref($node)) {
- if (ref $node eq 'SCALAR') {
- # found a variable
- $vars{$$node} = 1;
- } elsif ($node->[0] == FUNCTION_CALL) {
- # function calls
- push(@_, @{$node->[2]}) if defined $node->[2];
- } else {
- # binary ops
- push(@_, $node->[2], $node->[3]);
- }
+ my $tree = shift;
+ my %vars;
+
+ # hunt for VAR nodes in the tree
+ my @stack = @$tree;
+ while (@stack) {
+ my $node = shift @stack;
+ if (ref $node and ref $node eq 'ARRAY') {
+ if ($node->[0] eq 'VAR') {
+ $vars{$node->[1]} = 1;
+ } else {
+ push @stack, @$node;
+ }
+ }
}
- }
-
- return keys %vars;
+ return keys %vars;
}
# allow loops to stay as HTML::Template objects, we don't need to
@@ -239,7 +244,7 @@
# setup %FUNC
local %FUNC = (%FUNC, %$expr_func);
- my $result = HTML::Template::output($self, @_);
+ my $result = $self->SUPER::output(@_);
# restore cached values to their hideout in the parse_stack
if ($options->{cache}) {
@@ -252,79 +257,111 @@
sub _expr_evaluate {
my ($tree, $template) = @_;
- my ($op, $lhs, $rhs);
-
- # return literals up
- return $tree unless ref $tree;
-
- # lookup vars
- return $template->param($$tree)
- if ref $tree eq 'SCALAR';
-
- my $type = $tree->[0];
-
- # handle binary expressions
- if ($type == BIN_OP) {
- ($op, $lhs, $rhs) = ($tree->[1], $tree->[2], $tree->[3]);
-
- # recurse and resolve subexpressions
- $lhs = _expr_evaluate($lhs, $template) if ref($lhs);
- $rhs = _expr_evaluate($rhs, $template) if ref($rhs);
+ my ($op, $lhs, $rhs, $node, $type, @stack);
+
+ my @nodes = $tree;
+ while (@nodes) {
+ my $node = shift @nodes;
+ my $type = $node->[0];
+
+ if ($type eq 'LITERAL') {
+ push @stack, $node->[1];
+ next;
+ }
+
+ if ($type eq 'VAR') {
+ push @stack, $template->param($node->[1]);
+ next;
+ }
+
+ if ($type eq 'SUB_EXPR') {
+ unshift @nodes, @{$node}[1..$#{$node}];
+ next;
+ }
+
+ if ($type eq 'BIN_OP') {
+ $op = $node->[1];
+ $rhs = pop(@stack);
+ $lhs = pop(@stack);
+
+ # do the op
+ if ($op eq '==') {push @stack, $lhs == $rhs; next; }
+ if ($op eq 'eq') {push @stack, $lhs eq $rhs; next; }
+ if ($op eq '>') {push @stack, $lhs > $rhs; next; }
+ if ($op eq '<') {push @stack, $lhs < $rhs; next; }
+
+ if ($op eq '!=') {push @stack, $lhs != $rhs; next; }
+ if ($op eq 'ne') {push @stack, $lhs ne $rhs; next; }
+ if ($op eq '>=') {push @stack, $lhs >= $rhs; next; }
+ if ($op eq '<=') {push @stack, $lhs <= $rhs; next; }
+
+ if ($op eq '+') {push @stack, $lhs + $rhs; next; }
+ if ($op eq '-') {push @stack, $lhs - $rhs; next; }
+ if ($op eq '/') {push @stack, $lhs / $rhs; next; }
+ if ($op eq '*') {push @stack, $lhs * $rhs; next; }
+ if ($op eq '%') {push @stack, $lhs % $rhs; next; }
+
+ if ($op eq 'le') {push @stack, $lhs le $rhs; next; }
+ if ($op eq 'ge') {push @stack, $lhs ge $rhs; next; }
+ if ($op eq 'lt') {push @stack, $lhs lt $rhs; next; }
+ if ($op eq 'gt') {push @stack, $lhs gt $rhs; next; }
+
+ # short circuit or
+ if ($op eq 'or' or $op eq '||') {
+ if ($lhs) {
+ push @stack, 1;
+ next;
+ }
+ if ($rhs) {
+ push @stack, 1;
+ next;
+ }
+ push @stack, 0;
+ next;
+ }
+
+ # short circuit and
+ if ($op eq '&&' or $op eq 'and') {
+ unless ($lhs) {
+ push @stack, 0;
+ next;
+ }
+ unless ($rhs) {
+ push @stack, 0;
+ next;
+ }
+ push @stack, 1;
+ next;
+ }
- # do the op
- $op eq '==' and return $lhs == $rhs;
- $op eq 'eq' and return $lhs eq $rhs;
- $op eq '>' and return $lhs > $rhs;
- $op eq '<' and return $lhs < $rhs;
-
- $op eq '!=' and return $lhs != $rhs;
- $op eq 'ne' and return $lhs ne $rhs;
- $op eq '>=' and return $lhs >= $rhs;
- $op eq '<=' and return $lhs <= $rhs;
-
- $op eq '+' and return $lhs + $rhs;
- $op eq '-' and return $lhs - $rhs;
- $op eq '/' and return $lhs / $rhs;
- $op eq '*' and return $lhs * $rhs;
- $op eq '%' and return $lhs % $rhs;
-
- if ($op eq 'or' or $op eq '||') {
- # short circuit or
- $lhs = _expr_evaluate($lhs, $template) if ref $lhs;
- return 1 if $lhs;
- $rhs = _expr_evaluate($rhs, $template) if ref $rhs;
- return 1 if $rhs;
- return 0;
- } else {
- # short circuit and
- $lhs = _expr_evaluate($lhs, $template) if ref $lhs;
- return 0 unless $lhs;
- $rhs = _expr_evaluate($rhs, $template) if ref $rhs;
- return 0 unless $rhs;
- return 1;
- }
-
- $op eq 'le' and return $lhs le $rhs;
- $op eq 'ge' and return $lhs ge $rhs;
- $op eq 'lt' and return $lhs lt $rhs;
- $op eq 'gt' and return $lhs gt $rhs;
-
- confess("HTML::Template::Expr : unknown op: $op");
+ confess("HTML::Template::Expr : unknown op: $op");
+ }
+
+ if ($type eq 'FUNCTION_CALL') {
+ my $name = $node->[1];
+ my $args = $node->[2];
+ croak("HTML::Template::Expr : found unknown subroutine call ".
+ ": $name.\n")
+ unless exists($FUNC{$name});
+ if (defined $args) {
+ push @stack,
+ scalar
+ $FUNC{$name}->(map { _expr_evaluate($_, $template) } @$args);
+ } else {
+ push @stack, scalar $FUNC{$name}->();
+ }
+ next;
+ }
+
+ confess("HTML::Template::Expr : unrecognized node in tree: $node");
}
- if ($type == FUNCTION_CALL) {
- croak("HTML::Template::Expr : found unknown subroutine call : $tree->[1]\n") unless exists($FUNC{$tree->[1]});
-
- if (defined $tree->[2]) {
- return $FUNC{$tree->[1]}->(
- map { _expr_evaluate($_, $template) } @{$tree->[2]}
- );
- } else {
- return $FUNC{$tree->[1]}->();
- }
+ unless (@stack == 1) {
+ confess("HTML::Template::Expr : stack overflow! ".
+ "Please report this bug to the maintainer.");
}
- croak("HTML::Template::Expr : fell off the edge of _expr_evaluate()! This is a bug - please report it to the author.");
+ return $stack[0];
}
sub register_function {
@@ -423,15 +460,14 @@
<TMPL_VAR EXPR="sprintf('%d', foo)">
-The parser is currently rather simple, so all compound expressions
-must be parenthesized. Examples:
-
- <TMPL_VAR EXPR="(10 + foo) / bar">
-
- <TMPL_IF EXPR="(foo % 10) > (bar + 1)">
-
-If you don't like this rule please feel free to contribute a patch
-to improve the parser's grammar.
+You can string together operators to produce complex booleans:
+
+ <TMPL_IF EXPR="(foo || bar || baz || (bif && bing) || (bananas > 10))">
+ I'm in a complex situation.
+ </TMPL_IF>
+
+The parser is pretty simple, so you may need to use parenthesis to get
+the desired precedence.
=head1 COMPARISON
@@ -657,6 +693,7 @@
Peter Leonard
Tatsuhiko Miyagawa
+ Don Brodale
Thanks!
Modified: branches/upstream/libhtml-template-expr-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libhtml-template-expr-perl/current/MANIFEST?rev=45794&op=diff
==============================================================================
--- branches/upstream/libhtml-template-expr-perl/current/MANIFEST (original)
+++ branches/upstream/libhtml-template-expr-perl/current/MANIFEST Wed Oct 14 15:58:09 2009
@@ -8,6 +8,8 @@
t/02basic.t
t/03complex.t
t/04register.t
+t/05cache.t
+t/06extra_attributes.t
t/templates/foo.tmpl
t/templates/complex.tmpl
t/templates/loop.tmpl
@@ -16,6 +18,7 @@
t/templates/numerics.tmpl
t/templates/register.tmpl
t/templates/negative.tmpl
+t/templates/extra_attributes.tmpl
GPL
ARTISTIC
ANNOUNCE
Modified: branches/upstream/libhtml-template-expr-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libhtml-template-expr-perl/current/META.yml?rev=45794&op=diff
==============================================================================
--- branches/upstream/libhtml-template-expr-perl/current/META.yml (original)
+++ branches/upstream/libhtml-template-expr-perl/current/META.yml Wed Oct 14 15:58:09 2009
@@ -1,7 +1,7 @@
# http://module-build.sourceforge.net/META-spec.html
#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
name: HTML-Template-Expr
-version: 0.05
+version: 0.07
version_from: Expr.pm
installdirs: site
requires:
Modified: branches/upstream/libhtml-template-expr-perl/current/t/01parse.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libhtml-template-expr-perl/current/t/01parse.t?rev=45794&op=diff
==============================================================================
--- branches/upstream/libhtml-template-expr-perl/current/t/01parse.t (original)
+++ branches/upstream/libhtml-template-expr-perl/current/t/01parse.t Wed Oct 14 15:58:09 2009
@@ -1,19 +1,24 @@
-use Test::More tests => 14;
+use Test::More qw(no_plan);
+use Parse::RecDescent;
+
+use constant DEBUG => 0;
+$::RD_HINT = DEBUG;
+# $::RD_TRACE = 1;
+
use HTML::Template::Expr;
-use Parse::RecDescent;
use Data::Dumper;
-use constant DEBUG => 0;
+
# test grammar directly
-$::RD_HINT = 1 if DEBUG;
+
my @tests = (
"(foo > 10)",
"((foo < 10) != (bar > 10))",
"('foo' eq 'bar')",
"((foo + 10.1) > 100)",
"(((foo > 10) || (200 < bar)) + 10.5)",
- "(call(foo, 10))",
+ "(call(foo, 10, 20, 30))",
"(call(foo, 10) > 10)",
"(first( foo, 10 ))",
"(call(foo, \"baz\", 10) eq 'string val')",
@@ -21,17 +26,21 @@
"(((call(foo, 10) + 100) > 10) || (foo eq \"barf\"))",
"((foo > bar))",
"call(call2(call3()))",
- "call(foo > bar)"
+ "call(foo > bar)",
+ "(foo || bar || baz || bif)",
+ "((foo || bar || baz) && bif)",
+ "((foo || bar || baz) && (bif || 10))",
);
foreach my $test (@tests) {
- my $tree = $HTML::Template::Expr::PARSER->expression($test);
- ok($tree, "parsing \"$test\"");
- if (DEBUG) {
- local $Data::Dumper::Indent = 1;
- local $Data::Dumper::Purity = 0;
- local $Data::Dumper::Deepcopy = 1;
- print STDERR Data::Dumper->Dump([\$tree],['$tree']);
- print STDERR "vars: ", join(',', HTML::Template::Expr::_expr_vars($tree)), "\n\n";
- }
+ print STDERR "TRYING TO PARSE $test\n" if DEBUG;
+ my $tree = $HTML::Template::Expr::PARSER->expression($test);
+ ok($tree, "parsing \"$test\"");
+ if (DEBUG) {
+ local $Data::Dumper::Indent = 1;
+ local $Data::Dumper::Purity = 0;
+ local $Data::Dumper::Deepcopy = 1;
+ print STDERR Data::Dumper->Dump([\$tree],['$tree']);
+ print STDERR "vars: ", join(',', HTML::Template::Expr::_expr_vars($tree)), "\n\n";
+ }
}
Modified: branches/upstream/libhtml-template-expr-perl/current/t/03complex.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libhtml-template-expr-perl/current/t/03complex.t?rev=45794&op=diff
==============================================================================
--- branches/upstream/libhtml-template-expr-perl/current/t/03complex.t (original)
+++ branches/upstream/libhtml-template-expr-perl/current/t/03complex.t Wed Oct 14 15:58:09 2009
@@ -1,4 +1,4 @@
-use Test::More tests => 18;
+use Test::More qw(no_plan);
use HTML::Template::Expr;
my $template = HTML::Template::Expr->new(path => ['t/templates'],
@@ -15,13 +15,19 @@
unused => 0);
my $output = $template->output();
like($output, qr/Foo is greater than 10/i, "greater than");
-ok($output !~ qr/Bar and Foo/i, "and");
+unlike($output, qr/Bar and Foo/i, "and");
like($output, qr/Bar or Foo/i, "or");
like($output, qr/Bar - Foo = -11/i, "subtraction");
+like($output, qr/Foo - Bar \+ 10 = 21/i, "math strings");
like($output, qr/Math Works, Alright/i, "math");
like($output, qr/My name is President Clinton/, "string op 1");
like($output, qr/Resident Alien is phat/, "string op 2");
like($output, qr/Resident has 8 letters, which is less than 10 and greater than 5/, "string length");
+like($output, qr/Multiple ors works/, 'multiple or test');
+like($output, qr/Addition and comparison 1/);
+unlike($output, qr/Addition and comparison 2/);
+like($output, qr/Addition and comparison 3/);
+unlike($output, qr/And 0 works/);
$template = HTML::Template::Expr->new(path => ['t/templates'],
filename => 'loop.tmpl',
Modified: branches/upstream/libhtml-template-expr-perl/current/t/04register.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libhtml-template-expr-perl/current/t/04register.t?rev=45794&op=diff
==============================================================================
--- branches/upstream/libhtml-template-expr-perl/current/t/04register.t (original)
+++ branches/upstream/libhtml-template-expr-perl/current/t/04register.t Wed Oct 14 15:58:09 2009
@@ -1,4 +1,4 @@
-use Test::More tests => 3;
+use Test::More tests => 4;
use HTML::Template::Expr;
HTML::Template::Expr->register_function(directory_exists => sub {
@@ -10,6 +10,7 @@
1 while s/^([-+]?\d+)(\d{3})/$1,$2/;
return $_;
});
+HTML::Template::Expr->register_function(nada => sub { return });
my $template = HTML::Template::Expr->new(path => ['t/templates'],
filename => 'register.tmpl',
@@ -17,6 +18,7 @@
my $output = $template->output;
like $output, qr/^OK/, 'directory_exists()';
like $output, qr/2,000/, 'comify';
+like $output, qr/nada worked/, 'nada worked';
eval {
HTML::Template::Expr->register_function('foo', 'bar');
Added: branches/upstream/libhtml-template-expr-perl/current/t/05cache.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libhtml-template-expr-perl/current/t/05cache.t?rev=45794&op=file
==============================================================================
--- branches/upstream/libhtml-template-expr-perl/current/t/05cache.t (added)
+++ branches/upstream/libhtml-template-expr-perl/current/t/05cache.t Wed Oct 14 15:58:09 2009
@@ -1,0 +1,50 @@
+use Test::More tests => 15;
+use HTML::Template::Expr;
+use strict;
+
+my ($template, $output);
+
+# first load
+$template = HTML::Template::Expr->new(path => ['t/templates'],
+ filename => 'numerics.tmpl',
+ cache => 1,
+ cache_debug => 0,
+ );
+$template->param(float => 5.1,
+ four => 4);
+$output = $template->output;
+like($output, qr/INT: 5/, "int()");
+like($output, qr/SQRT: 2/, "sqrt()");
+like($output, qr/SQRT2: 4/, "sqrt() 2");
+like($output, qr/SUM: 14/, "int(4 + 10.1)");
+like($output, qr/SPRINTF: 14.1000/, "sprintf('%0.4f', (10.1 + 4))");
+
+# load from cache
+$template = HTML::Template::Expr->new(path => ['t/templates'],
+ filename => 'numerics.tmpl',
+ cache => 1,
+ cache_debug => 0,
+ );
+$template->param(float => 5.1,
+ four => 4);
+$output = $template->output;
+like($output, qr/INT: 5/, "int()");
+like($output, qr/SQRT: 2/, "sqrt()");
+like($output, qr/SQRT2: 4/, "sqrt() 2");
+like($output, qr/SUM: 14/, "int(4 + 10.1)");
+like($output, qr/SPRINTF: 14.1000/, "sprintf('%0.4f', (10.1 + 4))");
+
+# one more time...
+$template = HTML::Template::Expr->new(path => ['t/templates'],
+ filename => 'numerics.tmpl',
+ cache => 1,
+ cache_debug => 0,
+ );
+$template->param(float => 5.1,
+ four => 4);
+$output = $template->output;
+like($output, qr/INT: 5/, "int()");
+like($output, qr/SQRT: 2/, "sqrt()");
+like($output, qr/SQRT2: 4/, "sqrt() 2");
+like($output, qr/SUM: 14/, "int(4 + 10.1)");
+like($output, qr/SPRINTF: 14.1000/, "sprintf('%0.4f', (10.1 + 4))");
Added: branches/upstream/libhtml-template-expr-perl/current/t/06extra_attributes.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libhtml-template-expr-perl/current/t/06extra_attributes.t?rev=45794&op=file
==============================================================================
--- branches/upstream/libhtml-template-expr-perl/current/t/06extra_attributes.t (added)
+++ branches/upstream/libhtml-template-expr-perl/current/t/06extra_attributes.t Wed Oct 14 15:58:09 2009
@@ -1,0 +1,16 @@
+use Test::More qw(no_plan);
+use HTML::Template::Expr;
+
+my $template = HTML::Template::Expr->new(path => ['t/templates'],
+ filename => 'extra_attributes.tmpl',
+ );
+$template->param(who => 'me & you',
+ xss => '<SCRIPT SRC="MALICIOUS.JS" />',
+ back => 'http://google.com',
+ js_string => "This is\n'me'",);
+my $output = $template->output();
+like($output, qr/ME & YOU/);
+like($output, qr/<script src="malicious\.js" \/>/);
+like($output, qr/Http%3A%2F%2Fgoogle\.com/);
+like($output, qr/this is\\n\\'me\\'/);
+
Modified: branches/upstream/libhtml-template-expr-perl/current/t/templates/complex.tmpl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libhtml-template-expr-perl/current/t/templates/complex.tmpl?rev=45794&op=diff
==============================================================================
--- branches/upstream/libhtml-template-expr-perl/current/t/templates/complex.tmpl (original)
+++ branches/upstream/libhtml-template-expr-perl/current/t/templates/complex.tmpl Wed Oct 14 15:58:09 2009
@@ -11,7 +11,28 @@
Bar or Foo.
</tmpl_if>
+<tmpl_if expr="bar || foo || bar || foo">
+ Multiple ors works
+</tmpl_if>
+
+<tmpl_if expr="(bar || foo || bar || foo) && bar">
+ And 0 works
+</tmpl_if>
+
+<tmpl_if expr="(foo + 1) < (foo + 2)">
+ Addition and comparison 1
+</tmpl_if>
+
+<tmpl_if expr="(foo + 1) > (foo + 2)">
+ Addition and comparison 2
+</tmpl_if>
+
+<tmpl_if expr="((foo + 1) > (foo + 2)) || ((foo + 1) < (foo + 2))">
+ Addition and comparison 3
+</tmpl_if>
+
Bar - Foo = <tmpl_var expr="bar - foo">
+Foo - Bar + 10 = <tmpl_var expr="foo - bar + 10">
<tmpl_if expr="((foo * foo) > (foo + foo))">
Math Works, Alright
Added: branches/upstream/libhtml-template-expr-perl/current/t/templates/extra_attributes.tmpl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libhtml-template-expr-perl/current/t/templates/extra_attributes.tmpl?rev=45794&op=file
==============================================================================
--- branches/upstream/libhtml-template-expr-perl/current/t/templates/extra_attributes.tmpl (added)
+++ branches/upstream/libhtml-template-expr-perl/current/t/templates/extra_attributes.tmpl Wed Oct 14 15:58:09 2009
@@ -1,0 +1,4 @@
+<tmpl_var expr="uc(who)" escape="HTML">
+<tmpl_var escape="HTML" expr="lc(xss)">
+<tmpl_var expr="ucfirst(back)" escape="URL">
+<tmpl_var expr="lcfirst(js_string)" escape="JS">
Modified: branches/upstream/libhtml-template-expr-perl/current/t/templates/register.tmpl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libhtml-template-expr-perl/current/t/templates/register.tmpl?rev=45794&op=diff
==============================================================================
--- branches/upstream/libhtml-template-expr-perl/current/t/templates/register.tmpl (original)
+++ branches/upstream/libhtml-template-expr-perl/current/t/templates/register.tmpl Wed Oct 14 15:58:09 2009
@@ -1,2 +1,3 @@
<tmpl_if expr="directory_exists('t')">OK</tmpl_if>
<tmpl_var expr="commify(2000)">
+<tmpl_unless expr="nada()">nada worked</tmpl_unless>
More information about the Pkg-perl-cvs-commits
mailing list