+2.11 2007-05-07
+ * Add more samples to App synopsis.
+ * Add VIEW directive support to Template.
+ * Update data storage to more easily support TT2 parsers.
+ * Add regex support in Template.
+ * Add CONFIG directive in Template.
+ * Better error reporting.
+ * Allow parser to parse all TT2 tests in TT2 test suite.
+ * Add V2PIPE configuration to provide backward support for TT2 non-inline pipes.
+ * Add vmethod url.
+ * Cleanup argument parsing to be more compatible with TT2.
+
2.10 2007-04-27
* Allow for fully regex grammar based engine.
* Move to generic operator parse tree. All constructs are now only arrayrefs.
t/6_die_00_base.t
t/7_template_00_base.t
t/7_template_01_includes.t
+t/7_template_02_view.t
t/8_auth_00_base.t
t/9_jsondump_00_base.t
# 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.10
+version: 2.11
version_from: lib/CGI/Ex.pm
installdirs: site
requires:
use base qw(Exporter);
BEGIN {
- $VERSION = '2.10';
+ $VERSION = '2.11';
$PREFERRED_CGI_MODULE ||= 'CGI';
@EXPORT = ();
@EXPORT_OK = qw(get_form
use vars qw($VERSION);
BEGIN {
- $VERSION = '2.10';
+ $VERSION = '2.11';
Time::HiRes->import('time') if eval {require Time::HiRes};
eval {require Scalar::Util};
=head1 SYNOPSIS
+A basic example:
+
+ -------- File: /cgi-bin/my_cgi --------
+
#!/usr/bin/perl -w
use strict;
exit;
sub main_file_print {
- return \ "Hello World";
+ return \ "Hello World!";
+ }
+
+Well, you should put your content in an external file...
+
+ -------- File: /cgi-bin/my_cgi --------
+
+ #!/usr/bin/perl -w
+
+ use strict;
+ use base qw(CGI::Ex::App);
+
+ __PACKAGE__->navigate;
+
+ sub base_dir_abs { '/var/www/templates' }
+
+
+ -------- File: /var/www/templates/my_cgi/main.html --------
+
+ Hello World!
+
+How about if we want to add substitutions...
+
+ -------- File: /cgi-bin/my_cgi --------
+
+ #!/usr/bin/perl -w
+
+ use strict;
+ use base qw(CGI::Ex::App);
+
+ __PACKAGE__->navigate;
+
+ sub base_dir_abs { '/var/www/templates' }
+
+ sub main_hash_swap {
+ my $self = shift;
+ return {
+ greeting => 'Hello',
+ date => sub { scalar localtime },
+ };
}
-There is a longer "SYNOPSIS" after the process flow discussion.
+
+ -------- File: /var/www/templates/my_cgi/main.html --------
+
+ [% greeting %] World! ([% date %])
+
+
+How about a form with validation (inluding javascript validation)...
+
+ -------- File: /cgi-bin/my_cgi --------
+
+ #!/usr/bin/perl -w
+
+ use strict;
+ use base qw(CGI::Ex::App);
+
+ __PACKAGE__->navigate;
+
+ sub base_dir_abs { '/var/www/templates' }
+
+ sub main_hash_swap { {date => sub { scalar localtime }} }
+
+ sub main_hash_fill {
+ return {
+ guess => 50,
+ };
+ }
+
+ sub main_hash_validation {
+ return {
+ guess => {
+ required => 1,
+ compare1 => '<= 100',
+ compare1_error => 'Please enter a value less than 101',
+ compare2 => '> 0',
+ compare2_error => 'Please enter a value greater than 0',
+ },
+ };
+ }
+
+ sub main_finalize {
+ my $self = shift;
+ my $form = $self->form;
+
+ $self->add_to_form({was_correct => ($form->{'guess'} == 23)});
+
+ return 0; # indicate to show the page without trying to move along
+ }
+
+
+ -------- File: /var/www/templates/my_cgi/main.html --------
+
+ <h2>Hello World! ([% date %])</h2>
+
+ [% IF was_correct %]
+ <b>Correct!</b> - The number was [% guess %].<br>
+ [% ELSIF guess %]
+ <b>Incorrect</b> - The number was not [% guess %].<br>
+ [% END %]
+
+ <form name="[% form_name %]" method="post">
+
+ Enter a number between 1 and 100: <input type="text" name="guess"><br>
+ <span id="guess_error" style="color:red">[% guess_error %]</span><br>
+
+ <input type="submit">
+ </form>
+
+ [% js_validation %]
+
+
+There are infinite possibilities. There is a longer "SYNOPSIS" after
+the process flow discussion and more examples near the end of this
+document. It is interesting to note that there have been no databases
+so far. CGI::Ex::App is Controller/Viewer that is somewhat Model
+agnostic.
=head1 DESCRIPTION
use Digest::MD5 qw(md5_hex);
use CGI::Ex;
-$VERSION = '2.10';
+$VERSION = '2.11';
###----------------------------------------------------------------###
);
@EXPORT_OK = qw(conf_read conf_write in_cache);
-$VERSION = '2.10';
+$VERSION = '2.11';
$DEFAULT_EXT = 'conf';
use CGI::Ex::Dump qw(debug ctrace dex_html);
BEGIN {
- $VERSION = '2.10';
+ $VERSION = '2.11';
$SHOW_TRACE = 0 if ! defined $SHOW_TRACE;
$IGNORE_EVAL = 0 if ! defined $IGNORE_EVAL;
$EXTENDED_ERRORS = 1 if ! defined $EXTENDED_ERRORS;
use strict;
use Exporter;
-$VERSION = '2.10';
+$VERSION = '2.11';
@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);
use base qw(Exporter);
BEGIN {
- $VERSION = '2.10';
+ $VERSION = '2.11';
@EXPORT = qw(form_fill);
@EXPORT_OK = qw(fill form_fill html_escape get_tagval_by_key swap_tagval_by_key);
};
use base qw(Exporter);
BEGIN {
- $VERSION = '2.10';
+ $VERSION = '2.11';
@EXPORT = qw(JSONDump);
@EXPORT_OK = @EXPORT;
package CGI::Ex::Template;
+#STAT_TTL
+#memory leak in USE
+
###----------------------------------------------------------------###
# See the perldoc in CGI/Ex/Template.pod
# Copyright 2007 - Paul Seamons #
$QR_COMMENTS
$QR_FILENAME
$QR_NUM
- $QR_AQ_NOTDOT
$QR_AQ_SPACE
$QR_PRIVATE
$WHILE_MAX
$EXTRA_COMPILE_EXT
$DEBUG
+
+ @CONFIG_COMPILETIME
+ @CONFIG_RUNTIME
);
BEGIN {
- $VERSION = '2.10';
+ $VERSION = '2.11';
$PACKAGE_EXCEPTION = 'CGI::Ex::Template::Exception';
$PACKAGE_ITERATOR = 'CGI::Ex::Template::Iterator';
metatext => ['%%', '%%' ], # Text::MetaText
php => ['<\?', '\?>' ], # PHP
star => ['\[\*', '\*\]' ], # TT alternate
+ template => ['\[%', '%\]' ], # Normal Template Toolkit
template1 => ['[\[%]%', '%[%\]]'], # allow TT1 style
+ tt2 => ['\[%', '%\]' ], # TT2
};
$SCALAR_OPS = {
'0' => sub { $_[0] },
- as => \&vmethod_as_scalar,
chunk => \&vmethod_chunk,
collapse => sub { local $_ = $_[0]; s/^\s+//; s/\s+$//; s/\s+/ /g; $_ },
defined => sub { defined $_[0] ? 1 : '' },
indent => \&vmethod_indent,
int => sub { local $^W; int $_[0] },
- fmt => \&vmethod_as_scalar,
+ fmt => \&vmethod_fmt_scalar,
'format' => \&vmethod_format,
hash => sub { {value => $_[0]} },
- html => sub { local $_ = $_[0]; s/&/&/g; s/</</g; s/>/>/g; s/\"/"/g; $_ },
+ html => sub { local $_ = $_[0]; s/&/&/g; s/</</g; s/>/>/g; s/\"/"/g; s/\'/'/g; $_ },
item => sub { $_[0] },
lcfirst => sub { lcfirst $_[0] },
length => sub { defined($_[0]) ? length($_[0]) : 0 },
ucfirst => sub { ucfirst $_[0] },
upper => sub { uc $_[0] },
uri => \&vmethod_uri,
+ url => \&vmethod_url,
};
$FILTER_OPS = { # generally - non-dynamic filters belong in scalar ops
};
$LIST_OPS = {
- as => \&vmethod_as_list,
defined => sub { return 1 if @_ == 1; defined $_[0]->[ defined($_[1]) ? $_[1] : 0 ] },
first => sub { my ($ref, $i) = @_; return $ref->[0] if ! $i; return [@{$ref}[0 .. $i - 1]]},
- fmt => \&vmethod_as_list,
+ fmt => \&vmethod_fmt_list,
grep => sub { local $^W; my ($ref, $pat) = @_; [grep {/$pat/} @$ref] },
hash => sub { local $^W; my $list = shift; return {@$list} if ! @_; my $i = shift || 0; return {map {$i++ => $_} @$list} },
import => sub { my $ref = shift; push @$ref, grep {defined} map {ref eq 'ARRAY' ? @$_ : undef} @_; '' },
new => sub { local $^W; return [@_] },
null => sub { '' },
nsort => \&vmethod_nsort,
+ pick => \&vmethod_pick,
pop => sub { pop @{ $_[0] } },
push => sub { my $ref = shift; push @$ref, @_; return '' },
- random => sub { my $ref = shift; $ref->[ rand @$ref ] },
reverse => sub { [ reverse @{ $_[0] } ] },
shift => sub { shift @{ $_[0] } },
size => sub { local $^W; scalar @{ $_[0] } },
};
$HASH_OPS = {
- as => \&vmethod_as_hash,
defined => sub { return 1 if @_ == 1; defined $_[0]->{ defined($_[1]) ? $_[1] : '' } },
- delete => sub { my $h = shift; my @v = delete @{ $h }{map {defined($_) ? $_ : ''} @_}; @_ == 1 ? $v[0] : \@v },
+ delete => sub { my $h = shift; delete @{ $h }{map {defined($_) ? $_ : ''} @_}; '' },
each => sub { [%{ $_[0] }] },
exists => sub { exists $_[0]->{ defined($_[1]) ? $_[1] : '' } },
- fmt => \&vmethod_as_hash,
+ fmt => \&vmethod_fmt_hash,
hash => sub { $_[0] },
import => sub { my ($a, $b) = @_; @{$a}{keys %$b} = values %$b if ref($b) eq 'HASH'; '' },
item => sub { my ($h, $k) = @_; $k = '' if ! defined $k; $k =~ $QR_PRIVATE ? undef : $h->{$k} },
CATCH => [\&parse_CATCH, undef, 0, 0, {TRY => 1, CATCH => 1}],
CLEAR => [sub {}, \&play_CLEAR],
'#' => [sub {}, sub {}],
+ CONFIG => [\&parse_CONFIG, \&play_CONFIG],
DEBUG => [\&parse_DEBUG, \&play_DEBUG],
DEFAULT => [\&parse_DEFAULT, \&play_DEFAULT],
DUMP => [\&parse_DUMP, \&play_DUMP],
TRY => [sub {}, \&play_TRY, 1],
UNLESS => [\&parse_UNLESS, \&play_UNLESS, 1, 1],
USE => [\&parse_USE, \&play_USE],
- WHILE => [\&parse_IF, \&play_WHILE, 1, 1],
+ VIEW => [\&parse_VIEW, \&play_VIEW, 1],
+ WHILE => [\&parse_WHILE, \&play_WHILE, 1, 1],
WRAPPER => [\&parse_WRAPPER, \&play_WRAPPER, 1, 1],
#name #parse_sub #play_sub #block #postdir #continue #move_to_front
};
['prefix', 50, ['not', 'NOT'], sub { ! $_[0] } ],
['left', 45, ['and', 'AND'], undef ],
['right', 40, ['or', 'OR'], undef ],
- ['', 0, ['{}'], undef ],
- ['', 0, ['[]'], undef ],
+# ['', 0, ['{}'], undef ],
+# ['', 0, ['[]'], undef ],
+# ['', 0, ['qr'], undef ],
];
$OP = {map {my $ref = $_; map {$_ => $ref} @{$ref->[2]}} grep {$_->[0] ne 'prefix' } @$OPERATORS}; # all non-prefix
$OP_PREFIX = {map {my $ref = $_; map {$_ => $ref} @{$ref->[2]}} grep {$_->[0] eq 'prefix' } @$OPERATORS};
$QR_DIRECTIVE = '( [a-zA-Z]+\b | \| )';
$QR_COMMENTS = '(?-s: \# .* \s*)*';
- $QR_FILENAME = '([a-zA-Z]]:/|/)? [\w\-\.]+ (?:/[\w\-\.]+)*';
+ $QR_FILENAME = '([a-zA-Z]]:/|/)? [\w\.][\w\-\.]* (?:/[\w\-\.]+)*';
$QR_NUM = '(?:\d*\.\d+ | \d+) (?: [eE][+-]\d+ )?';
- $QR_AQ_NOTDOT = "(?! \\s* $QR_COMMENTS \\.)";
- $QR_AQ_SPACE = '(?: \\s+ | \$ | (?=[;+]) )'; # the + comes into play on filenames
+ $QR_AQ_SPACE = '(?: \\s+ | \$ | (?=;) )';
$QR_PRIVATE = qr/^[_.]/;
$WHILE_MAX = 1000;
$EXTRA_COMPILE_EXT = '.sto2';
+ @CONFIG_COMPILETIME = qw(ANYCASE INTERPOLATE PRE_CHOMP POST_CHOMP V1DOLLAR V2PIPE);
+ @CONFIG_RUNTIME = qw(DUMP);
+
eval {require Scalar::Util};
};
### parse and execute
my $doc;
eval {
+ ### handed us a precompiled document
+ if (ref($file) eq 'HASH' && $file->{'_tree'}) {
+ $doc = $file;
+
### load the document
- $doc = $self->load_parsed_tree($file) || $self->throw('undef', "Zero length content");;
+ } else {
+ $doc = $self->load_parsed_tree($file) || $self->throw('undef', "Zero length content");;
+ }
### prevent recursion
$self->throw('file', "recursion into '$doc->{name}'")
if (! @{ $doc->{'_tree'} }) { # no tags found - just return the content
$$out_ref = ${ $doc->{'_content'} };
} else {
- local $self->{'_vars'}->{'component'} = $doc;
- $self->{'_vars'}->{'template'} = $doc if $self->{'_top_level'};
+ local $self->{'_component'} = $doc;
+ local $self->{'_template'} = $self->{'_top_level'} ? $doc : $self->{'_template'};
+ local @{ $self }{@CONFIG_RUNTIME} = @{ $self }{@CONFIG_RUNTIME};
$self->execute_tree($doc->{'_tree'}, $out_ref);
- delete $self->{'_vars'}->{'template'} if $self->{'_top_level'};
}
- };
- ### trim whitespace from the beginning and the end of a block or template
- if ($self->{'TRIM'}) {
- substr($$out_ref, $i, length($$out_ref) - $i) =~ s{ \s+ $ }{}x; # tail first
- substr($$out_ref, $i, length($$out_ref) - $i) =~ s{ ^ \s+ }{}x;
- }
+ ### trim whitespace from the beginning and the end of a block or template
+ if ($self->{'TRIM'}) {
+ substr($$out_ref, $i, length($$out_ref) - $i) =~ s{ \s+ $ }{}x; # tail first
+ substr($$out_ref, $i, length($$out_ref) - $i) =~ s{ ^ \s+ }{}x;
+ }
+ };
### handle exceptions
if (my $err = $@) {
### looks like a string reference
if (ref $file) {
- $doc->{'_content'} = $file;
- $doc->{'name'} = 'input text';
- $doc->{'is_str_ref'} = 1;
+ $doc->{'_content'} = $file;
+ $doc->{'name'} = 'input text';
+ $doc->{'_is_str_ref'} = 1;
### looks like a previously cached-in-memory document
} elsif ($self->{'_documents'}->{$file}
$self->{'NAMESPACE'}->{$key} ||= $self->{'CONSTANTS'};
}
- local $self->{'_vars'}->{'component'} = $doc;
- $doc->{'_tree'} = $self->parse_tree($doc->{'_content'}); # errors die
+ local $self->{'_component'} = $doc;
+ $doc->{'_tree'} = eval { $self->parse_tree($doc->{'_content'}) }
+ || do { my $e = $@; $e->doc($doc) if UNIVERSAL::can($e, 'doc') && ! $e->doc; die $e }; # errors die
}
### cache parsed_tree in memory unless asked not to do so
- if (! $doc->{'is_str_ref'} && (! defined($self->{'CACHE_SIZE'}) || $self->{'CACHE_SIZE'})) {
+ if (! $doc->{'_is_str_ref'} && (! defined($self->{'CACHE_SIZE'}) || $self->{'CACHE_SIZE'})) {
$self->{'_documents'}->{$file} ||= $doc;
$doc->{'_cache_time'} = time;
my $END = $self->{'END_TAG'} || $TAGS->{$STYLE}->[1];
local $self->{'_end_tag'} = $END;
+ local @{ $self }{@CONFIG_COMPILETIME} = @{ $self }{@CONFIG_COMPILETIME};
+
my @tree; # the parsed tree
my $pointer = \@tree; # pointer to current tree to handle nested blocks
my @state; # maintain block levels
local $self->{'_state'} = \@state; # allow for items to introspect (usually BLOCKS)
local $self->{'_in_perl'}; # no interpolation in perl
+ my @in_view; # let us know if we are in a view
my @move_to_front; # items that need to be declared first (usually BLOCKS)
my @meta; # place to store any found meta information (to go into META)
my $post_chomp = 0; # previous post_chomp setting
splice(@$pointer, -1, 1, ()) if ! length $pointer->[-1]; # remove the node if it is zero length
}
if ($$str_ref =~ m{ \G \# }gcx) { # leading # means to comment the entire section
- $$str_ref =~ m{ \G (.*?) ($END) }gcxs # brute force - can't comment tags with nested %]
+ $$str_ref =~ m{ \G (.*?) ([+~=-]?) ($END) }gcxs # brute force - can't comment tags with nested %]
|| $self->throw('parse', "Missing closing tag", undef, pos($$str_ref));
$node->[0] = '#';
- $node->[2] = pos($$str_ref) - length($2);
+ $node->[2] = pos($$str_ref) - length($3);
push @$pointer, $node;
+
+ $post_chomp = $2;
+ $post_chomp ||= $self->{'POST_CHOMP'};
+ $post_chomp =~ y/-=~+/1230/ if $post_chomp;
next;
}
$$str_ref =~ m{ \G \s* $QR_COMMENTS }gcxo;
$parent_node->[5] = $node;
my $parent_type = $parent_node->[0];
if (! $DIRECTIVES->{$func}->[4]->{$parent_type}) {
- $self->throw('parse', "Found unmatched nested block", $node, 0);
+ $self->throw('parse', "Found unmatched nested block", $node, pos($$str_ref));
}
}
### normal end block
if ($func eq 'END') {
if ($DIRECTIVES->{$parent_node->[0]}->[5]) { # move things like BLOCKS to front
- push @move_to_front, $parent_node;
+ if ($parent_node->[0] eq 'BLOCK'
+ && defined($parent_node->[3])
+ && @in_view) {
+ push @{ $in_view[-1] }, $parent_node;
+ } else {
+ push @move_to_front, $parent_node;
+ }
if ($pointer->[-1] && ! $pointer->[-1]->[6]) { # capturing doesn't remove the var
splice(@$pointer, -1, 1, ());
}
} elsif ($parent_node->[0] =~ /PERL$/) {
delete $self->{'_in_perl'};
+ } elsif ($parent_node->[0] eq 'VIEW') {
+ my $ref = { map {($_->[3] => $_->[4])} @{ pop @in_view }};
+ unshift @{ $parent_node->[3] }, $ref;
}
### continuation block - such as an elsif
} elsif ($func eq 'TAGS') {
my $end;
- if ($$str_ref =~ m{
- \G (\w+) # tags name
- \s* $QR_COMMENTS # optional comments
- ([+~=-]?) ($END) # forced close
- }gcx) {
+ if ($$str_ref =~ m{ \G (\w+) \s* $QR_COMMENTS }gcxs) {
my $ref = $TAGS->{lc $1} || $self->throw('parse', "Invalid TAGS name \"$1\"", undef, pos($$str_ref));
($START, $END) = @$ref;
- ($post_chomp, $end) = ($2, $3);
-
- } elsif ($$str_ref =~ m{
- \G (\S+) \s+ (\S+) # two non-space things
- (?:\s+(un|)quoted?)? # optional unquoted adjective
- \s* $QR_COMMENTS # optional comments
- ([+~=-]?) ($END) # forced close
- }gcxo) {
- ($START, $END, my $unquote, $post_chomp, $end) = ($1, $2, $3, $4, $5);
- for ($START, $END) {
- if ($unquote) { eval { "" =~ /$_/; 1 } || $self->throw('parse', "Invalid TAGS \"$_\": $@", undef, pos($$str_ref)) }
- else { $_ = quotemeta $_ }
- }
+
} else {
- $self->throw('parse', "Invalid TAGS", undef, pos($$str_ref));
+ local $self->{'_operator_precedence'} = 1; # prevent operator matching
+ $START = $$str_ref =~ m{ \G (?= [\'\"\/]) }gcx
+ ? $self->parse_expr($str_ref)
+ : $self->parse_expr($str_ref, {auto_quote => "(\\S+) \\s+ $QR_COMMENTS"})
+ || $self->throw('parse', "Invalid opening tag in TAGS", undef, pos($$str_ref));
+ $END = $$str_ref =~ m{ \G (?= [\'\"\/]) }gcx
+ ? $self->parse_expr($str_ref)
+ : $self->parse_expr($str_ref, {auto_quote => "(\\S+) \\s* $QR_COMMENTS"})
+ || $self->throw('parse', "Invalid closing tag in TAGS", undef, pos($$str_ref));
+ for my $tag ($START, $END) {
+ $tag = $self->play_expr($tag);
+ $tag = quotemeta($tag) if ! ref $tag;
+ }
}
- $post_chomp ||= $self->{'POST_CHOMP'};
- $post_chomp =~ y/-=~+/1230/ if $post_chomp;
- $node->[2] = pos($$str_ref) - length($end);
- $continue = 0;
- $post_op = undef;
+ $node->[2] = pos $$str_ref;
- $self->{'_end_tag'} = $END; # need to keep track so parse_expr knows when to stop
- next;
+ ### allow for one more closing tag of the old style
+ if ($$str_ref =~ m{ \G ([+~=-]?) $self->{'_end_tag'} }gcxs) {
+ $post_chomp = $1 || $self->{'POST_CHOMP'};
+ $post_chomp =~ y/-=~+/1230/ if $post_chomp;
+ $continue = 0;
+ $post_op = undef;
+ $self->{'_end_tag'} = $END; # need to keep track so parse_expr knows when to stop
+ next;
+ }
+
+ $self->{'_end_tag'} = $END;
} elsif ($func eq 'META') {
- my $args = $self->parse_args($str_ref);
+ my $args = $self->parse_args($str_ref, {named_at_front => 1});
my $hash;
- if (($hash = $self->play_expr($args->[-1]))
+ if (($hash = $self->play_expr($args->[0]))
&& UNIVERSAL::isa($hash, 'HASH')) {
unshift @meta, %$hash; # first defined win
}
push @state, $node;
$pointer = $node->[4] ||= [];
}
+ push @in_view, [] if $func eq 'VIEW';
}
- #} elsif (1) {
- # $node->[0] = 'GET';
- # $node->[2] = $node->[1] + 5;
- # $node->[3] = ['one',0];
- # $$str_ref =~ m{ $END }gcx;
- # push @$pointer, $node;
- # next;
-
### allow for bare variable getting and setting
} elsif (defined(my $var = $self->parse_expr($str_ref))) {
push @$pointer, $node;
- if ($$str_ref =~ m{ \G ($QR_OP_ASSIGN) >? \s* $QR_COMMENTS }gcxo) {
+ if ($$str_ref =~ m{ \G ($QR_OP_ASSIGN) >? (?! [+=~-]? $END) \s* $QR_COMMENTS }gcx) {
$node->[0] = 'SET';
$node->[3] = eval { $DIRECTIVES->{'SET'}->[0]->($self, $str_ref, $node, $1, $var) };
if (my $err = $@) {
$node->[3] = $var;
}
- ### now look for the closing tag
- } elsif ($$str_ref =~ m{ \G ([+=~-]?) ($END) }gcxs) {
+ ### handle empty tags [% %]
+ } elsif ($$str_ref =~ m{ \G (?: ; \s* $QR_COMMENTS)? ([+=~-]?) ($END) }gcxs) {
my $end = $2;
$post_chomp = $1 || $self->{'POST_CHOMP'};
$post_chomp =~ y/-=~+/1230/ if $post_chomp;
-
$node->[2] = pos($$str_ref) - length($end);
$continue = 0;
$post_op = undef;
+ next;
} else { # error
- my $all = substr($$str_ref, $node->[1], pos($$str_ref) - $node->[1]);
- $all =~ s/^\s+//;
- $all =~ s/\s+$//;
- $self->throw('parse', "Not sure how to handle tag \"$all\"", $node);
+ $self->throw('parse', "Not sure how to handle tag", $node, pos($$str_ref));
}
### we now have the directive to capture for an item like "SET foo = BLOCK" - store it
}
### look for the closing tag again
- if ($$str_ref =~ m{ \G ([+=~-]?) ($END) }gcxs) {
+ if ($$str_ref =~ m{ \G (?: ; \s* $QR_COMMENTS)? ([+=~-]?) ($END) }gcxs) {
my $end = $2;
$post_chomp = $1 || $self->{'POST_CHOMP'};
$post_chomp =~ y/-=~+/1230/ if $post_chomp;
my $str_ref = shift;
my $ARGS = shift || {};
my $is_aq = $ARGS->{'auto_quote'} ? 1 : 0;
+ my $mark = pos $$str_ref;
### allow for custom auto_quoting (such as hash constructors)
if ($is_aq) {
- if ($$str_ref =~ m{ \G $ARGS->{'auto_quote'} \s* $QR_COMMENTS }gcx) {
+ if ($$str_ref =~ m{ \G $ARGS->{'auto_quote'} }gcx) {
return $1;
- ### allow for auto-quoted $foo or ${foo.bar} type constructs
- } elsif ($$str_ref =~ m{ \G \$ (\w+ (?:\.\w+)*) \b \s* $QR_COMMENTS }gcxo) {
+ ### allow for auto-quoted $foo
+ } elsif ($$str_ref =~ m{ \G \$ (\w+\b (?:\.\w+\b)*) \s* $QR_COMMENTS }gcxo) {
my $name = $1;
- return $self->parse_expr(\$name);
+ if ($$str_ref !~ m{ \G \( }gcx || $name =~ /^(?:qw|m|\d)/) {
+ return $self->parse_expr(\$name);
+ }
+ ### this is a little cryptic/odd - but TT allows items in
+ ### autoquote position to only be prefixed by a $ - gross
+ ### so we will defer to the regular parsing - but after the $
+ pos($$str_ref) = $mark + 1;
+ $is_aq = undef; # but don't allow operators - false flag handed down
+ ### allow for ${foo.bar} type constructs
} elsif ($$str_ref =~ m{ \G \$\{ \s* }gcx) {
my $var = $self->parse_expr($str_ref);
$$str_ref =~ m{ \G \s* \} \s* $QR_COMMENTS }gcxo
### test for leading prefix operators
my $has_prefix;
- my $mark = pos $$str_ref;
while (! $is_aq && $$str_ref =~ m{ \G ($QR_OP_PREFIX) }gcxo) {
push @{ $has_prefix }, $1;
$$str_ref =~ m{ \G \s* $QR_COMMENTS }gcxo;
my @var;
my $is_literal;
my $is_namespace;
+ my $already_parsed_args;
### allow hex
if ($$str_ref =~ m{ \G 0x ( [a-fA-F0-9]+ ) \s* $QR_COMMENTS }gcxo) {
$is_literal = 1;
### allow for quoted array constructor
- } elsif (! $is_aq && $$str_ref =~ m{ \G qw (\W) \s* }gcxo) {
+ } elsif (! $is_aq && $$str_ref =~ m{ \G qw ([^\w\s]) \s* }gcxo) {
my $quote = $1;
$quote =~ y|([{<|)]}>|;
- $$str_ref =~ m{ \G (.*?) \Q$quote\E \s* $QR_COMMENTS }gcxs
+ $$str_ref =~ m{ \G (.*?) (?<!\\) \Q$quote\E \s* $QR_COMMENTS }gcxs
|| $self->throw('parse.missing.array_close', "Missing close \"$quote\"", undef, pos($$str_ref));
my $str = $1;
- $str =~ s{ ^ \s+ | \s+ $ }{}x;
+ $str =~ s{ ^ \s+ }{}x;
+ $str =~ s{ \s+ $ }{}x;
+ $str =~ s{ \\ \Q$quote\E }{$quote}gx;
push @var, [undef, '[]', split /\s+/, $str];
+ ### allow for regex constructor
+ } elsif (! $is_aq && $$str_ref =~ m{ \G / }gcx) {
+ $$str_ref =~ m{ \G (.*?) (?<! \\) / ([msixeg]*) \s* $QR_COMMENTS }gcxos
+ || $self->throw('parse', 'Unclosed regex tag "/"', undef, pos($$str_ref));
+ my ($str, $opts) = ($1, $2);
+ $self->throw('parse', 'e option not allowed on regex', undef, pos($$str_ref)) if $opts =~ /e/;
+ $self->throw('parse', 'g option not supported on regex', undef, pos($$str_ref)) if $opts =~ /g/;
+ $str =~ s|\\n|\n|g;
+ $str =~ s|\\t|\t|g;
+ $str =~ s|\\r|\r|g;
+ $str =~ s|\\\/|\/|g;
+ $str =~ s|\\\$|\$|g;
+ $self->throw('parse', "Invalid regex: $@", undef, pos($$str_ref)) if ! eval { "" =~ /$str/; 1 };
+ push @var, [undef, 'qr', $str, $opts];
+
### looks like a normal variable start
} elsif ($$str_ref =~ m{ \G (\w+) \s* $QR_COMMENTS }gcxo) {
push @var, $1;
$is_namespace = 1 if $self->{'NAMESPACE'} && $self->{'NAMESPACE'}->{$1};
### allow for literal strings
- } elsif ($$str_ref =~ m{ \G ([\"\']) (|.*?[^\\]) \1 \s* $QR_COMMENTS }gcxos) {
- if ($1 eq "'") { # no interpolation on single quoted strings
- my $str = $2;
+ } elsif ($$str_ref =~ m{ \G ([\"\']) }gcx) {
+ my $quote = $1;
+ $$str_ref =~ m{ \G (.*?) (?<! \\) $quote \s* $QR_COMMENTS }gcxs
+ || $self->throw('parse', "Unclosed quoted string ($1)", undef, pos($$str_ref));
+ my $str = $1;
+ if ($quote eq "'") { # no interpolation on single quoted strings
$str =~ s{ \\\' }{\'}xg;
push @var, \ $str;
$is_literal = 1;
} else {
- my $str = $2;
$str =~ s/\\n/\n/g;
$str =~ s/\\t/\t/g;
$str =~ s/\\r/\r/g;
$str =~ s/\\"/"/g;
- my @pieces = $ARGS->{'auto_quote'}
+ my @pieces = $is_aq
? split(m{ (?: ^ | (?<!\\)) (\$\w+ | \$\{ .*? (?<!\\) \}) }x, $str) # autoquoted items get a single $\w+ - no nesting
: split(m{ (?: ^ | (?<!\\)) (\$\w+ (?:\.\w+)* | \$\{ .*? (?<!\\) \}) }x, $str);
my $n = 0;
foreach my $piece (@pieces) {
$piece =~ s/\\\$/\$/g;
+ $piece =~ s/\\//g;
next if ! ($n++ % 2);
next if $piece !~ m{ ^ \$ (\w+ (?:\.\w+)*) $ }x
&& $piece !~ m{ ^ \$\{ \s* (.*?) (?<!\\) \} $ }x;
}
}
if ($is_aq) {
- #$$str_ref = $copy; # TODO ?
return ${ $var[0] } if $is_literal;
push @var, 0;
return \@var;
} elsif (! $is_aq && $$str_ref =~ m{ \G \{ \s* $QR_COMMENTS }gcxo) {
local $self->{'_operator_precedence'} = 0; # reset precedence
my $hashref = [undef, '{}'];
- while (defined(my $key = $self->parse_expr($str_ref, {auto_quote => "(\\w+) $QR_AQ_NOTDOT"}))) {
+ while (defined(my $key = $self->parse_expr($str_ref, {auto_quote => "(\\w+\\b) (?! \\.) \\s* $QR_COMMENTS"}))) {
$$str_ref =~ m{ \G = >? \s* $QR_COMMENTS }gcxo;
my $val = $self->parse_expr($str_ref);
push @$hashref, $key, $val;
$$str_ref =~ m{ \G \) \s* $QR_COMMENTS }gcxo
|| $self->throw('parse.missing.paren', "Missing close \)", undef, pos($$str_ref));
- @var = @$var;
- pop @var; # pull off the trailing args of the paren group
- # TODO - we could forward lookahed for a period or pipe
+
+ $self->throw('parse', 'Paren group cannot be followed by an open paren', undef, pos($$str_ref))
+ if $$str_ref =~ m{ \G \( }gcx;
+
+ $already_parsed_args = 1;
+ if (! ref $var) {
+ push @var, \$var, 0;
+ $is_literal = 1;
+ } elsif (! defined $var->[0]) {
+ push @var, $var, 0;
+ } else {
+ push @var, @$var;
+ }
### nothing to find - return failure
} else {
+ pos($$str_ref) = $mark if $is_aq || $has_prefix;
return;
}
- return if $is_aq; # auto_quoted thing was too complicated
+ # auto_quoted thing was too complicated
+ if ($is_aq) {
+ pos($$str_ref) = $mark;
+ return;
+ }
### looks for args for the initial
- if ($$str_ref =~ m{ \G \( \s* $QR_COMMENTS }gcxo) {
+ if ($already_parsed_args) {
+ # do nothing
+ } elsif ($$str_ref =~ m{ \G \( \s* $QR_COMMENTS }gcxo) {
local $self->{'_operator_precedence'} = 0; # reset precedence
my $args = $self->parse_args($str_ref, {is_parened => 1});
$$str_ref =~ m{ \G \) \s* $QR_COMMENTS }gcxo
push @var, 0;
}
+
### allow for nested items
- while ($$str_ref =~ m{ \G ( \.(?!\.) | \|(?!\|) ) \s* $QR_COMMENTS }gcxo) {
+ while ($$str_ref =~ m{ \G ( \.(?!\.) | \|(?!\|) ) }gcx) {
+ if ($1 eq '|' && $self->{'V2PIPE'}) {
+ pos($$str_ref) -= 1;
+ last;
+ }
+
push(@var, $1) if ! $ARGS->{'no_dots'};
+ $$str_ref =~ m{ \G \s* $QR_COMMENTS }gcxo;
+
### allow for interpolated variables in the middle - one.$foo.two
if ($$str_ref =~ m{ \G \$ (\w+) \b \s* $QR_COMMENTS }gcxo) {
push @var, $self->{'V1DOLLAR'} ? $1 : [$1, 0];
}
### allow for all "operators"
- if (! $self->{'_operator_precedence'}) {
+ if (! $self->{'_operator_precedence'} && defined $is_aq) {
my $tree;
my $found;
while (1) {
my @args;
my @named;
+ my $name;
+ my $end = $self->{'_end_tag'} || '(?!)';
while (1) {
my $mark = pos $$str_ref;
+
+ ### look to see if the next thing is a directive or a closing tag
if (! $ARGS->{'is_parened'}
- && $$str_ref =~ m{ \G $QR_DIRECTIVE (?: \s+ | (?: \s* $QR_COMMENTS (?: ;|[+=~-]?$self->{'_end_tag'}))) }gcxo
+ && ! $ARGS->{'require_arg'}
+ && $$str_ref =~ m{ \G $QR_DIRECTIVE (?: \s+ | (?: \s* $QR_COMMENTS (?: ;|[+=~-]?$end))) }gcxo
&& ((pos($$str_ref) = $mark) || 1) # always revert
&& $DIRECTIVES->{$self->{'ANYCASE'} ? uc($1) : $1} # looks like a directive - we are done
) {
last;
}
+ if ($$str_ref =~ m{ \G [+=~-]? $end }gcx) {
+ pos($$str_ref) = $mark;
+ last;
+ }
- if (defined(my $name = $self->parse_expr($str_ref, {auto_quote => "(\\w+) $QR_AQ_NOTDOT"}))
- && ($$str_ref =~ m{ \G = >? \s* $QR_COMMENTS }gcxo # see if we also match assignment
- || ((pos $$str_ref = $mark) && 0)) # if not - we need to rollback
- ) {
+ ### find the initial arg
+ my $name;
+ if ($ARGS->{'allow_bare_filenames'}) {
+ $name = $self->parse_expr($str_ref, {auto_quote => "
+ ($QR_FILENAME # file name
+ | \\w+\\b (?: :\\w+\\b)* ) # or block
+ (?= [+=~-]? $end # an end tag
+ | \\s*[+,;] # followed by explicit + , or ;
+ | \\s+ (?! [\\s=]) # or space not before an =
+ ) \\s* $QR_COMMENTS"});
+ # filenames can be separated with a "+" - why a "+" ?
+ if ($$str_ref =~ m{ \G \+ (?! [+=~-]? $end) \s* $QR_COMMENTS }gcxo) {
+ push @args, $name;
+ $ARGS->{'require_arg'} = 1;
+ next;
+ }
+ }
+ if (! defined $name) {
+ $name = $self->parse_expr($str_ref);
+ if (! defined $name) {
+ if ($ARGS->{'require_arg'} && ! @args && ! $ARGS->{'positional_only'} && ! @named) {
+ $self->throw('parse', 'Argument required', undef, pos($$str_ref));
+ } else {
+ last;
+ }
+ }
+ }
+
+ $$str_ref =~ m{ \G \s* $QR_COMMENTS }gcxo;
+
+ ### see if it is named or positional
+ if ($$str_ref =~ m{ \G = >? \s* $QR_COMMENTS }gcxo) {
$self->throw('parse', 'Named arguments not allowed', undef, $mark) if $ARGS->{'positional_only'};
my $val = $self->parse_expr($str_ref);
- $$str_ref =~ m{ \G , \s* $QR_COMMENTS }gcxo;
+ $name = $name->[0] if ref($name) && @$name == 2 && ! $name->[1]; # strip a level of indirection on named arguments
push @named, $name, $val;
- } elsif (defined(my $arg = $self->parse_expr($str_ref))) {
- push @args, $arg;
- $$str_ref =~ m{ \G , \s* $QR_COMMENTS }gcxo;
} else {
- last;
+ push @args, $name;
}
+
+ ### look for trailing comma
+ $ARGS->{'require_arg'} = ($$str_ref =~ m{ \G , \s* $QR_COMMENTS }gcxo) || 0;
}
- ### allow for named arguments to be added also
- push @args, [[undef, '{}', @named], 0] if scalar @named;
+ ### allow for named arguments to be added at the front (if asked)
+ if ($ARGS->{'named_at_front'}) {
+ unshift @args, [[undef, '{}', @named], 0];
+ } elsif (scalar @named) { # only add at end - if there are some
+ push @args, [[undef, '{}', @named], 0]
+ }
return \@args;
}
return if $name =~ $QR_PRIVATE; # don't allow vars that begin with _
return \$self->{'_vars'}->{$name} if $i >= $#$var && $ARGS->{'return_ref'} && ! ref $self->{'_vars'}->{$name};
$ref = $self->{'_vars'}->{$name};
- $ref = $VOBJS->{$name} if ! defined $ref;
+ $ref = ($name eq 'template' || $name eq 'component') ? $self->{"_$name"} : $VOBJS->{$name} if ! defined $ref;
}
}
return $ref;
}
+sub is_empty_named_args {
+ my ($self, $hash_ident) = @_;
+ # [[undef, '{}', 'key1', 'val1', 'key2, 'val2'], 0]
+ return @{ $hash_ident->[0] } <= 2;
+}
+
sub set_variable {
my ($self, $var, $val, $ARGS) = @_;
$ARGS ||= {};
$last->[-1] = (ref $last->[-1] ? [@{ $last->[-1] }, @_] : [@_]) if @_;
return $self->play_expr($last);
} };
+ } elsif ($op eq 'qr') {
+ return $tree->[3] ? qr{(?$tree->[3]:$tree->[2])} : qr{$tree->[2]};
}
$self->throw('operator', "Un-implemented operation $op");
sub parse_BLOCK {
my ($self, $str_ref, $node) = @_;
- my $block_name = '';
- if ($$str_ref =~ m{ \G (\w+ (?: :\w+)*) \s* (?! [\.\|]) }gcx
- || $$str_ref =~ m{ \G '(|.*?[^\\])' \s* (?! [\.\|]) }gcx
- || $$str_ref =~ m{ \G "(|.*?[^\\])" \s* (?! [\.\|]) }gcx
- ) {
- $block_name = $1;
- ### allow for nested blocks to have nested names
- my @names = map {$_->[3]} grep {$_->[0] eq 'BLOCK'} @{ $self->{'_state'} };
- $block_name = join("/", @names, $block_name) if scalar @names;
- }
+ my $end = $self->{'_end_tag'} || '(?!)';
+ my $block_name = $self->parse_expr($str_ref, {auto_quote => "
+ ($QR_FILENAME # file name
+ | \\w+\\b (?: :\\w+\\b)* ) # or block
+ (?= [+=~-]? $end # an end tag
+ | \\s*[+,;] # followed by explicit + , or ;
+ | \\s+ (?! [\\s=]) # or space not before an =
+ ) \\s* $QR_COMMENTS"});
- return $block_name;
+ return '' if ! defined $block_name;
+
+ my $prepend = join "/", map {$_->[3]} grep {ref($_) && $_->[0] eq 'BLOCK'} @{ $self->{'_state'} || {} };
+ return $prepend ? "$prepend/$block_name" : $block_name;
}
sub play_BLOCK {
### store a named reference - but do nothing until something processes it
$self->{'BLOCKS'}->{$block_name} = {
_tree => $node->[4],
- name => $self->{'_vars'}->{'component'}->{'name'} .'/'. $block_name,
+ name => $self->{'_component'}->{'name'} .'/'. $block_name,
};
return;
sub parse_CATCH {
my ($self, $str_ref) = @_;
- return $self->parse_expr($str_ref, {auto_quote => "(\\w+ (?: \\.\\w+)*) $QR_AQ_SPACE"});
+ return $self->parse_expr($str_ref, {auto_quote => "(\\w+\\b (?: \\.\\w+\\b)*) $QR_AQ_SPACE \\s* $QR_COMMENTS"});
}
sub play_control {
$$out_ref = '';
}
+sub parse_CONFIG {
+ my ($self, $str_ref) = @_;
+
+ my %ctime = map {$_ => 1} @CONFIG_COMPILETIME;
+ my %rtime = map {$_ => 1} @CONFIG_RUNTIME;
+
+ my $config = $self->parse_args($str_ref, {named_at_front => 1, is_parened => 1});
+ my $ref = $config->[0]->[0];
+ for (my $i = 2; $i < @$ref; $i += 2) {
+ my $key = $ref->[$i] = uc $ref->[$i];
+ my $val = $ref->[$i + 1];
+ if ($ctime{$key}) {
+ splice @$ref, $i, 2, (); # remove the options
+ $self->{$key} = $self->play_expr($val);
+ $i -= 2;
+ } elsif (! $rtime{$key}) {
+ $self->throw('parse', "Unknown CONFIG option \"$key\"", undef, pos($$str_ref));
+ }
+ }
+ for (my $i = 1; $i < @$config; $i++) {
+ my $key = $config->[$i] = uc $config->[$i]->[0];
+ if ($ctime{$key}) {
+ $config->[$i] = "CONFIG $key = ".(defined($self->{$key}) ? $self->{$key} : 'undef');
+ } elsif (! $rtime{$key}) {
+ $self->throw('parse', "Unknown CONFIG option \"$key\"", undef, pos($$str_ref));
+ }
+ }
+ return $config;
+}
+
+sub play_CONFIG {
+ my ($self, $config) = @_;
+
+ my %rtime = map {$_ => 1} @CONFIG_RUNTIME;
+
+ ### do runtime config - not many options get these
+ my ($named, @the_rest) = @$config;
+ $named = $self->play_expr($named);
+ @{ $self }{keys %$named} = @{ $named }{keys %$named};
+
+ ### show what current values are
+ return join("\n", map { $rtime{$_} ? ("CONFIG $_ = ".(defined($self->{$_}) ? $self->{$_} : 'undef')) : $_ } @the_rest);
+}
+
sub parse_DEBUG {
my ($self, $str_ref) = @_;
$$str_ref =~ m{ \G ([Oo][Nn] | [Oo][Ff][Ff] | [Ff][Oo][Rr][Mm][Aa][Tt]) \s* }gcx
sub parse_DUMP {
my ($self, $str_ref) = @_;
- my $ref = $self->parse_expr($str_ref);
- return $ref;
+ return $self->parse_args($str_ref, {named_at_front => 1});
}
sub play_DUMP {
- my ($self, $ident, $node) = @_;
- require Data::Dumper;
- local $Data::Dumper::Sortkeys = 1;
+ my ($self, $dump, $node) = @_;
+
+ my $conf = $self->{'DUMP'};
+ return if ! $conf && defined $conf; # DUMP => 0
+ $conf = {} if ref $conf ne 'HASH';
+
+ ### allow for handler override
+ my $handler = $conf->{'handler'};
+ if (! $handler) {
+ require Data::Dumper;
+ my $obj = Data::Dumper->new([]);
+ my $meth;
+ foreach my $prop (keys %$conf) { $obj->$prop($conf->{$prop}) if $prop =~ /^\w+$/ && ($meth = $obj->can($prop)) }
+ my $sort = defined($conf->{'Sortkeys'}) ? $obj->Sortkeys : 1;
+ $obj->Sortkeys(sub { my $h = shift; [grep {$_ !~ $QR_PRIVATE} ($sort ? sort keys %$h : keys %$h)] });
+ $handler = sub { $obj->Values([@_]); $obj->Dump }
+ }
+
+ my ($named, @dump) = @$dump;
+ push @dump, $named if ! $self->is_empty_named_args($named); # add named args back on at end - if there are some
+ $_ = $self->play_expr($_) foreach @dump;
+
+ ### look for the text describing what to dump
my $info = $self->node_info($node);
my $out;
- my $var;
- if ($ident) {
- $out = Data::Dumper::Dumper($self->play_expr($ident));
- $var = $info->{'text'};
- $var =~ s/^[+\-~=]?\s*DUMP\s+//;
- $var =~ s/\s*[+\-~=]?$//;
+ if (@dump) {
+ $out = $handler->(@dump && @dump == 1 ? $dump[0] : \@dump);
+ my $name = $info->{'text'};
+ $name =~ s/^[+=~-]?\s*DUMP\s+//;
+ $name =~ s/\s*[+=~-]?$//;
+ $out =~ s/\$VAR1/$name/;
+ } elsif (defined($conf->{'EntireStash'}) && ! $conf->{'EntireStash'}) {
+ $out = '';
} else {
- my @were_never_here = (qw(template component), grep {$_ =~ $QR_PRIVATE} keys %{ $self->{'_vars'} });
- local @{ $self->{'_vars'} }{ @were_never_here };
- delete @{ $self->{'_vars'} }{ @were_never_here };
- $out = Data::Dumper::Dumper($self->{'_vars'});
- $var = 'EntireStash';
- }
- if ($ENV{'REQUEST_METHOD'}) {
- $out =~ s/</</g;
+ $out = $handler->($self->{'_vars'});
+ $out =~ s/\$VAR1/EntireStash/g;
+ }
+
+ if ($conf->{'html'} || (! defined($conf->{'html'}) && $ENV{'REQUEST_METHOD'})) {
+ $out = $SCALAR_OPS->{'html'}->($out);
$out = "<pre>$out</pre>";
- $out =~ s/\$VAR1/$var/;
- $out = "<b>DUMP: File \"$info->{file}\" line $info->{line}</b>$out";
+ $out = "<b>DUMP: File \"$info->{file}\" line $info->{line}</b>$out" if $conf->{'header'} || ! defined $conf->{'header'};
} else {
- $out =~ s/\$VAR1/$var/;
+ $out = "DUMP: File \"$info->{file}\" line $info->{line}\n $out" if $conf->{'header'} || ! defined $conf->{'header'};
}
return $out;
sub parse_INSERT { $DIRECTIVES->{'PROCESS'}->[0]->(@_) }
sub play_INSERT {
- my ($self, $var, $node, $out_ref) = @_;
- my ($names, $args) = @$var;
+ my ($self, $args, $node, $out_ref) = @_;
- foreach my $name (@$names) {
+ my ($named, @files) = @$args;
+
+ foreach my $name (@files) {
my $filename = $self->play_expr($name);
$$out_ref .= $self->_insert($filename);
}
sub parse_MACRO {
my ($self, $str_ref, $node) = @_;
- my $name = $self->parse_expr($str_ref, {auto_quote => "(\\w+) $QR_AQ_NOTDOT"});
+ my $name = $self->parse_expr($str_ref, {auto_quote => "(\\w+\\b) (?! \\.) \\s* $QR_COMMENTS"});
$self->throw('parse', "Missing macro name", undef, pos($$str_ref)) if ! defined $name;
if (! ref $name) {
$name = [ $name, 0 ];
sub play_META {
my ($self, $hash) = @_;
+
+ my @keys = keys %$hash;
+
my $ref;
if ($self->{'_top_level'}) {
- $ref = $self->{'_vars'}->{'template'} ||= {};
+ $ref = $self->{'_template'} ||= {};
} else {
- $ref = $self->{'_vars'}->{'component'} ||= {};
- }
- foreach my $key (keys %$hash) {
- next if $key eq 'name' || $key eq 'modtime';
- $ref->{$key} = $hash->{$key};
+ $ref = $self->{'_component'} ||= {};
}
+
+ @{ $ref }{ @keys } = @{ $hash }{ @keys };
return;
}
sub parse_PROCESS {
my ($self, $str_ref) = @_;
- my $info = [[], []];
- while (defined(my $filename = $self->parse_expr($str_ref, {
- auto_quote => "($QR_FILENAME | \\w+ (?: :\\w+)* ) $QR_AQ_SPACE",
- }))) {
- push @{$info->[0]}, $filename;
- last if $$str_ref !~ m{ \G \+ \s* $QR_COMMENTS }gcxo;
- }
- ### we can almost use parse_args - except we allow for nested key names (foo.bar) here
- while (1) {
- my $mark = pos $$str_ref;
- if ($$str_ref =~ m{ \G $QR_DIRECTIVE (?: \s+ | (?: \s* $QR_COMMENTS (?: ;|[+=~-]?$self->{'_end_tag'}))) }gcxo) {
- pos($$str_ref) = $mark;
- last if $DIRECTIVES->{$self->{'ANYCASE'} ? uc $1 : $1}; # looks like a directive - we are done
- }
- if ($$str_ref =~ m{ \G [+=~-]? $self->{'_end_tag'} }gcx) {
- pos($$str_ref) = $mark;
- last;
- }
-
- my $var = $self->parse_expr($str_ref);
-
- last if ! defined $var;
- if ($$str_ref !~ m{ \G = >? \s* }gcx) {
- $self->throw('parse.missing.equals', 'Missing equals while parsing args', undef, pos($$str_ref));
- }
-
- my $val = $self->parse_expr($str_ref);
- push @{$info->[1]}, [$var, $val];
- $$str_ref =~ m{ \G , \s* $QR_COMMENTS }gcxo if $val;
- }
-
- return $info;
+ return $self->parse_args($str_ref, {
+ named_at_front => 1,
+ allow_bare_filenames => 1,
+ require_arg => 1,
+ });
}
sub play_PROCESS {
my ($self, $info, $node, $out_ref) = @_;
- my ($files, $args) = @$info;
+ my ($args, @files) = @$info;
### set passed args
- foreach (@$args) {
- my $key = $_->[0];
- my $val = $self->play_expr($_->[1]);
+ # [[undef, '{}', 'key1', 'val1', 'key2', 'val2'], 0]
+ $args = $args->[0];
+ foreach (my $i = 2; $i < @$args; $i+=2) {
+ my $key = $args->[$i];
+ my $val = $self->play_expr($args->[$i+1]);
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});
}
### iterate on any passed block or filename
- foreach my $ref (@$files) {
+ foreach my $ref (@files) {
next if ! defined $ref;
my $filename = $self->play_expr($ref);
my $out = ''; # have temp item to allow clear to correctly clear
### allow for $template which is used in some odd instances
} else {
- $self->throw('process', "Unable to process document $filename") if $ref->[0] ne 'template';
+ my $doc;
+ if ($ref->[0] eq 'template') {
+ $doc = $filename;
+ } else {
+ $doc = $self->play_expr($ref);
+ if (ref($doc) ne 'HASH' || ! $doc->{'_tree'}) {
+ $self->throw('process', "Passed item doesn't appear to be a valid document");
+ }
+ }
$self->throw('process', "Recursion detected in $node->[0] \$template") if $self->{'_process_dollar_template'};
local $self->{'_process_dollar_template'} = 1;
- local $self->{'_vars'}->{'component'} = my $doc = $filename;
+ local $self->{'_component'} = $filename;
return if ! $doc->{'_tree'};
### execute and trim
push @SET, ['=', $set, undef];
}
}
+
return \@SET;
}
sub parse_THROW {
my ($self, $str_ref, $node) = @_;
- my $name = $self->parse_expr($str_ref, {auto_quote => "(\\w+ (?: \\.\\w+)*) $QR_AQ_SPACE"});
+ my $name = $self->parse_expr($str_ref, {auto_quote => "(\\w+\\b (?: \\.\\w+\\b)*) $QR_AQ_SPACE \\s* $QR_COMMENTS"});
$self->throw('parse.missing', "Missing name in THROW", $node, pos($$str_ref)) if ! $name;
- my $args = $self->parse_args($str_ref);
+ my $args = $self->parse_args($str_ref, {named_at_front => 1});
return [$name, $args];
}
sub play_THROW {
my ($self, $ref, $node) = @_;
my ($name, $args) = @$ref;
+
$name = $self->play_expr($name);
+
+ my $named = shift @$args;
+ push @$args, $named if ! $self->is_empty_named_args($named); # add named args back on at end - if there are some
+
my @args = $args ? map { $self->play_expr($_) } @$args : ();
$self->throw($name, \@args, $node);
}
my $var;
my $mark = pos $$str_ref;
- if (defined(my $_var = $self->parse_expr($str_ref, {auto_quote => "(\\w+) $QR_AQ_NOTDOT"}))
+ if (defined(my $_var = $self->parse_expr($str_ref, {auto_quote => "(\\w+\\b) (?! \\.) \\s* $QR_COMMENTS"}))
&& ($$str_ref =~ m{ \G = >? \s* $QR_COMMENTS }gcxo # make sure there is assignment
- || ((pos $$str_ref = $mark) && 0)) # otherwise we need to rollback
+ || ((pos($$str_ref) = $mark) && 0)) # otherwise we need to rollback
) {
$var = $_var;
}
- my $module = $self->parse_expr($str_ref, {auto_quote => "(\\w+ (?: (?:\\.|::) \\w+)*) $QR_AQ_NOTDOT"});
+ my $module = $self->parse_expr($str_ref, {auto_quote => "(\\w+\\b (?: (?:\\.|::) \\w+\\b)*) (?! \\.) \\s* $QR_COMMENTS"});
$self->throw('parse', "Missing plugin name while parsing $$str_ref", undef, pos($$str_ref)) if ! defined $module;
$module =~ s/\./::/g;
my $args;
my $open = $$str_ref =~ m{ \G \( \s* $QR_COMMENTS }gcxo;
- $args = $self->parse_args($str_ref, {is_parened => $open});
+ $args = $self->parse_args($str_ref, {is_parened => $open, named_at_front => 1});
if ($open) {
$$str_ref =~ m{ \G \) \s* $QR_COMMENTS }gcxo || $self->throw('parse.missing', "Missing close ')'", undef, pos($$str_ref));
my @var = map {($_, 0, '.')} split /(?:\.|::)/, $var;
pop @var; # remove the trailing '.'
+ my $named = shift @$args;
+ push @$args, $named if ! $self->is_empty_named_args($named); # add named args back on at end - if there are some
+
### look for a plugin_base
my $BASE = $self->{'PLUGIN_BASE'} || 'Template::Plugin'; # I'm not maintaining plugins - leave that to TT
my $obj;
return;
}
+sub parse_VIEW {
+ my ($self, $str_ref) = @_;
+
+ my $ref = $self->parse_args($str_ref, {
+ named_at_front => 1,
+ require_arg => 1,
+ });
+
+ return $ref;
+}
+#sub parse_VIEW { $DIRECTIVES->{'PROCESS'}->[0]->(@_) }
+
+sub play_VIEW {
+ my ($self, $ref, $node, $out_ref) = @_;
+
+ my ($blocks, $args, $name) = @$ref;
+
+ ### get args ready
+ # [[undef, '{}', 'key1', 'val1', 'key2', 'val2'], 0]
+ $args = $args->[0];
+ my $hash = {};
+ foreach (my $i = 2; $i < @$args; $i+=2) {
+ my $key = $args->[$i];
+ my $val = $self->play_expr($args->[$i+1]);
+ if (ref $key) {
+ if (@$key == 2 && ! ref($key->[0]) && ! $key->[1]) {
+ $key = $key->[0];
+ } else {
+ $self->set_variable($key, $val);
+ next; # what TT does
+ }
+ }
+ $hash->{$key} = $val;
+ }
+
+ ### prepare the blocks
+ my $prefix = $hash->{'prefix'} || (ref($name) && @$name == 2 && ! $name->[1] && ! ref($name->[0])) ? "$name->[0]/" : '';
+ foreach my $key (keys %$blocks) {
+ $blocks->{$key} = {name => "${prefix}${key}", _tree => $blocks->{$key}};
+ }
+ $hash->{'blocks'} = $blocks;
+
+ ### get the view
+ if (! eval { require Template::View }) {
+ $self->throw('view', 'Could not load Template::View library');
+ }
+ my $view = Template::View->new($self->context, $hash)
+ || $self->throw('view', $Template::View::ERROR);
+
+ ### 'play it'
+ my $old_view = $self->play_expr(['view', 0]);
+ $self->set_variable($name, $view);
+ $self->set_variable(['view', 0], $view);
+
+ if ($node->[4]) {
+ my $out = '';
+ $self->execute_tree($node->[4], \$out);
+ # throw away $out
+ }
+
+ $self->set_variable(['view', 0], $old_view);
+ $view->seal;
+
+ return '';
+}
+
+sub parse_WHILE { $DIRECTIVES->{'IF'}->[0]->(@_) }
+
sub play_WHILE {
my ($self, $var, $node, $out_ref) = @_;
return '' if ! defined $var;
return undef;
}
-sub parse_WRAPPER { $DIRECTIVES->{'INCLUDE'}->[0]->(@_) }
+sub parse_WRAPPER { $DIRECTIVES->{'PROCESS'}->[0]->(@_) }
sub play_WRAPPER {
- my ($self, $var, $node, $out_ref) = @_;
+ my ($self, $args, $node, $out_ref) = @_;
my $sub_tree = $node->[4] || return;
- my ($names, $args) = @$var;
+ my ($named, @files) = @$args;
my $out = '';
$self->execute_tree($sub_tree, \$out);
- foreach my $name (reverse @$names) {
+ foreach my $name (reverse @files) {
local $self->{'_vars'}->{'content'} = $out;
$out = '';
- $DIRECTIVES->{'INCLUDE'}->[1]->($self, [[$name], $args], $node, \$out);
+ $DIRECTIVES->{'INCLUDE'}->[1]->($self, [$named, $name], $node, \$out);
}
$$out_ref .= $out;
my $paths = $self->{'INCLUDE_PATHS'} ||= do {
# TT does this everytime a file is looked up - we are going to do it just in time - the first time
- my $paths = $self->{'INCLUDE_PATH'} || $self->throw('file', "INCLUDE_PATH not set");
+ my $paths = $self->{'INCLUDE_PATH'} || [];
$paths = $paths->() if UNIVERSAL::isa($paths, 'CODE');
$paths = $self->split_paths($paths) if ! UNIVERSAL::isa($paths, 'ARRAY');
$paths; # return of the do
my $var2 = $self->{'VARIABLES'} || $self->{'PRE_DEFINE'} || {};
$var1->{'global'} ||= {}; # allow for the "global" namespace - that continues in between processing
my $copy = {%$var2, %$var1, %$swap};
- local $copy->{'template'};
local $self->{'BLOCKS'} = $blocks = {%$blocks}; # localize blocks - but save a copy to possibly restore
my $meta = ($doc->{'_tree'} && ref($doc->{'_tree'}->[0]) && $doc->{'_tree'}->[0]->[0] eq 'META')
? $doc->{'_tree'}->[0]->[3] : {};
- $copy->{'template'} = $doc;
+ local $self->{'_template'} = $doc;
@{ $doc }{keys %$meta} = values %$meta;
### process any other templates
###----------------------------------------------------------------###
sub exception {
- my ($self, $type, $info, $node) = @_;
+ my $self = shift;
+ my $type = shift;
+ my $info = shift;
return $type if ref($type) =~ /Template::Exception$/;
if (ref($info) eq 'ARRAY') {
my $hash = ref($info->[-1]) eq 'HASH' ? pop(@$info) : {};
$type = 'undef';
}
}
- return $PACKAGE_EXCEPTION->new($type, $info, $node);
+ return $PACKAGE_EXCEPTION->new($type, $info, @_);
}
sub throw { die shift->exception(@_) }
sub node_info {
my ($self, $node) = @_;
- my $doc = $self->{'_vars'}->{'component'};
+ my $doc = $self->{'_component'};
my $i = $node->[1];
my $j = $node->[2] || return ''; # META can be 0
$doc->{'_content'} ||= do { my $s = $self->slurp($doc->{'_filename'}) ; \$s };
}
sub get_line_number_by_index {
- my ($self, $doc, $index) = @_;
+ my ($self, $doc, $index, $include_char) = @_;
+ return 1 if $index <= 0;
+
### get the line offsets for the doc
- my $lines = $doc->{'line_offsets'} ||= do {
+ my $lines = $doc->{'_line_offsets'} ||= do {
$doc->{'_content'} ||= do { my $s = $self->slurp($doc->{'_filename'}) ; \$s };
my $i = 0;
my @lines = (0);
}
\@lines;
};
+
### binary search them (this is fast even on big docs)
- return $#$lines + 1 if $index > $lines->[-1];
my ($i, $j) = (0, $#$lines);
- while (1) {
- return $i + 1 if abs($i - $j) <= 1;
- my $k = int(($i + $j) / 2);
- $j = $k if $lines->[$k] >= $index;
- $i = $k if $lines->[$k] <= $index;
+ if ($index > $lines->[-1]) {
+ $i = $j;
+ } else {
+ while (1) {
+ last if abs($i - $j) <= 1;
+ my $k = int(($i + $j) / 2);
+ $j = $k if $lines->[$k] >= $index;
+ $i = $k if $lines->[$k] <= $index;
+ }
}
+ return $include_char ? ($i + 1, $index - $lines->[$i]) : $i + 1;
}
###----------------------------------------------------------------###
return 1;
}
-sub vmethod_as_scalar {
+sub vmethod_fmt_scalar {
my $str = shift; $str = '' if ! defined $str;
my $pat = shift; $pat = '%s' if ! defined $pat;
local $^W;
: sprintf($pat, $str);
}
-sub vmethod_as_list {
+sub vmethod_fmt_list {
my $ref = shift || return '';
my $pat = shift; $pat = '%s' if ! defined $pat;
my $sep = shift; $sep = ' ' if ! defined $sep;
: join($sep, map {sprintf $pat, $_} @$ref);
}
-sub vmethod_as_hash {
+sub vmethod_fmt_hash {
my $ref = shift || return '';
my $pat = shift; $pat = "%s\t%s" if ! defined $pat;
my $sep = shift; $sep = "\n" if ! defined $sep;
: [sort {$a <=> $b} @$list];
}
+sub vmethod_pick {
+ my $ref = shift;
+ no warnings;
+ my $n = int(shift);
+ $n = 1 if $n < 1;
+ my @ind = map { $ref->[ rand @$ref ] } 1 .. $n;
+ return $n == 1 ? $ind[0] : \@ind;
+}
+
sub vmethod_repeat {
my ($str, $n, $join) = @_;
return '' if ! defined $str || ! length $str;
return $str;
}
+sub vmethod_url {
+ my $str = shift;
+ utf8::encode($str) if defined &utf8::encode;
+ $str =~ s/([^;\/?:@&=+\$,A-Za-z0-9\-_.!~*\'()])/sprintf('%%%02X', ord($1))/eg;
+ return $str;
+}
+
sub filter_eval {
my $context = shift;
fallback => 1;
sub new {
- my ($class, $type, $info, $node, $pos, $str_ref) = @_;
- return bless [$type, $info, $node, $pos, $str_ref], $class;
+ my ($class, $type, $info, $node, $pos, $doc) = @_;
+ return bless [$type, $info, $node, $pos, $doc], $class;
}
sub type { shift->[0] }
sub node {
my $self = shift;
- $self->[2] = shift if $#_ == 0;
+ $self->[2] = shift if @_;
$self->[2];
}
-sub offset { shift->[3] || 0 }
+sub offset {
+ my $self = shift;
+ $self->[3] = shift if @_;
+ $self->[3];
+}
sub doc {
my $self = shift;
- $self->[4] = shift if $#_ == 0;
+ $self->[4] = shift if @_;
$self->[4];
}
sub as_string {
my $self = shift;
- my $msg = $self->type .' error - '. $self->info;
- if (my $node = $self->node) {
-# $msg .= " (In tag $node->[0] starting at char ".($node->[1] + $self->offset).")";
- }
if ($self->type =~ /^parse/) {
- $msg .= " (At char ".$self->offset.")";
+ if (my $doc = $self->doc) {
+ my ($line, $char) = CGI::Ex::Template->get_line_number_by_index($doc, $self->offset, 'include_char');
+ return $self->type ." error - $doc->{'name'} line $line char $char: ". $self->info;
+ } else {
+ return $self->type .' error - '. $self->info .' (At char '. $self->offset .')';
+ }
+ } else {
+ return $self->type .' error - '. $self->info;
}
- return $msg;
}
###----------------------------------------------------------------###
sub _template { shift->{'_template'} || die "Missing _template" }
+sub template {
+ my ($self, $name) = @_;
+ return $self->_template->{'BLOCKS'}->{$name} || $self->_template->load_parsed_tree($name);
+}
+
sub config { shift->_template }
sub stash {
sub process {
my $self = shift;
my $ref = shift;
- my $vars = $self->_template->_vars;
+ my $args = shift || {};
+
+ $self->_template->set_variable($_, $args->{$_}) for keys %$args;
+
my $out = '';
- $self->_template->_process($ref, $vars, \$out);
+ $self->_template->_process($ref, $self->_template->_vars, \$out);
return $out;
}
sub include {
my $self = shift;
- my $file = shift;
+ my $ref = shift;
my $args = shift || {};
- $self->_template->set_variable($_, $args->{$_}) for keys %$args;
+ my $t = $self->_template;
+
+ my $swap = $t->{'_vars'};
+ local $t->{'_vars'} = {%$swap};
+
+ $t->set_variable($_, $args->{$_}) for keys %$args;
my $out = ''; # have temp item to allow clear to correctly clear
- eval { $self->_template->_process($file, $self->{'_vars'}, \$out) };
+ eval { $t->_process($ref, $t->_vars, \$out) };
if (my $err = $@) {
die $err if ref($err) !~ /Template::Exception$/ || $err->type !~ /return/;
}
$t->process('my/template.tt', $swap)
|| die $t->error;
- ### Anything in the Template::Toolkit SYNOPSIS would fit here also
+ ### CET uses the same syntax and configuration as Template::Toolkit
=head1 DESCRIPTION
[% color = qw/Red Blue/; FOR [1..4] ; color.${ loop.index % color.size } ; END %]
# = RedBlueRedBlue
+=item You can use regular expression quoting.
+
+ [% "foo".match( /(F\w+)/i ).0 %] # = foo
+
=item Tags can be nested.
[% f = "[% (1 + 2) %]" %][% f|eval %] # = 3
[% "aa" | repeat(2) . length %] # = 4
+=item Added V2PIPE configuration item
+
+Restores the behavior of the pipe operator to be
+compatible with TT2.
+
+With V2PIPE = 1
+
+ [% PROCESS a | repeat(2) %] # = value of block or file a repeated twice
+
+With V2PIPE = 0 (default)
+
+ [% PROCESS a | repeat(2) %] # = process block or file named a ~ a
+
=item Added Virtual Object Namespaces. (TT3)
The Text, List, and Hash types give direct access
[% qw/a b c/.2 %] # = c
+=item Added regex contructor. (TT3)
+
+ [% "FOO".match(/(foo)/i).0 %] # = FOO
+
+ [% a = /(foo)/i; "FOO".match(a).0 %] # = FOO
+
=item Allow for scientific notation. (TT3)
[% a = 1.2e-20 %]
[% DUMP a.a %]
+=item Added CONFIG directive.
+
+ [% CONFIG
+ ANYCASE => 1
+ PRE_CHOMP => '-'
+ %]
+
=item CET does not generate Perl code.
It generates an "opcode" tree. The opcode tree is an arrayref
=item There is no context.
CET provides a context object that mimics the Template::Context
-interface for use by some TT filters, eval perl blocks, and plugins.
+interface for use by some TT filters, eval perl blocks, views,
+and plugins.
=item There is no stash.
CET uses the load_parsed_tree method to get and cache templates.
-=item There is no grammar.
+=item There is no parser/grammar.
-CET has its own built-in recursive regex based grammar system.
+CET has its own built-in recursive regex based parser and grammar system.
-=item There is no VIEW directive.
+CET can actually be substituted in place of the native Template::Parser and
+Template::Grammar in TT by using the Template::Parser::CET module. This
+module uses the output of parse_tree to generate a TT style compiled perl
+document.
=item The DEBUG directive is more limited.
It only understands DEBUG_DIRS (8) and DEBUG_UNDEF (2).
-=item When debug dirs is on, directives on different lines separated by colons show the line they
-are on rather than a general line range.
+=item CET has better line information
+
+When debug dirs is on, directives on different lines separated
+by colons show the line they are on rather than a general line range.
+
+Parse errors actually know what line and character they occured at.
=back
=head1 VARIABLES
-This section discusses how to use variables and expressions in the TT mini-language.
+This section discusses how to use variables and expressions in the TT
+mini-language.
-A variable is the most simple construct to insert into the TT mini language. A variable
-name will look for the matching value inside CGI::Ex::Templates internal stash of variables
-which is essentially a hash reference. This stash is initially populated by either passing
-a hashref as the second argument to the process method, or by setting the "VARIABLES" or
-"PRE_DEFINE" configuration variables.
+A variable is the most simple construct to insert into the TT mini
+language. A variable name will look for the matching value inside
+CGI::Ex::Templates internal stash of variables which is essentially a
+hash reference. This stash is initially populated by either passing a
+hashref as the second argument to the process method, or by setting
+the "VARIABLES" or "PRE_DEFINE" configuration variables.
### some sample variables
my %vars = (
=head2 GETTING VARIABLES
-Once you have variables defined, they can be used directly in the template by using their name
-in the stash. Or by using the GET directive.
+Once you have variables defined, they can be used directly in the
+template by using their name in the stash. Or by using the GET
+directive.
[% foo %]
[% one %]
1.0
bar
-To access members of a hashref or an arrayref, you can chain together the names using a ".".
+To access members of a hashref or an arrayref, you can chain together
+the names using a ".".
[% some_data.a %]
[% my_list.0] [% my_list.1 %] [% my_list.-1 %]
20 21 50
4
-If the value of a variable is a code reference, it will be called. You can add a set of parenthesis
-and arguments to pass arguments. Arguments are variables and can be as complex as necessary.
+If the value of a variable is a code reference, it will be called.
+You can add a set of parenthesis and arguments to pass arguments.
+Arguments are variables and can be as complex as necessary.
[% some_code %]
[% some_code() %]
You passed me (bar).
You passed me (1.0, 2, 3).
-If the value of a variable is an object, methods can be called using the "." operator.
+If the value of a variable is an object, methods can be called using
+the "." operator.
[% cet %]
31
3 | 1 | 4 | 5 | 9
-It is also possible to "interpolate" variable names using a "$". This allows for storing
-the name of a variable inside another variable. If a variable name is a little
-more complex it can be embedded inside of "${" and "}".
+It is also possible to "interpolate" variable names using a "$". This
+allows for storing the name of a variable inside another variable. If
+a variable name is a little more complex it can be embedded inside of
+"${" and "}".
[% $vname %]
[% ${vname} %]
3234
3234
-In CET it is also possible to embed any expression (non-directive) in "${" and "}"
-and it is possible to use non-integers for array access. (This is not available in TT2)
+In CET it is also possible to embed any expression (non-directive) in
+"${" and "}" and it is possible to use non-integers for array access.
+(This is not available in TT2)
[% ['a'..'z'].${ 2.3 } %]
[% {ab => 'AB'}.${ 'a' ~ 'b' } %]
=head2 SETTING VARIABLES.
-To define variables during processing, you can use the = operator. In most cases
-this is the same as using the SET directive.
+To define variables during processing, you can use the = operator. In
+most cases this is the same as using the SET directive.
[% a = 234 %][% a %]
[% SET b = "Hello" %][% b %]
Note: virtual methods can only be used on hash contructs in CET, not in TT.
+=item Regex Constructs.
+
+ [% /foo/ %] Prints (?-xism:foo)
+ [% a = /(foo)/i %][% "FOO".match(a).0 %] Prints FOO
+
+Note: this works in CET and is planned for TT3.
+
=head1 EXPRESSIONS
Expressions are one or more variables or literals joined together with
with the exception of the variable name in the SET directive, and the
filename of PROCESS, INCLUDE, WRAPPER, and INSERT.
-The following section shows some samples of expressions. For a full list
-of available operators, please see the section titled OPERATORS.
+The following section shows some samples of expressions. For a full
+list of available operators, please see the section titled OPERATORS.
[% 1 + 2 %] Prints 3
[% 1 + 2 * 3 %] Prints 7
=head2 SCALAR VIRTUAL METHODS AND FILTERS
-The following is the list of builtin virtual methods and filters
-that can be called on scalar data types. In CET and TT3, filters and
-virtual methods are more closely related than in TT2. In general anywhere a
-virtual method can be used a filter can be used also - and likewise all scalar
-virtual methods can be used as filters.
+The following is the list of builtin virtual methods and filters that
+can be called on scalar data types. In CET and TT3, filters and
+virtual methods are more closely related than in TT2. In general
+anywhere a virtual method can be used a filter can be used also - and
+likewise all scalar virtual methods can be used as filters.
In addition to the filters listed below, CET will automatically load
Template::Filters and use them if Template::Toolkit is installed.
=item '0'
- [% item = 'foo' %][% item.0 %] Returns self. Allows for scalars to mask as arrays (scalars
- already will, but this allows for more direct access).
+ [% item = 'foo' %][% item.0 %] Returns foo.
+
+Allows for scalars to mask as arrays (scalars already will, but this
+allows for more direct access).
=item chunk
[% item.match("(\w+) (\w+)", 1) %] Same as before - but match globally.
+In CGI::Ex::Template and TT3 you can use regular expressions notation as well.
+
+ [% item.match( /(\w+) (\w+)/ ) %] Same as before.
+
+ [% item.match( m{(\w+) (\w+)} ) %] Same as before.
+
=item null
[% item.null %] Do nothing.
[% item.replace("(\w+)", "($1)") %] Surround all words with parenthesis.
+In CGI::Ex::Template and TT3 you may also use normal regular expression notation.
+
+ [% item.replace(/(\w+)/, "($1)") %] Same as before.
+
=item search
[% item.search("(\w+)") %] Tests if the given pattern is in the string.
+In CGI::Ex::Template and TT3 you may also use normal regular expression notation.
+
+ [% item.search(/(\w+)/, "($1)") %] Same as before.
+
=item size
[% item.size %] Always returns 1.
[% item.split("\s+", 3) %] Returns an arrayref from the item split on /\s+/ splitting until 3 elements are found.
+In CGI::Ex::Template and TT3 you may also use normal regular expression notation.
+
+ [% item.split( /\s+/, 3 ) %] Same as before.
+
=item stderr
[% item.stderr %] Print the item to the current STDERR handle.
[% item.uri %] Perform a very basic URI encoding.
+=item url
+
+ [% item.url %] Perform a URI encoding - but some characters such
+ as : and / are left intact.
+
=back
=head2 LIST VIRTUAL METHODS
[% mylist.push(23) %] Adds an element to the end of the arrayref (the stash is modified).
-=item random
+=item pick
- [% mylist.random %] Returns a random item from the list.
- [% ['a' .. 'z'].random %]
+ [% mylist.pick %] Returns a random item from the list.
+ [% ['a' .. 'z'].pick %]
+
+An additional numeric argument is how many items to return.
+
+ [% ['a' .. 'z'].pick(8).join('') %]
Note: This filter is not available as of TT2.15.
[% myhash.delete('a') %] Deletes the item from the hash.
+Unlink Perl the value is not returned. Multiple values may be passed
+and represent the keys to be deleted.
+
=item each
[% myhash.each.join(", ") %] Turns the contents of the hash into a list - subject
or template. This can be useful when used in conjunction with the TRY
statement to clear generated content if an error occurs later.
+=item C<CONFIG>
+
+Allow for changing the value of some compile time and runtime configuration
+options.
+
+ [% CONFIG
+ ANYCASE => 1
+ PRE_CHOMP => '-'
+ %]
+
+The following compile time configuration options may be set:
+
+ ANYCASE
+ INTERPOLATE
+ PRE_CHOMP
+ POST_CHOMP
+ V1DOLLAR
+ V2PIPE
+
+The following runtime configuration options may be set:
+
+ DUMP
+
+If non-named parameters as passed, they will show the current configuration:
+
+ [% CONFIG ANYCASE, PRE_CHOMP %]
+
+ CONFIG ANYCASE = undef
+ CONFIG PRE_CHOMP = undef
+
=item C<DEBUG>
Used to reset the DEBUG_FORMAT configuration variable, or to turn
=item C<DUMP>
-This is not provided in TT. DUMP inserts a Data::Dumper printout
-of the variable or expression. If no argument is passed it will
-dump the entire contents of the current variable stash (with
-private keys removed.
+DUMP inserts a Data::Dumper printout of the variable or expression.
+If no argument is passed it will dump the entire contents of the
+current variable stash (with private keys removed).
+
+The output also includes the current file and line number that the
+DUMP directive was called from.
-If the template is being processed in a web request, DUMP will html
-encode the DUMP automatically.
+See the DUMP configuration item for ways to customize and control
+the output available to the DUMP directive.
[% DUMP %] # dumps everything
Alias for the FILTER directive. Note that | is similar to the
'.' in CGI::Ex::Template. Therefore a pipe cannot be used directly after a
variable name in some situations (the pipe will act only on that variable).
-This is the behavior employed by TT3.
+This is the behavior employed by TT3. To get the TT2 behavior for a PIPE, use
+the V2PIPE configuration item.
=item C<FINAL>
metatext => ['%%', '%%' ], # Text::MetaText
php => ['<\?', '\?>' ], # PHP
star => ['\[\*', '\*\]' ], # TT alternate
+ template => ['\[%', '%\]' ], # Normal Template Toolkit
template1 => ['[\[%]%', '%[%\]]'], # allow TT1 style
+ tt2 => ['\[%', '%\]' ], # TT2
If custom tags are supplied, by default they are escaped using
-quotemeta. If a third argument is given and is equal to "unquoted",
-then no quoting takes place on the new tags.
+quotemeta. You may also pass explicitly quoted strings,
+or regular expressions as arguments as well (if your
+regex begins with a ', ", or / you must quote it.
[% TAGS [<] [>] %] matches "[<] tag [>]"
- [% TAGS [<] [>] unquoted %] matches "< tag >"
+ [% TAGS '[<]' '[>]' %] matches "[<] tag [>]"
+
+ [% TAGS "[<]" "[>]" %] matches "[<] tag [>]"
+
+ [% TAGS /[<]/ /[>]/ %] matches "< tag >"
[% TAGS ** ** %] matches "** tag **"
- [% TAGS ** ** unquoted %] Throws an exception.
+ [% TAGS /**/ /**/ %] Throws an exception.
=item C<THROW>
See the documentation for Template::Manual::Plugins.
+=item C<VIEW>
+
+Implement a TT style view. For more information, please
+see the Template::View documentation. This DIRECTIVE
+will correctly parse the arguments and then pass them
+along to a newly created Template::View object. It
+will fail if Template::View can not be found.
+
=item C<WHILE>
Will process a block of code while a condition is true.
by CGI::Ex::Template to delay the creation of an array until the
execution of the compiled template.
+=item C<qr>
+
+This operator is not used in TT. It is used internally
+by CGI::Ex::Template to store a regular expression and its options.
+It will return a compiled Regexp object when compiled.
+
=back
String to use to split INCLUDE_PATH with. Default is :. It is more
straight forward to just send INCLUDE_PATH an arrayref of paths.
+=item DUMP
+
+Configures the behavior of the DUMP tag. May be set to 0, a hashref,
+or another true value. Default is true.
+
+If set to 0, all DUMP directives will do nothing. This is useful if
+you would like to turn off the DUMP directives under some environments.
+
+IF set to a true value (or undefined) then DUMP directives will operate.
+
+If set to a hashref, the values of the hash can be used to configure
+the operation of the DUMP directives. The following are the values
+that can be set in this hash.
+
+=over 4
+
+=item EntireStash
+
+Default 1. If set to 0, then the DUMP directive will not print the
+entire contents of the stash when a DUMP directive is called without
+arguments.
+
+=item handler
+
+Defaults to an internal coderef. If set to a coderef, the DUMP directive will pass the
+arguments to be dumped and expects a string with the dumped data. This
+gives complete control over the dump process.
+
+Note 1: The default handler makes sure that values matching the
+private variable regex are not included. If you install your own handler,
+you will need to take care of these variables if you intend for them
+to not be shown.
+
+Note 2: If you would like the name of the variable to be dumped, include
+the string '$VAR1' and the DUMP directive will interpolate the value. For
+example, to dump all output as YAML - you could do the following:
+
+ DUMP => {
+ handler => sub {
+ require YAML;
+ return "\$VAR1 =\n".YAML::Dump(shift);
+ },
+ }
+
+=item header
+
+Default 1. Controls whether a header is printed for each DUMP directive.
+The header contains the file and line number the DUMP directive was
+called from. If set to 0 the headers are disabled.
+
+=item html
+
+Defaults to 1 if $ENV{'REQUEST_METHOD'} is set - 0 otherwise. If set to
+1, then the output of the DUMP directive is passed to the html filter
+and encased in "pre" tags. If set to 0 no html encoding takes place.
+
+=item Sortkeys, Useqq, Ident, Pad, etc
+
+Any of the Data::Dumper configuration items may be passed.
+
+=back
+
=item END_TAG
Set a string to use as the closing delimiter for TT. Default is "%]".
"Text: ${foo}" "Text: ${foo}"
"Text: ${$foo}" "Text: ${foo}"
+=item V2PIPE
+
+Restores the behavior of the pipe operator to be compatible with TT2.
+
+With V2PIPE = 1
+
+ [%- BLOCK a %]b is [% b %]
+ [% END %]
+ [%- PROCESS a b => 237 | repeat(2) %]
+
+ # output of block "a" with b set to 237 is passed to the repeat(2) filter
+
+ b is 237
+ b is 237
+
+With V2PIPE = 0 (default)
+
+ [%- BLOCK a %]b is [% b %]
+ [% END %]
+ [% PROCESS a b => 237 | repeat(2) %]
+
+ # b set to 237 repeated twice, and b passed to block "a"
+
+ b is 237237
+
=item VARIABLES
A hashref of variables to initialize the template stash with. These
=head1 VARIABLE PARSE TREE
-CGI::Ex::Template parses templates into an tree of operations. Even
-variable access is parsed into a tree. This is done in a manner
-somewhat similar to the way that TT operates except that nested
-variables such as foo.bar|baz contain the '.' or '|' in between each
-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).
+CGI::Ex::Template parses templates into an tree of operations (an AST
+or abstract syntax tree). Even variable access is parsed into a tree.
+This is done in a manner somewhat similar to the way that TT operates
+except that nested variables such as foo.bar|baz contain the '.' or
+'|' in between each 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_expr method would return).
one.${two().three} [ 'one', 0, '.', ['two', [], '.', 'three', 0], 0]
2.34 2.34
"one" "one"
+ 1 + 2 [ [ undef, '+', 1, 2 ], 0]
+ a + b [ [ undef, '+', ['a', 0], ['b', 0] ], 0 ]
"one"|length [ [ undef, '~', "one" ], 0, '|', 'length', 0 ]
"one $a two" [ [ undef, '~', 'one ', ['a', 0], ' two' ], 0 ]
[0, 1, 2] [ [ undef, '[]', 0, 1, 2 ], 0 ]
{a => 'b'} [ [ undef, '{}', 'a', 'b' ], 0 ]
{a => 'b'}.size [ [ undef, '{}', 'a', 'b' ], 0, '.', 'size', 0 ]
{$a => b} [ [ undef, '{}', ['a', 0], ['b', 0] ], 0 ]
- 1 + 2 [ [ undef, '+', 1, 2 ], 0]
- a + b [ [ undef, '+', ['a', 0], ['b', 0] ], 0 ]
a * (b + c) [ [ undef, '*', ['a', 0], [ [undef, '+', ['b', 0], ['c', 0]], 0 ]], 0 ]
(a + b) [ [ undef, '+', ['a', 0], ['b', 0] ]], 0 ]
(a + b) * c [ [ undef, '*', [ [undef, '+', ['a', 0], ['b', 0] ], 0 ], ['c', 0] ], 0 ]
=item C<filter_*>
-Methods by these names implement filters that are more than one line.
+Methods by these names implement filters that are more complex than one liners.
=item C<get_line_number_by_index>
=item C<vmethod_*>
-Methods by these names implement virtual methods that are more than one line.
+Methods by these names implement virtual methods that are more complex than oneliners.
=back
Paul Seamons <paul at seamons dot com>
+=head1 LICENSE
+
+This module may be distributed under the same terms as Perl itself.
+
=cut
@UNSUPPORTED_BROWSERS
);
-$VERSION = '2.10';
+$VERSION = '2.11';
$DEFAULT_EXT = 'val';
$QR_EXTRA = qr/^(\w+_error|as_(array|string|hash)_\w+|no_\w+)/;
};
use strict;
-use Test::More tests => ! $is_tt ? 740 : 579;
+use Test::More tests => ! $is_tt ? 806 : 599;
use Data::Dumper qw(Dumper);
use constant test_taint => 0 && eval { require Taint::Runtime };
sub process_ok { # process the value and say if it was ok
my $str = shift;
my $test = shift;
- my $vars = shift;
- my $obj = shift || $module->new(@{ $vars->{tt_config} || [] }); # new object each time
+ my $vars = shift || {};
+ my $conf = local $vars->{'tt_config'} = $vars->{'tt_config'} || [];
+ my $obj = shift || $module->new(@$conf); # new object each time
my $out = '';
my $line = (caller)[2];
+ delete $vars->{'tt_config'};
Taint::Runtime::taint(\$str) if test_taint;
$obj->process(\$str, $vars, \$out);
my $ok = ref($test) ? $out =~ $test : $out eq $test;
- ok($ok, "Line $line \"$str\" => \"$out\"" . ($ok ? '' : " - should've been \"$test\""));
- warn "# process_ok called at line $line.\n" if ! $ok;
- print $obj->error if ! $ok && $obj->can('error');
- print Dumper $obj->parse_tree(\$str) if ! $ok && $obj->can('parse_tree');
- exit if ! $ok;
- return $obj;
+ if ($ok) {
+ ok(1, "Line $line \"$str\" => \"$out\"");
+ return $obj;
+ } else {
+ ok(0, "Line $line \"$str\"");
+ warn "# Was:\n$out\n# Should've been:\n$test\n";
+ print $obj->error if $obj->can('error');
+ print Dumper $obj->parse_tree(\$str) if $obj->can('parse_tree');
+ exit;
+ }
}
###----------------------------------------------------------------###
process_ok("[% foo.length %]" => 1, {foo => sub { 7 }});
process_ok("[% foo.0 %]" => 7, {foo => sub { return 7, 2, 3 }});
process_ok("[% foo(bar) %]" => 7, {foo => sub { $_[0] }, bar => 7});
+process_ok("[% foo(bar.baz) %]" => 7,{foo => sub { $_[0] }, bar => {baz => 7}});
process_ok("[% foo.seven %]" => 7, {foo => $obj});
process_ok("[% foo.seven() %]" => 7, {foo => $obj});
process_ok("[% foo.seven.length %]" => 1, {foo => $obj});
process_ok("[% foo.\$name.baz %]" => '', {name => 'bar', bar => {baz => 7}});
process_ok("[% \"hi\" %]" => 'hi');
+process_ok("[% \"hi %]" => '');
process_ok("[% 'hi' %]" => 'hi');
+process_ok("[% 'hi %]" => '');
process_ok("[% \"\$foo\" %]" => '7', {foo => 7});
process_ok("[% \"hi \$foo\" %]" => 'hi 7', {foo => 7});
process_ok("[% \"hi \${foo}\" %]" => 'hi 7', {foo => 7});
process_ok("[% _foo %]2" => '2', {_foo => 1});
process_ok("[% \$bar %]2" => '2', {_foo => 1, bar => '_foo'});
process_ok("[% __foo %]2" => '2', {__foo => 1});
-process_ok("[% _foo = 1 %][% _foo %]2" => '2');
-process_ok("[% foo._bar %]2" => '2', {foo => {_bar =>1}});
process_ok("[% qw/Foo Bar Baz/.0 %]" => 'Foo') if ! $is_tt;
process_ok('[% [0..10].-1 %]' => '10') if ! $is_tt;
process_ok('[% [0..10].${ 2.3 } %]' => '2') if ! $is_tt;
+process_ok("[% (1 + 2)() %]" => ''); # parse error
+process_ok("[% (1 + 2) %]" => '3');
+process_ok("[% (a) %]" => '2', {a => 2});
+process_ok("[% ('foo') %]" => 'foo');
+process_ok("[% (a(2)) %]" => '2', {a => sub { $_[0] }});
+
###----------------------------------------------------------------###
print "### SET ##############################################################\n";
process_ok("[% foo = 1 bar = 2 %][% foo = 3 bar %][% foo %][% bar %]" => '232') if ! $is_tt;
process_ok("[% a = 1 a = a + 2 a %]" => 3) if ! $is_tt;
-###----------------------------------------------------------------###
-print "### reserved words ###################################################\n";
-
-$vars = {
- GET => 'named_get',
- get => 'lower_named_get',
- named_get => 'value of named_get',
- hold_get => 'GET',
-};
-process_ok("[% GET %]" => '', $vars);
-process_ok("[% GET GET %]" => 'named_get', $vars) if ! $is_tt;
-process_ok("[% GET get %]" => 'lower_named_get', $vars);
-process_ok("[% GET \${'GET'} %]" => 'bar', {GET => 'bar'});
+process_ok("[% _foo = 1 %][% _foo %]2" => '2');
+process_ok("[% foo._bar %]2" => '2', {foo => {_bar =>1}});
-process_ok("[% GET = 1 %][% GET GET %]" => '', $vars);
-process_ok("[% SET GET = 1 %][% GET GET %]" => '1', $vars) if ! $is_tt;
+###----------------------------------------------------------------###
+print "### multiple statements in same tag ##################################\n";
-process_ok("[% GET \$hold_get %]" => 'named_get', $vars);
-process_ok("[% GET \$GET %]" => 'value of named_get', $vars) if ! $is_tt;
-process_ok("[% BLOCK GET %]hi[% END %][% PROCESS GET %]" => 'hi') if ! $is_tt;
-process_ok("[% BLOCK foo %]hi[% END %][% PROCESS foo a = GET %]" => 'hi', $vars) if ! $is_tt;
-process_ok("[% BLOCK foo %]hi[% END %][% PROCESS foo GET = 1 %]" => '');
-process_ok("[% BLOCK foo %]hi[% END %][% PROCESS foo IF GET %]" => 'hi', $vars) if ! $is_tt;
+process_ok("[% foo; %]" => '1', {foo => 1});
+process_ok("[% GET foo; %]" => '1', {foo => 1});
+process_ok("[% GET foo; GET foo %]" => '11', {foo => 1});
###----------------------------------------------------------------###
print "### CALL / DEFAULT ###################################################\n";
print "### scalar vmethods ##################################################\n";
process_ok("[% n.0 %]" => '7', {n => 7}) if ! $is_tt;
-process_ok("[% n.as %]" => '7', {n => 7}) if ! $is_tt;
-process_ok("[% n.as('%02d') %]" => '07', {n => 7}) if ! $is_tt;
-process_ok("[% n.as('%0*d', 3) %]" => '007', {n => 7}) if ! $is_tt;
-process_ok("[% n.as('(%s)') %]" => "(a\nb)", {n => "a\nb"}) if ! $is_tt;
process_ok("[% n.chunk(3).join %]" => 'abc def g', {n => 'abcdefg'});
process_ok("[% n.chunk(-3).join %]" => 'a bcd efg', {n => 'abcdefg'});
process_ok("[% n|collapse %]" => "a b", {n => ' a b '}); # TT2 filter
process_ok("[% n.int %]" => "123", {n => "123.234"}) if ! $is_tt;
process_ok("[% n.int %]" => "123", {n => "123gggg"}) if ! $is_tt;
process_ok("[% n.int %]" => "0", {n => "ff123.234"}) if ! $is_tt;
+process_ok("[% n.fmt %]" => '7', {n => 7}) if ! $is_tt;
process_ok("[% n.fmt('%02d') %]" => '07', {n => 7}) if ! $is_tt;
process_ok("[% n.fmt('%0*d', 3) %]" => '007', {n => 7}) if ! $is_tt;
process_ok("[% n.fmt('(%s)') %]" => "(a\nb)", {n => "a\nb"}) if ! $is_tt;
process_ok("[% n|format('%02d') %]" => '07', {n => 7}); # TT2 filter
-process_ok("[% n.format('%0*d', 3) %]" => '007', {n => 7}) if ! $is_tt;
+process_ok("[% n|format('%0*d', 3) %]" => '007', {n => 7}) if ! $is_tt;
process_ok("[% n|format('(%s)') %]" => "(a)\n(b)", {n => "a\nb"}); # TT2 filter
process_ok("[% n.hash.items.1 %]" => "b", {n => {a => "b"}});
process_ok("[% n|html %]" => "&", {n => '&'}); # TT2 filter
###----------------------------------------------------------------###
print "### list vmethods ####################################################\n";
-process_ok("[% a.as %]" => '2 3', {a => [2,3]}) if ! $is_tt;
-process_ok("[% a.as('%02d') %]" => '02 03', {a => [2,3]}) if ! $is_tt;
-process_ok("[% a.as('%02d',' ') %]" => '02 03', {a => [2,3]}) if ! $is_tt;
-process_ok("[% a.as('%02d','|') %]" => '02|03', {a => [2,3]}) if ! $is_tt;
-process_ok("[% a.as('%0*d','|', 3) %]" => '002|003', {a => [2,3]}) if ! $is_tt;
process_ok("[% a.defined %]" => '1', {a => [2,3]});
process_ok("[% a.defined(1) %]" => '1', {a => [2,3]});
process_ok("[% a.defined(3) %]" => '', {a => [2,3]});
process_ok("[% a.first %]" => '2', {a => [2..10]});
process_ok("[% a.first(3).join %]" => '2 3 4', {a => [2..10]});
+process_ok("[% a.fmt %]" => '2 3', {a => [2,3]}) if ! $is_tt;
+process_ok("[% a.fmt('%02d') %]" => '02 03', {a => [2,3]}) if ! $is_tt;
process_ok("[% a.fmt('%02d',' ') %]" => '02 03', {a => [2,3]}) if ! $is_tt;
process_ok("[% a.fmt('%02d','|') %]" => '02|03', {a => [2,3]}) if ! $is_tt;
process_ok("[% a.fmt('%0*d','|', 3) %]" => '002|003', {a => [2,3]}) if ! $is_tt;
process_ok("[% a.nsort('b').0.b %]" => '7', {a => [{b => 23}, {b => 7}]});
process_ok("[% a.pop %][% a.join %]" => '32', {a => [2, 3]});
process_ok("[% a.push(3) %][% a.join %]" => '2 3 3', {a => [2, 3]});
-process_ok("[% a.random %]" => qr{ ^\d$ }x, {a => [2, 3]}) if ! $is_tt;
+process_ok("[% a.pick %]" => qr{ ^[23]$ }x, {a => [2, 3]}) if ! $is_tt;
+process_ok("[% a.pick(5).join('') %]" => qr{ ^[23]{5}$ }x, {a => [2, 3]}) if ! $is_tt;
process_ok("[% a.reverse.join %]" => '3 2', {a => [2, 3]});
process_ok("[% a.shift %][% a.join %]" => '23', {a => [2, 3]});
process_ok("[% a.size %]" => '2', {a => [2, 3]});
###----------------------------------------------------------------###
print "### hash vmethods ####################################################\n";
-process_ok("[% h.as %]" => "b\tB\nc\tC", {h => {b => "B", c => "C"}}) if ! $is_tt;
-process_ok("[% h.as('%s => %s') %]" => "b => B\nc => C", {h => {b => "B", c => "C"}}) if ! $is_tt;
-process_ok("[% h.as('%s => %s', '|') %]" => "b => B|c => C", {h => {b => "B", c => "C"}}) if ! $is_tt;
-process_ok("[% h.as('%*s=>%s', '|', 3) %]" => " b=>B| c=>C", {h => {b => "B", c => "C"}}) if ! $is_tt;
-process_ok("[% h.as('%*s=>%*s', '|', 3, 4) %]" => " b=> B| c=> C", {h => {b => "B", c => "C"}}) if ! $is_tt;
process_ok("[% h.defined %]" => "1", {h => {}});
process_ok("[% h.defined('a') %]" => "1", {h => {a => 1}});
process_ok("[% h.defined('b') %]" => "", {h => {a => 1}});
process_ok("[% h.defined('a') %]" => "", {h => {a => undef}});
-process_ok("[% h.delete('a') %]|[% h.keys.0 %]" => "1|b", {h => {a => 1, b=> 2}}) if ! $is_tt;
-process_ok("[% h.delete('a') %]|[% h.keys.0 %]" => "|b", {h => {a => 1, b=> 2}}) if $is_tt;
-process_ok("[% h.delete('a', 'b').join %]|[% h.keys.0 %]" => "1 2|", {h => {a => 1, b=> 2}}) if ! $is_tt;
-process_ok("[% h.delete('a', 'b').join %]|[% h.keys.0 %]" => "|", {h => {a => 1, b=> 2}}) if $is_tt;
-process_ok("[% h.delete('a', 'c').join %]|[% h.keys.0 %]" => "1 |b", {h => {a => 1, b=> 2}}) if ! $is_tt;
-process_ok("[% h.delete('a', 'c').join %]|[% h.keys.0 %]" => "|b", {h => {a => 1, b=> 2}}) if $is_tt;
+process_ok("[% h.delete('a') %]|[% h.keys.0 %]" => "|b", {h => {a => 1, b=> 2}});
+process_ok("[% h.delete('a', 'b').join %]|[% h.keys.0 %]" => "|", {h => {a => 1, b=> 2}});
+process_ok("[% h.delete('a', 'c').join %]|[% h.keys.0 %]" => "|b", {h => {a => 1, b=> 2}});
process_ok("[% h.each.sort.join %]" => "1 2 a b", {h => {a => 1, b=> 2}});
process_ok("[% h.exists('a') %]" => "1", {h => {a => 1}});
process_ok("[% h.exists('b') %]" => "", {h => {a => 1}});
process_ok("[% h.exists('a') %]" => "1", {h => {a => undef}});
+process_ok("[% h.fmt %]" => "b\tB\nc\tC", {h => {b => "B", c => "C"}}) if ! $is_tt;
process_ok("[% h.fmt('%s => %s') %]" => "b => B\nc => C", {h => {b => "B", c => "C"}}) if ! $is_tt;
process_ok("[% h.fmt('%s => %s', '|') %]" => "b => B|c => C", {h => {b => "B", c => "C"}}) if ! $is_tt;
process_ok("[% h.fmt('%*s=>%s', '|', 3) %]" => " b=>B| c=>C", {h => {b => "B", c => "C"}}) if ! $is_tt;
process_ok('[% "hi" FILTER foo %]' => 'hihi', {tt_config => [FILTERS => {foo => [sub {$_[0]x2},0]}]});
process_ok('[% "hi" FILTER foo(2) %]' => 'hihi', {tt_config => [FILTERS => {foo => [sub {my$a=$_[1];sub{$_[0]x$a}},1]}]});
-process_ok('[% ["a".."z"].random %]' => qr/^[a-z]/) if ! $is_tt;
-process_ok('[% ["a".."z"].${ 26.rand } %]' => qr/^[a-z]/) if ! $is_tt;
+process_ok('[% ["a".."z"].pick %]' => qr/^[a-z]/) if ! $is_tt;
process_ok("[% ' ' | uri %]" => '%20');
process_ok('[% {a => "B", c => "D"}.fmt("%s:%s") %]' => "a:B\nc:D") if ! $is_tt;
process_ok('[% {a => "B", c => "D"}.fmt("%s:%s", "; ") %]' => "a:B; c:D") if ! $is_tt;
-process_ok('[% 1.format("%s") %]' => '1') if ! $is_tt;
-process_ok('[% 1.format("%*s", 6) %]' => ' 1') if ! $is_tt;
-process_ok('[% 1.format("%-*s", 6) %]' => '1 ') if ! $is_tt;
+process_ok('[% 1|format("%s") %]' => '1') if ! $is_tt;
+process_ok('[% 1|format("%*s", 6) %]' => ' 1') if ! $is_tt;
+process_ok('[% 1|format("%-*s", 6) %]' => '1 ') if ! $is_tt;
process_ok('[% 1.fmt("%-*s", 6) %]' => '1 ') if ! $is_tt;
process_ok('[% [1,2].fmt("%-*s", "|", 6) %]' => '1 |2 ') if ! $is_tt;
process_ok(" \n[%- foo %]" => " ") if ! $is_tt;
process_ok(" \n \n[%- foo %]" => " \n ") if ! $is_tt;
-process_ok("[% foo %] " => ' ');
-process_ok("[% foo -%] " => ' ');
-process_ok("[% foo -%]\n" => '');
-process_ok("[% foo -%] \n" => '');
-process_ok("[% foo -%]\n " => ' ');
-process_ok("[% foo -%]\n\n\n" => "\n\n");
-process_ok("[% foo -%] \n " => ' ');
+process_ok("[% 7 %] " => '7 ');
+process_ok("[% 7 -%] " => '7 ');
+process_ok("[% 7 -%]\n" => '7');
+process_ok("[% 7 -%] \n" => '7');
+process_ok("[% 7 -%]\n " => '7 ');
+process_ok("[% 7 -%]\n\n\n" => "7\n\n");
+process_ok("[% 7 -%] \n " => '7 ');
###----------------------------------------------------------------###
print "### string operators #################################################\n";
process_ok("[% 0 ? 1 ? 1 + 2 * 3 : 1 + 2 * 4 : 1 + 2 * 5 %]" => '11');
+###----------------------------------------------------------------###
+print "### regex ############################################################\n";
+
+process_ok("[% /foo/ %]" => '(?-xism:foo)') if ! $is_tt;
+process_ok("[% /foo %]" => '') if ! $is_tt;
+process_ok("[% /foo/x %]" => '(?-xism:(?x:foo))') if ! $is_tt;
+process_ok("[% /foo/xi %]" => '(?-xism:(?xi:foo))') if ! $is_tt;
+process_ok("[% /foo/xis %]" => '(?-xism:(?xis:foo))') if ! $is_tt;
+process_ok("[% /foo/xism %]" => '(?-xism:(?xism:foo))') if ! $is_tt;
+process_ok("[% /foo/e %]" => '') if ! $is_tt;
+process_ok("[% /foo/g %]" => '') if ! $is_tt;
+process_ok("[% /foo %]" => '') if ! $is_tt;
+process_ok("[% /foo**/ %]" => '') if ! $is_tt;
+process_ok("[% /fo\\/o/ %]" => '(?-xism:fo/o)') if ! $is_tt;
+process_ok("[% 'foobar'.match(/(f\\w\\w)/).0 %]" => 'foo') if ! $is_tt;
+
###----------------------------------------------------------------###
print "### BLOCK / PROCESS / INCLUDE#########################################\n";
-process_ok("[% PROCESS foo %]" => '');
-process_ok("[% BLOCK foo %]" => '');
-process_ok("[% BLOCK foo %][% END %]" => '');
+process_ok("[% PROCESS foo %]one" => '');
+process_ok("[% BLOCK foo %]one" => '');
+process_ok("[% BLOCK foo %][% END %]one" => 'one');
process_ok("[% BLOCK %][% END %]one" => 'one');
-process_ok("[% BLOCK foo %]hi there[% END %]" => '');
+process_ok("[% BLOCK foo %]hi there[% END %]one" => 'one');
process_ok("[% BLOCK foo %][% BLOCK foo %][% END %][% END %]" => '');
process_ok("[% BLOCK foo %]hi there[% END %][% PROCESS foo %]" => 'hi there');
process_ok("[% PROCESS foo %][% BLOCK foo %]hi there[% END %]" => 'hi there');
+process_ok("[% BLOCK foo %]hi there[% END %][% PROCESS foo foo %]" => 'hi therehi there') if ! $is_tt;
+process_ok("[% BLOCK foo %]hi there[% END %][% PROCESS foo, foo %]" => 'hi therehi there') if ! $is_tt;
+process_ok("[% BLOCK foo %]hi there[% END %][% PROCESS foo + foo %]" => 'hi therehi there');
process_ok("[% BLOCK foo %]hi [% one %] there[% END %][% PROCESS foo %]" => 'hi ONE there', {one => 'ONE'});
process_ok("[% BLOCK foo %]hi [% IF 1 %]Yes[% END %] there[% END %]<<[% PROCESS foo %]>>" => '<<hi Yes there>>');
process_ok("[% BLOCK foo %]hi [% one %] there[% END %][% PROCESS foo one = 'two' %]" => 'hi two there');
process_ok("[% BLOCK foo %]hi [% one.two %] there[% END %][% PROCESS foo one.two = 'two' %]" => 'hi two there');
process_ok("[% BLOCK foo %]hi [% one.two %] there[% END %][% PROCESS foo + foo one.two = 'two' %]" => 'hi two there'x2);
+process_ok("[% BLOCK foo %][% BLOCK bar %]hi [% one %] there[% END %][% END %][% PROCESS foo/bar one => 'two' %]" => 'hi two there');
process_ok("[% BLOCK foo %]hi [% one %] there[% END %][% PROCESS foo one = 'two' %][% one %]" => 'hi two theretwo');
process_ok("[% BLOCK foo %]hi [% one %] there[% END %][% INCLUDE foo one = 'two' %][% one %]" => 'hi two there');
process_ok("[%# BLOCK one %]two" => 'two');
process_ok("[%# BLOCK one %]two[% END %]" => '');
process_ok("[%# BLOCK one %]two[% END %]three" => '');
+process_ok("[%
+#
+-%]
+foo" => "foo");
###----------------------------------------------------------------###
print "### FOREACH / NEXT / LAST ############################################\n";
process_ok("[% FOREACH i = [1..3] %][% loop.size %][% END %][% loop.size %]" => '333') if ! $is_tt;
process_ok("[% FOREACH i = [1..3] %][% loop.size %][% END %][% loop.size %]" => '3331') if $is_tt;
+process_ok('[% FOREACH f = [1..3]; 1; END %]' => '111');
+process_ok('[% FOREACH f = [1..3]; f; END %]' => '123');
+process_ok('[% FOREACH f = [1..3]; "$f"; END %]' => '123');
+process_ok('[% FOREACH f = [1..3]; f + 1; END %]' => '234');
+
###----------------------------------------------------------------###
print "### WHILE ############################################################\n";
process_ok("[% FOREACH f = [1..3] %][% f %][% IF loop.last %][% CLEAR %][% END %][% END %]" => '');
process_ok("[% FOREACH f = [1..3] %][% IF loop.last %][% CLEAR %][% END %][% f %][% END %]" => '3');
-###----------------------------------------------------------------###
-print "### multiple statements in same tag ##################################\n";
-
-process_ok("[% GET foo; GET foo %]" => '11', {foo => 1});
-process_ok('[% FOREACH f = [1..3]; 1; END %]' => '111');
-process_ok('[% FOREACH f = [1..3]; f; END %]' => '123');
-process_ok('[% FOREACH f = [1..3]; "$f"; END %]' => '123');
-process_ok('[% FOREACH f = [1..3]; f + 1; END %]' => '234');
-
###----------------------------------------------------------------###
print "### post opererative directives ######################################\n";
process_ok("[% TAGS metatext %]%% 1 + 2 %%" => 3);
process_ok("[% TAGS php %]<? 1 + 2 ?>" => 3);
process_ok("[% TAGS star %][* 1 + 2 *]" => 3);
+process_ok("[% TAGS template %][% 1 + 2 %]" => 3);
process_ok("[% TAGS template1 %][% 1 + 2 %]" => 3);
process_ok("[% TAGS template1 %]%% 1 + 2 %%" => 3);
+process_ok("[% TAGS tt2 %][% 1 + 2 %]" => 3);
process_ok("[% TAGS html %] <!--- 1 + 2 -->" => '3');
process_ok("[% TAGS html %]<!-- 1 + 2 --->" => '3') if ! $is_tt;
process_ok("[% TAGS <!-- --> %]<!-- 1 + 2 -->" => '3');
process_ok("[% TAGS [<] [>] %][<] 1 + 2 [>]" => 3);
-process_ok("[% TAGS [<] [>] unquoted %]< 1 + 2 >" => 3) if ! $is_tt;
+process_ok("[% TAGS '[<]' '[>]' %][<] 1 + 2 [>]" => 3) if ! $is_tt;
+process_ok("[% TAGS /[<]/ /[>]/ %]< 1 + 2 >" => 3) if ! $is_tt;
process_ok("[% TAGS ** ** %]** 1 + 2 **" => 3);
-process_ok("[% TAGS ** ** quoted %]** 1 + 2 **" => 3);
-process_ok("[% TAGS ** ** unquoted %]** 1 + 2 **" => "") if ! $is_tt;
+process_ok("[% TAGS '**' '**' %]** 1 + 2 **" => 3) if ! $is_tt;
+process_ok("[% TAGS /**/ /**/ %]** 1 + 2 **" => "") if ! $is_tt;
+
+process_ok("[% TAGS html --><!-- 1 + 2 -->" => '3') if ! $is_tt;
+process_ok("[% TAGS html ; 7 --><!-- 1 + 2 -->" => '73') if ! $is_tt;
+process_ok("[% TAGS html ; 7 %]<!-- 1 + 2 -->" => '') if ! $is_tt; # error - the old closing tag must come next
###----------------------------------------------------------------###
print "### SWITCH / CASE ####################################################\n";
process_ok('[% constants.a %]|[% $constants.a %]|[% constants.$a %]' => 'A|A|A', {tt_config => [V1DOLLAR => 1, CONSTANTS => {a => 'A'}]});
+###----------------------------------------------------------------###
+print "### V2PIPE ###########################################################\n";
+
+process_ok("[%- BLOCK a %]b is [% b %]
+[% END %]
+[%- PROCESS a b => 237 | repeat(2) %]" => "b is 237
+b is 237\n", {tt_config => [V2PIPE => 1]});
+
+process_ok("[%- BLOCK a %]b is [% b %]
+[% END %]
+[%- PROCESS a b => 237 | repeat(2) %]" => "b is 237237\n") if ! $is_tt;
+
###----------------------------------------------------------------###
print "### configuration ####################################################\n";
process_ok("[% template.name %]" => 'input text');
process_ok("[% META foo = 'bar' %][% template.foo %]" => 'bar');
+process_ok("[% META name = 'bar' %][% template.name %]" => 'bar');
process_ok("[% META foo = 'bar' %][% component.foo %]" => 'bar');
+process_ok("[% META foo = 'bar' %][% component = '' %][% component.foo %]|foo" => '|foo');
+process_ok("[% META foo = 'bar' %][% template = '' %][% template.foo %]|foo" => '|foo');
###----------------------------------------------------------------###
print "### references #######################################################\n";
process_ok('[% a = "ab" ; f = "abcd"; foo = \f.replace(a, "-AB-") ; f = "ab"; foo %]' => '-AB-cd');
process_ok('[% a = "ab" ; f = "abcd"; foo = \f.replace(a, "-AB-").replace("-AB-", "*") ; f = "ab"; foo %]' => '*cd');
+###----------------------------------------------------------------###
+print "### reserved words ###################################################\n";
+
+$vars = {
+ GET => 'named_get',
+ get => 'lower_named_get',
+ named_get => 'value of named_get',
+ hold_get => 'GET',
+};
+process_ok("[% GET %]" => '', $vars);
+process_ok("[% GET GET %]" => 'named_get', $vars) if ! $is_tt;
+process_ok("[% GET get %]" => 'lower_named_get', $vars);
+process_ok("[% GET \${'GET'} %]" => 'bar', {GET => 'bar'});
+
+process_ok("[% GET = 1 %][% GET GET %]" => '', $vars);
+process_ok("[% SET GET = 1 %][% GET GET %]" => '1', $vars) if ! $is_tt;
+
+process_ok("[% GET \$hold_get %]" => 'named_get', $vars);
+process_ok("[% GET \$GET %]" => 'value of named_get', $vars) if ! $is_tt;
+process_ok("[% BLOCK GET %]hi[% END %][% PROCESS GET %]" => 'hi') if ! $is_tt;
+process_ok("[% BLOCK foo %]hi[% END %][% PROCESS foo a = GET %]" => 'hi', $vars) if ! $is_tt;
+process_ok("[% BLOCK foo %]hi[% END %][% PROCESS foo GET = 1 %]" => '');
+process_ok("[% BLOCK foo %]hi[% END %][% PROCESS foo IF GET %]" => 'hi', $vars) if ! $is_tt;
+
###----------------------------------------------------------------###
print "### embedded items ###################################################\n";
process_ok('[% " \t " %]' => " \t ");
process_ok('[% " \r " %]' => " \r ");
+process_ok("[% 'foo\\'bar' %]" => "foo'bar");
+process_ok('[% "foo\\"bar" %]' => 'foo"bar');
+process_ok('[% qw(foo \)).1 %]' => ')') if ! $is_tt;
+process_ok('[% qw|foo \||.1 %]' => '|') if ! $is_tt;
+
process_ok("[% ' \\' ' %]" => " ' ");
process_ok("[% ' \\r ' %]" => ' \r ');
process_ok("[% ' \\n ' %]" => ' \n ');
process_ok('[% f = ">[% TRY; f.eval ; CATCH; \'caught\' ; END %]"; f.eval %]' => '>>>>>caught', {tt_config => [MAX_EVAL_RECURSE => 5]}) if ! $is_tt;
process_ok('[% f = ">[% TRY; f.eval ; CATCH; \'foo\' ; END %]"; f.eval;f.eval %]' => '>>foo>>foo', {tt_config => [MAX_EVAL_RECURSE => 2]}) if ! $is_tt;
+###----------------------------------------------------------------###
+print "### DUMP #############################################################\n";
+
+if (! $is_tt) {
+local $ENV{'REQUEST_METHOD'} = 0;
+process_ok("[% DUMP a %]" => "DUMP: File \"input text\" line 1\n a = undef;\n");
+process_ok("[% p = DUMP a; p.collapse %]" => 'DUMP: File "input text" line 1 a = undef;');
+process_ok("[% p = DUMP a; p.collapse %]" => 'DUMP: File "input text" line 1 a = \'s\';', {a => "s"});
+process_ok("[%\n p = DUMP a; p.collapse %]" => 'DUMP: File "input text" line 2 a = \'s\';', {a => "s"});
+process_ok("[% p = DUMP a, b; p.collapse %]" => 'DUMP: File "input text" line 1 a, b = [ \'s\', undef ];', {a => "s"});
+process_ok("[% p = DUMP a Useqq => 'b'; p.collapse %]" => 'DUMP: File "input text" line 1 a Useqq => \'b\' = [ \'s\', { \'Useqq\' => \'b\' } ];', {a => "s"});
+process_ok("[% p = DUMP a; p.collapse %]" => 'DUMP: File "input text" line 1 a = "s";', {a => "s", tt_config => [DUMP => {Useqq => 1}]});
+process_ok("[% p = DUMP a; p.collapse %]|foo" => '|foo', {a => "s", tt_config => [DUMP => 0]});
+process_ok("[% p = DUMP _a, b; p.collapse %]" => 'DUMP: File "input text" line 1 _a, b = [ undef, \'c\' ];', {_a => "s", b=> "c"});
+process_ok("[% p = DUMP {a => 'b'}; p.collapse %]" => 'DUMP: File "input text" line 1 {a => \'b\'} = { \'a\' => \'b\' };');
+process_ok("[% p = DUMP _a; p.collapse %]" => 'DUMP: File "input text" line 1 _a = undef;', {_a => "s"});
+process_ok("[% p = DUMP a; p.collapse %]" => 'DUMP: File "input text" line 1 a = { \'b\' => \'c\' };', {a => {b => 'c'}});
+process_ok("[% p = DUMP a; p.collapse %]" => 'DUMP: File "input text" line 1 a = {};', {a => {_b => 'c'}});
+process_ok("[% p = DUMP a; p.collapse %]" => 'DUMP: File "input text" line 1 a = {};', {a => {_b => 'c'}, tt_config => [DUMP => {Sortkeys => 1}]});
+process_ok("[% p = DUMP a; p.collapse %]" => 'DUMP: File "input text" line 1 Dump(7)', {a => 7, tt_config => [DUMP => {handler=>sub {"Dump(@_)"}}]});
+process_ok("[% p = DUMP a; p.collapse %]" => 'a = \'s\';', {a => "s", tt_config => [DUMP => {header => 0}]});
+process_ok("[% p = DUMP a; p.collapse %]" => '<pre>a = 's'; </pre>', {a => "s", tt_config => [DUMP => {header => 0, html => 1}]});
+local $ENV{'REQUEST_METHOD'} = 1;
+process_ok("[% p = DUMP a; p.collapse %]" => '<pre>a = 's'; </pre>', {a => "s", tt_config => [DUMP => {header => 0}]});
+process_ok("[% p = DUMP a; p.collapse %]" => 'a = \'s\';', {a => "s", tt_config => [DUMP => {header => 0, html => 0}]});
+local $ENV{'REQUEST_METHOD'} = 0;
+process_ok("[% SET global; p = DUMP; p.collapse %]" => "DUMP: File \"input text\" line 1 EntireStash = { 'a' => 'b', 'global' => '' };", {a => 'b', tt_config => [DUMP => {Sortkeys => 1}]});
+process_ok("[% SET global; p = DUMP; p.collapse %]" => "DUMP: File \"input text\" line 1 EntireStash = { 'a' => 'b', 'global' => '' };", {a => 'b', tt_config => [DUMP => {Sortkeys => 1, EntireStash => 1}]});
+process_ok("[% SET global; p = DUMP; p.collapse %]" => "DUMP: File \"input text\" line 1", {a => 'b', tt_config => [DUMP => {Sortkeys => 1, EntireStash => 0}]});
+}
+
+###----------------------------------------------------------------###
+print "### CONFIG ############################################################\n";
+
+if (! $is_tt) {
+process_ok("[% CONFIG ANYCASE => 1 %][% get 234 %]" => 234);
+process_ok("[% CONFIG anycase => 1 %][% get 234 %]" => 234);
+process_ok("[% CONFIG PRE_CHOMP => '-' %]\n[% 234 %]" => 234);
+process_ok("[% CONFIG POST_CHOMP => '-' %][% 234 %]\n" => 234);
+process_ok("[% CONFIG INTERPOLATE => '-' %]\${ 234 }" => 234);
+process_ok("[% CONFIG V1DOLLAR => 1 %][% a = 234 %][% \$a %]" => 234);
+process_ok("[% CONFIG V2PIPE => 1 %][% BLOCK a %]b is [% b %][% END %][% PROCESS a b => 234 | repeat(2) %]" => "b is 234b is 234");
+
+process_ok("[% CONFIG BOGUS => 2 %]bar" => '');
+
+process_ok("[% CONFIG ANYCASE %]|[% CONFIG ANYCASE => 1 %][% CONFIG ANYCASE %]" => 'CONFIG ANYCASE = undef|CONFIG ANYCASE = 1');
+process_ok("[% CONFIG ANYCASE %]|[% CONFIG ANYCASE => 1 %][% CONFIG ANYCASE %]" => 'CONFIG ANYCASE = undef|CONFIG ANYCASE = 1');
+
+process_ok("[% CONFIG DUMP %]|[% CONFIG DUMP => 0 %][% DUMP %]bar" => 'CONFIG DUMP = undef|bar');
+process_ok("[% CONFIG DUMP => {Useqq=>1, header=>0, html=>0} %][% DUMP 'foo' %]" => "'foo' = \"foo\";\n");
+}
+
###----------------------------------------------------------------###
print "### DONE #############################################################\n";
ok(-d $test_dir, "Got a test dir up and running");
-sub process_ok { # process the value
+sub process_ok { # process the value and say if it was ok
my $str = shift;
my $test = shift;
- my $args = shift;
+ my $vars = shift || {};
+ my $conf = local $vars->{'tt_config'} = $vars->{'tt_config'} || [];
+ my $obj = shift || $module->new(@$conf, ABSOLUTE => 1, INCLUDE_PATH => $test_dir); # new object each time
my $out = '';
+ my $line = (caller)[2];
+ delete $vars->{'tt_config'};
Taint::Runtime::taint(\$str) if test_taint;
- my $obj = $module->new(ABSOLUTE => 1, INCLUDE_PATH => $test_dir);
- $obj->process(\$str, $args, \$out);
- my $ok = $out eq $test;
- ok($ok, "\"$str\" => \"$out\"" . ($ok ? '' : " - should've been \"$test\""));
- my $line = (caller)[2];
- warn "# process_ok called at line $line.\n" if ! $ok;
+ $obj->process(\$str, $vars, \$out);
+ my $ok = ref($test) ? $out =~ $test : $out eq $test;
+ if ($ok) {
+ ok(1, "Line $line \"$str\" => \"$out\"");
+ return $obj;
+ } else {
+ ok(0, "Line $line \"$str\"");
+ warn "# Was:\n$out\n# Should've been:\n$test\n";
+ print $obj->error if $obj->can('error');
+ print Dumper $obj->parse_tree(\$str) if $obj->can('parse_tree');
+ exit;
+ }
}
### create some files to include
--- /dev/null
+# -*- Mode: Perl; -*-
+
+=head1 NAME
+
+7_template_02_view.t - Test the ability to handle views in CGI::Ex::Template
+
+=cut
+
+#============================================================= -*-perl-*-
+#
+# The tests used here where originally written by Andy Wardley
+# They have been modified to work with this testing framework
+# The following is the original Copyright notice included with
+# the t/view.t document that these tests were taken from.
+#
+# Tests the 'View' plugin.
+#
+# Written by Andy Wardley <abw@kfs.org>
+#
+# Copyright (C) 2000 Andy Wardley. All Rights Reserved.
+#
+# This is free software; you can redistribute it and/or modify it
+# under the same terms as Perl itself.
+#
+# Id: view.t 131 2001-06-14 13:20:12Z abw
+#
+#========================================================================
+
+use vars qw($module $is_tt);
+BEGIN {
+ $module = 'CGI::Ex::Template'; #real 0m0.885s #user 0m0.432s #sys 0m0.004s
+# $module = 'Template'; #real 0m2.133s #user 0m1.108s #sys 0m0.024s
+ $is_tt = $module eq 'Template';
+};
+
+use strict;
+use Test::More tests => ! $is_tt ? 53 : 53;
+use Data::Dumper qw(Dumper);
+
+use_ok($module);
+
+my $skipped;
+SKIP: {
+ if (! eval { require Template::View }) {
+ $skipped = 1;
+ skip("Template::View is not installed - skipping VIEW tests", 52);
+ }
+};
+exit if $skipped;
+
+
+sub process_ok { # process the value and say if it was ok
+ my $str = shift;
+ my $test = shift;
+ my $vars = shift || {};
+ my $conf = local $vars->{'tt_config'} = $vars->{'tt_config'} || [];
+ my $obj = shift || $module->new(@$conf); # new object each time
+ my $out = '';
+ my $line = (caller)[2];
+ delete $vars->{'tt_config'};
+
+ $obj->process(\$str, $vars, \$out);
+ my $ok = ref($test) ? $out =~ $test : $out eq $test;
+ if ($ok) {
+ ok(1, "Line $line \"$str\" => \"$out\"");
+ return $obj;
+ } else {
+ ok(0, "Line $line \"$str\"");
+ warn "# Was:\n$out\n# Should've been:\n$test\n";
+ print $obj->error if $obj->can('error');
+ print Dumper $obj->parse_tree(\$str) if $obj->can('parse_tree');
+ exit;
+ }
+}
+
+### This next section of code is verbatim from Andy's code
+#------------------------------------------------------------------------
+package Foo;
+
+sub new {
+ my $class = shift;
+ bless { @_ }, $class;
+}
+
+sub present {
+ my $self = shift;
+ return '{ ' . join(', ', map { "$_ => $self->{ $_ }" }
+ sort keys %$self) . ' }';
+}
+
+sub reverse {
+ my $self = shift;
+ return '{ ' . join(', ', map { "$_ => $self->{ $_ }" }
+ reverse sort keys %$self) . ' }';
+}
+
+#------------------------------------------------------------------------
+package Blessed::List;
+
+sub as_list {
+ my $self = shift;
+ return @$self;
+}
+
+#------------------------------------------------------------------------
+package main;
+
+my $vars = {
+ foo => Foo->new( pi => 3.14, e => 2.718 ),
+ blessed_list => bless([ "Hello", "World" ], 'Blessed::List'),
+};
+
+###----------------------------------------------------------------###
+### These are Andy's tests coded as Paul's process_oks
+
+### View plugin usage
+
+process_ok("[% USE v = View -%]
+[[% v.prefix %]]" => "[]", $vars);
+
+process_ok("[% USE v = View( map => { default='any' } ) -%]
+[[% v.map.default %]]" => "[any]", $vars);
+
+process_ok("[% USE view( prefix=> 'foo/', suffix => '.tt2') -%]
+[[% view.prefix %]bar[% view.suffix %]]
+[[% view.template_name('baz') %]]" => "[foo/bar.tt2]
+[foo/baz.tt2]", $vars);
+
+process_ok("[% USE view( prefix=> 'foo/', suffix => '.tt2') -%]
+[[% view.prefix %]bar[% view.suffix %]]
+[[% view.template_name('baz') %]]" => "[foo/bar.tt2]
+[foo/baz.tt2]", $vars);
+
+process_ok("[% USE view -%]
+[% view.print('Hello World') %]
+[% BLOCK text %]TEXT: [% item %][% END -%]" => "TEXT: Hello World\n", $vars);
+
+process_ok("[% USE view -%]
+[% view.print( { foo => 'bar' } ) %]
+[% BLOCK hash %]HASH: {
+[% FOREACH key = item.keys.sort -%]
+ [% key %] => [% item.\$key %]
+[%- END %]
+}
+[% END -%]" => "HASH: {
+ foo => bar
+}\n\n", $vars);
+
+process_ok("[% USE view -%]
+[% view = view.clone( prefix => 'my_' ) -%]
+[% view.view('hash', { bar => 'baz' }) %]
+[% BLOCK my_hash %]HASH: {
+[% FOREACH key = item.keys.sort -%]
+ [% key %] => [% item.\$key %]
+[%- END %]
+}
+[% END -%]" => "HASH: {
+ bar => baz
+}\n\n", $vars);
+
+process_ok("[% USE view(prefix='my_') -%]
+[% view.print( foo => 'wiz', bar => 'waz' ) %]
+[% BLOCK my_hash %]KEYS: [% item.keys.sort.join(', ') %][% END %]
+
+" => "KEYS: bar, foo\n\n\n", $vars);
+
+process_ok("[% USE view -%]
+[% view.print( view ) %]
+[% BLOCK Template_View %]Printing a Template::View object[% END -%]" => "Printing a Template::View object\n", $vars);
+
+process_ok("[% USE view(prefix='my_') -%]
+[% view.print( view ) %]
+[% view.print( view, prefix='your_' ) %]
+[% BLOCK my_Template_View %]Printing my Template::View object[% END -%]
+[% BLOCK your_Template_View %]Printing your Template::View object[% END -%]" => "Printing my Template::View object
+Printing your Template::View object\n" , $vars);
+
+process_ok("[% USE view(prefix='my_', notfound='any' ) -%]
+[% view.print( view ) %]
+[% view.print( view, prefix='your_' ) %]
+[% BLOCK my_any %]Printing any of my objects[% END -%]
+[% BLOCK your_any %]Printing any of your objects[% END -%]" => "Printing any of my objects
+Printing any of your objects
+", $vars);
+
+process_ok("[% USE view(prefix => 'my_', map => { default => 'catchall' } ) -%]
+[% view.print( view ) %]
+[% view.print( view, default='catchsome' ) %]
+[% BLOCK my_catchall %]Catching all defaults[% END -%]
+[% BLOCK my_catchsome %]Catching some defaults[% END -%]" => "Catching all defaults
+Catching some defaults
+", $vars);
+
+process_ok("[% USE view(prefix => 'my_', map => { default => 'catchnone' } ) -%]
+[% view.default %]
+[% view.default = 'catchall' -%]
+[% view.default %]
+[% view.print( view ) %]
+[% view.print( view, default='catchsome' ) %]
+[% BLOCK my_catchall %]Catching all defaults[% END -%]
+[% BLOCK my_catchsome %]Catching some defaults[% END -%]" => "catchnone
+catchall
+Catching all defaults
+Catching some defaults
+", $vars);
+
+process_ok("[% USE view(prefix='my_', default='catchall' notfound='lost') -%]
+[% view.print( view ) %]
+[% BLOCK my_lost %]Something has been found[% END -%]" => "Something has been found
+", $vars);
+
+process_ok("[% USE view -%]
+[% TRY ;
+ view.print( view ) ;
+ CATCH view ;
+ \"[\$error.type] \$error.info\" ;
+ END
+%]" => "[view] file error - Template_View: not found", $vars);
+
+process_ok("[% USE view -%]
+[% view.print( foo ) %]" => "{ e => 2.718, pi => 3.14 }", $vars);
+
+process_ok("[% USE view -%]
+[% view.print( foo, method => 'reverse' ) %]" => "{ pi => 3.14, e => 2.718 }", $vars);
+
+process_ok("[% USE view(prefix='my_', include_naked=0, view_naked=1) -%]
+[% BLOCK my_foo; \"Foo: \$item\"; END -%]
+[[% view.view_foo(20) %]]
+[[% view.foo(30) %]]" => "[Foo: 20]
+[Foo: 30]", $vars);
+
+process_ok("[% USE view(prefix='my_', include_naked=0, view_naked=0) -%]
+[% BLOCK my_foo; \"Foo: \$item\"; END -%]
+[[% view.view_foo(20) %]]
+[% TRY ;
+ view.foo(30) ;
+ CATCH ;
+ error.info ;
+ END
+%]" => "[Foo: 20]
+no such view member: foo", $vars);
+
+process_ok("[% USE view(map => { HASH => 'my_hash', ARRAY => 'your_list' }) -%]
+[% BLOCK text %]TEXT: [% item %][% END -%]
+[% BLOCK my_hash %]HASH: [% item.keys.sort.join(', ') %][% END -%]
+[% BLOCK your_list %]LIST: [% item.join(', ') %][% END -%]
+[% view.print(\"some text\") %]
+[% view.print({ alpha => 'a', bravo => 'b' }) %]
+[% view.print([ 'charlie', 'delta' ]) %]" => "TEXT: some text
+HASH: alpha, bravo
+LIST: charlie, delta", $vars);
+
+process_ok("[% USE view(item => 'thing',
+ map => { HASH => 'my_hash', ARRAY => 'your_list' }) -%]
+[% BLOCK text %]TEXT: [% thing %][% END -%]
+[% BLOCK my_hash %]HASH: [% thing.keys.sort.join(', ') %][% END -%]
+[% BLOCK your_list %]LIST: [% thing.join(', ') %][% END -%]
+[% view.print(\"some text\") %]
+[% view.print({ alpha => 'a', bravo => 'b' }) %]
+[% view.print([ 'charlie', 'delta' ]) %]" => "TEXT: some text
+HASH: alpha, bravo
+LIST: charlie, delta", $vars);
+
+process_ok("[% USE view -%]
+[% view.print('Hello World') %]
+[% view1 = view.clone( prefix='my_') -%]
+[% view1.print('Hello World') %]
+[% view2 = view1.clone( prefix='dud_', notfound='no_text' ) -%]
+[% view2.print('Hello World') %]
+[% BLOCK text %]TEXT: [% item %][% END -%]
+[% BLOCK my_text %]MY TEXT: [% item %][% END -%]
+[% BLOCK dud_no_text %]NO TEXT: [% item %][% END -%]" => "TEXT: Hello World
+MY TEXT: Hello World
+NO TEXT: Hello World
+", $vars);
+
+process_ok("[% USE view( prefix = 'base_', default => 'any' ) -%]
+[% view1 = view.clone( prefix => 'one_') -%]
+[% view2 = view.clone( prefix => 'two_') -%]
+[% view.default %] / [% view.map.default %]
+[% view1.default = 'anyone' -%]
+[% view1.default %] / [% view1.map.default %]
+[% view2.map.default = 'anytwo' -%]
+[% view2.default %] / [% view2.map.default %]
+[% view.print(\"Hello World\") %] / [% view.print(blessed_list) %]
+[% view1.print(\"Hello World\") %] / [% view1.print(blessed_list) %]
+[% view2.print(\"Hello World\") %] / [% view2.print(blessed_list) %]
+[% BLOCK base_text %]ANY TEXT: [% item %][% END -%]
+[% BLOCK one_text %]ONE TEXT: [% item %][% END -%]
+[% BLOCK two_text %]TWO TEXT: [% item %][% END -%]
+[% BLOCK base_any %]BASE ANY: [% item.as_list.join(', ') %][% END -%]
+[% BLOCK one_anyone %]ONE ANY: [% item.as_list.join(', ') %][% END -%]
+[% BLOCK two_anytwo %]TWO ANY: [% item.as_list.join(', ') %][% END -%]" => "any / any
+anyone / anyone
+anytwo / anytwo
+ANY TEXT: Hello World / BASE ANY: Hello, World
+ONE TEXT: Hello World / ONE ANY: Hello, World
+TWO TEXT: Hello World / TWO ANY: Hello, World
+", $vars);
+
+process_ok("[% USE view( prefix => 'my_', item => 'thing' ) -%]
+[% view.view('thingy', [ 'foo', 'bar'] ) %]
+[% BLOCK my_thingy %]thingy: [ [% thing.join(', ') %] ][%END %]" => "thingy: [ foo, bar ]
+", $vars);
+
+process_ok("[% USE view -%]
+[% view.map.\${'Template::View'} = 'myview' -%]
+[% view.print(view) %]
+[% BLOCK myview %]MYVIEW[% END%]" => "MYVIEW
+", $vars);
+
+process_ok("[% USE view -%]
+[% view.include('greeting', msg => 'Hello World!') %]
+[% BLOCK greeting %]msg: [% msg %][% END -%]" => "msg: Hello World!
+", $vars);
+
+process_ok("[% USE view( prefix=\"my_\" )-%]
+[% view.include('greeting', msg => 'Hello World!') %]
+[% BLOCK my_greeting %]msg: [% msg %][% END -%]" => "msg: Hello World!
+", $vars);
+
+process_ok("[% USE view( prefix=\"my_\" )-%]
+[% view.include_greeting( msg => 'Hello World!') %]
+[% BLOCK my_greeting %]msg: [% msg %][% END -%]" => "msg: Hello World!
+", $vars);
+
+process_ok("[% USE view( prefix=\"my_\" )-%]
+[% INCLUDE \$view.template('greeting')
+ msg = 'Hello World!' %]
+[% BLOCK my_greeting %]msg: [% msg %][% END -%]" => "msg: Hello World!
+", $vars);
+
+process_ok("[% USE view( title=\"My View\" )-%]
+[% view.title %]" => "My View", $vars);
+
+process_ok("[% USE view( title=\"My View\" )-%]
+[% newview = view.clone( col = 'Chartreuse') -%]
+[% newerview = newview.clone( title => 'New Title' ) -%]
+[% view.title %]
+[% newview.title %]
+[% newview.col %]
+[% newerview.title %]
+[% newerview.col %]" => "My View
+My View
+Chartreuse
+New Title
+Chartreuse", $vars);
+
+###----------------------------------------------------------------###
+
+### VIEW directive usage
+
+process_ok("[% VIEW fred prefix='blat_' %]
+This is the view
+[% END -%]
+[% BLOCK blat_foo; 'This is blat_foo'; END -%]
+[% fred.view_foo %]" => "This is blat_foo", $vars);
+
+process_ok("[% VIEW fred %]
+This is the view
+[% view.prefix = 'blat_' %]
+[% END -%]
+[% BLOCK blat_foo; 'This is blat_foo'; END -%]
+[% fred.view_foo %]" => "This is blat_foo", $vars);
+
+process_ok("[% VIEW fred %]
+This is the view
+[% view.prefix = 'blat_' %]
+[% view.thingy = 'bloop' %]
+[% fred.name = 'Freddy' %]
+[% END -%]
+[% fred.prefix %]
+[% fred.thingy %]
+[% fred.name %]" => "blat_
+bloop
+Freddy", $vars);
+
+process_ok("[% VIEW fred prefix='blat_'; view.name='Fred'; END -%]
+[% fred.prefix %]
+[% fred.name %]
+[% TRY;
+ fred.prefix = 'nonblat_';
+ CATCH;
+ error;
+ END
+%]
+[% TRY;
+ fred.name = 'Derek';
+ CATCH;
+ error;
+ END
+%]" => "blat_
+Fred
+view error - cannot update config item in sealed view: prefix
+view error - cannot update item in sealed view: name", $vars);
+
+process_ok("[% VIEW foo prefix='blat_' default=\"default\" notfound=\"notfound\"
+ title=\"fred\" age=23 height=1.82 %]
+[% view.other = 'another' %]
+[% END -%]
+[% BLOCK blat_hash -%]
+[% FOREACH key = item.keys.sort -%]
+ [% key %] => [% item.\$key %]
+[% END -%]
+[% END -%]
+[% foo.print(foo.data) %]" => " age => 23
+ height => 1.82
+ other => another
+ title => fred
+", $vars);
+
+process_ok("[% VIEW foo %]
+[% BLOCK hello -%]
+Hello World!
+[% END %]
+[% BLOCK goodbye -%]
+Goodbye World!
+[% END %]
+[% END -%]
+[% TRY; INCLUDE foo; CATCH; error; END %]
+[% foo.include_hello %]" => "file error - foo: not found
+Hello World!
+", $vars);
+
+process_ok("[% title = \"Previous Title\" -%]
+[% VIEW foo
+ include_naked = 1
+ title = title or 'Default Title'
+ copy = 'me, now'
+-%]
+
+[% view.bgcol = '#ffffff' -%]
+
+[% BLOCK header -%]
+Header: bgcol: [% view.bgcol %]
+ title: [% title %]
+ view.title: [% view.title %]
+[%- END %]
+
+[% BLOCK footer -%]
+© Copyright [% view.copy %]
+[%- END %]
+
+[% END -%]
+[% title = 'New Title' -%]
+[% foo.header %]
+[% foo.header(bgcol='#dead' title=\"Title Parameter\") %]
+[% foo.footer %]
+[% foo.footer(copy=\"you, then\") %]
+" => "Header: bgcol: #ffffff
+ title: New Title
+ view.title: Previous Title
+Header: bgcol: #ffffff
+ title: Title Parameter
+ view.title: Previous Title
+© Copyright me, now
+© Copyright me, now
+", $vars);
+
+process_ok("[% VIEW foo
+ title = 'My View'
+ author = 'Andy Wardley'
+ bgcol = bgcol or '#ffffff'
+-%]
+[% view.arg1 = 'argument #1' -%]
+[% view.data.arg2 = 'argument #2' -%]
+[% END -%]
+ [% foo.title %]
+ [% foo.author %]
+ [% foo.bgcol %]
+ [% foo.arg1 %]
+ [% foo.arg2 %]
+[% bar = foo.clone( title='New View', arg1='New Arg1' ) %]cloned!
+ [% bar.title %]
+ [% bar.author %]
+ [% bar.bgcol %]
+ [% bar.arg1 %]
+ [% bar.arg2 %]
+originals:
+ [% foo.title %]
+ [% foo.arg1 %]
+
+" => " My View
+ Andy Wardley
+ #ffffff
+ argument #1
+ argument #2
+cloned!
+ New View
+ Andy Wardley
+ #ffffff
+ New Arg1
+ argument #2
+originals:
+ My View
+ argument #1
+
+", $vars);
+
+process_ok("[% VIEW basic title = \"My Web Site\" %]
+ [% BLOCK header -%]
+ This is the basic header: [% title or view.title %]
+ [%- END -%]
+[% END -%]
+
+[%- VIEW fancy
+ title = \"<fancy>\$basic.title</fancy>\"
+ basic = basic
+%]
+ [% BLOCK header ; view.basic.header(title = title or view.title) %]
+ Fancy new part of header
+ [%- END %]
+[% END -%]
+===
+[% basic.header %]
+[% basic.header( title = \"New Title\" ) %]
+===
+[% fancy.header %]
+[% fancy.header( title = \"Fancy Title\" ) %]" => "===
+ This is the basic header: My Web Site
+ This is the basic header: New Title
+===
+ This is the basic header: <fancy>My Web Site</fancy>
+ Fancy new part of header
+ This is the basic header: Fancy Title
+ Fancy new part of header", $vars);
+
+process_ok("[% VIEW baz notfound='lost' %]
+[% BLOCK lost; 'lost, not found'; END %]
+[% END -%]
+[% baz.any %]" => "lost, not found", $vars);
+
+process_ok("[% VIEW woz prefix='outer_' %]
+[% BLOCK wiz; 'The inner wiz'; END %]
+[% END -%]
+[% BLOCK outer_waz; 'The outer waz'; END -%]
+[% woz.wiz %]
+[% woz.waz %]" => "The inner wiz
+The outer waz", $vars);
+
+process_ok("[% VIEW foo %]
+
+ [% BLOCK file -%]
+ File: [% item.name %]
+ [%- END -%]
+
+ [% BLOCK directory -%]
+ Dir: [% item.name %]
+ [%- END %]
+
+[% END -%]
+[% foo.view_file({ name => 'some_file' }) %]
+[% foo.include_file(item => { name => 'some_file' }) %]
+[% foo.view('directory', { name => 'some_dir' }) %]" => " File: some_file
+ File: some_file
+ Dir: some_dir", $vars);
+
+process_ok("[% BLOCK parent -%]
+This is the base block
+[%- END -%]
+[% VIEW super %]
+ [%- BLOCK parent -%]
+ [%- INCLUDE parent FILTER replace('base', 'super') -%]
+ [%- END -%]
+[% END -%]
+base: [% INCLUDE parent %]
+super: [% super.parent %]" => "base: This is the base block
+super: This is the super block", $vars);
+
+process_ok("[% BLOCK foo -%]
+public foo block
+[%- END -%]
+[% VIEW plain %]
+ [% BLOCK foo -%]
+<plain>[% PROCESS foo %]</plain>
+ [%- END %]
+[% END -%]
+[% VIEW fancy %]
+ [% BLOCK foo -%]
+ [%- plain.foo | replace('plain', 'fancy') -%]
+ [%- END %]
+[% END -%]
+[% plain.foo %]
+[% fancy.foo %]" => "<plain>public foo block</plain>
+<fancy>public foo block</fancy>", $vars);
+
+process_ok("[% VIEW foo %]
+[% BLOCK Blessed_List -%]
+This is a list: [% item.as_list.join(', ') %]
+[% END -%]
+[% END -%]
+[% foo.print(blessed_list) %]" => "This is a list: Hello, World
+", $vars);
+
+process_ok("[% VIEW my.foo value=33; END -%]
+n: [% my.foo.value %]" => "n: 33", $vars);
+
+process_ok("[% VIEW parent -%]
+[% BLOCK one %]This is base one[% END %]
+[% BLOCK two %]This is base two[% END %]
+[% END -%]
+
+[%- VIEW child1 base=parent %]
+[% BLOCK one %]This is child1 one[% END %]
+[% END -%]
+
+[%- VIEW child2 base=parent %]
+[% BLOCK two %]This is child2 two[% END %]
+[% END -%]
+
+[%- VIEW child3 base=child2 %]
+[% BLOCK two %]This is child3 two[% END %]
+[% END -%]
+
+[%- FOREACH child = [ child1, child2, child3 ] -%]
+one: [% child.one %]
+[% END -%]
+[% FOREACH child = [ child1, child2, child3 ] -%]
+two: [% child.two %]
+[% END %]
+" => "one: This is child1 one
+one: This is base one
+one: This is base one
+two: This is base two
+two: This is child2 two
+two: This is child3 two
+
+", $vars);
+
+process_ok("[% VIEW my.view.default
+ prefix = 'view/default/'
+ value = 3.14;
+ END
+-%]
+value: [% my.view.default.value %]" => "value: 3.14", $vars);
+
+process_ok("[% VIEW my.view.default
+ prefix = 'view/default/'
+ value = 3.14;
+ END;
+ VIEW my.view.one
+ base = my.view.default
+ prefix = 'view/one/';
+ END;
+ VIEW my.view.two
+ base = my.view.default
+ value = 2.718;
+ END;
+-%]
+[% BLOCK view/default/foo %]Default foo[% END -%]
+[% BLOCK view/one/foo %]One foo[% END -%]
+0: [% my.view.default.foo %]
+1: [% my.view.one.foo %]
+2: [% my.view.two.foo %]
+0: [% my.view.default.value %]
+1: [% my.view.one.value %]
+2: [% my.view.two.value %]" => "0: Default foo
+1: One foo
+2: Default foo
+0: 3.14
+1: 3.14
+2: 2.718", $vars);
+
+process_ok("[% VIEW foo number = 10 sealed = 0; END -%]
+a: [% foo.number %]
+b: [% foo.number = 20 %]
+c: [% foo.number %]
+d: [% foo.number(30) %]
+e: [% foo.number %]" => "a: 10
+b:
+c: 20
+d: 30
+e: 30", $vars);
+
+process_ok("[% VIEW foo number = 10 silent = 1; END -%]
+a: [% foo.number %]
+b: [% foo.number = 20 %]
+c: [% foo.number %]
+d: [% foo.number(30) %]
+e: [% foo.number %]" => "a: 10
+b:
+c: 10
+d: 10
+e: 10", $vars);
projects / chaz / p5-CGI-Ex / commitdiff
