package CGI::Ex::Template;
-#STAT_TTL
-#memory leak in USE
-
###----------------------------------------------------------------###
# See the perldoc in CGI/Ex/Template.pod
# Copyright 2007 - Paul Seamons #
$WHILE_MAX
$EXTRA_COMPILE_EXT
$DEBUG
+ $STAT_TTL
@CONFIG_COMPILETIME
@CONFIG_RUNTIME
);
BEGIN {
- $VERSION = '2.11';
+ $VERSION = '2.12';
$PACKAGE_EXCEPTION = 'CGI::Ex::Template::Exception';
$PACKAGE_ITERATOR = 'CGI::Ex::Template::Iterator';
$PACKAGE_CONTEXT = 'CGI::Ex::Template::_Context';
$PACKAGE_STASH = 'CGI::Ex::Template::_Stash';
$PACKAGE_PERL_HANDLE = 'CGI::Ex::Template::EvalPerlHandle';
- $MAX_EVAL_RECURSE = 50;
- $MAX_MACRO_RECURSE = 50;
$TAGS = {
asp => ['<%', '%>' ], # ASP
### setup the operator parsing
$OPERATORS = [
# type precedence symbols action (undef means play_operator will handle)
- ['prefix', 99, ['\\'], undef ],
- ['postfix', 98, ['++'], undef ],
- ['postfix', 98, ['--'], undef ],
- ['prefix', 97, ['++'], undef ],
- ['prefix', 97, ['--'], undef ],
- ['right', 96, ['**', 'pow'], sub { $_[0] ** $_[1] } ],
- ['prefix', 93, ['!'], sub { ! $_[0] } ],
+ ['prefix', 99, ['\\'], undef ],
+ ['postfix', 98, ['++'], undef ],
+ ['postfix', 98, ['--'], undef ],
+ ['prefix', 97, ['++'], undef ],
+ ['prefix', 97, ['--'], undef ],
+ ['right', 96, ['**', 'pow'], sub { $_[0] ** $_[1] } ],
+ ['prefix', 93, ['!'], sub { ! $_[0] } ],
['prefix', 93, ['-'], sub { @_ == 1 ? 0 - $_[0] : $_[0] - $_[1] } ],
- ['left', 90, ['*'], sub { $_[0] * $_[1] } ],
- ['left', 90, ['/'], sub { $_[0] / $_[1] } ],
- ['left', 90, ['div', 'DIV'], sub { int($_[0] / $_[1]) } ],
- ['left', 90, ['%', 'mod', 'MOD'], sub { $_[0] % $_[1] } ],
- ['left', 85, ['+'], sub { $_[0] + $_[1] } ],
+ ['left', 90, ['*'], sub { $_[0] * $_[1] } ],
+ ['left', 90, ['/'], sub { $_[0] / $_[1] } ],
+ ['left', 90, ['div', 'DIV'], sub { int($_[0] / $_[1]) } ],
+ ['left', 90, ['%', 'mod', 'MOD'], sub { $_[0] % $_[1] } ],
+ ['left', 85, ['+'], sub { $_[0] + $_[1] } ],
['left', 85, ['-'], sub { @_ == 1 ? 0 - $_[0] : $_[0] - $_[1] } ],
- ['left', 85, ['~', '_'], undef ],
- ['none', 80, ['<'], sub { $_[0] < $_[1] } ],
- ['none', 80, ['>'], sub { $_[0] > $_[1] } ],
- ['none', 80, ['<='], sub { $_[0] <= $_[1] } ],
- ['none', 80, ['>='], sub { $_[0] >= $_[1] } ],
- ['none', 80, ['lt'], sub { $_[0] lt $_[1] } ],
- ['none', 80, ['gt'], sub { $_[0] gt $_[1] } ],
- ['none', 80, ['le'], sub { $_[0] le $_[1] } ],
- ['none', 80, ['ge'], sub { $_[0] ge $_[1] } ],
- ['none', 75, ['==', 'eq'], sub { $_[0] eq $_[1] } ],
- ['none', 75, ['!=', 'ne'], sub { $_[0] ne $_[1] } ],
- ['left', 70, ['&&'], undef ],
- ['right', 65, ['||'], undef ],
- ['none', 60, ['..'], sub { $_[0] .. $_[1] } ],
- ['ternary', 55, ['?', ':'], undef ],
- ['assign', 53, ['+='], sub { $_[0] + $_[1] } ],
- ['assign', 53, ['-='], sub { $_[0] - $_[1] } ],
- ['assign', 53, ['*='], sub { $_[0] * $_[1] } ],
- ['assign', 53, ['/='], sub { $_[0] / $_[1] } ],
- ['assign', 53, ['%='], sub { $_[0] % $_[1] } ],
- ['assign', 53, ['**='], sub { $_[0] ** $_[1] } ],
- ['assign', 53, ['~=', '_='], sub { $_[0] . $_[1] } ],
- ['assign', 52, ['='], undef ],
- ['prefix', 50, ['not', 'NOT'], sub { ! $_[0] } ],
- ['left', 45, ['and', 'AND'], undef ],
- ['right', 40, ['or', 'OR'], undef ],
-# ['', 0, ['{}'], undef ],
-# ['', 0, ['[]'], undef ],
-# ['', 0, ['qr'], undef ],
+ ['left', 85, ['~', '_'], undef ],
+ ['none', 80, ['<'], sub { $_[0] < $_[1] } ],
+ ['none', 80, ['>'], sub { $_[0] > $_[1] } ],
+ ['none', 80, ['<='], sub { $_[0] <= $_[1] } ],
+ ['none', 80, ['>='], sub { $_[0] >= $_[1] } ],
+ ['none', 80, ['lt'], sub { $_[0] lt $_[1] } ],
+ ['none', 80, ['gt'], sub { $_[0] gt $_[1] } ],
+ ['none', 80, ['le'], sub { $_[0] le $_[1] } ],
+ ['none', 80, ['ge'], sub { $_[0] ge $_[1] } ],
+ ['none', 75, ['==', 'eq'], sub { $_[0] eq $_[1] } ],
+ ['none', 75, ['!=', 'ne'], sub { $_[0] ne $_[1] } ],
+ ['left', 70, ['&&'], undef ],
+ ['right', 65, ['||'], undef ],
+ ['none', 60, ['..'], sub { $_[0] .. $_[1] } ],
+ ['ternary', 55, ['?', ':'], undef ],
+ ['assign', 53, ['+='], sub { $_[0] + $_[1] } ],
+ ['assign', 53, ['-='], sub { $_[0] - $_[1] } ],
+ ['assign', 53, ['*='], sub { $_[0] * $_[1] } ],
+ ['assign', 53, ['/='], sub { $_[0] / $_[1] } ],
+ ['assign', 53, ['%='], sub { $_[0] % $_[1] } ],
+ ['assign', 53, ['**='], sub { $_[0] ** $_[1] } ],
+ ['assign', 53, ['~=', '_='], sub { $_[0] . $_[1] } ],
+ ['assign', 52, ['='], undef ],
+ ['prefix', 50, ['not', 'NOT'], sub { ! $_[0] } ],
+ ['left', 45, ['and', 'AND'], undef ],
+ ['right', 40, ['or', 'OR'], undef ],
];
$OP = {map {my $ref = $_; map {$_ => $ref} @{$ref->[2]}} grep {$_->[0] ne 'prefix' } @$OPERATORS}; # all non-prefix
$OP_PREFIX = {map {my $ref = $_; map {$_ => $ref} @{$ref->[2]}} grep {$_->[0] eq 'prefix' } @$OPERATORS};
$QR_PRIVATE = qr/^[_.]/;
$WHILE_MAX = 1000;
- $EXTRA_COMPILE_EXT = '.sto2';
+ $EXTRA_COMPILE_EXT = '.sto';
+ $MAX_EVAL_RECURSE = 50;
+ $MAX_MACRO_RECURSE = 50;
+ $STAT_TTL ||= 1;
@CONFIG_COMPILETIME = qw(ANYCASE INTERPOLATE PRE_CHOMP POST_CHOMP V1DOLLAR V2PIPE);
@CONFIG_RUNTIME = qw(DUMP);
return if ! defined $file;
my $doc = {name => $file};
+ my $ref = $self->{'_documents'}->{$file};
### looks like a string reference
if (ref $file) {
$doc->{'_is_str_ref'} = 1;
### looks like a previously cached-in-memory document
- } elsif ($self->{'_documents'}->{$file}
- && ( ($self->{'_documents'}->{$file}->{'_cache_time'} == time) # don't stat more than once a second
- || ($self->{'_documents'}->{$file}->{'modtime'}
- == (stat $self->{'_documents'}->{$file}->{'_filename'})[9]))) {
+ } elsif ($ref
+ && ( time - $ref->{'cache_time'} < ($self->{'STAT_TTL'} || $STAT_TTL) # don't stat more than once a second
+ || $ref->{'modtime'} == (stat $ref->{'_filename'})[9] # otherwise see if the file was modified
+ )) {
$doc = $self->{'_documents'}->{$file};
- $doc->{'_cache_time'} = time;
return $doc;
### looks like a block name of some sort
$doc->{'_tree'} = $block->{'_tree'} || $self->throw('block', "Invalid block definition (missing tree)");
return $doc;
+ ### handle cached not_founds
+ } elsif ($self->{'_not_found'}->{$file}
+ && ((time - $self->{'_not_found'}->{$file}->{'cache_time'}
+ < ($self->{'NEGATIVE_STAT_TTL'} || $self->{'STAT_TTL'} || $STAT_TTL)) # negative cache for a second
+ || do { delete $self->{'_not_found'}->{$file}; 0 } # clear cache on failure
+ )) {
+ die $self->{'_not_found'}->{$file}->{'exception'};
### go and look on the file system
} else {
last;
}
}
- die $err if ! $doc->{'_tree'};
+ $err = '' if ! $doc->{'_tree'};
} elsif ($self->{'DEFAULT'}) {
- $doc->{'_filename'} = eval { $self->include_filename($self->{'DEFAULT'}) } || die $err;
- } else {
+ $err = '' if ($doc->{'_filename'} = eval { $self->include_filename($self->{'DEFAULT'}) });
+ }
+ if ($err) {
+ ### cache the negative error
+ if (! defined($self->{'NEGATIVE_STAT_TTL'}) || $self->{'NEGATIVE_STAT_TTL'}) {
+ $err = $self->exception('undef', $err) if ref($err) !~ /Template::Exception$/;
+ $self->{'_not_found'}->{$file} = {
+ cache_time => time,
+ exception => $self->exception($err->type, $err->info." (cached)"),
+ };
+ }
die $err;
}
}
### cache parsed_tree in memory unless asked not to do so
if (! $doc->{'_is_str_ref'} && (! defined($self->{'CACHE_SIZE'}) || $self->{'CACHE_SIZE'})) {
$self->{'_documents'}->{$file} ||= $doc;
- $doc->{'_cache_time'} = time;
+ $doc->{'cache_time'} = time;
### allow for config option to keep the cache size down
if ($self->{'CACHE_SIZE'}) {
my $all = $self->{'_documents'};
if (scalar(keys %$all) > $self->{'CACHE_SIZE'}) {
my $n = 0;
- foreach my $file (sort {$all->{$b}->{'_cache_time'} <=> $all->{$a}->{'_cache_time'}} keys %$all) {
+ foreach my $file (sort {$all->{$b}->{'cache_time'} <=> $all->{$a}->{'cache_time'}} keys %$all) {
delete($all->{$file}) if ++$n > $self->{'CACHE_SIZE'};
}
}
### determine the top level of this particular variable access
my $ref;
+ use CGI::Ex::Dump qw(debug dex_trace);
+ debug dex_trace
+ if ref $var ne 'ARRAY';
my $name = $var->[$i++];
my $args = $var->[$i++];
warn "play_expr: begin \"$name\"\n" if trace;
$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 ($named, @args) = @$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 : ();
+ @args = map { $self->play_expr($_) } @args;
$self->throw($name, \@args, $node);
}
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
+ my ($named, @args) = @$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
if ($self->{'PLUGIN_FACTORY'}->{$module} || eval {require $require}) {
my $shape = $package->load;
my $context = $self->context;
- my @args = $args ? map { $self->play_expr($_) } @$args : ();
- $obj = $shape->new($context, @args);
+ $obj = $shape->new($context, map { $self->play_expr($_) } @args);
} elsif (lc($module) eq 'iterator') { # use our iterator if none found (TT's works just fine)
- $obj = $PACKAGE_ITERATOR->new($args ? $self->play_expr($args->[0]) : []);
+ $obj = $PACKAGE_ITERATOR->new($args[0]);
} elsif (my @packages = grep {lc($package) eq lc($_)} @{ $self->list_plugins({base => $base}) }) {
foreach my $package (@packages) {
my $require = "$package.pm";
eval {require $require} || next;
my $shape = $package->load;
my $context = $self->context;
- my @args = $args ? map { $self->play_expr($_) } @$args : ();
- $obj = $shape->new($context, @args);
+ $obj = $shape->new($context, map { $self->play_expr($_) } @args);
}
} elsif ($self->{'LOAD_PERL'}) {
my $require = "$module.pm";
$require =~ s|::|/|g;
if (eval {require $require}) {
- my @args = $args ? map { $self->play_expr($_) } @$args : ();
- $obj = $module->new(@args);
+ $obj = $module->new(map { $self->play_expr($_) } @args);
}
}
}
return $ref;
}
-#sub parse_VIEW { $DIRECTIVES->{'PROCESS'}->[0]->(@_) }
sub play_VIEW {
my ($self, $ref, $node, $out_ref) = @_;
my $copy = {%$var2, %$var1, %$swap};
local $self->{'BLOCKS'} = $blocks = {%$blocks}; # localize blocks - but save a copy to possibly restore
+ local $self->{'_template'};
delete $self->{'_debug_off'};
delete $self->{'_debug_format'};
### handle pre process items that go before every document
+ my $pre = '';
if ($self->{'PRE_PROCESS'}) {
+ $self->_load_template_meta($content);
foreach my $name (@{ $self->split_paths($self->{'PRE_PROCESS'}) }) {
- my $out = '';
- $self->_process($name, $copy, \$out);
- $output = $out . $output;
+ $self->_process($name, $copy, \$pre);
}
}
- ### handle the process config - which loads a template in place of the real one
- if (exists $self->{'PROCESS'}) {
- ### load the meta data for the top document
- my $doc = $self->load_parsed_tree($content) || {};
- my $meta = ($doc->{'_tree'} && ref($doc->{'_tree'}->[0]) && $doc->{'_tree'}->[0]->[0] eq 'META')
- ? $doc->{'_tree'}->[0]->[3] : {};
+ ### process the central file now - catching errors to allow for the ERROR config
+ eval {
+ ### handle the PROCESS config - which loads another template in place of the real one
+ if (exists $self->{'PROCESS'}) {
+ $self->_load_template_meta($content);
+ foreach my $name (@{ $self->split_paths($self->{'PROCESS'}) }) {
+ next if ! length $name;
+ $self->_process($name, $copy, \$output);
+ }
- local $self->{'_template'} = $doc;
- @{ $doc }{keys %$meta} = values %$meta;
+ ### handle "normal" content
+ } else {
+ local $self->{'_start_top_level'} = 1;
+ $self->_process($content, $copy, \$output);
+ }
+ };
- ### process any other templates
- foreach my $name (@{ $self->split_paths($self->{'PROCESS'}) }) {
- next if ! length $name;
- $self->_process($name, $copy, \$output);
+ ### catch errors with ERROR config
+ if (my $err = $@) {
+ $err = $self->exception('undef', $err) if ref($err) !~ /Template::Exception$/;
+ die $err if $err->type =~ /stop|return/;
+ my $catch = $self->{'ERRORS'} || $self->{'ERROR'} || die $err;
+ $catch = {default => $catch} if ! ref $catch;
+ my $type = $err->type;
+ my $last_found;
+ my $file;
+ foreach my $name (keys %$catch) {
+ my $_name = (! defined $name || lc($name) eq 'default') ? '' : $name;
+ if ($type =~ / ^ \Q$_name\E \b /x
+ && (! defined($last_found) || length($last_found) < length($_name))) { # more specific wins
+ $last_found = $_name;
+ $file = $catch->{$name};
+ }
}
- ### handle "normal" content
- } else {
- local $self->{'_start_top_level'} = 1;
- $self->_process($content, $copy, \$output);
+ ### found error handler - try it out
+ if (defined $file) {
+ $output = '';
+ local $copy->{'error'} = local $copy->{'e'} = $err;
+ $self->_process($file, $copy, \$output);
+ }
+ }
+
+ ### handle wrapper directives
+ if (exists $self->{'WRAPPER'}) {
+ $self->_load_template_meta($content);
+ foreach my $name (reverse @{ $self->split_paths($self->{'WRAPPER'}) }) {
+ next if ! length $name;
+ local $copy->{'content'} = $output;
+ my $out = '';
+ $self->_process($name, $copy, \$out);
+ $output = $out;
+ }
}
+ $output = $pre . $output if length $pre;
### handle post process items that go after every document
if ($self->{'POST_PROCESS'}) {
+ $self->_load_template_meta($content);
foreach my $name (@{ $self->split_paths($self->{'POST_PROCESS'}) }) {
$self->_process($name, $copy, \$output);
}
print STDERR "DEBUG: ", @_;
}
+sub _load_template_meta {
+ my $self = shift;
+ return if $self->{'_template'}; # only do once as need
+
+ ### load the meta data for the top document
+ ### this is needed by some of the custom handlers such as PRE_PROCESS and POST_PROCESS
+ my $content = shift;
+ my $doc = $self->{'_template'} = $self->load_parsed_tree($content) || {};
+ my $meta = ($doc->{'_tree'} && ref($doc->{'_tree'}->[0]) && $doc->{'_tree'}->[0]->[0] eq 'META')
+ ? $doc->{'_tree'}->[0]->[3] : {};
+
+ $self->{'_template'} = $doc;
+ @{ $doc }{keys %$meta} = values %$meta;
+
+ return;
+}
+
+
###----------------------------------------------------------------###
sub exception {
hash => {a => 'b'},
};
+ # print to STDOUT
$t->process('my/template.tt', $swap)
|| die $t->error;
+ # process into a variable
+ my $out = '';
+ $t->process('my/template.tt', $swap, \$out);
+
### CET uses the same syntax and configuration as Template::Toolkit
=head1 DESCRIPTION
=head1 TODO
- Add WRAPPER configuration item (the WRAPPER directive is supported).
-
- Add ERROR config item
+ Add HTML::Template support
=head1 HOW IS CGI::Ex::Template DIFFERENT
PRE_CHOMP => '-'
%]
+=item Configuration options can use lowercase names instead
+of the all uppercase names that TT2 uses.
+
+ my $t = CGI::Ex::Template->new({
+ anycase => 1,
+ interpolate => 1,
+ });
+
=item CET does not generate Perl code.
It generates an "opcode" tree. The opcode tree is an arrayref
Filenames must be relative to INCLUDE_PATH unless the ABSOLUTE
or RELATIVE configuration items are set.
+Multiple filenames can be passed by separating them with a plus, a space,
+or commas (TT2 doesn't support the comma). Any supplied arguments will
+be used on all templates.
+
+ [% INCLUDE "path/to/template.html",
+ "path/to/template2.html" a = "An arg" b = "Another arg" %]
+
=item C<INSERT>
Insert the contents of a file without template parsing.
Filenames must be relative to INCLUDE_PATH unless the ABSOLUTE
or RELATIVE configuration items are set.
+Multiple filenames can be passed by separating them with a plus, a space,
+or commas (TT2 doesn't support the comma).
+
+ [% INSERT "path/to/template.html",
+ "path/to/template2.html" %]
+
=item C<LAST>
Used to exit out of a WHILE or FOREACH loop.
Filenames must be relative to INCLUDE_PATH unless the ABSOLUTE
or RELATIVE configuration items are set.
+Multiple filenames can be passed by separating them with a plus, a space,
+or commas (TT2 doesn't support the comma). Any supplied arguments will
+be used on all templates.
+
+ [% PROCESS "path/to/template.html",
+ "path/to/template2.html" a = "An arg" b = "Another arg" %]
+
=item C<RAWPERL>
Only available if the EVAL_PERL configuration item is true (default is false).
in the [% content %] variable to the block or filename listed in the
WRAPPER tag.
- [% WRAPPER foo %]
- My content to be processed.[% a = 2 %]
+ [% WRAPPER foo b = 23 %]
+ My content to be processed ([% b %]).[% a = 2 %]
[% END %]
[% BLOCK foo %]
This would print.
A header (2).
- My content to be processed.
+ My content to be processed (23).
A footer (2).
-The WRAPPER directive may also be used as a post directive.
+The WRAPPER directive may also be used as a post operative directive.
[% BLOCK baz %]([% content %])[% END -%]
[% "foobar" WRAPPER baz %]
(foobar)');
+Multiple filenames can be passed by separating them with a plus, a space,
+or commas (TT2 doesn't support the comma). Any supplied arguments will
+be used on all templates. Wrappers are processed in reverse order, so
+that the first wrapper listed will surround each subsequent wrapper listed.
+Variables from inner wrappers are available to the next wrapper that
+surrounds it.
+
+ [% WRAPPER "path/to/outer.html",
+ "path/to/inner.html" a = "An arg" b = "Another arg" %]
+
+
=back
Set a string to use as the closing delimiter for TT. Default is "%]".
+=item ERROR
+
+Used as a fall back when the processing of a template fails. May either
+be a single filename that will be used in all cases, or may be a hashref
+of options where the keynames represent error types that will be handled
+by the filename in their value. A key named default will be used if no
+other matching keyname can be found. The selection process is similar
+to that of the TRY/CATCH/THROW directives (see those directives for more
+information).
+
+ my $t = CGI::Ex::Template->new({
+ ERROR => 'general/catch_all_errors.html',
+ });
+
+ my $t = CGI::Ex::Template->new({
+ ERROR => {
+ default => 'general/catch_all_errors.html',
+ foo => 'catch_all_general_foo_errors.html',
+ 'foo.bar' => 'catch_foo_bar_errors.html',
+ },
+ });
+
+Note that the ERROR handler will only be used for errors during the
+processing of the main document. It will not catch errors that
+occur in templates found in the PRE_PROCESS, POST_PROCESS, and WRAPPER
+configuration items.
+
+=item ERRORS
+
+Same as the ERROR configuration item. Both may be used interchangably.
+
=item EVAL_PERL
Boolean. Default false. If set to a true value, PERL and RAWPERL blocks
Any number of hashes can be added to the NAMESPACE hash.
+=item NEGATIVE_STAT_TTL (Not in TT)
+
+Defaults to STAT_TTL which defaults to $STAT_TTL which defaults to 1.
+
+Similar to STAT_TTL - but represents the time-to-live
+seconds until a document that was not found is checked again against
+the system for modifications. Setting this number higher will allow for
+fewer file system accesses. Setting it to a negative number will allow
+for the file system to be checked every hit.
+
=item OUTPUT
Alternate way of passing in the output location for processed templates.
Set a string to use as the opening delimiter for TT. Default is "[%".
+=item STAT_TTL
+
+Defaults to $STAT_TTL which defaults to 1. Represents time-to-live
+seconds until a cached in memory document is compared to the file
+system for modifications. Setting this number higher will allow for
+fewer file system accesses. Setting it to a negative number will allow
+for the file system to be checked every hit.
+
=item TAG_STYLE
Allow for setting the type of tag delimiters to use for parsing the TT.
variables are available for use in any of the executed templates.
See the section on VARIABLES for the types of information that can be passed in.
-=back
+=item WRAPPER
+Operates similar to the WRAPPER directive. The option can be given a
+single filename, or an arrayref of filenames that will be used to wrap
+the processed content. If an arrayref is passed the filenames are
+processed in reverse order, so that the first filename specified will
+end up being on the outside (surrounding all other wrappers).
+ my $t = CGI::Ex::Template->new(
+ WRAPPER => ['my/wrappers/outer.html', 'my/wrappers/inner.html'],
+ );
-=head1 UNSUPPORTED TT CONFIGURATION
+Content generated by the PRE_PROCESS and POST_PROCESS will come before
+and after (respectively) the content generated by the WRAPPER
+configuration item.
-=over 4
+See the WRAPPER direcive for more examples of how wrappers are construted.
-=item WRAPPER
+=back
-This will be supported - just not done yet.
-=item ERROR
+=head1 UNSUPPORTED TT CONFIGURATION
-This will be supported - just not done yet.
+=over 4
=item LOAD_TEMPLATES
CGI::Ex::Template has its own built in parser. The closest similarity is
the parse_tree method. The output of parse_tree is an optree that is
-later run by execute_tree.
+later run by execute_tree. CET provides a backend to the Template::Parser::CET
+module which can be used to replace the default parser when using
+the standard Template::Toolkit library.
=item GRAMMAR
use vars qw($module $is_tt);
BEGIN {
$module = 'CGI::Ex::Template';
- #$module = 'Template';
+# $module = 'Template';
$is_tt = $module eq 'Template';
};
use strict;
-use Test::More tests => 25 - ($is_tt ? 6 : 0);
+use Test::More tests => (! $is_tt) ? 93 : 83;
use Data::Dumper qw(Dumper);
use constant test_taint => 0 && eval { require Taint::Runtime };
my $foo_template = "$test_dir/foo.tt";
END { unlink $foo_template };
open(my $fh, ">$foo_template") || die "Couldn't open $foo_template: $!";
-print $fh "([% INCLUDE bar.tt %])";
+print $fh "([% template.foo %][% INCLUDE bar.tt %])";
close $fh;
###
my $bar_template = "$test_dir/bar.tt";
END { unlink $bar_template };
open($fh, ">$bar_template") || die "Couldn't open $bar_template: $!";
-print $fh "BAR";
+print $fh "[% blue %]BAR";
close $fh;
my $baz_template = "$test_dir/baz.tt";
my $wrap_template = "$test_dir/wrap.tt";
END { unlink $wrap_template };
open($fh, ">$wrap_template") || die "Couldn't open $wrap_template: $!";
-print $fh "Hi[% content %]there";
+print $fh "Hi[% baz; template.foo; baz = 'wrap' %][% content %]there";
close $fh;
+###
+my $meta_template = "$test_dir/meta.tt";
+END { unlink $meta_template };
+open($fh, ">$meta_template") || die "Couldn't open $meta_template: $!";
+print $fh "[% META bar='meta.tt' %]Metafoo([% component.foo %]) Metabar([% component.bar %])";
+close $fh;
+
+###
+my $catch_template = "$test_dir/catch.tt";
+END { unlink $catch_template };
+open($fh, ">$catch_template") || die "Couldn't open $catch_template: $!";
+print $fh "Error ([% error.type %]) - ([% error.info %])";
+close $fh;
+
+###
+my $catch2_template = "$test_dir/catch2.tt";
+END { unlink $catch2_template };
+open($fh, ">$catch2_template") || die "Couldn't open $catch2_template: $!";
+print $fh "Error2 ([% error.type %]) - ([% error.info %])";
+close $fh;
+
+###
+my $die_template = "$test_dir/die.tt";
+END { unlink $die_template };
+open($fh, ">$die_template") || die "Couldn't open $die_template: $!";
+print $fh "[% THROW bing 'blang' %])";
+close $fh;
+
+###
+my $config_template = "$test_dir/config.tt";
+END { unlink $config_template };
+open($fh, ">$config_template") || die "Couldn't open $config_template: $!";
+print $fh "[% CONFIG DUMP => {html => 1} %][% DUMP foo %]";
+close $fh;
+
+
###----------------------------------------------------------------###
-### INSERT
+print "### INSERT ###########################################################\n";
-process_ok("([% INSERT bar.tt %])" => '(BAR)');
-process_ok("([% SET file = 'bar.tt' %][% INSERT \$file %])" => '(BAR)');
-process_ok("([% SET file = 'bar.tt' %][% INSERT \${file} %])" => '(BAR)') if ! $is_tt;
-process_ok("([% SET file = 'bar.tt' %][% INSERT \"\$file\" %])" => '(BAR)');
-process_ok("([% SET file = 'bar' %][% INSERT \"\$file.tt\" %])" => '(BAR)') if ! $is_tt;
+process_ok("([% INSERT bar.tt %])" => '([% blue %]BAR)');
+process_ok("([% SET file = 'bar.tt' %][% INSERT \$file %])" => '([% blue %]BAR)');
+process_ok("([% SET file = 'bar.tt' %][% INSERT \${file} %])" => '([% blue %]BAR)') if ! $is_tt;
+process_ok("([% SET file = 'bar.tt' %][% INSERT \"\$file\" %])" => '([% blue %]BAR)');
+process_ok("([% SET file = 'bar' %][% INSERT \"\$file.tt\" %])" => '([% blue %]BAR)') if ! $is_tt;
###----------------------------------------------------------------###
-### INCLUDE
+print "### INCLUDE ##########################################################\n";
process_ok("([% INCLUDE bar.tt %])" => '(BAR)');
+process_ok("[% PROCESS foo.tt %]" => '(BAR)');
+process_ok("[% PROCESS meta.tt %]" => 'Metafoo() Metabar(meta.tt)');
+process_ok("[% META foo = 'string'; PROCESS meta.tt %]" => 'Metafoo() Metabar(meta.tt)');
+process_ok("[% PROCESS meta.tt %][% template.bar %]" => 'Metafoo() Metabar(meta.tt)');
+process_ok("[% META foo = 'meta'; PROCESS foo.tt %]" => '(metaBAR)');
process_ok("([% SET file = 'bar.tt' %][% INCLUDE \$file %])" => '(BAR)');
process_ok("([% SET file = 'bar.tt' %][% INCLUDE \${file} %])" => '(BAR)') if ! $is_tt;
process_ok("([% SET file = 'bar.tt' %][% INCLUDE \"\$file\" %])" => '(BAR)');
process_ok("[% SET baz = 21 %]([% INCLUDE baz.tt %])[% baz %]" => '(42)21');
###----------------------------------------------------------------###
-### PROCESS
+print "### PROCESS ##########################################################\n";
process_ok("([% PROCESS bar.tt %])" => '(BAR)');
+process_ok("[% PROCESS foo.tt %]" => '(BAR)');
+process_ok("[% PROCESS meta.tt %]" => 'Metafoo() Metabar(meta.tt)');
+process_ok("[% META foo = 'string'; PROCESS meta.tt %]" => 'Metafoo() Metabar(meta.tt)');
+process_ok("[% PROCESS meta.tt %][% template.bar %]" => 'Metafoo() Metabar(meta.tt)');
+process_ok("[% META foo = 'meta'; PROCESS foo.tt %]" => '(metaBAR)');
process_ok("([% SET file = 'bar.tt' %][% PROCESS \$file %])" => '(BAR)');
process_ok("([% SET file = 'bar.tt' %][% PROCESS \${file} %])" => '(BAR)') if ! $is_tt;
process_ok("([% SET file = 'bar.tt' %][% PROCESS \"\$file\" %])" => '(BAR)');
process_ok("[% SET baz = 21 %]([% PROCESS baz.tt %])[% baz %]" => '(42)42');
###----------------------------------------------------------------###
-### WRAPPER
+print "### WRAPPER ##########################################################\n";
process_ok("([% WRAPPER wrap.tt %])" => '');
process_ok("([% WRAPPER wrap.tt %] one [% END %])" => '(Hi one there)');
+process_ok("([% WRAPPER wrap.tt %] ([% baz %]) [% END %])" => '(Hi () there)');
+process_ok("([% WRAPPER wrap.tt %] one [% END %])" => '(HiBAZ one there)', {baz => 'BAZ'});
+process_ok("([% WRAPPER wrap.tt %] ([% baz; baz='-local' %]) [% END %][% baz %])" => '(Hi-local () there-local)');
+process_ok("([% WRAPPER wrap.tt %][% META foo='BLAM' %] [% END %])" => '(HiBLAM there)');
+
+###----------------------------------------------------------------###
+print "### CONFIG PRE_PROCESS ###############################################\n";
+
+process_ok("Foo" => "BARFoo", {tt_config => [PRE_PROCESS => 'bar.tt']});
+process_ok("Foo" => "BARFoo", {tt_config => [PRE_PROCESS => ['bar.tt']]});
+process_ok("Foo" => "(BAR)BARFoo", {tt_config => [PRE_PROCESS => ['foo.tt', 'bar.tt']]});
+process_ok("Foo" => "BlueBARFoo", {tt_config => [PRE_PROCESS => 'bar.tt'], blue => 'Blue'});
+process_ok("Foo[% blue='Blue' %]" => "BARFoo", {tt_config => [PRE_PROCESS => 'bar.tt']});
+process_ok("Foo[% META foo='meta' %]" => "(metaBAR)Foo", {tt_config => [PRE_PROCESS => 'foo.tt']});
+process_ok("([% WRAPPER wrap.tt %] one [% END %])" => 'BAR(Hi one there)', {tt_config => [PRE_PROCESS => 'bar.tt']});
+
+###----------------------------------------------------------------###
+print "### CONFIG POST_PROCESS ##############################################\n";
+
+process_ok("Foo" => "FooBAR", {tt_config => [POST_PROCESS => 'bar.tt']});
+process_ok("Foo" => "FooBAR", {tt_config => [POST_PROCESS => ['bar.tt']]});
+process_ok("Foo" => "Foo(BAR)BAR", {tt_config => [POST_PROCESS => ['foo.tt', 'bar.tt']]});
+process_ok("Foo" => "FooBlueBAR", {tt_config => [POST_PROCESS => 'bar.tt'], blue => 'Blue'});
+process_ok("Foo[% blue='Blue' %]" => "FooBlueBAR", {tt_config => [POST_PROCESS => 'bar.tt']});
+process_ok("Foo[% META foo='meta' %]" => "Foo(metaBAR)", {tt_config => [POST_PROCESS => 'foo.tt']});
+process_ok("([% WRAPPER wrap.tt %] one [% END %])" => '(Hi one there)BAR', {tt_config => [POST_PROCESS => 'bar.tt']});
+
+###----------------------------------------------------------------###
+print "### CONFIG PROCESS ###################################################\n";
+
+process_ok("Foo" => "BAR", {tt_config => [PROCESS => 'bar.tt']});
+process_ok("Foo" => "BAR", {tt_config => [PROCESS => ['bar.tt']]});
+process_ok("Foo" => "(BAR)BAR", {tt_config => [PROCESS => ['foo.tt', 'bar.tt']]});
+process_ok("Foo" => "BlueBAR", {tt_config => [PROCESS => 'bar.tt'], blue => 'Blue'});
+process_ok("Foo[% META foo='meta' %]" => "(metaBAR)", {tt_config => [PROCESS => 'foo.tt']});
+process_ok("Foo[% META foo='meta' %]" => "BAR(metaBAR)", {tt_config => [PRE_PROCESS => 'bar.tt', PROCESS => 'foo.tt']});
+process_ok("Foo[% META foo='meta' %]" => "(metaBAR)BAR", {tt_config => [POST_PROCESS => 'bar.tt', PROCESS => 'foo.tt']});
+
+###----------------------------------------------------------------###
+print "### CONFIG WRAPPER ###################################################\n";
+
+process_ok(" one " => 'Hi one there', {tt_config => [WRAPPER => 'wrap.tt']});
+process_ok(" one " => 'Hi one there', {tt_config => [WRAPPER => ['wrap.tt']]});
+process_ok(" one " => 'HiwrapHi one therethere', {tt_config => [WRAPPER => ['wrap.tt', 'wrap.tt']]});
+process_ok(" ([% baz %]) " => 'Hi () there', {tt_config => [WRAPPER => 'wrap.tt']});
+process_ok(" one " => 'HiBAZ one there', {baz => 'BAZ', tt_config => [WRAPPER => 'wrap.tt']});;
+process_ok(" ([% baz; baz='-local' %]) " => 'Hi-local () there', {tt_config => [WRAPPER => 'wrap.tt']});
+process_ok("[% META foo='BLAM' %] " => 'HiBLAM there', {tt_config => [WRAPPER => 'wrap.tt']});
+
+process_ok(" one " => 'BARHi one there', {tt_config => [WRAPPER => 'wrap.tt', PRE_PROCESS => 'bar.tt']});
+process_ok(" one " => 'HiBARthere', {tt_config => [WRAPPER => 'wrap.tt', PROCESS => 'bar.tt']});
+process_ok(" one " => 'Hi one thereBAR', {tt_config => [WRAPPER => 'wrap.tt', POST_PROCESS => 'bar.tt']});
+
+###----------------------------------------------------------------###
+print "### CONFIG ERRORS ####################################################\n";
+
+process_ok("[% THROW foo 'bar' %]" => 'Error (foo) - (bar)', {tt_config => [ERROR => 'catch.tt']});
+process_ok("[% THROW foo 'bar' %]" => 'Error (foo) - (bar)', {tt_config => [ERRORS => 'catch.tt']});
+process_ok("[% THROW foo 'bar' %]" => 'Error (foo) - (bar)', {tt_config => [ERROR => {default => 'catch.tt'}]});
+process_ok("[% THROW foo 'bar' %]" => 'Error (foo) - (bar)', {tt_config => [ERRORS => {default => 'catch.tt'}]});
+process_ok("[% THROW foo 'bar' %]" => 'Error2 (foo) - (bar)', {tt_config => [ERRORS => {foo => 'catch2.tt', default => 'catch.tt'}]});
+process_ok("[% THROW foo.baz 'bar' %]" => 'Error2 (foo.baz) - (bar)', {tt_config => [ERRORS => {foo => 'catch2.tt', default => 'catch.tt'}]});
+process_ok("[% THROW foo.baz 'bar' %]" => 'Error2 (foo.baz) - (bar)', {tt_config => [ERRORS => {'foo.baz' => 'catch2.tt', default => 'catch.tt'}]});
+process_ok("[% THROW foo 'bar' %]" => 'Error (foo) - (bar)', {tt_config => [ERRORS => {'foo.baz' => 'catch2.tt', default => 'catch.tt'}]});
+process_ok("[% THROW foo.baz 'bar' %]" => 'Error2 (foo.baz) - (bar)', {tt_config => [ERRORS => {foo => 'catch2.tt', default => 'catch.tt'}]});
+
+process_ok("[% THROW foo 'bar' %]" => 'BARError (foo) - (bar)', {tt_config => [ERROR => 'catch.tt', PRE_PROCESS => 'bar.tt']});
+process_ok("[% THROW foo 'bar' %]" => 'Error (bing) - (blang)', {tt_config => [ERROR => 'catch.tt', PROCESS => 'die.tt']});
+process_ok("[% THROW foo 'bar' %]" => 'Error (bing) - (blang)', {tt_config => [ERROR => 'catch.tt', PROCESS => ['bar.tt', 'die.tt']]});
+process_ok("[% THROW foo 'bar' %]" => 'Error (foo) - (bar)BAR', {tt_config => [ERROR => 'catch.tt', POST_PROCESS => 'bar.tt']});
+process_ok("[% THROW foo 'bar' %]" => 'HiError (foo) - (bar)there', {tt_config => [ERROR => 'catch.tt', WRAPPER => 'wrap.tt']});
+
+process_ok("(outer)[% PROCESS 'die.tt' %]" => 'Error (bing) - (blang)', {tt_config => [ERROR => 'catch.tt']});
+process_ok("(outer)[% TRY %][% PROCESS 'die.tt' %][% CATCH %] [% END %]" => '(outer) ', {tt_config => [ERROR => 'catch.tt']});
+
+process_ok(" one " => '', {tt_config => [ERROR => 'catch.tt', PRE_PROCESS => 'die.tt']});
+process_ok(" one " => '', {tt_config => [ERROR => 'catch.tt', POST_PROCESS => 'die.tt']});
+process_ok(" one " => '', {tt_config => [ERROR => 'catch.tt', WRAPPER => 'die.tt']});
+
+###----------------------------------------------------------------###
+print "### CONFIG and DUMP ##################################################\n";
+
+process_ok("[% CONFIG DUMP => {html => 0}; DUMP foo; PROCESS config.tt; DUMP foo %]" => qq{DUMP: File "input text" line 1
+ foo = 'FOO';
+<b>DUMP: File "config.tt" line 1</b><pre>foo = 'FOO';
+</pre>DUMP: File "input text" line 1
+ foo = 'FOO';
+}, {foo => 'FOO'}) if ! $is_tt;
+
+###----------------------------------------------------------------###
+print "### NOT FOUND CACHE ##################################################\n";
+
+process_ok("[% BLOCK foo; TRY; PROCESS blurty.tt; CATCH %]([% error.type %])([% error.info %])\n[% END; END; PROCESS foo; PROCESS foo %]" => "(file)(blurty.tt: not found)\n(file)(blurty.tt: not found (cached))\n", {tt_config => [NEGATIVE_STAT_TTL => 2]}) if ! $is_tt;
+process_ok("[% BLOCK foo; TRY; PROCESS blurty.tt; CATCH %]([% error.type %])([% error.info %])\n[% END; END; PROCESS foo; PROCESS foo %]" => "(file)(blurty.tt: not found)\n(file)(blurty.tt: not found)\n", {tt_config => [NEGATIVE_STAT_TTL => -1]}) if ! $is_tt;
+process_ok("[% BLOCK foo; TRY; PROCESS blurty.tt; CATCH %]([% error.type %])([% error.info %])\n[% END; END; PROCESS foo; PROCESS foo %]" => "(file)(blurty.tt: not found)\n(file)(blurty.tt: not found)\n", {tt_config => [STAT_TTL => -1]}) if ! $is_tt;
+
+###----------------------------------------------------------------###
+print "### DONE #############################################################\n";
projects / chaz / p5-CGI-Ex / commitdiff
