X-Git-Url: https://git.dogcows.com/gitweb?p=chaz%2Fp5-CGI-Ex;a=blobdiff_plain;f=lib%2FCGI%2FEx%2FTemplate.pm;h=5f8c1778f89873ce2c2ffd9afeeddee9c6f1d6d2;hp=370336796954cf8acc479a854122f1113f3cbb03;hb=8abbacc82b52f460bef67c1923ae98873a95e123;hpb=3fe8e76eb82e9d74f656674c5ba913950e166ab1 diff --git a/lib/CGI/Ex/Template.pm b/lib/CGI/Ex/Template.pm index 3703367..5f8c177 100644 --- a/lib/CGI/Ex/Template.pm +++ b/lib/CGI/Ex/Template.pm @@ -2,7 +2,7 @@ package CGI::Ex::Template; ###----------------------------------------------------------------### # See the perldoc in CGI/Ex/Template.pod -# Copyright 2006 - Paul Seamons # +# Copyright 2007 - Paul Seamons # # Distributed under the Perl Artistic License without warranty # ###----------------------------------------------------------------### @@ -39,7 +39,7 @@ use vars qw($VERSION ); BEGIN { - $VERSION = '2.02'; + $VERSION = '2.08'; $PACKAGE_EXCEPTION = 'CGI::Ex::Template::Exception'; $PACKAGE_ITERATOR = 'CGI::Ex::Template::Iterator'; @@ -66,6 +66,7 @@ BEGIN { defined => sub { 1 }, indent => \&vmethod_indent, int => sub { local $^W; int $_[0] }, + fmt => \&vmethod_as_scalar, 'format' => \&vmethod_format, hash => sub { {value => $_[0]} }, html => sub { local $_ = $_[0]; s/&/&/g; s//>/g; s/\"/"/g; $_ }, @@ -101,6 +102,7 @@ BEGIN { $LIST_OPS = { as => \&vmethod_as_list, first => sub { my ($ref, $i) = @_; return $ref->[0] if ! $i; return [@{$ref}[0 .. $i - 1]]}, + fmt => \&vmethod_as_list, grep => sub { my ($ref, $pat) = @_; [grep {/$pat/} @$ref] }, hash => sub { local $^W; my ($list, $i) = @_; defined($i) ? {map {$i++ => $_} @$list} : {@$list} }, join => sub { my ($ref, $join) = @_; $join = ' ' if ! defined $join; local $^W; return join $join, @$ref }, @@ -129,6 +131,7 @@ BEGIN { delete => sub { return '' if ! defined $_[1]; delete $_[0]->{ $_[1] } }, each => sub { [%{ $_[0] }] }, exists => sub { return '' if ! defined $_[1]; exists $_[0]->{ $_[1] } }, + fmt => \&vmethod_as_hash, hash => sub { $_[0] }, import => sub { my ($a, $b) = @_; return '' if ref($b) ne 'HASH'; @{$a}{keys %$b} = values %$b; '' }, item => sub { my ($h, $k) = @_; return '' if ! defined $k || $k =~ $QR_PRIVATE; $h->{$k} }, @@ -204,33 +207,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 +244,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 [@_] } ], ]; @@ -273,10 +276,12 @@ BEGIN { $QR_NUM = '(?:\d*\.\d+ | \d+) (?: [eE][+-]\d+ )?'; $QR_AQ_NOTDOT = "(?! \\s* $QR_COMMENTS \\.)"; $QR_AQ_SPACE = '(?: \\s+ | \$ | (?=[;+]) )'; # the + comes into play on filenames - $QR_PRIVATE = qr/^_/; + $QR_PRIVATE = qr/^[_.]/; $WHILE_MAX = 1000; $EXTRA_COMPILE_EXT = '.sto'; + + eval {require Scalar::Util}; }; ###----------------------------------------------------------------### @@ -649,7 +654,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 +673,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 +792,7 @@ sub execute_tree { ###----------------------------------------------------------------### -sub parse_variable { +sub parse_expr { my $self = shift; my $str_ref = shift; my $ARGS = shift || {}; @@ -803,7 +808,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 +816,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 +875,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 +899,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 +917,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 +930,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 +962,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 +988,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 +1002,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 +1021,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 +1044,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 +1058,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 +1087,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 +1145,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 +1189,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 +1201,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 +1214,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 +1222,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 +1244,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 +1260,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 +1282,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 +1305,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 +1338,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 +1360,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 +1372,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 +1385,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 +1408,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 +1434,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 +1453,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 +1472,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 +1532,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 +1544,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 +1613,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 +1660,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,18 +1671,19 @@ 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; } sub play_DUMP { my ($self, $ident, $node) = @_; require Data::Dumper; + local $Data::Dumper::Sortkeys = 1; my $info = $self->node_info($node); 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 +1713,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 +1742,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 +1757,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 +1830,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 +1863,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 +1898,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 +1909,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 ]; @@ -1910,7 +1939,8 @@ sub play_MACRO { $sub_tree = $sub_tree->[0]->[4]; } - my $self_copy = $self->weak_copy; + my $self_copy = $self; + eval {require Scalar::Util; Scalar::Util::weaken($self_copy)}; ### install a closure in the stash that will handle the macro $self->set_variable($name, sub { @@ -1998,7 +2028,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 +2039,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 +2061,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 +2074,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 +2161,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 +2178,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 +2199,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 +2217,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 +2229,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 +2255,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 +2264,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 +2303,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 +2347,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; @@ -2350,38 +2380,41 @@ sub play_USE { pop @var; # remove the trailing '.' ### look for a plugin_base - my $base = $self->{'PLUGIN_BASE'} || 'Template::Plugin'; # I'm not maintaining plugins - leave that to TT - my $package = $self->{'PLUGINS'}->{$module} ? $self->{'PLUGINS'}->{$module} - : $self->{'PLUGIN_FACTORY'}->{$module} ? $self->{'PLUGIN_FACTORY'}->{$module} - : "${base}::${module}"; - my $require = "$package.pm"; - $require =~ s|::|/|g; - - ### try and load the module - fall back to bare module if allowed + my $BASE = $self->{'PLUGIN_BASE'} || 'Template::Plugin'; # I'm not maintaining plugins - leave that to TT my $obj; - if ($self->{'PLUGIN_FACTORY'}->{$module} || eval {require $require}) { - my $shape = $package->load; - my $context = $self->context; - my @args = $args ? map { $self->get_variable($_) } @$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]) : []); - } elsif (my @packages = grep {lc($package) eq lc($_)} @{ $self->list_plugins({base => $base}) }) { - foreach my $package (@packages) { - my $require = "$package.pm"; - $require =~ s|::|/|g; - eval {require $require} || next; + + foreach my $base (ref($BASE) eq 'ARRAY' ? @$BASE : $BASE) { + my $package = $self->{'PLUGINS'}->{$module} ? $self->{'PLUGINS'}->{$module} + : $self->{'PLUGIN_FACTORY'}->{$module} ? $self->{'PLUGIN_FACTORY'}->{$module} + : "${base}::${module}"; + my $require = "$package.pm"; + $require =~ s|::|/|g; + + ### try and load the module - fall back to bare module if allowed + 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 ($self->{'LOAD_PERL'}) { - my $require = "$module.pm"; - $require =~ s|::|/|g; - if (eval {require $require}) { - my @args = $args ? map { $self->get_variable($_) } @$args : (); - $obj = $module->new(@args); + } elsif (lc($module) eq 'iterator') { # use our iterator if none found (TT's works just fine) + $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"; + $require =~ s|::|/|g; + eval {require $require} || next; + my $shape = $package->load; + my $context = $self->context; + 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->play_expr($_) } @$args : (); + $obj = $module->new(@args); + } } } if (! defined $obj) { @@ -2405,7 +2438,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) }; @@ -2752,20 +2785,6 @@ sub list_plugins { }; } -### get a copy of self without circular refs for use in closures -sub weak_copy { - my $self = shift; - my $self_copy; - if (eval { require Scalar::Util } - && defined &Scalar::Util::weaken) { - $self_copy = $self; - Scalar::Util::weaken($self_copy); - } else { - $self_copy = bless {%$self}, ref($self); # hackish way to avoid circular refs on old perls (pre 5.8) - } - return $self_copy; -} - sub debug_node { my ($self, $node) = @_; my $info = $self->node_info($node); @@ -2833,26 +2852,30 @@ sub define_vmethod { } sub vmethod_as_scalar { - my ($str, $pat) = @_; - $pat = '%s' if ! defined $pat; + my $str = shift; $str = '' if ! defined $str; + my $pat = shift; $pat = '%s' if ! defined $pat; local $^W; - return sprintf $pat, $str; + return @_ ? sprintf($pat, $_[0], $str) + : sprintf($pat, $str); } sub vmethod_as_list { - my ($ref, $pat, $sep) = @_; - $pat = '%s' if ! defined $pat; - $sep = ' ' if ! defined $sep; + my $ref = shift || return ''; + my $pat = shift; $pat = '%s' if ! defined $pat; + my $sep = shift; $sep = ' ' if ! defined $sep; local $^W; - return join($sep, map {sprintf $pat, $_} @$ref); + return @_ ? join($sep, map {sprintf $pat, $_[0], $_} @$ref) + : join($sep, map {sprintf $pat, $_} @$ref); } sub vmethod_as_hash { - my ($ref, $pat, $sep) = @_; - $pat = "%s\t%s" if ! defined $pat; - $sep = "\n" if ! defined $sep; + my $ref = shift || return ''; + my $pat = shift; $pat = "%s\t%s" if ! defined $pat; + my $sep = shift; $sep = "\n" if ! defined $sep; local $^W; - return join($sep, map {sprintf $pat, $_, $ref->{$_}} sort keys %$ref); + return ! @_ ? join($sep, map {sprintf $pat, $_, $ref->{$_}} sort keys %$ref) + : @_ == 1 ? join($sep, map {sprintf $pat, $_[0], $_, $ref->{$_}} sort keys %$ref) # don't get to pick - it applies to the key + : join($sep, map {sprintf $pat, $_[0], $_, $_[1], $ref->{$_}} sort keys %$ref); } sub vmethod_chunk { @@ -2880,7 +2903,11 @@ sub vmethod_indent { sub vmethod_format { my $str = shift; $str = '' if ! defined $str; my $pat = shift; $pat = '%s' if ! defined $pat; - return join "\n", map{ sprintf $pat, $_ } split(/\n/, $str); + if (@_) { + return join "\n", map{ sprintf $pat, $_[0], $_ } split(/\n/, $str); + } else { + return join "\n", map{ sprintf $pat, $_ } split(/\n/, $str); + } } sub vmethod_match { @@ -3002,7 +3029,14 @@ 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_tree(\$str)); +} + +sub dump_parse_expr { + my $obj = UNIVERSAL::isa($_[0], __PACKAGE__) ? shift : __PACKAGE__->new; + my $str = shift; + require Data::Dumper; + return Data::Dumper::Dumper($obj->parse_expr(\$str)); } ###----------------------------------------------------------------### @@ -3211,16 +3245,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;