From 6c57b3331d84010b9e2031f8e3c8937c3117e8fc Mon Sep 17 00:00:00 2001 From: Paul Seamons Date: Tue, 8 May 2007 00:00:00 +0000 Subject: [PATCH] CGI::Ex 2.11 --- Changes | 12 + MANIFEST | 1 + META.yml | 2 +- lib/CGI/Ex.pm | 2 +- lib/CGI/Ex/App.pm | 2 +- lib/CGI/Ex/App.pod | 121 +++++- lib/CGI/Ex/Auth.pm | 2 +- lib/CGI/Ex/Conf.pm | 2 +- lib/CGI/Ex/Die.pm | 2 +- lib/CGI/Ex/Dump.pm | 2 +- lib/CGI/Ex/Fill.pm | 2 +- lib/CGI/Ex/JSONDump.pm | 2 +- lib/CGI/Ex/Template.pm | 784 +++++++++++++++++++++++++------------ lib/CGI/Ex/Template.pod | 349 ++++++++++++++--- lib/CGI/Ex/Validate.pm | 2 +- t/7_template_00_base.t | 273 +++++++++---- t/7_template_01_includes.t | 26 +- t/7_template_02_view.t | 684 ++++++++++++++++++++++++++++++++ 18 files changed, 1864 insertions(+), 406 deletions(-) create mode 100644 t/7_template_02_view.t diff --git a/Changes b/Changes index 1a20232..e19a6af 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,15 @@ +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. diff --git a/MANIFEST b/MANIFEST index 4a5a872..7b6ac03 100644 --- a/MANIFEST +++ b/MANIFEST @@ -82,5 +82,6 @@ t/5_dump_00_base.t 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 diff --git a/META.yml b/META.yml index 41bb0f6..42b2c96 100644 --- a/META.yml +++ b/META.yml @@ -1,7 +1,7 @@ # http://module-build.sourceforge.net/META-spec.html #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: CGI-Ex -version: 2.10 +version: 2.11 version_from: lib/CGI/Ex.pm installdirs: site requires: diff --git a/lib/CGI/Ex.pm b/lib/CGI/Ex.pm index 0090135..b6677bf 100644 --- a/lib/CGI/Ex.pm +++ b/lib/CGI/Ex.pm @@ -24,7 +24,7 @@ use vars qw($VERSION use base qw(Exporter); BEGIN { - $VERSION = '2.10'; + $VERSION = '2.11'; $PREFERRED_CGI_MODULE ||= 'CGI'; @EXPORT = (); @EXPORT_OK = qw(get_form diff --git a/lib/CGI/Ex/App.pm b/lib/CGI/Ex/App.pm index 545c318..29483cc 100644 --- a/lib/CGI/Ex/App.pm +++ b/lib/CGI/Ex/App.pm @@ -10,7 +10,7 @@ use strict; use vars qw($VERSION); BEGIN { - $VERSION = '2.10'; + $VERSION = '2.11'; Time::HiRes->import('time') if eval {require Time::HiRes}; eval {require Scalar::Util}; diff --git a/lib/CGI/Ex/App.pod b/lib/CGI/Ex/App.pod index e0a539f..8280b95 100644 --- a/lib/CGI/Ex/App.pod +++ b/lib/CGI/Ex/App.pod @@ -4,6 +4,10 @@ CGI::Ex::App - Anti-framework application framework. =head1 SYNOPSIS +A basic example: + + -------- File: /cgi-bin/my_cgi -------- + #!/usr/bin/perl -w use strict; @@ -13,10 +17,123 @@ CGI::Ex::App - Anti-framework application framework. 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 -------- + +

Hello World! ([% date %])

