From d2b7c937e86e6e8c4b4193e9f4a8da075919b4fd Mon Sep 17 00:00:00 2001 From: Paul Seamons Date: Sat, 10 Jun 2006 00:00:00 +0000 Subject: [PATCH] CGI::Ex 2.03 --- CGI-Ex.spec | 2 +- Changes | 6 + META.yml | 2 +- lib/CGI/Ex.pm | 2 +- lib/CGI/Ex/App.pm | 2 +- lib/CGI/Ex/Auth.pm | 2 +- lib/CGI/Ex/Conf.pm | 2 +- lib/CGI/Ex/Dump.pm | 2 +- lib/CGI/Ex/Fill.pm | 2 +- lib/CGI/Ex/Template.pm | 337 +++++++++++++++++++++------------------- lib/CGI/Ex/Template.pod | 69 ++++---- lib/CGI/Ex/Validate.pm | 2 +- t/7_template_00_base.t | 2 +- 13 files changed, 233 insertions(+), 199 deletions(-) diff --git a/CGI-Ex.spec b/CGI-Ex.spec index 41ddd24..0cebbe9 100644 --- a/CGI-Ex.spec +++ b/CGI-Ex.spec @@ -1,5 +1,5 @@ %define name CGI-Ex -%define version 2.02 +%define version 2.03 %define __find_provides %( echo -n /usr/lib/rpm/find-provides && [ -x /usr/lib/rpm/find-provides.perl ] && echo .perl ) %define __find_requires %( echo -n /usr/lib/rpm/find-requires && [ -x /usr/lib/rpm/find-requires.perl ] && echo .perl ) diff --git a/Changes b/Changes index 12a29df..3e7bee4 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,9 @@ +2.03 2006-06-10 + * Fix the associativity of operators in Template to match perl + * Allow for multiple prefix operators. + * Change name of parse_variable to parse_expr + * Change name of get_variable to play_expr + 2.02 2006-06-08 * Fix the yaml tests * Add failed_sleep to Auth diff --git a/META.yml b/META.yml index 690896c..7dff86d 100644 --- a/META.yml +++ b/META.yml @@ -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: CGI-Ex -version: 2.02 +version: 2.03 version_from: lib/CGI/Ex.pm installdirs: site requires: diff --git a/lib/CGI/Ex.pm b/lib/CGI/Ex.pm index 42f7b64..e009324 100644 --- a/lib/CGI/Ex.pm +++ b/lib/CGI/Ex.pm @@ -24,7 +24,7 @@ use vars qw($VERSION use base qw(Exporter); BEGIN { - $VERSION = '2.02'; + $VERSION = '2.03'; $PREFERRED_CGI_MODULE ||= 'CGI'; @EXPORT = (); @EXPORT_OK = qw(get_form diff --git a/lib/CGI/Ex/App.pm b/lib/CGI/Ex/App.pm index 11e3965..0c3b1f7 100644 --- a/lib/CGI/Ex/App.pm +++ b/lib/CGI/Ex/App.pm @@ -10,7 +10,7 @@ use strict; use vars qw($VERSION); BEGIN { - $VERSION = '2.02'; + $VERSION = '2.03'; Time::HiRes->import('time') if eval {require Time::HiRes}; } diff --git a/lib/CGI/Ex/Auth.pm b/lib/CGI/Ex/Auth.pm index 2208427..67605ff 100644 --- a/lib/CGI/Ex/Auth.pm +++ b/lib/CGI/Ex/Auth.pm @@ -18,7 +18,7 @@ use MIME::Base64 qw(encode_base64 decode_base64); use Digest::MD5 qw(md5_hex); use CGI::Ex; -$VERSION = '2.02'; +$VERSION = '2.03'; ###----------------------------------------------------------------### diff --git a/lib/CGI/Ex/Conf.pm b/lib/CGI/Ex/Conf.pm index 82c76dc..787be6f 100644 --- a/lib/CGI/Ex/Conf.pm +++ b/lib/CGI/Ex/Conf.pm @@ -28,7 +28,7 @@ use vars qw($VERSION ); @EXPORT_OK = qw(conf_read conf_write); -$VERSION = '2.02'; +$VERSION = '2.03'; $DEFAULT_EXT = 'conf'; diff --git a/lib/CGI/Ex/Dump.pm b/lib/CGI/Ex/Dump.pm index 7a2e7aa..a841e8e 100644 --- a/lib/CGI/Ex/Dump.pm +++ b/lib/CGI/Ex/Dump.pm @@ -17,7 +17,7 @@ use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION use strict; use Exporter; -$VERSION = '2.02'; +$VERSION = '2.03'; @ISA = qw(Exporter); @EXPORT = qw(dex dex_warn dex_text dex_html ctrace dex_trace); @EXPORT_OK = qw(dex dex_warn dex_text dex_html ctrace dex_trace debug); diff --git a/lib/CGI/Ex/Fill.pm b/lib/CGI/Ex/Fill.pm index ee6d2a1..0947028 100644 --- a/lib/CGI/Ex/Fill.pm +++ b/lib/CGI/Ex/Fill.pm @@ -24,7 +24,7 @@ use vars qw($VERSION use base qw(Exporter); BEGIN { - $VERSION = '2.02'; + $VERSION = '2.03'; @EXPORT = qw(form_fill); @EXPORT_OK = qw(fill form_fill html_escape get_tagval_by_key swap_tagval_by_key); }; diff --git a/lib/CGI/Ex/Template.pm b/lib/CGI/Ex/Template.pm index 3703367..75886ef 100644 --- a/lib/CGI/Ex/Template.pm +++ b/lib/CGI/Ex/Template.pm @@ -39,7 +39,7 @@ use vars qw($VERSION ); BEGIN { - $VERSION = '2.02'; + $VERSION = '2.03'; $PACKAGE_EXCEPTION = 'CGI::Ex::Template::Exception'; $PACKAGE_ITERATOR = 'CGI::Ex::Template::Iterator'; @@ -204,33 +204,33 @@ BEGIN { ### setup the operator parsing $OPERATORS = [ # type precedence symbols action (undef means play_operator will handle) + ['postfix', 99, ['++'], undef ], + ['postfix', 99, ['--'], undef ], ['prefix', 98, ['++'], undef ], ['prefix', 98, ['--'], undef ], - ['postfix', 98, ['++'], undef ], - ['postfix', 98, ['--'], undef ], - ['infix', 96, ['**', 'pow'], sub { $_[0] ** $_[1] } ], + ['right', 96, ['**', 'pow'], sub { $_[0] ** $_[1] } ], ['prefix', 93, ['!'], sub { ! $_[0] } ], ['prefix', 93, ['-'], sub { @_ == 1 ? 0 - $_[0] : $_[0] - $_[1] } ], - ['infix', 90, ['*'], sub { $_[0] * $_[1] } ], - ['infix', 90, ['/'], sub { $_[0] / $_[1] } ], - ['infix', 90, ['div', 'DIV'], sub { int($_[0] / $_[1]) } ], - ['infix', 90, ['%', 'mod', 'MOD'], sub { $_[0] % $_[1] } ], - ['infix', 85, ['+'], sub { $_[0] + $_[1] } ], - ['infix', 85, ['-'], sub { @_ == 1 ? 0 - $_[0] : $_[0] - $_[1] } ], - ['infix', 85, ['~', '_'], sub { join "", @_ } ], - ['infix', 80, ['<'], sub { $_[0] < $_[1] } ], - ['infix', 80, ['>'], sub { $_[0] > $_[1] } ], - ['infix', 80, ['<='], sub { $_[0] <= $_[1] } ], - ['infix', 80, ['>='], sub { $_[0] >= $_[1] } ], - ['infix', 80, ['lt'], sub { $_[0] lt $_[1] } ], - ['infix', 80, ['gt'], sub { $_[0] gt $_[1] } ], - ['infix', 80, ['le'], sub { $_[0] le $_[1] } ], - ['infix', 80, ['ge'], sub { $_[0] ge $_[1] } ], - ['infix', 75, ['==', 'eq'], sub { $_[0] eq $_[1] } ], - ['infix', 75, ['!=', 'ne'], sub { $_[0] ne $_[1] } ], - ['infix', 70, ['&&'], undef ], - ['infix', 65, ['||'], undef ], - ['infix', 60, ['..'], sub { $_[0] .. $_[1] } ], + ['left', 90, ['*'], sub { $_[0] * $_[1] } ], + ['left', 90, ['/'], sub { $_[0] / $_[1] } ], + ['left', 90, ['div', 'DIV'], sub { int($_[0] / $_[1]) } ], + ['left', 90, ['%', 'mod', 'MOD'], sub { $_[0] % $_[1] } ], + ['left', 85, ['+'], sub { $_[0] + $_[1] } ], + ['left', 85, ['-'], sub { @_ == 1 ? 0 - $_[0] : $_[0] - $_[1] } ], + ['left', 85, ['~', '_'], sub { join "", @_ } ], + ['none', 80, ['<'], sub { $_[0] < $_[1] } ], + ['none', 80, ['>'], sub { $_[0] > $_[1] } ], + ['none', 80, ['<='], sub { $_[0] <= $_[1] } ], + ['none', 80, ['>='], sub { $_[0] >= $_[1] } ], + ['none', 80, ['lt'], sub { $_[0] lt $_[1] } ], + ['none', 80, ['gt'], sub { $_[0] gt $_[1] } ], + ['none', 80, ['le'], sub { $_[0] le $_[1] } ], + ['none', 80, ['ge'], sub { $_[0] ge $_[1] } ], + ['none', 75, ['==', 'eq'], sub { $_[0] eq $_[1] } ], + ['none', 75, ['!=', 'ne'], sub { $_[0] ne $_[1] } ], + ['left', 70, ['&&'], undef ], + ['right', 65, ['||'], undef ], + ['none', 60, ['..'], sub { $_[0] .. $_[1] } ], ['ternary', 55, ['?', ':'], undef ], ['assign', 53, ['+='], sub { $_[0] + $_[1] } ], ['assign', 53, ['-='], sub { $_[0] - $_[1] } ], @@ -241,8 +241,8 @@ BEGIN { ['assign', 53, ['~=', '_='], sub { $_[0] . $_[1] } ], ['assign', 52, ['='], undef ], ['prefix', 50, ['not', 'NOT'], sub { ! $_[0] } ], - ['infix', 45, ['and', 'AND'], undef ], - ['infix', 40, ['or', 'OR'], undef ], + ['left', 45, ['and', 'AND'], undef ], + ['right', 40, ['or', 'OR'], undef ], ['', 0, ['hash'], sub { return {@_}; } ], ['', 0, ['array'], sub { return [@_] } ], ]; @@ -649,7 +649,7 @@ sub parse_tree { } elsif ($func eq 'META') { my $args = $self->parse_args(\$tag); my $hash; - if (($hash = $self->get_variable($args->[-1])) + if (($hash = $self->play_expr($args->[-1])) && UNIVERSAL::isa($hash, 'HASH')) { unshift @meta, %$hash; # first defined win } @@ -668,7 +668,7 @@ sub parse_tree { } ### allow for bare variable getting and setting - } elsif (defined(my $var = $self->parse_variable(\$tag))) { + } elsif (defined(my $var = $self->parse_expr(\$tag))) { push @$pointer, $node; if ($tag =~ s{ ^ ($QR_OP_ASSIGN) >? \s* $QR_COMMENTS }{}ox) { $node->[0] = 'SET'; @@ -787,7 +787,7 @@ sub execute_tree { ###----------------------------------------------------------------### -sub parse_variable { +sub parse_expr { my $self = shift; my $str_ref = shift; my $ARGS = shift || {}; @@ -803,7 +803,7 @@ sub parse_variable { } elsif ($$str_ref =~ s{ ^ \$ (\w+ (?:\.\w+)*) \b \s* $QR_COMMENTS }{}ox || $$str_ref =~ s{ ^ \$\{ \s* ([^\}]+) \} \s* $QR_COMMENTS }{}ox) { my $name = $1; - return $self->parse_variable(\$name); + return $self->parse_expr(\$name); } } @@ -811,9 +811,9 @@ sub parse_variable { ### test for leading prefix operators my $has_prefix; - if ($copy =~ s{ ^ ($QR_OP_PREFIX) \s* $QR_COMMENTS }{}ox) { + while ($copy =~ s{ ^ ($QR_OP_PREFIX) \s* $QR_COMMENTS }{}ox) { return if $ARGS->{'auto_quote'}; # auto_quoted thing was too complicated - $has_prefix = $1; + push @{ $has_prefix }, $1; } my @var; @@ -870,7 +870,7 @@ sub parse_variable { next if $piece !~ m{ ^ \$ (\w+ (?:\.\w+)*) $ }x && $piece !~ m{ ^ \$\{ \s* ([^\}]+) \} $ }x; my $name = $1; - $piece = $self->parse_variable(\$name); + $piece = $self->parse_expr(\$name); } @pieces = grep {defined && length} @pieces; if (@pieces == 1 && ! ref $pieces[0]) { @@ -894,13 +894,13 @@ sub parse_variable { } elsif ($copy =~ s{ ^ \$ (\w+) \b \s* $QR_COMMENTS }{}ox || $copy =~ s{ ^ \$\{ \s* ([^\}]+) \} \s* $QR_COMMENTS }{}ox) { my $name = $1; - push @var, $self->parse_variable(\$name); + push @var, $self->parse_expr(\$name); ### looks like an array constructor } elsif ($copy =~ s{ ^ \[ \s* $QR_COMMENTS }{}ox) { local $self->{'_operator_precedence'} = 0; # reset presedence my $arrayref = ['array']; - while (defined(my $var = $self->parse_variable(\$copy))) { + while (defined(my $var = $self->parse_expr(\$copy))) { push @$arrayref, $var; $copy =~ s{ ^ , \s* $QR_COMMENTS }{}ox; } @@ -912,9 +912,9 @@ sub parse_variable { } elsif ($copy =~ s{ ^ \{ \s* $QR_COMMENTS }{}ox) { local $self->{'_operator_precedence'} = 0; # reset precedence my $hashref = ['hash']; - while (defined(my $key = $self->parse_variable(\$copy, {auto_quote => qr{ ^ (\w+) $QR_AQ_NOTDOT }xo}))) { + while (defined(my $key = $self->parse_expr(\$copy, {auto_quote => qr{ ^ (\w+) $QR_AQ_NOTDOT }xo}))) { $copy =~ s{ ^ = >? \s* $QR_COMMENTS }{}ox; - my $val = $self->parse_variable(\$copy); + my $val = $self->parse_expr(\$copy); push @$hashref, $key, $val; $copy =~ s{ ^ , \s* $QR_COMMENTS }{}ox; } @@ -925,7 +925,7 @@ sub parse_variable { ### looks like a paren grouper } elsif ($copy =~ s{ ^ \( \s* $QR_COMMENTS }{}ox) { local $self->{'_operator_precedence'} = 0; # reset precedence - my $var = $self->parse_variable(\$copy, {allow_parened_ops => 1}); + my $var = $self->parse_expr(\$copy, {allow_parened_ops => 1}); $copy =~ s{ ^ \) \s* $QR_COMMENTS }{}ox || $self->throw('parse.missing.paren', "Missing close \)", undef, length($$str_ref) - length($copy)); @var = @$var; @@ -957,7 +957,7 @@ sub parse_variable { if ($copy =~ s{ ^ \$(\w+) \s* $QR_COMMENTS }{}ox || $copy =~ s{ ^ \$\{ \s* ([^\}]+)\} \s* $QR_COMMENTS }{}ox) { my $name = $1; - my $var = $self->parse_variable(\$name); + my $var = $self->parse_expr(\$name); push @var, $var; ### allow for names @@ -983,7 +983,7 @@ sub parse_variable { ### flatten literals and constants as much as possible my $var = ($is_literal && $#var == 1) ? ${ $var[0] } - : $is_namespace ? $self->get_variable(\@var, {is_namespace_during_compile => 1}) + : $is_namespace ? $self->play_expr(\@var, {is_namespace_during_compile => 1}) : \@var; ### allow for all "operators" @@ -997,11 +997,15 @@ sub parse_variable { } local $self->{'_operator_precedence'} = 1; - my $op = $1; - my $var2 = $OP_POSTFIX->{$op} ? 1 : $self->parse_variable(\$copy); # cheat - give a "second value" to postfix ops + my $op = $1; + + ### allow for postfix - doesn't check precedence - someday we might change - but not today (only affects post ++ and --) + if ($OP_POSTFIX->{$op}) { + $var = [\ [$op, $var, 1], 0]; # cheat - give a "second value" to postfix ops + next; ### allow for prefix operator precedence - if ($has_prefix && $OP->{$op}->[1] < $OP_PREFIX->{$has_prefix}->[1]) { + } elsif ($has_prefix && $OP->{$op}->[1] < $OP_PREFIX->{$has_prefix->[-1]}->[1]) { if ($tree) { if ($#$tree == 1) { # only one operator - keep simple things fast $var = [\ [$tree->[0], $var, $tree->[1]], 0]; @@ -1012,13 +1016,14 @@ sub parse_variable { undef $tree; undef $found; } - $var = [ \ [ $has_prefix, $var ], 0 ]; - undef $has_prefix; + $var = [ \ [ $has_prefix->[-1], $var ], 0 ]; + if (! @$has_prefix) { undef $has_prefix } else { pop @$has_prefix } } ### add the operator to the tree + my $var2 = $self->parse_expr(\$copy); push (@{ $tree ||= [] }, $op, $var2); - $found->{$op} = $OP->{$op}->[1]; + $found->{$OP->{$op}->[1]}->{$op} = 1; # found->{precedence}->{op} } ### if we found operators - tree the nodes by operator precedence @@ -1034,7 +1039,7 @@ sub parse_variable { ### allow for prefix on non-chained variables if ($has_prefix) { - $var = [ \ [ $has_prefix, $var ], 0 ]; + $var = [ \ [ $_, $var ], 0 ] for reverse @$has_prefix; } $$str_ref = $copy; # commit the changes @@ -1048,26 +1053,26 @@ sub apply_precedence { my @var; my $trees; ### look at the operators we found in the order we found them - for my $op (sort {$found->{$a} <=> $found->{$b}} keys %$found) { - local $found->{$op}; - delete $found->{$op}; - my @trees; - my @ternary; - - ### split the array on the current operator - for (my $i = 0; $i <= $#$tree; $i ++) { - my $is_ternary = $OP_TERNARY->{$op} && grep {$_ eq $tree->[$i]} @{ $OP->{$op}->[2] }; - next if $tree->[$i] ne $op && ! $is_ternary; - push @trees, [splice @$tree, 0, $i, ()]; # everything up to the operator - push @ternary, $tree->[0] if $is_ternary; - shift @$tree; # pull off the operator + for my $prec (sort keys %$found) { + my $ops = $found->{$prec}; + local $found->{$prec}; + delete $found->{$prec}; + + ### split the array on the current operators for this level + my @ops; + my @exprs; + for (my $i = 1; $i <= $#$tree; $i += 2) { + next if ! $ops->{ $tree->[$i] }; + push @ops, $tree->[$i]; + push @exprs, [splice @$tree, 0, $i, ()]; + shift @$tree; $i = -1; } - next if ! @trees; # this iteration didn't have the current operator - push @trees, $tree if scalar @$tree; # elements after last operator + next if ! @exprs; # this iteration didn't have the current operator + push @exprs, $tree if scalar @$tree; # add on any remaining items - ### now - for this level split on remaining operators, or add the variable to the tree - for my $node (@trees) { + ### simplify sub expressions + for my $node (@exprs) { if (@$node == 1) { $node = $node->[0]; # single item - its not a tree } elsif (@$node == 3) { @@ -1077,30 +1082,48 @@ sub apply_precedence { } } - ### return infix and assign - if (! $OP_TERNARY->{$op}) { - my $val = $trees[-1]; - $val = [ \ [ $op, $trees[$_], $val ], 0 ] for reverse (0 .. $#trees - 1); # reverse order - helps out || - return $val; - } + ### assemble this current level - ### return simple ternary - if (@ternary == 2) { - return [ \ [ $op, @trees ], 0 ]; - } + ### some rules: + # 1) items at the same precedence level must all be either right or left or ternary associative + # 2) ternary items cannot share precedence with anybody else. + # 3) there really shouldn't be another operator at the same level as a postfix + my $type = $OP->{$ops[0]}->[0]; + + if ($type eq 'ternary') { + my $op = $OP->{$ops[0]}->[2]->[0]; # use the first op as what we are using - ### reorder complex ternary - rare case - while ($#ternary >= 1) { - ### if we look starting from the back - the first lead ternary op will always be next to its matching op - for (my $i = $#ternary; $i >= 0; $i --) { - next if $OP->{$ternary[$i]}->[2]->[1] eq $ternary[$i]; - my ($op, $op2) = splice @ternary, $i, 2, (); # remove the pair of operators - my $node = [ \ [$op, @trees[$i .. $i + 2] ], 0 ]; - splice @trees, $i, 3, $node; + ### return simple ternary + if (@exprs == 3) { + $self->throw('parse', "Ternary operator mismatch") if $ops[0] ne $op; + $self->throw('parse', "Ternary operator mismatch") if ! $ops[1] || $ops[1] eq $op; + return [ \ [ $op, @exprs ], 0 ]; } - } - return $trees[0]; # at this point the ternary has been reduced to a single operator + + ### reorder complex ternary - rare case + while ($#ops >= 1) { + ### if we look starting from the back - the first lead ternary op will always be next to its matching op + for (my $i = $#ops; $i >= 0; $i --) { + next if $OP->{$ops[$i]}->[2]->[1] eq $ops[$i]; + my ($op, $op2) = splice @ops, $i, 2, (); # remove the pair of operators + my $node = [ \ [$op, @exprs[$i .. $i + 2] ], 0 ]; + splice @exprs, $i, 3, $node; + } + } + return $exprs[0]; # at this point the ternary has been reduced to a single operator + + } elsif ($type eq 'right' || $type eq 'assign') { + my $val = $exprs[-1]; + $val = [ \ [ $ops[$_ - 1], $exprs[$_], $val ], 0 ] for reverse (0 .. $#exprs - 1); + return $val; + + } else { + my $val = $exprs[0]; + $val = [ \ [ $ops[$_ - 1], $val, $exprs[$_] ], 0 ] for (1 .. $#exprs); + return $val; + + } } $self->throw('parse', "Couldn't apply precedence"); @@ -1117,14 +1140,14 @@ sub parse_args { my @named; while (length $$str_ref) { my $copy = $$str_ref; - if (defined(my $name = $self->parse_variable(\$copy, {auto_quote => qr{ ^ (\w+) $QR_AQ_NOTDOT }xo})) + if (defined(my $name = $self->parse_expr(\$copy, {auto_quote => qr{ ^ (\w+) $QR_AQ_NOTDOT }xo})) && $copy =~ s{ ^ = >? \s* $QR_COMMENTS }{}ox) { $self->throw('parse', 'Named arguments not allowed') if $ARGS->{'positional_only'}; - my $val = $self->parse_variable(\$copy); + my $val = $self->parse_expr(\$copy); $copy =~ s{ ^ , \s* $QR_COMMENTS }{}ox; push @named, $name, $val; $$str_ref = $copy; - } elsif (defined(my $arg = $self->parse_variable($str_ref))) { + } elsif (defined(my $arg = $self->parse_expr($str_ref))) { push @args, $arg; $$str_ref =~ s{ ^ , \s* $QR_COMMENTS }{}ox; } else { @@ -1161,7 +1184,7 @@ sub interpolate_node { } elsif ($piece =~ m{ ^ \$ (\w+ (?:\.\w+)*) $ }x || $piece =~ m{ ^ \$\{ \s* ([^\}]+) \} $ }x) { my $name = $1; - push @sub_tree, ['GET', $offset - length($piece), $offset, $self->parse_variable(\$name)]; + push @sub_tree, ['GET', $offset - length($piece), $offset, $self->parse_expr(\$name)]; } else { $self->throw('parse', "Parse error during interpolate node"); } @@ -1173,7 +1196,7 @@ sub interpolate_node { ###----------------------------------------------------------------### -sub get_variable { +sub play_expr { ### allow for the parse tree to store literals return $_[1] if ! ref $_[1]; @@ -1186,7 +1209,7 @@ sub get_variable { my $ref; my $name = $var->[$i++]; my $args = $var->[$i++]; - warn "get_variable: begin \"$name\"\n" if trace; + warn "play_expr: begin \"$name\"\n" if trace; if (ref $name) { if (ref $name eq 'SCALAR') { # a scalar literal $ref = $$name; @@ -1194,7 +1217,7 @@ sub get_variable { return $self->play_operator($$name) if ${ $name }->[0] eq '..'; $ref = $self->play_operator($$name); } else { # a named variable access (ie via $name.foo) - $name = $self->get_variable($name); + $name = $self->play_expr($name); if (defined $name) { return if $name =~ $QR_PRIVATE; # don't allow vars that begin with _ $ref = $self->{'_vars'}->{$name}; @@ -1216,7 +1239,7 @@ sub get_variable { ### check at each point if the rurned thing was a code if (UNIVERSAL::isa($ref, 'CODE')) { - my @results = $ref->($args ? map { $self->get_variable($_) } @$args : ()); + my @results = $ref->($args ? map { $self->play_expr($_) } @$args : ()); if (defined $results[0]) { $ref = ($#results > 0) ? \@results : $results[0]; } elsif (defined $results[1]) { @@ -1232,12 +1255,12 @@ sub get_variable { my $was_dot_call = $ARGS->{'no_dots'} ? 1 : $var->[$i++] eq '.'; $name = $var->[$i++]; $args = $var->[$i++]; - warn "get_variable: nested \"$name\"\n" if trace; + warn "play_expr: nested \"$name\"\n" if trace; ### allow for named portions of a variable name (foo.$name.bar) if (ref $name) { if (ref($name) eq 'ARRAY') { - $name = $self->get_variable($name); + $name = $self->play_expr($name); if (! defined($name) || $name =~ $QR_PRIVATE || $name =~ /^\./) { $ref = undef; last; @@ -1254,10 +1277,10 @@ sub get_variable { ### allow for scalar and filter access (this happens for every non virtual method call) if (! ref $ref) { if ($SCALAR_OPS->{$name}) { # normal scalar op - $ref = $SCALAR_OPS->{$name}->($ref, $args ? map { $self->get_variable($_) } @$args : ()); + $ref = $SCALAR_OPS->{$name}->($ref, $args ? map { $self->play_expr($_) } @$args : ()); } elsif ($LIST_OPS->{$name}) { # auto-promote to list and use list op - $ref = $LIST_OPS->{$name}->([$ref], $args ? map { $self->get_variable($_) } @$args : ()); + $ref = $LIST_OPS->{$name}->([$ref], $args ? map { $self->play_expr($_) } @$args : ()); } elsif (my $filter = $self->{'FILTERS'}->{$name} # filter configured in Template args || $FILTER_OPS->{$name} # predefined filters in CET @@ -1277,7 +1300,7 @@ sub get_variable { eval { my $sub = $filter->[0]; if ($filter->[1]) { # it is a "dynamic filter" that will return a sub - ($sub, my $err) = $sub->($self->context, $args ? map { $self->get_variable($_) } @$args : ()); + ($sub, my $err) = $sub->($self->context, $args ? map { $self->play_expr($_) } @$args : ()); if (! $sub && $err) { $self->throw('filter', $err) if ref($err) !~ /Template::Exception$/; die $err; @@ -1310,7 +1333,7 @@ sub get_variable { ### method calls on objects if ($was_dot_call && UNIVERSAL::can($ref, 'can')) { - my @args = $args ? map { $self->get_variable($_) } @$args : (); + my @args = $args ? map { $self->play_expr($_) } @$args : (); my @results = eval { $ref->$name(@args) }; if ($@) { my $class = ref $ref; @@ -1332,7 +1355,7 @@ sub get_variable { if ($was_dot_call && exists($ref->{$name}) ) { $ref = $ref->{$name}; } elsif ($HASH_OPS->{$name}) { - $ref = $HASH_OPS->{$name}->($ref, $args ? map { $self->get_variable($_) } @$args : ()); + $ref = $HASH_OPS->{$name}->($ref, $args ? map { $self->play_expr($_) } @$args : ()); } elsif ($ARGS->{'is_namespace_during_compile'}) { return $var; # abort - can't fold namespace variable } else { @@ -1344,7 +1367,7 @@ sub get_variable { if ($name =~ m{ ^ -? $QR_NUM $ }ox) { $ref = $ref->[$name]; } elsif ($LIST_OPS->{$name}) { - $ref = $LIST_OPS->{$name}->($ref, $args ? map { $self->get_variable($_) } @$args : ()); + $ref = $LIST_OPS->{$name}->($ref, $args ? map { $self->play_expr($_) } @$args : ()); } else { $ref = undef; } @@ -1357,7 +1380,7 @@ sub get_variable { if (! defined $ref) { if ($self->{'_debug_undef'}) { my $chunk = $var->[$i - 2]; - $chunk = $self->get_variable($chunk) if ref($chunk) eq 'ARRAY'; + $chunk = $self->play_expr($chunk) if ref($chunk) eq 'ARRAY'; die "$chunk is undefined\n"; } else { $ref = $self->undefined_any($var); @@ -1380,7 +1403,7 @@ sub set_variable { my $args = $var->[$i++]; if (ref $ref) { if (ref($ref) eq 'ARRAY') { # named access (ie via $name.foo) - $ref = $self->get_variable($ref); + $ref = $self->play_expr($ref); if (defined $ref && $ref !~ $QR_PRIVATE) { # don't allow vars that begin with _ if ($#$var <= $i) { return $self->{'_vars'}->{$ref} = $val; @@ -1406,7 +1429,7 @@ sub set_variable { ### check at each point if the returned thing was a code if (UNIVERSAL::isa($ref, 'CODE')) { - my @results = $ref->($args ? map { $self->get_variable($_) } @$args : ()); + my @results = $ref->($args ? map { $self->play_expr($_) } @$args : ()); if (defined $results[0]) { $ref = ($#results > 0) ? \@results : $results[0]; } elsif (defined $results[1]) { @@ -1425,7 +1448,7 @@ sub set_variable { ### allow for named portions of a variable name (foo.$name.bar) if (ref $name) { if (ref($name) eq 'ARRAY') { - $name = $self->get_variable($name); + $name = $self->play_expr($name); if (! defined($name) || $name =~ /^[_.]/) { return; } @@ -1444,7 +1467,7 @@ sub set_variable { ### method calls on objects } elsif (UNIVERSAL::can($ref, 'can')) { my $lvalueish; - my @args = $args ? map { $self->get_variable($_) } @$args : (); + my @args = $args ? map { $self->play_expr($_) } @$args : (); if ($i >= $#$var) { $lvalueish = 1; push @args, $val; @@ -1504,11 +1527,11 @@ sub play_operator { if ($OP_DISPATCH->{$tree->[0]}) { local $^W; if ($OP_ASSIGN->{$tree->[0]}) { - my $val = $OP_DISPATCH->{$tree->[0]}->( $self->get_variable($tree->[1]), $self->get_variable($tree->[2]) ); + my $val = $OP_DISPATCH->{$tree->[0]}->( $self->play_expr($tree->[1]), $self->play_expr($tree->[2]) ); $self->set_variable($tree->[1], $val); return $val; } else { - return $OP_DISPATCH->{$tree->[0]}->( map { $self->get_variable($tree->[$_]) } 1 .. $#$tree ); + return $OP_DISPATCH->{$tree->[0]}->( map { $self->play_expr($tree->[$_]) } 1 .. $#$tree ); } } @@ -1516,30 +1539,30 @@ sub play_operator { ### do custom and short-circuitable operators if ($op eq '=') { - my $val = $self->get_variable($tree->[2]); + my $val = $self->play_expr($tree->[2]); $self->set_variable($tree->[1], $val); return $val; } elsif ($op eq '||' || $op eq 'or' || $op eq 'OR') { - return $self->get_variable($tree->[1]) || $self->get_variable($tree->[2]) || ''; + return $self->play_expr($tree->[1]) || $self->play_expr($tree->[2]) || ''; } elsif ($op eq '&&' || $op eq 'and' || $op eq 'AND') { - my $var = $self->get_variable($tree->[1]) && $self->get_variable($tree->[2]); + my $var = $self->play_expr($tree->[1]) && $self->play_expr($tree->[2]); return $var ? $var : 0; } elsif ($op eq '?') { local $^W; - return $self->get_variable($tree->[1]) ? $self->get_variable($tree->[2]) : $self->get_variable($tree->[3]); + return $self->play_expr($tree->[1]) ? $self->play_expr($tree->[2]) : $self->play_expr($tree->[3]); } elsif ($op eq '++') { local $^W; - my $val = 0 + $self->get_variable($tree->[1]); + my $val = 0 + $self->play_expr($tree->[1]); $self->set_variable($tree->[1], $val + 1); return $tree->[2] ? $val : $val + 1; # ->[2] is set to 1 during parsing of postfix ops } elsif ($op eq '--') { local $^W; - my $val = 0 + $self->get_variable($tree->[1]); + my $val = 0 + $self->play_expr($tree->[1]); $self->set_variable($tree->[1], $val - 1); return $tree->[2] ? $val : $val - 1; # ->[2] is set to 1 during parsing of postfix ops } @@ -1585,12 +1608,12 @@ sub play_CALL { $DIRECTIVES->{'GET'}->[1]->(@_); return } sub parse_CASE { my ($self, $tag_ref) = @_; return if $$tag_ref =~ s{ ^ DEFAULT \s* }{}x; - return $self->parse_variable($tag_ref); + return $self->parse_expr($tag_ref); } sub parse_CATCH { my ($self, $tag_ref) = @_; - return $self->parse_variable($tag_ref, {auto_quote => qr{ ^ (\w+ (?: \.\w+)*) $QR_AQ_SPACE }xo}); + return $self->parse_expr($tag_ref, {auto_quote => qr{ ^ (\w+ (?: \.\w+)*) $QR_AQ_SPACE }xo}); } sub play_control { @@ -1632,9 +1655,9 @@ sub play_DEFAULT { foreach (@$set) { my ($op, $set, $default) = @$_; next if ! defined $set; - my $val = $self->get_variable($set); + my $val = $self->play_expr($set); if (! $val) { - $default = defined($default) ? $self->get_variable($default) : ''; + $default = defined($default) ? $self->play_expr($default) : ''; $self->set_variable($set, $default); } } @@ -1643,7 +1666,7 @@ sub play_DEFAULT { sub parse_DUMP { my ($self, $tag_ref) = @_; - my $ref = $self->parse_variable($tag_ref); + my $ref = $self->parse_expr($tag_ref); return $ref; } @@ -1654,7 +1677,7 @@ sub play_DUMP { my $out; my $var; if ($ident) { - $out = Data::Dumper::Dumper($self->get_variable($ident)); + $out = Data::Dumper::Dumper($self->play_expr($ident)); $var = $info->{'text'}; $var =~ s/^[+\-~=]?\s*DUMP\s+//; $var =~ s/\s*[+\-~=]?$//; @@ -1684,7 +1707,7 @@ sub parse_FILTER { $name = $1; } - my $filter = $self->parse_variable($tag_ref); + my $filter = $self->parse_expr($tag_ref); $filter = '' if ! defined $filter; return [$name, $filter]; @@ -1713,11 +1736,11 @@ sub play_FILTER { sub parse_FOREACH { my ($self, $tag_ref) = @_; - my $items = $self->parse_variable($tag_ref); + my $items = $self->parse_expr($tag_ref); my $var; if ($$tag_ref =~ s{ ^ (= | [Ii][Nn]\b) \s* }{}x) { $var = [@$items]; - $items = $self->parse_variable($tag_ref); + $items = $self->parse_expr($tag_ref); } return [$var, $items]; } @@ -1728,7 +1751,7 @@ sub play_FOREACH { ### get the items - make sure it is an arrayref my ($var, $items) = @$ref; - $items = $self->get_variable($items); + $items = $self->play_expr($items); return '' if ! defined $items; if (ref($items) !~ /Iterator$/) { @@ -1801,26 +1824,26 @@ sub play_FOREACH { sub parse_GET { my ($self, $tag_ref) = @_; - my $ref = $self->parse_variable($tag_ref); + my $ref = $self->parse_expr($tag_ref); $self->throw('parse', "Missing variable name") if ! defined $ref; return $ref; } sub play_GET { my ($self, $ident, $node) = @_; - my $var = $self->get_variable($ident); + my $var = $self->play_expr($ident); return (! defined $var) ? $self->undefined_get($ident, $node) : $var; } sub parse_IF { my ($self, $tag_ref) = @_; - return $self->parse_variable($tag_ref); + return $self->parse_expr($tag_ref); } sub play_IF { my ($self, $var, $node, $out_ref) = @_; - my $val = $self->get_variable($var); + my $val = $self->play_expr($var); if ($val) { my $body_ref = $node->[4] ||= []; $self->execute_tree($body_ref, $out_ref); @@ -1834,7 +1857,7 @@ sub play_IF { return; } my $var = $node->[3]; - my $val = $self->get_variable($var); + my $val = $self->play_expr($var); if ($val) { my $body_ref = $node->[4] ||= []; $self->execute_tree($body_ref, $out_ref); @@ -1869,7 +1892,7 @@ sub play_INSERT { my ($names, $args) = @$var; foreach my $name (@$names) { - my $filename = $self->get_variable($name); + my $filename = $self->play_expr($name); $$out_ref .= $self->_insert($filename); } @@ -1880,7 +1903,7 @@ sub parse_MACRO { my ($self, $tag_ref, $node) = @_; my $copy = $$tag_ref; - my $name = $self->parse_variable(\$copy, {auto_quote => qr{ ^ (\w+) $QR_AQ_NOTDOT }xo}); + my $name = $self->parse_expr(\$copy, {auto_quote => qr{ ^ (\w+) $QR_AQ_NOTDOT }xo}); $self->throw('parse', "Missing macro name") if ! defined $name; if (! ref $name) { $name = [ $name, 0 ]; @@ -1998,7 +2021,7 @@ sub play_PERL { sub parse_PROCESS { my ($self, $tag_ref) = @_; my $info = [[], []]; - while (defined(my $filename = $self->parse_variable($tag_ref, { + while (defined(my $filename = $self->parse_expr($tag_ref, { auto_quote => qr{ ^ ($QR_FILENAME | \w+ (?: :\w+)* ) $QR_AQ_SPACE }xo, }))) { push @{$info->[0]}, $filename; @@ -2009,13 +2032,13 @@ sub parse_PROCESS { while (length $$tag_ref) { last if $$tag_ref =~ / ^ (\w+) (?: ;|$|\s)/x && $DIRECTIVES->{$1}; ### looks like a directive - we are done - my $var = $self->parse_variable($tag_ref); + my $var = $self->parse_expr($tag_ref); last if ! defined $var; if ($$tag_ref !~ s{ ^ = >? \s* }{}x) { $self->throw('parse.missing.equals', 'Missing equals while parsing args'); } - my $val = $self->parse_variable($tag_ref); + my $val = $self->parse_expr($tag_ref); push @{$info->[1]}, [$var, $val]; $$tag_ref =~ s{ ^ , \s* $QR_COMMENTS }{}ox if $val; } @@ -2031,7 +2054,7 @@ sub play_PROCESS { ### set passed args foreach (@$args) { my ($key, $val) = @$_; - $val = $self->get_variable($val); + $val = $self->play_expr($val); if (ref($key) && @$key == 2 && $key->[0] eq 'import' && UNIVERSAL::isa($val, 'HASH')) { # import ?! - whatever foreach my $key (keys %$val) { $self->set_variable([$key,0], $val->{$key}); @@ -2044,7 +2067,7 @@ sub play_PROCESS { ### iterate on any passed block or filename foreach my $ref (@$files) { next if ! defined $ref; - my $filename = $self->get_variable($ref); + my $filename = $self->play_expr($ref); my $out = ''; # have temp item to allow clear to correctly clear ### normal blocks or filenames @@ -2131,12 +2154,12 @@ sub parse_SET { my $val = $node->[4] ||= []; # setup storage return [[$initial_op, $initial_var, $val]]; } else { # get a normal variable - return [[$initial_op, $initial_var, $self->parse_variable($tag_ref)]]; + return [[$initial_op, $initial_var, $self->parse_expr($tag_ref)]]; } } while (length $$tag_ref) { - my $set = $self->parse_variable($tag_ref); + my $set = $self->parse_expr($tag_ref); last if ! defined $set; if ($$tag_ref =~ s{ ^ ($QR_OP_ASSIGN) >? \s* }{}x) { @@ -2148,7 +2171,7 @@ sub parse_SET { push @SET, [$op, $set, $val]; last; } else { # get a normal variable - push @SET, [$op, $set, $self->parse_variable($tag_ref)]; + push @SET, [$op, $set, $self->parse_expr($tag_ref)]; } } else { push @SET, ['=', $set, undef]; @@ -2169,12 +2192,12 @@ sub play_SET { $val = ''; $self->execute_tree($sub_tree, \$val); } else { # normal var - $val = $self->get_variable($val); + $val = $self->play_expr($val); } if ($OP_DISPATCH->{$op}) { local $^W; - $val = $OP_DISPATCH->{$op}->($self->get_variable($set), $val); + $val = $OP_DISPATCH->{$op}->($self->play_expr($set), $val); } $self->set_variable($set, $val); @@ -2187,7 +2210,7 @@ sub parse_SWITCH { $DIRECTIVES->{'GET'}->[0]->(@_) } sub play_SWITCH { my ($self, $var, $node, $out_ref) = @_; - my $val = $self->get_variable($var); + my $val = $self->play_expr($var); $val = '' if ! defined $val; ### $node->[4] is thrown away @@ -2199,7 +2222,7 @@ sub play_SWITCH { next; } - my $val2 = $self->get_variable($var); + my $val2 = $self->play_expr($var); $val2 = [$val2] if ! UNIVERSAL::isa($val2, 'ARRAY'); for my $test (@$val2) { # find matching values next if ! defined $val && defined $test; @@ -2225,7 +2248,7 @@ sub play_SWITCH { sub parse_THROW { my ($self, $tag_ref, $node) = @_; - my $name = $self->parse_variable($tag_ref, {auto_quote => qr{ ^ (\w+ (?: \.\w+)*) $QR_AQ_SPACE }xo}); + my $name = $self->parse_expr($tag_ref, {auto_quote => qr{ ^ (\w+ (?: \.\w+)*) $QR_AQ_SPACE }xo}); $self->throw('parse.missing', "Missing name in THROW", $node) if ! $name; my $args = $self->parse_args($tag_ref); return [$name, $args]; @@ -2234,8 +2257,8 @@ sub parse_THROW { sub play_THROW { my ($self, $ref, $node) = @_; my ($name, $args) = @$ref; - $name = $self->get_variable($name); - my @args = $args ? map { $self->get_variable($_) } @$args : (); + $name = $self->play_expr($name); + my @args = $args ? map { $self->play_expr($_) } @$args : (); $self->throw($name, \@args, $node); } @@ -2273,7 +2296,7 @@ sub play_TRY { next; } next if ! $err; - my $name = $self->get_variable($node->[3]); + my $name = $self->play_expr($node->[3]); $name = '' if ! defined $name || lc($name) eq 'default'; if ($type =~ / ^ \Q$name\E \b /x && (! defined($last_found) || length($last_found) < length($name))) { # more specific wins @@ -2317,14 +2340,14 @@ sub parse_USE { my $var; my $copy = $$tag_ref; - if (defined(my $_var = $self->parse_variable(\$copy, {auto_quote => qr{ ^ (\w+) $QR_AQ_NOTDOT }xo})) + if (defined(my $_var = $self->parse_expr(\$copy, {auto_quote => qr{ ^ (\w+) $QR_AQ_NOTDOT }xo})) && $copy =~ s{ ^ = >? \s* $QR_COMMENTS }{}ox) { $var = $_var; $$tag_ref = $copy; } $copy = $$tag_ref; - my $module = $self->parse_variable(\$copy, {auto_quote => qr{ ^ (\w+ (?: (?:\.|::) \w+)*) $QR_AQ_NOTDOT }xo}); + my $module = $self->parse_expr(\$copy, {auto_quote => qr{ ^ (\w+ (?: (?:\.|::) \w+)*) $QR_AQ_NOTDOT }xo}); $self->throw('parse', "Missing plugin name while parsing $$tag_ref") if ! defined $module; $module =~ s/\./::/g; @@ -2362,10 +2385,10 @@ sub play_USE { if ($self->{'PLUGIN_FACTORY'}->{$module} || eval {require $require}) { my $shape = $package->load; my $context = $self->context; - my @args = $args ? map { $self->get_variable($_) } @$args : (); + my @args = $args ? map { $self->play_expr($_) } @$args : (); $obj = $shape->new($context, @args); } elsif (lc($module) eq 'iterator') { # use our iterator if none found (TT's works just fine) - $obj = $PACKAGE_ITERATOR->new($args ? $self->get_variable($args->[0]) : []); + $obj = $PACKAGE_ITERATOR->new($args ? $self->play_expr($args->[0]) : []); } elsif (my @packages = grep {lc($package) eq lc($_)} @{ $self->list_plugins({base => $base}) }) { foreach my $package (@packages) { my $require = "$package.pm"; @@ -2373,14 +2396,14 @@ sub play_USE { eval {require $require} || next; my $shape = $package->load; my $context = $self->context; - my @args = $args ? map { $self->get_variable($_) } @$args : (); + my @args = $args ? map { $self->play_expr($_) } @$args : (); $obj = $shape->new($context, @args); } } elsif ($self->{'LOAD_PERL'}) { my $require = "$module.pm"; $require =~ s|::|/|g; if (eval {require $require}) { - my @args = $args ? map { $self->get_variable($_) } @$args : (); + my @args = $args ? map { $self->play_expr($_) } @$args : (); $obj = $module->new(@args); } } @@ -2405,7 +2428,7 @@ sub play_WHILE { my $count = $WHILE_MAX; while (--$count > 0) { - $self->get_variable($var) || last; + $self->play_expr($var) || last; ### execute the sub tree eval { $self->execute_tree($sub_tree, $out_ref) }; @@ -3002,7 +3025,7 @@ sub dump_parse { my $obj = UNIVERSAL::isa($_[0], __PACKAGE__) ? shift : __PACKAGE__->new; my $str = shift; require Data::Dumper; - return Data::Dumper::Dumper($obj->parse_variable(\$str)); + return Data::Dumper::Dumper($obj->parse_expr(\$str)); } ###----------------------------------------------------------------### @@ -3211,16 +3234,16 @@ sub get { my ($self, $var) = @_; if (! ref $var) { if ($var =~ /^\w+$/) { $var = [$var, 0] } - else { $var = $self->_template->parse_variable(\$var, {no_dots => 1}) } + else { $var = $self->_template->parse_expr(\$var, {no_dots => 1}) } } - return $self->_template->get_variable($var, {no_dots => 1}); + return $self->_template->play_expr($var, {no_dots => 1}); } sub set { my ($self, $var, $val) = @_; if (! ref $var) { if ($var =~ /^\w+$/) { $var = [$var, 0] } - else { $var = $self->_template->parse_variable(\$var, {no_dots => 1}) } + else { $var = $self->_template->parse_expr(\$var, {no_dots => 1}) } } $self->_template->set_variable($var, $val, {no_dots => 1}); return $val; diff --git a/lib/CGI/Ex/Template.pod b/lib/CGI/Ex/Template.pod index d954eab..cd7dd09 100644 --- a/lib/CGI/Ex/Template.pod +++ b/lib/CGI/Ex/Template.pod @@ -1912,7 +1912,7 @@ tighter it binds). =item C<.> -Binary. The dot operator. Allows for accessing sub-members, methods, or +The dot operator. Allows for accessing sub-members, methods, or virtual methods of nested data structures. my $obj->process(\$content, {a => {b => [0, {c => [34, 57]}]}}, \$output); @@ -1930,7 +1930,7 @@ call the vmethod - use "|". =item C<|> -Binary. The pipe operator. Similar to the dot operator. Allows for +The pipe operator. Similar to the dot operator. Allows for explicit calling of virtual methods and filters (filters are "merged" with virtual methods in CGI::Ex::Template and TT3) when accessing hashrefs and objects. See the note for the "." operator. @@ -1988,13 +1988,13 @@ or postfix operator. =item C<** ^ pow> -Binary. X raised to the Y power. This isn't available in TT 2.15. +Right associative binary. X raised to the Y power. This isn't available in TT 2.15. [% 2 ** 3 %] => 8 =item C -Unary not. Negation of the value. +Prefix not. Negation of the value. =item C<-> @@ -2004,11 +2004,11 @@ Prefix minus. Returns the value multiplied by -1. =item C<*> -Binary. Multiplication. +Left associative binary. Multiplication. =item C -Binary. Division. Note that / is floating point division, but div and +Left associative binary. Division. Note that / is floating point division, but div and DIV are integer division. [% 10 / 4 %] => 2.5 @@ -2016,58 +2016,63 @@ DIV are integer division. =item C<% mod MOD> -Binary. Modulus. +Left associative binary. Modulus. [% 15 % 8 %] => 7 =item C<+> -Binary. Addition. +Left associative binary. Addition. =item C<-> -Binary. Minus. +Left associative binary. Minus. =item C<_ ~> -Binary. String concatenation. +Left associative binary. String concatenation. [% "a" ~ "b" %] => ab =item C<< < > <= >= >> -Binary. Numerical comparators. +Non associative binary. Numerical comparators. =item C -Binary. String comparators. +Non associative binary. String comparators. =item C<== eq> -Binary. Equality test. TT chose to use Perl's eq for both operators. +Non associative binary. Equality test. TT chose to use Perl's eq for both operators. There is no test for numeric equality. =item C -Binary. Non-equality test. TT chose to use Perl's ne for both +Non associative binary. Non-equality test. TT chose to use Perl's ne for both operators. There is no test for numeric non-equality. =item C<&&> -Multiple arity. And. All values must be true. If all values are true, the last +Left associative binary. And. All values must be true. If all values are true, the last value is returned as the truth value. [% 2 && 3 && 4 %] => 4 =item C<||> -Multiple arity. Or. The first true value is returned. +Right associative binary. Or. The first true value is returned. [% 0 || '' || 7 %] => 7 +Note: perl is left associative on this operator - but it doesn't matter because +|| has its own precedence level. Setting it to right allows for CET to short +circuit earlier in the expression optree (left is (((1,2), 3), 4) while right +is (1, (2, (3, 4))). + =item C<..> -Binary. Range creator. Returns an arrayref containing the values +Non associative binary. Range creator. Returns an arrayref containing the values between and including the first and last arguments. [% t = [1 .. 5] %] => variable t contains an array with 1,2,3,4, and 5 @@ -2080,14 +2085,14 @@ The .. operator is the only operator that returns a list of items. =item C -Ternary. Can be nested with other ?: pairs. +Ternary - right associative. Can be nested with other ?: pairs. [% 1 ? 2 : 3 %] => 2 [% 0 ? 2 : 3 %] => 3 =item C<*= += -= /= **= %= ~=> -Self-modifying assignment. Sets the left hand side +Self-modifying assignment - right associative. Sets the left hand side to the operation of the left hand side and right (clear as mud). In order to not conflict with SET, FOREACH and other operations, this operator is only available in parenthesis. @@ -2097,7 +2102,7 @@ operator is only available in parenthesis. =item C<=> -Assignment. Sets the left-hand side to the value of the righthand side. In order +Assignment - right associative. Sets the left-hand side to the value of the righthand side. In order to not conflict with SET, FOREACH and other operations, this operator is only available in parenthesis. Returns the value of the righthand side. @@ -2106,25 +2111,25 @@ available in parenthesis. Returns the value of the righthand side. =item C -Lower precedence version of the '!' operator. +Prefix. Lower precedence version of the '!' operator. =item C -Lower precedence version of the '&&' operator. +Left associative. Lower precedence version of the '&&' operator. =item C -Lower precedence version of the '||' operator. +Right associative. Lower precedence version of the '||' operator. =item C -Multiple arity. This operator is not used in TT. It is used internally +This operator is not used in TT. It is used internally by CGI::Ex::Template to delay the creation of a hash until the execution of the compiled template. =item C -Multiple arity. This operator is not used in TT. It is used internally +This operator is not used in TT. It is used internally by CGI::Ex::Template to delay the creation of an array until the execution of the compiled template. @@ -2502,7 +2507,7 @@ been executed. =item UNDEFINED_ANY This is not a TT configuration option. This option expects to be a code -ref that will be called if a variable is undefined during a call to get_variable. +ref that will be called if a variable is undefined during a call to play_expr. It is passed the variable identity array as a single argument. This is most similar to the "undefined" method of Template::Stash. It allows for the "auto-defining" of a variable for use in the template. It is @@ -2579,7 +2584,7 @@ Template::Toolkit or the appropriate plugin module. CGI::Ex::Template uses its own mechanism for loading filters. TT would use the Template::Filters object to load filters requested via the FILTER directive. The functionality for doing this in CGI::Ex::Template -is contained in the list_filters method and the get_variable method. +is contained in the list_filters method and the play_expr method. Full support is offered for the FILTERS configuration item. @@ -2630,7 +2635,7 @@ name level. Operators are parsed and stored as part of the variable (it may be more appropriate to say we are parsing a term or an expression). The following table shows a variable or expression and the corresponding parsed tree -(this is what the parse_variable method would return). +(this is what the parse_expr method would return). one [ 'one', 0 ] one() [ 'one', [] ] @@ -2701,7 +2706,7 @@ $CGI::Ex::Template::PACKAGE_EXCEPTION. Executes a parsed tree (returned from parse_tree) -=item C +=item C Turns a variable identity array into the parsed variable. This method is also responsible for playing operators and running virtual methods @@ -2739,14 +2744,14 @@ hash that contains the parsed tree. Allow for the multitudinous ways that TT parses arguments. This allows for positional as well as named arguments. Named arguments can be separated with a "=" or "=>", and positional arguments should be separated by " " or ",". This only returns an array -of parsed variables. To get the actual values, you must call get_variable on each value. +of parsed variables. To get the actual values, you must call play_expr on each value. =item C Used by load_parsed_tree. This is the main grammar engine of the program. It uses method in the $DIRECTIVES hashref to parse different DIRECTIVE TYPES. -=item C +=item C Used to parse a variable, an expression, a literal string, or a number. It returns a parsed variable tree. Samples of parsed variables can be found in the VARIABLE PARSE TREE @@ -2763,7 +2768,7 @@ Creates an exception object from the arguments and dies. =item C -Called during get_variable if a value is returned that is undefined. This could +Called during play_expr if a value is returned that is undefined. This could be used to magically create variables on the fly. This is similar to Template::Stash::undefined. It is suggested that undefined_get be used instead. Default behavior returns undef. You may also pass a coderef via the UNDEFINED_ANY configuration variable. Also, you can try using diff --git a/lib/CGI/Ex/Validate.pm b/lib/CGI/Ex/Validate.pm index b0c6b4f..2749642 100644 --- a/lib/CGI/Ex/Validate.pm +++ b/lib/CGI/Ex/Validate.pm @@ -22,7 +22,7 @@ use vars qw($VERSION @UNSUPPORTED_BROWSERS ); -$VERSION = '2.02'; +$VERSION = '2.03'; $DEFAULT_EXT = 'val'; $QR_EXTRA = qr/^(\w+_error|as_(array|string|hash)_\w+|no_\w+)/; diff --git a/t/7_template_00_base.t b/t/7_template_00_base.t index 48472dd..85065cf 100644 --- a/t/7_template_00_base.t +++ b/t/7_template_00_base.t @@ -306,7 +306,7 @@ process_ok("[% 123.2.length %]" => 5) if ! $is_tt; process_ok("[% -123.2.length %]" => -5) if ! $is_tt; # the - doesn't bind as tight as the dot methods process_ok("[% (-123.2).length %]" => 6) if ! $is_tt; process_ok("[% a = 23; a.0 %]" => 23) if ! $is_tt; # '0' is a scalar_op -process_ok('[% 1.rand %]' => qr/^0\.\d+$/) if ! $is_tt; +process_ok('[% 1.rand %]' => qr/^0\.\d+(?:e-?\d+)?$/) if ! $is_tt; process_ok("[% n.repeat %]" => '1', {n => 1}) if ! $is_tt; # tt2 virtual method defaults to 0 process_ok("[% n.repeat(0) %]" => '', {n => 1}); -- 2.44.0