+ + [% IF was_correct %] + Correct! - The number was [% guess %].
+ [% ELSIF guess %] + Incorrect - The number was not [% guess %].
+ [% END %] + +
+ + Enter a number between 1 and 100:
+ [% guess_error %]
+ + +
+ + [% 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 diff --git a/lib/CGI/Ex/Auth.pm b/lib/CGI/Ex/Auth.pm index ebf20fd..0c38494 100644 --- a/lib/CGI/Ex/Auth.pm +++ b/lib/CGI/Ex/Auth.pm @@ -18,7 +18,7 @@ use MIME::Base64 qw(encode_base64 decode_base64); use Digest::MD5 qw(md5_hex); use CGI::Ex; -$VERSION = '2.10'; +$VERSION = '2.11'; ###----------------------------------------------------------------### diff --git a/lib/CGI/Ex/Conf.pm b/lib/CGI/Ex/Conf.pm index c6e1823..ac55180 100644 --- a/lib/CGI/Ex/Conf.pm +++ b/lib/CGI/Ex/Conf.pm @@ -29,7 +29,7 @@ use vars qw($VERSION ); @EXPORT_OK = qw(conf_read conf_write in_cache); -$VERSION = '2.10'; +$VERSION = '2.11'; $DEFAULT_EXT = 'conf'; diff --git a/lib/CGI/Ex/Die.pm b/lib/CGI/Ex/Die.pm index 23d5f32..1145f2e 100644 --- a/lib/CGI/Ex/Die.pm +++ b/lib/CGI/Ex/Die.pm @@ -23,7 +23,7 @@ use CGI::Ex; 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; diff --git a/lib/CGI/Ex/Dump.pm b/lib/CGI/Ex/Dump.pm index e8df246..fd6360b 100644 --- a/lib/CGI/Ex/Dump.pm +++ b/lib/CGI/Ex/Dump.pm @@ -17,7 +17,7 @@ use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION use strict; use Exporter; -$VERSION = '2.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); diff --git a/lib/CGI/Ex/Fill.pm b/lib/CGI/Ex/Fill.pm index d4c718a..646e210 100644 --- a/lib/CGI/Ex/Fill.pm +++ b/lib/CGI/Ex/Fill.pm @@ -24,7 +24,7 @@ use vars qw($VERSION use base qw(Exporter); BEGIN { - $VERSION = '2.10'; + $VERSION = '2.11'; @EXPORT = qw(form_fill); @EXPORT_OK = qw(fill form_fill html_escape get_tagval_by_key swap_tagval_by_key); }; diff --git a/lib/CGI/Ex/JSONDump.pm b/lib/CGI/Ex/JSONDump.pm index 3fa9b8f..9242ad9 100644 --- a/lib/CGI/Ex/JSONDump.pm +++ b/lib/CGI/Ex/JSONDump.pm @@ -17,7 +17,7 @@ use strict; use base qw(Exporter); BEGIN { - $VERSION = '2.10'; + $VERSION = '2.11'; @EXPORT = qw(JSONDump); @EXPORT_OK = @EXPORT; diff --git a/lib/CGI/Ex/Template.pm b/lib/CGI/Ex/Template.pm index 9353337..37dda33 100644 --- a/lib/CGI/Ex/Template.pm +++ b/lib/CGI/Ex/Template.pm @@ -1,5 +1,8 @@ package CGI::Ex::Template; +#STAT_TTL +#memory leak in USE + ###----------------------------------------------------------------### # See the perldoc in CGI/Ex/Template.pod # Copyright 2007 - Paul Seamons # @@ -28,7 +31,6 @@ use vars qw($VERSION $QR_COMMENTS $QR_FILENAME $QR_NUM - $QR_AQ_NOTDOT $QR_AQ_SPACE $QR_PRIVATE @@ -37,10 +39,13 @@ use vars qw($VERSION $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'; @@ -58,21 +63,22 @@ BEGIN { 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; $_ }, + html => sub { local $_ = $_[0]; s/&/&/g; s//>/g; s/\"/"/g; s/\'/'/g; $_ }, item => sub { $_[0] }, lcfirst => sub { lcfirst $_[0] }, length => sub { defined($_[0]) ? length($_[0]) : 0 }, @@ -94,6 +100,7 @@ BEGIN { ucfirst => sub { ucfirst $_[0] }, upper => sub { uc $_[0] }, uri => \&vmethod_uri, + url => \&vmethod_url, }; $FILTER_OPS = { # generally - non-dynamic filters belong in scalar ops @@ -104,10 +111,9 @@ BEGIN { }; $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} @_; '' }, @@ -120,9 +126,9 @@ BEGIN { 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] } }, @@ -134,12 +140,11 @@ BEGIN { }; $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} }, @@ -175,6 +180,7 @@ BEGIN { 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], @@ -206,7 +212,8 @@ BEGIN { 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 }; @@ -254,8 +261,9 @@ BEGIN { ['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}; @@ -281,15 +289,17 @@ BEGIN { $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}; }; @@ -328,8 +338,14 @@ sub _process { ### 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}'") @@ -340,18 +356,18 @@ sub _process { 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 = $@) { @@ -374,9 +390,9 @@ sub load_parsed_tree { ### 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} @@ -473,12 +489,13 @@ sub load_parsed_tree { $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; @@ -524,11 +541,14 @@ sub parse_tree { 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 @@ -583,11 +603,15 @@ sub parse_tree { 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; @@ -626,7 +650,7 @@ sub parse_tree { $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)); } } @@ -636,12 +660,21 @@ sub parse_tree { ### 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 @@ -657,43 +690,44 @@ sub parse_tree { } 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 } @@ -709,20 +743,13 @@ sub parse_tree { 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 = $@) { @@ -734,21 +761,18 @@ sub parse_tree { $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 @@ -759,7 +783,7 @@ sub parse_tree { } ### 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; @@ -841,17 +865,26 @@ sub parse_expr { 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 @@ -863,7 +896,6 @@ sub parse_expr { ### 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; @@ -872,6 +904,7 @@ sub parse_expr { 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) { @@ -886,39 +919,59 @@ sub parse_expr { $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 (.*?) (?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 (.*?) (?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 (.*?) (?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{ (?: ^ | (?{'_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; @@ -992,19 +1044,36 @@ sub parse_expr { $$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 @@ -1014,10 +1083,18 @@ sub parse_expr { 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]; @@ -1064,7 +1141,7 @@ sub parse_expr { } ### allow for all "operators" - if (! $self->{'_operator_precedence'}) { + if (! $self->{'_operator_precedence'} && defined $is_aq) { my $tree; my $found; while (1) { @@ -1222,34 +1299,75 @@ sub parse_args { 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; } @@ -1349,7 +1467,7 @@ sub play_expr { 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; } } @@ -1515,6 +1633,12 @@ sub play_expr { 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 ||= {}; @@ -1722,6 +1846,8 @@ sub play_operator { $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"); @@ -1732,18 +1858,19 @@ sub play_operator { 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 { @@ -1752,7 +1879,7 @@ 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; @@ -1770,7 +1897,7 @@ sub parse_CASE { 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 { @@ -1783,6 +1910,50 @@ sub play_CLEAR { $$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 @@ -1825,36 +1996,54 @@ sub play_DEFAULT { 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/($self->{'_vars'}); + $out =~ s/\$VAR1/EntireStash/g; + } + + if ($conf->{'html'} || (! defined($conf->{'html'}) && $ENV{'REQUEST_METHOD'})) { + $out = $SCALAR_OPS->{'html'}->($out); $out = "
$out
"; - $out =~ s/\$VAR1/$var/; - $out = "DUMP: File \"$info->{file}\" line $info->{line}$out"; + $out = "DUMP: File \"$info->{file}\" line $info->{line}$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; @@ -2048,10 +2237,11 @@ sub play_INCLUDE { 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); } @@ -2062,7 +2252,7 @@ sub play_INSERT { 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 ]; @@ -2127,16 +2317,17 @@ sub play_MACRO { 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; } @@ -2185,50 +2376,25 @@ sub play_PERL { 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}); @@ -2239,7 +2405,7 @@ sub play_PROCESS { } ### 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 @@ -2250,10 +2416,18 @@ sub play_PROCESS { ### 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 @@ -2352,6 +2526,7 @@ sub parse_SET { push @SET, ['=', $set, undef]; } } + return \@SET; } @@ -2423,16 +2598,21 @@ sub play_SWITCH { 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); } @@ -2515,20 +2695,20 @@ sub parse_USE { 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)); @@ -2546,6 +2726,9 @@ sub play_USE { 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; @@ -2595,6 +2778,74 @@ sub play_USE { 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; @@ -2622,21 +2873,21 @@ sub play_WHILE { 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; @@ -2663,7 +2914,7 @@ sub include_filename { 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 @@ -2759,7 +3010,6 @@ sub process { 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 @@ -2782,7 +3032,7 @@ sub process { 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 @@ -2885,7 +3135,9 @@ sub DEBUG { ###----------------------------------------------------------------### 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) : {}; @@ -2901,7 +3153,7 @@ sub exception { $type = 'undef'; } } - return $PACKAGE_EXCEPTION->new($type, $info, $node); + return $PACKAGE_EXCEPTION->new($type, $info, @_); } sub throw { die shift->exception(@_) } @@ -2962,7 +3214,7 @@ sub debug_node { 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 }; @@ -2977,9 +3229,11 @@ sub node_info { } 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); @@ -2990,15 +3244,20 @@ sub get_line_number_by_index { } \@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; } ###----------------------------------------------------------------### @@ -3018,7 +3277,7 @@ sub define_vmethod { 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; @@ -3026,7 +3285,7 @@ sub vmethod_as_scalar { : 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; @@ -3035,7 +3294,7 @@ sub vmethod_as_list { : 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; @@ -3100,6 +3359,15 @@ sub vmethod_nsort { : [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; @@ -3177,6 +3445,13 @@ sub vmethod_uri { 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; @@ -3243,8 +3518,8 @@ use overload 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] } @@ -3253,28 +3528,34 @@ sub info { shift->[1] } 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; } ###----------------------------------------------------------------### @@ -3342,6 +3623,11 @@ use vars qw($AUTOLOAD); 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 { @@ -3356,21 +3642,29 @@ sub eval_perl { shift->_template->{'EVAL_PERL'} } 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/; } diff --git a/lib/CGI/Ex/Template.pod b/lib/CGI/Ex/Template.pod index 52df7af..f931261 100644 --- a/lib/CGI/Ex/Template.pod +++ b/lib/CGI/Ex/Template.pod @@ -18,7 +18,7 @@ CGI::Ex::Template - Fast and lightweight TT2/3 template engine $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 @@ -235,6 +235,10 @@ not just variables. [% 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 @@ -266,6 +270,19 @@ the virtual method. (TT3) [% "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 @@ -311,6 +328,12 @@ to virtual methods. [% 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 %] @@ -373,6 +396,13 @@ Used for Data::Dumpering the passed variable or expression. [% 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 @@ -393,7 +423,8 @@ configuration items. =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. @@ -408,30 +439,39 @@ perl blocks, and plugins. 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 = ( @@ -458,8 +498,9 @@ a hashref as the second argument to the process method, or by setting the "VARIA =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 %] @@ -471,7 +512,8 @@ Would print when processed: 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 %] @@ -483,8 +525,9 @@ Would print: 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() %] @@ -498,7 +541,8 @@ Would print: 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 %] @@ -526,9 +570,10 @@ Would print: 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} %] @@ -544,8 +589,9 @@ Would print: 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' } %] @@ -559,8 +605,8 @@ Would print: =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 %] @@ -703,6 +749,13 @@ Note: this works in CET and is planned for TT3. 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 @@ -710,8 +763,8 @@ operators. An expression can be used anywhere a variable can be used 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 @@ -738,11 +791,11 @@ are discussed in a later section. =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. @@ -758,8 +811,10 @@ object (except for true filters such as eval and redirect). =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 @@ -849,6 +904,12 @@ processed separately. [% 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. @@ -887,10 +948,18 @@ This is a filter and is not available via the Text virtual object. [% 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. @@ -903,6 +972,10 @@ This is a filter and is not available via the Text virtual object. [% 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. @@ -929,6 +1002,11 @@ This is a filter and is not available via the Text virtual object. [% 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 @@ -998,10 +1076,14 @@ Default pattern is %s and the default join string is a space. [% 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. @@ -1070,6 +1152,9 @@ Default pattern is "%s\t%s" and the default join string is a newline. [% 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 @@ -1277,6 +1362,36 @@ Clears any of the content currently generated in the innermost block 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 + +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 Used to reset the DEBUG_FORMAT configuration variable, or to turn @@ -1298,13 +1413,15 @@ defined or was zero length. =item C -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 @@ -1336,7 +1453,8 @@ TODO - enumerate the at least 7 ways to pass and use filters. 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 @@ -1670,19 +1788,26 @@ The named tags are (duplicated from TT): 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 @@ -1860,6 +1985,14 @@ See the PLUGIN_BASE, and PLUGINS configuration items. See the documentation for Template::Manual::Plugins. +=item C + +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 Will process a block of code while a condition is true. @@ -2180,6 +2313,12 @@ This operator is not used in TT. It is used internally by CGI::Ex::Template to delay the creation of an array until the execution of the compiled template. +=item C + +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 @@ -2380,6 +2519,68 @@ The name of a default template file to use if the passed one is not found. 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 "%]". @@ -2610,6 +2811,31 @@ following is a basic table of changes invoked by using V1DOLLAR. "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 @@ -2702,12 +2928,13 @@ $DIRECTIVES hashref. =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). @@ -2721,6 +2948,8 @@ The following table shows a variable or expression and the corresponding parsed 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 ] @@ -2729,8 +2958,6 @@ The following table shows a variable or expression and the corresponding parsed {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 ] @@ -2894,7 +3121,7 @@ Used to get debug info on a directive if DEBUG_DIRS is set. =item C -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 @@ -2939,7 +3166,7 @@ by the pseudo context object and may disappear at some point. =item C -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 @@ -2948,4 +3175,8 @@ Methods by these names implement virtual methods that are more than one line. Paul Seamons +=head1 LICENSE + +This module may be distributed under the same terms as Perl itself. + =cut diff --git a/lib/CGI/Ex/Validate.pm b/lib/CGI/Ex/Validate.pm index fbbb2c7..35f7176 100644 --- a/lib/CGI/Ex/Validate.pm +++ b/lib/CGI/Ex/Validate.pm @@ -22,7 +22,7 @@ use vars qw($VERSION @UNSUPPORTED_BROWSERS ); -$VERSION = '2.10'; +$VERSION = '2.11'; $DEFAULT_EXT = 'val'; $QR_EXTRA = qr/^(\w+_error|as_(array|string|hash)_\w+|no_\w+)/; diff --git a/t/7_template_00_base.t b/t/7_template_00_base.t index 2d830d3..b5813fc 100644 --- a/t/7_template_00_base.t +++ b/t/7_template_00_base.t @@ -14,7 +14,7 @@ BEGIN { }; 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 }; @@ -27,21 +27,27 @@ Taint::Runtime::taint_start() if test_taint; 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; + } } ###----------------------------------------------------------------### @@ -99,6 +105,7 @@ process_ok("[% foo(7) %]" => 7, {foo => sub { $_[0] }}); 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}); @@ -167,7 +174,9 @@ process_ok("[% foo.\$name %]" => 7, {name => 'bar', foo => {bar => 7}}); 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}); @@ -182,13 +191,17 @@ process_ok("[% \"hi \${foo.echo(7)}\" %]" => 'hi 7', {foo => $obj}); 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"; @@ -261,29 +274,15 @@ process_ok("[% foo = 1 bar = 2 %][% foo %][% bar %]" => '12'); 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"; @@ -302,10 +301,6 @@ ok($t == 3, "CALL method actually called var"); 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 @@ -318,11 +313,12 @@ process_ok("[% n|indent('wow ') %]" => "wow a\nwow b", {n => "a\nb"}); # TT2 fil 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 @@ -369,16 +365,13 @@ process_ok("[% n|uri %]" => 'a%20b', {n => "a b"}); # 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; @@ -405,7 +398,8 @@ process_ok("[% a.nsort.join %]" => '1 2 3', {a => [2, 3, 1]}); 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]}); @@ -424,25 +418,18 @@ process_ok("[% a.unshift(3) %][% a.join %]" => '3 2 3', {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; @@ -506,8 +493,7 @@ process_ok('[% "hi" FILTER foo %]' => 'hihi', {tt_config => [FILTERS => {foo => 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'); @@ -522,9 +508,9 @@ process_ok('[% {a => "B", c => "D"}.fmt %]' => "a\tB\nc\tD") if ! $is_tt; 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; @@ -557,13 +543,13 @@ process_ok(" \n\n[%- foo %]" => " \n"); 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"; @@ -654,22 +640,42 @@ process_ok("[% t = 0 or 0 ? 0 : 0 or 2 ? 2 : 3 %][% t %]" => '2'); 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 %]>>" => '<>'); 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'); @@ -702,6 +708,10 @@ process_ok("[%# BLOCK one %]" => ''); 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"; @@ -746,6 +756,11 @@ process_ok("[% FOREACH [1..3] %][% loop.size %][% END %][% loop.size %]" => '333 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"; @@ -788,15 +803,6 @@ process_ok("[% FOREACH f = [1..3] %][% IF loop.first %][% CLEAR %][% END %][% f 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"; @@ -833,8 +839,10 @@ process_ok("[% TAGS mason %]<% 1 + 2 >" => 3); process_ok("[% TAGS metatext %]%% 1 + 2 %%" => 3); process_ok("[% TAGS php %]" => 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 %] " => '3'); process_ok("[% TAGS html %]" => '3') if ! $is_tt; @@ -845,10 +853,15 @@ process_ok("[% BLOCK foo %][% TAGS html %][% END %][% PROCESS foo process_ok("[% TAGS %]" => '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 -->" => '3') if ! $is_tt; +process_ok("[% TAGS html ; 7 -->" => '73') if ! $is_tt; +process_ok("[% TAGS html ; 7 %]" => '') if ! $is_tt; # error - the old closing tag must come next ###----------------------------------------------------------------### print "### SWITCH / CASE ####################################################\n"; @@ -1011,6 +1024,18 @@ process_ok('[% "$a" %]|$a|[% "${a}" %]|${a}' => 'A|A|A|A', {a => 'A', A => ' 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"; @@ -1035,7 +1060,10 @@ print "### META #############################################################\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"; @@ -1064,6 +1092,30 @@ process_ok('[% a = "ab" ; f = "abcd"; foo = \f.replace(a, "-AB-").replace("-AB-" 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"; @@ -1074,6 +1126,11 @@ process_ok('[% " \n " %]' => " \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 '); @@ -1099,5 +1156,57 @@ process_ok('[% qw([% 1 + 2 %]).join.eval %]' => '3') if ! $is_tt; 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 %]" => '
a = 's'; 
', {a => "s", tt_config => [DUMP => {header => 0, html => 1}]}); +local $ENV{'REQUEST_METHOD'} = 1; +process_ok("[% p = DUMP a; p.collapse %]" => '
a = 's'; 
', {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"; diff --git a/t/7_template_01_includes.t b/t/7_template_01_includes.t index c52fe15..4054746 100644 --- a/t/7_template_01_includes.t +++ b/t/7_template_01_includes.t @@ -29,20 +29,30 @@ mkdir $test_dir, 0755; 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 diff --git a/t/7_template_02_view.t b/t/7_template_02_view.t new file mode 100644 index 0000000..dee8588 --- /dev/null +++ b/t/7_template_02_view.t @@ -0,0 +1,684 @@ +# -*- 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 +# +# 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 = \"\$basic.title\" + 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: My Web Site + 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 -%] +[% PROCESS foo %] + [%- END %] +[% END -%] +[% VIEW fancy %] + [% BLOCK foo -%] + [%- plain.foo | replace('plain', 'fancy') -%] + [%- END %] +[% END -%] +[% plain.foo %] +[% fancy.foo %]" => "public foo block +public foo block", $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); -- 2.43.0