Skip to content
Fetching contributors…
Cannot retrieve contributors at this time
executable file 20474 lines (18645 sloc) 434 KB
#!/usr/bin/env perl
#BOOTSTRAP-BEGIN
# This is the standalone Jemplate compiler.
#
# All you need is this program and the program called `perl`. You don't need
# to install any Perl modules.
#
# If you downloaded this program from the internet, don't forget to put it in
# your path and make sure it is executable. Like this:
#
# mv jemplate /usr/local/bin/
# chmod +x /usr/local/bin/jemplate
#
# Try this command to make sure it works:
#
# jemplate --help
use Config;
BEGIN {
@INC = (
$Config::Config{archlib},
$Config::Config{privlib},
);
}
use strict;
use warnings;
#
# Inline include of Number/Compare.pm
#
BEGIN { $INC{'Number/Compare.pm'} = 'dummy/Number/Compare.pm'; }
BEGIN {
#line 0 "Number/Compare.pm"
package Number::Compare;
use strict;
use Carp qw(croak);
use vars qw/$VERSION/;
$VERSION = '0.03';
sub new {
my $referent = shift;
my $class = ref $referent || $referent;
my $expr = $class->parse_to_perl( shift );
bless eval "sub { \$_[0] $expr }", $class;
}
sub parse_to_perl {
shift;
my $test = shift;
$test =~ m{^
([<>]=?)? # comparison
(.*?) # value
([kmg]i?)? # magnitude
$}ix
or croak "don't understand '$test' as a test";
my $comparison = $1 || '==';
my $target = $2;
my $magnitude = $3 || '';
$target *= 1000 if lc $magnitude eq 'k';
$target *= 1024 if lc $magnitude eq 'ki';
$target *= 1000000 if lc $magnitude eq 'm';
$target *= 1024*1024 if lc $magnitude eq 'mi';
$target *= 1000000000 if lc $magnitude eq 'g';
$target *= 1024*1024*1024 if lc $magnitude eq 'gi';
return "$comparison $target";
}
sub test { $_[0]->( $_[1] ) }
1;
}
#
# Inline include of Text/Glob.pm
#
BEGIN { $INC{'Text/Glob.pm'} = 'dummy/Text/Glob.pm'; }
BEGIN {
#line 0 "Text/Glob.pm"
package Text::Glob;
use strict;
use Exporter;
use vars qw/$VERSION @ISA @EXPORT_OK
$strict_leading_dot $strict_wildcard_slash/;
$VERSION = '0.09';
@ISA = 'Exporter';
@EXPORT_OK = qw( glob_to_regex glob_to_regex_string match_glob );
$strict_leading_dot = 1;
$strict_wildcard_slash = 1;
use constant debug => 0;
sub glob_to_regex {
my $glob = shift;
my $regex = glob_to_regex_string($glob);
return qr/^$regex$/;
}
sub glob_to_regex_string
{
my $glob = shift;
my ($regex, $in_curlies, $escaping);
local $_;
my $first_byte = 1;
for ($glob =~ m/(.)/gs) {
if ($first_byte) {
if ($strict_leading_dot) {
$regex .= '(?=[^\.])' unless $_ eq '.';
}
$first_byte = 0;
}
if ($_ eq '/') {
$first_byte = 1;
}
if ($_ eq '.' || $_ eq '(' || $_ eq ')' || $_ eq '|' ||
$_ eq '+' || $_ eq '^' || $_ eq '$' || $_ eq '@' || $_ eq '%' ) {
$regex .= "\\$_";
}
elsif ($_ eq '*') {
$regex .= $escaping ? "\\*" :
$strict_wildcard_slash ? "[^/]*" : ".*";
}
elsif ($_ eq '?') {
$regex .= $escaping ? "\\?" :
$strict_wildcard_slash ? "[^/]" : ".";
}
elsif ($_ eq '{') {
$regex .= $escaping ? "\\{" : "(";
++$in_curlies unless $escaping;
}
elsif ($_ eq '}' && $in_curlies) {
$regex .= $escaping ? "}" : ")";
--$in_curlies unless $escaping;
}
elsif ($_ eq ',' && $in_curlies) {
$regex .= $escaping ? "," : "|";
}
elsif ($_ eq "\\") {
if ($escaping) {
$regex .= "\\\\";
$escaping = 0;
}
else {
$escaping = 1;
}
next;
}
else {
$regex .= $_;
$escaping = 0;
}
$escaping = 0;
}
print "# $glob $regex\n" if debug;
return $regex;
}
sub match_glob {
print "# ", join(', ', map { "'$_'" } @_), "\n" if debug;
my $glob = shift;
my $regex = glob_to_regex $glob;
local $_;
grep { $_ =~ $regex } @_;
}
1;
}
#
# Inline include of File/Find/Rule.pm
#
BEGIN { $INC{'File/Find/Rule.pm'} = 'dummy/File/Find/Rule.pm'; }
BEGIN {
#line 0 "File/Find/Rule.pm"
package File::Find::Rule;
use strict;
use File::Spec;
use Text::Glob 'glob_to_regex';
use Number::Compare;
use Carp qw/croak/;
use File::Find (); # we're only wrapping for now
our $VERSION = '0.33';
sub import {
my $pkg = shift;
my $to = caller;
for my $sym ( qw( find rule ) ) {
no strict 'refs';
*{"$to\::$sym"} = \&{$sym};
}
for (grep /^:/, @_) {
my ($extension) = /^:(.*)/;
eval "require File::Find::Rule::$extension";
croak "couldn't bootstrap File::Find::Rule::$extension: $@" if $@;
}
}
*rule = \&find;
sub find {
my $object = __PACKAGE__->new();
my $not = 0;
while (@_) {
my $method = shift;
my @args;
if ($method =~ s/^\!//) {
# jinkies, we're really negating this
unshift @_, $method;
$not = 1;
next;
}
unless (defined prototype $method) {
my $args = shift;
@args = ref $args eq 'ARRAY' ? @$args : $args;
}
if ($not) {
$not = 0;
@args = $object->new->$method(@args);
$method = "not";
}
my @return = $object->$method(@args);
return @return if $method eq 'in';
}
$object;
}
sub new {
my $referent = shift;
my $class = ref $referent || $referent;
bless {
rules => [],
subs => {},
iterator => [],
extras => {},
maxdepth => undef,
mindepth => undef,
}, $class;
}
sub _force_object {
my $object = shift;
$object = $object->new()
unless ref $object;
$object;
}
sub _flatten {
my @flat;
while (@_) {
my $item = shift;
ref $item eq 'ARRAY' ? push @_, @{ $item } : push @flat, $item;
}
return @flat;
}
sub name {
my $self = _force_object shift;
my @names = map { ref $_ eq "Regexp" ? $_ : glob_to_regex $_ } _flatten( @_ );
push @{ $self->{rules} }, {
rule => 'name',
code => join( ' || ', map { "m{$_}" } @names ),
args => \@_,
};
$self;
}
use vars qw( %X_tests );
%X_tests = (
-r => readable => -R => r_readable =>
-w => writeable => -W => r_writeable =>
-w => writable => -W => r_writable =>
-x => executable => -X => r_executable =>
-o => owned => -O => r_owned =>
-e => exists => -f => file =>
-z => empty => -d => directory =>
-s => nonempty => -l => symlink =>
=> -p => fifo =>
-u => setuid => -S => socket =>
-g => setgid => -b => block =>
-k => sticky => -c => character =>
=> -t => tty =>
-M => modified =>
-A => accessed => -T => ascii =>
-C => changed => -B => binary =>
);
for my $test (keys %X_tests) {
my $sub = eval 'sub () {
my $self = _force_object shift;
push @{ $self->{rules} }, {
code => "' . $test . ' \$_",
rule => "'.$X_tests{$test}.'",
};
$self;
} ';
no strict 'refs';
*{ $X_tests{$test} } = $sub;
}
use vars qw( @stat_tests );
@stat_tests = qw( dev ino mode nlink uid gid rdev
size atime mtime ctime blksize blocks );
{
my $i = 0;
for my $test (@stat_tests) {
my $index = $i++; # to close over
my $sub = sub {
my $self = _force_object shift;
my @tests = map { Number::Compare->parse_to_perl($_) } @_;
push @{ $self->{rules} }, {
rule => $test,
args => \@_,
code => 'do { my $val = (stat $_)['.$index.'] || 0;'.
join ('||', map { "(\$val $_)" } @tests ).' }',
};
$self;
};
no strict 'refs';
*$test = $sub;
}
}
sub any {
my $self = _force_object shift;
# compile all the subrules to code fragments
push @{ $self->{rules} }, {
rule => "any",
code => '(' . join( ' || ', map '( ' . $_->_compile . ' )', @_ ). ')',
args => \@_,
};
# merge all the subs hashes of the kids into ourself
%{ $self->{subs} } = map { %{ $_->{subs} } } $self, @_;
$self;
}
*or = \&any;
sub not {
my $self = _force_object shift;
push @{ $self->{rules} }, {
rule => 'not',
args => \@_,
code => '(' . join ( ' && ', map { "!(". $_->_compile . ")" } @_ ) . ")",
};
# merge all the subs hashes into us
%{ $self->{subs} } = map { %{ $_->{subs} } } $self, @_;
$self;
}
*none = \&not;
sub prune () {
my $self = _force_object shift;
push @{ $self->{rules} },
{
rule => 'prune',
code => '$File::Find::prune = 1'
};
$self;
}
sub discard () {
my $self = _force_object shift;
push @{ $self->{rules} }, {
rule => 'discard',
code => '$discarded = 1',
};
$self;
}
sub exec {
my $self = _force_object shift;
my $code = shift;
push @{ $self->{rules} }, {
rule => 'exec',
code => $code,
};
$self;
}
sub grep {
my $self = _force_object shift;
my @pattern = map {
ref $_
? ref $_ eq 'ARRAY'
? map { [ ( ref $_ ? $_ : qr/$_/ ) => 0 ] } @$_
: [ $_ => 1 ]
: [ qr/$_/ => 1 ]
} @_;
$self->exec( sub {
local *FILE;
open FILE, $_ or return;
local ($_, $.);
while (<FILE>) {
for my $p (@pattern) {
my ($rule, $ret) = @$p;
return $ret
if ref $rule eq 'Regexp'
? /$rule/
: $rule->(@_);
}
}
return;
} );
}
for my $setter (qw( maxdepth mindepth extras )) {
my $sub = sub {
my $self = _force_object shift;
$self->{$setter} = shift;
$self;
};
no strict 'refs';
*$setter = $sub;
}
sub relative () {
my $self = _force_object shift;
$self->{relative} = 1;
$self;
}
sub DESTROY {}
sub AUTOLOAD {
our $AUTOLOAD;
$AUTOLOAD =~ /::not_([^:]*)$/
or croak "Can't locate method $AUTOLOAD";
my $method = $1;
my $sub = sub {
my $self = _force_object shift;
$self->not( $self->new->$method(@_) );
};
{
no strict 'refs';
*$AUTOLOAD = $sub;
}
&$sub;
}
sub in {
my $self = _force_object shift;
my @found;
my $fragment = $self->_compile;
my %subs = %{ $self->{subs} };
warn "relative mode handed multiple paths - that's a bit silly\n"
if $self->{relative} && @_ > 1;
my $topdir;
my $code = 'sub {
(my $path = $File::Find::name) =~ s#^(?:\./+)+##;
my @args = ($_, $File::Find::dir, $path);
my $maxdepth = $self->{maxdepth};
my $mindepth = $self->{mindepth};
my $relative = $self->{relative};
# figure out the relative path and depth
my $relpath = $File::Find::name;
$relpath =~ s{^\Q$topdir\E/?}{};
my $depth = scalar File::Spec->splitdir($relpath);
#print "name: \'$File::Find::name\' ";
#print "relpath: \'$relpath\' depth: $depth relative: $relative\n";
defined $maxdepth && $depth >= $maxdepth
and $File::Find::prune = 1;
defined $mindepth && $depth < $mindepth
and return;
#print "Testing \'$_\'\n";
my $discarded;
return unless ' . $fragment . ';
return if $discarded;
if ($relative) {
push @found, $relpath if $relpath ne "";
}
else {
push @found, $path;
}
}';
#use Data::Dumper;
#print Dumper \%subs;
#warn "Compiled sub: '$code'\n";
my $sub = eval "$code" or die "compile error '$code' $@";
for my $path (@_) {
# $topdir is used for relative and maxdepth
$topdir = $path;
# slice off the trailing slash if there is one (the
# maxdepth/mindepth code is fussy)
$topdir =~ s{/?$}{}
unless $topdir eq '/';
$self->_call_find( { %{ $self->{extras} }, wanted => $sub }, $path );
}
return @found;
}
sub _call_find {
my $self = shift;
File::Find::find( @_ );
}
sub _compile {
my $self = shift;
return '1' unless @{ $self->{rules} };
my $code = join " && ", map {
if (ref $_->{code}) {
my $key = "$_->{code}";
$self->{subs}{$key} = $_->{code};
"\$subs{'$key'}->(\@args) # $_->{rule}\n";
}
else {
"( $_->{code} ) # $_->{rule}\n";
}
} @{ $self->{rules} };
#warn $code;
return $code;
}
sub start {
my $self = _force_object shift;
$self->{iterator} = [ $self->in( @_ ) ];
$self;
}
sub match {
my $self = _force_object shift;
return shift @{ $self->{iterator} };
}
1;
}
#
# Inline include of Template/Constants.pm
#
BEGIN { $INC{'Template/Constants.pm'} = 'dummy/Template/Constants.pm'; }
BEGIN {
#line 0 "Template/Constants.pm"
package Template::Constants;
require Exporter;
use strict;
use warnings;
use Exporter;
use vars qw( @EXPORT_OK %EXPORT_TAGS );
use vars qw( $DEBUG_OPTIONS @STATUS @ERROR @CHOMP @DEBUG @ISA );
@ISA = qw( Exporter );
our $VERSION = 2.75;
use constant STATUS_OK => 0; # ok
use constant STATUS_RETURN => 1; # ok, block ended by RETURN
use constant STATUS_STOP => 2; # ok, stoppped by STOP
use constant STATUS_DONE => 3; # ok, iterator done
use constant STATUS_DECLINED => 4; # ok, declined to service request
use constant STATUS_ERROR => 255; # error condition
use constant ERROR_RETURN => 'return'; # return a status code
use constant ERROR_FILE => 'file'; # file error: I/O, parse, recursion
use constant ERROR_VIEW => 'view'; # view error
use constant ERROR_UNDEF => 'undef'; # undefined variable value used
use constant ERROR_PERL => 'perl'; # error in [% PERL %] block
use constant ERROR_FILTER => 'filter'; # filter error
use constant ERROR_PLUGIN => 'plugin'; # plugin error
use constant CHOMP_NONE => 0; # do not remove whitespace
use constant CHOMP_ALL => 1; # remove whitespace up to newline
use constant CHOMP_ONE => 1; # new name for CHOMP_ALL
use constant CHOMP_COLLAPSE => 2; # collapse whitespace to a single space
use constant CHOMP_GREEDY => 3; # remove all whitespace including newlines
use constant DEBUG_OFF => 0; # do nothing
use constant DEBUG_ON => 1; # basic debugging flag
use constant DEBUG_UNDEF => 2; # throw undef on undefined variables
use constant DEBUG_VARS => 4; # general variable debugging
use constant DEBUG_DIRS => 8; # directive debugging
use constant DEBUG_STASH => 16; # general stash debugging
use constant DEBUG_CONTEXT => 32; # context debugging
use constant DEBUG_PARSER => 64; # parser debugging
use constant DEBUG_PROVIDER => 128; # provider debugging
use constant DEBUG_PLUGINS => 256; # plugins debugging
use constant DEBUG_FILTERS => 512; # filters debugging
use constant DEBUG_SERVICE => 1024; # context debugging
use constant DEBUG_ALL => 2047; # everything
use constant DEBUG_CALLER => 4096; # add caller file/line
use constant DEBUG_FLAGS => 4096; # bitmask to extraxt flags
$DEBUG_OPTIONS = {
&DEBUG_OFF => off => off => &DEBUG_OFF,
&DEBUG_ON => on => on => &DEBUG_ON,
&DEBUG_UNDEF => undef => undef => &DEBUG_UNDEF,
&DEBUG_VARS => vars => vars => &DEBUG_VARS,
&DEBUG_DIRS => dirs => dirs => &DEBUG_DIRS,
&DEBUG_STASH => stash => stash => &DEBUG_STASH,
&DEBUG_CONTEXT => context => context => &DEBUG_CONTEXT,
&DEBUG_PARSER => parser => parser => &DEBUG_PARSER,
&DEBUG_PROVIDER => provider => provider => &DEBUG_PROVIDER,
&DEBUG_PLUGINS => plugins => plugins => &DEBUG_PLUGINS,
&DEBUG_FILTERS => filters => filters => &DEBUG_FILTERS,
&DEBUG_SERVICE => service => service => &DEBUG_SERVICE,
&DEBUG_ALL => all => all => &DEBUG_ALL,
&DEBUG_CALLER => caller => caller => &DEBUG_CALLER,
};
@STATUS = qw( STATUS_OK STATUS_RETURN STATUS_STOP STATUS_DONE
STATUS_DECLINED STATUS_ERROR );
@ERROR = qw( ERROR_FILE ERROR_VIEW ERROR_UNDEF ERROR_PERL
ERROR_RETURN ERROR_FILTER ERROR_PLUGIN );
@CHOMP = qw( CHOMP_NONE CHOMP_ALL CHOMP_ONE CHOMP_COLLAPSE CHOMP_GREEDY );
@DEBUG = qw( DEBUG_OFF DEBUG_ON DEBUG_UNDEF DEBUG_VARS
DEBUG_DIRS DEBUG_STASH DEBUG_CONTEXT DEBUG_PARSER
DEBUG_PROVIDER DEBUG_PLUGINS DEBUG_FILTERS DEBUG_SERVICE
DEBUG_ALL DEBUG_CALLER DEBUG_FLAGS );
@EXPORT_OK = ( @STATUS, @ERROR, @CHOMP, @DEBUG );
%EXPORT_TAGS = (
'all' => [ @EXPORT_OK ],
'status' => [ @STATUS ],
'error' => [ @ERROR ],
'chomp' => [ @CHOMP ],
'debug' => [ @DEBUG ],
);
sub debug_flags {
my ($self, $debug) = @_;
my (@flags, $flag, $value);
$debug = $self unless defined($debug) || ref($self);
if ($debug =~ /^\d+$/) {
foreach $flag (@DEBUG) {
next if $flag =~ /^DEBUG_(OFF|ALL|FLAGS)$/;
# don't trash the original
my $copy = $flag;
$flag =~ s/^DEBUG_//;
$flag = lc $flag;
return $self->error("no value for flag: $flag")
unless defined($value = $DEBUG_OPTIONS->{ $flag });
$flag = $value;
if ($debug & $flag) {
$value = $DEBUG_OPTIONS->{ $flag };
return $self->error("no value for flag: $flag") unless defined $value;
push(@flags, $value);
}
}
return wantarray ? @flags : join(', ', @flags);
}
else {
@flags = split(/\W+/, $debug);
$debug = 0;
foreach $flag (@flags) {
$value = $DEBUG_OPTIONS->{ $flag };
return $self->error("unknown debug flag: $flag") unless defined $value;
$debug |= $value;
}
return $debug;
}
}
1;
}
#
# Inline include of Template/Base.pm
#
BEGIN { $INC{'Template/Base.pm'} = 'dummy/Template/Base.pm'; }
BEGIN {
#line 0 "Template/Base.pm"
package Template::Base;
use strict;
use warnings;
use Template::Constants;
our $VERSION = 2.78;
sub new {
my $class = shift;
my ($argnames, @args, $arg, $cfg);
{ no strict 'refs';
no warnings 'once';
$argnames = \@{"$class\::BASEARGS"} || [ ];
}
# shift off all mandatory args, returning error if undefined or null
foreach $arg (@$argnames) {
return $class->error("no $arg specified")
unless ($cfg = shift);
push(@args, $cfg);
}
# fold all remaining args into a hash, or use provided hash ref
$cfg = defined $_[0] && ref($_[0]) eq 'HASH' ? shift : { @_ };
my $self = bless {
(map { ($_ => shift @args) } @$argnames),
_ERROR => '',
DEBUG => 0,
}, $class;
return $self->_init($cfg) ? $self : $class->error($self->error);
}
sub error {
my $self = shift;
my $errvar;
{
no strict qw( refs );
$errvar = ref $self ? \$self->{ _ERROR } : \${"$self\::ERROR"};
}
if (@_) {
$$errvar = ref($_[0]) ? shift : join('', @_);
return undef;
}
else {
return $$errvar;
}
}
sub _init {
my ($self, $config) = @_;
return $self;
}
sub debug {
my $self = shift;
my $msg = join('', @_);
my ($pkg, $file, $line) = caller();
unless ($msg =~ /\n$/) {
$msg .= ($self->{ DEBUG } & Template::Constants::DEBUG_CALLER)
? " at $file line $line\n"
: "\n";
}
print STDERR "[$pkg] $msg";
}
sub module_version {
my $self = shift;
my $class = ref $self || $self;
no strict 'refs';
return ${"${class}::VERSION"};
}
1;
}
#
# Inline include of Template/Config.pm
#
BEGIN { $INC{'Template/Config.pm'} = 'dummy/Template/Config.pm'; }
BEGIN {
#line 0 "Template/Config.pm"
package Template::Config;
use strict;
use warnings;
use base 'Template::Base';
use vars qw( $VERSION $DEBUG $ERROR $INSTDIR
$PARSER $PROVIDER $PLUGINS $FILTERS $ITERATOR
$LATEX_PATH $PDFLATEX_PATH $DVIPS_PATH
$STASH $SERVICE $CONTEXT $CONSTANTS @PRELOAD );
$VERSION = 2.75;
$DEBUG = 0 unless defined $DEBUG;
$ERROR = '';
$CONTEXT = 'Template::Context';
$FILTERS = 'Template::Filters';
$ITERATOR = 'Template::Iterator';
$PARSER = 'Template::Parser';
$PLUGINS = 'Template::Plugins';
$PROVIDER = 'Template::Provider';
$SERVICE = 'Template::Service';
$STASH = 'Template::Stash::XS';
$CONSTANTS = 'Template::Namespace::Constants';
@PRELOAD = ( $CONTEXT, $FILTERS, $ITERATOR, $PARSER,
$PLUGINS, $PROVIDER, $SERVICE, $STASH );
$INSTDIR = '';
sub preload {
my $class = shift;
foreach my $module (@PRELOAD, @_) {
$class->load($module) || return;
};
return 1;
}
sub load {
my ($class, $module) = @_;
$module =~ s[::][/]g;
$module .= '.pm';
eval { require $module; };
return $@ ? $class->error("failed to load $module: $@") : 1;
}
sub parser {
my $class = shift;
my $params = defined($_[0]) && ref($_[0]) eq 'HASH'
? shift : { @_ };
return undef unless $class->load($PARSER);
return $PARSER->new($params)
|| $class->error("failed to create parser: ", $PARSER->error);
}
sub provider {
my $class = shift;
my $params = defined($_[0]) && ref($_[0]) eq 'HASH'
? shift : { @_ };
return undef unless $class->load($PROVIDER);
return $PROVIDER->new($params)
|| $class->error("failed to create template provider: ",
$PROVIDER->error);
}
sub plugins {
my $class = shift;
my $params = defined($_[0]) && ref($_[0]) eq 'HASH'
? shift : { @_ };
return undef unless $class->load($PLUGINS);
return $PLUGINS->new($params)
|| $class->error("failed to create plugin provider: ",
$PLUGINS->error);
}
sub filters {
my $class = shift;
my $params = defined($_[0]) && ref($_[0]) eq 'HASH'
? shift : { @_ };
return undef unless $class->load($FILTERS);
return $FILTERS->new($params)
|| $class->error("failed to create filter provider: ",
$FILTERS->error);
}
sub iterator {
my $class = shift;
my $list = shift;
return undef unless $class->load($ITERATOR);
return $ITERATOR->new($list, @_)
|| $class->error("failed to create iterator: ", $ITERATOR->error);
}
sub stash {
my $class = shift;
my $params = defined($_[0]) && ref($_[0]) eq 'HASH'
? shift : { @_ };
return undef unless $class->load($STASH);
return $STASH->new($params)
|| $class->error("failed to create stash: ", $STASH->error);
}
sub context {
my $class = shift;
my $params = defined($_[0]) && ref($_[0]) eq 'HASH'
? shift : { @_ };
return undef unless $class->load($CONTEXT);
return $CONTEXT->new($params)
|| $class->error("failed to create context: ", $CONTEXT->error);
}
sub service {
my $class = shift;
my $params = defined($_[0]) && ref($_[0]) eq 'HASH'
? shift : { @_ };
return undef unless $class->load($SERVICE);
return $SERVICE->new($params)
|| $class->error("failed to create context: ", $SERVICE->error);
}
sub constants {
my $class = shift;
my $params = defined($_[0]) && ref($_[0]) eq 'HASH'
? shift : { @_ };
return undef unless $class->load($CONSTANTS);
return $CONSTANTS->new($params)
|| $class->error("failed to create constants namespace: ",
$CONSTANTS->error);
}
sub instdir {
my ($class, $dir) = @_;
my $inst = $INSTDIR
|| return $class->error("no installation directory");
$inst =~ s[/$][]g;
$inst .= "/$dir" if $dir;
return $inst;
}
package Template::TieString;
sub TIEHANDLE {
my ($class, $textref) = @_;
bless $textref, $class;
}
sub PRINT {
my $self = shift;
$$self .= join('', @_);
}
1;
}
#
# Inline include of Template/Document.pm
#
BEGIN { $INC{'Template/Document.pm'} = 'dummy/Template/Document.pm'; }
BEGIN {
#line 0 "Template/Document.pm"
package Template::Document;
use strict;
use warnings;
use base 'Template::Base';
use Template::Constants;
our $VERSION = 2.79;
our $DEBUG = 0 unless defined $DEBUG;
our $ERROR = '';
our ($COMPERR, $AUTOLOAD, $UNICODE);
BEGIN {
# UNICODE is supported in versions of Perl from 5.008 onwards
if ($UNICODE = $] > 5.007 ? 1 : 0) {
if ($] > 5.008) {
# utf8::is_utf8() available from Perl 5.8.1 onwards
*is_utf8 = \&utf8::is_utf8;
}
elsif ($] == 5.008) {
# use Encode::is_utf8() for Perl 5.8.0
require Encode;
*is_utf8 = \&Encode::is_utf8;
}
}
}
sub new {
my ($class, $doc) = @_;
my ($block, $defblocks, $variables, $metadata) = @$doc{ qw( BLOCK DEFBLOCKS VARIABLES METADATA ) };
$defblocks ||= { };
$metadata ||= { };
# evaluate Perl code in $block to create sub-routine reference if necessary
unless (ref $block) {
local $SIG{__WARN__} = \&catch_warnings;
$COMPERR = '';
# DON'T LOOK NOW! - blindly untainting can make you go blind!
$block =~ /(.*)/s;
$block = $1;
$block = eval $block;
return $class->error($@)
unless defined $block;
}
# same for any additional BLOCK definitions
@$defblocks{ keys %$defblocks } =
# MORE BLIND UNTAINTING - turn away if you're squeamish
map {
ref($_)
? $_
: ( /(.*)/s && eval($1) or return $class->error($@) )
} values %$defblocks;
bless {
%$metadata,
_BLOCK => $block,
_DEFBLOCKS => $defblocks,
_VARIABLES => $variables,
_HOT => 0,
}, $class;
}
sub block {
return $_[0]->{ _BLOCK };
}
sub blocks {
return $_[0]->{ _DEFBLOCKS };
}
sub variables {
return $_[0]->{ _VARIABLES };
}
sub process {
my ($self, $context) = @_;
my $defblocks = $self->{ _DEFBLOCKS };
my $output;
# check we're not already visiting this template
return $context->throw(Template::Constants::ERROR_FILE,
"recursion into '$self->{ name }'")
if $self->{ _HOT } && ! $context->{ RECURSION }; ## RETURN ##
$context->visit($self, $defblocks);
$self->{ _HOT } = 1;
eval {
my $block = $self->{ _BLOCK };
$output = &$block($context);
};
$self->{ _HOT } = 0;
$context->leave();
die $context->catch($@)
if $@;
return $output;
}
sub AUTOLOAD {
my $self = shift;
my $method = $AUTOLOAD;
$method =~ s/.*:://;
return if $method eq 'DESTROY';
return $self->{ $method };
}
sub _dump {
my $self = shift;
my $dblks;
my $output = "$self : $self->{ name }\n";
$output .= "BLOCK: $self->{ _BLOCK }\nDEFBLOCKS:\n";
if ($dblks = $self->{ _DEFBLOCKS }) {
foreach my $b (keys %$dblks) {
$output .= " $b: $dblks->{ $b }\n";
}
}
return $output;
}
sub as_perl {
my ($class, $content) = @_;
my ($block, $defblocks, $metadata) = @$content{ qw( BLOCK DEFBLOCKS METADATA ) };
$block =~ s/\n(?!#line)/\n /g;
$block =~ s/\s+$//;
$defblocks = join('', map {
my $code = $defblocks->{ $_ };
$code =~ s/\n(?!#line)/\n /g;
$code =~ s/\s*$//;
" '$_' => $code,\n";
} keys %$defblocks);
$defblocks =~ s/\s+$//;
$metadata = join('', map {
my $x = $metadata->{ $_ };
$x =~ s/(['\\])/\\$1/g;
" '$_' => '$x',\n";
} keys %$metadata);
$metadata =~ s/\s+$//;
return <<EOF
$class->new({
METADATA => {
$metadata
},
BLOCK => $block,
DEFBLOCKS => {
$defblocks
},
});
EOF
}
sub write_perl_file {
my ($class, $file, $content) = @_;
my ($fh, $tmpfile);
return $class->error("invalid filename: $file")
unless $file =~ /^(.+)$/s;
eval {
require File::Temp;
require File::Basename;
($fh, $tmpfile) = File::Temp::tempfile(
DIR => File::Basename::dirname($file)
);
my $perlcode = $class->as_perl($content) || die $!;
if ($UNICODE && is_utf8($perlcode)) {
$perlcode = "use utf8;\n\n$perlcode";
binmode $fh, ":utf8";
}
print $fh $perlcode;
close($fh);
};
return $class->error($@) if $@;
return rename($tmpfile, $file)
|| $class->error($!);
}
sub catch_warnings {
$COMPERR .= join('', @_);
}
1;
}
#
# Inline include of Template/Exception.pm
#
BEGIN { $INC{'Template/Exception.pm'} = 'dummy/Template/Exception.pm'; }
BEGIN {
#line 0 "Template/Exception.pm"
package Template::Exception;
use strict;
use warnings;
use constant TYPE => 0;
use constant INFO => 1;
use constant TEXT => 2;
use overload q|""| => "as_string", fallback => 1;
our $VERSION = 2.70;
sub new {
my ($class, $type, $info, $textref) = @_;
bless [ $type, $info, $textref ], $class;
}
sub type {
$_[0]->[ TYPE ];
}
sub info {
$_[0]->[ INFO ];
}
sub type_info {
my $self = shift;
@$self[ TYPE, INFO ];
}
sub text {
my ($self, $newtextref) = @_;
my $textref = $self->[ TEXT ];
if ($newtextref) {
$$newtextref .= $$textref if $textref && $textref ne $newtextref;
$self->[ TEXT ] = $newtextref;
return '';
}
elsif ($textref) {
return $$textref;
}
else {
return '';
}
}
sub as_string {
my $self = shift;
return $self->[ TYPE ] . ' error - ' . $self->[ INFO ];
}
sub select_handler {
my ($self, @options) = @_;
my $type = $self->[ TYPE ];
my %hlut;
@hlut{ @options } = (1) x @options;
while ($type) {
return $type if $hlut{ $type };
# strip .element from the end of the exception type to find a
# more generic handler
$type =~ s/\.?[^\.]*$//;
}
return undef;
}
1;
}
#
# Inline include of Template/Service.pm
#
BEGIN { $INC{'Template/Service.pm'} = 'dummy/Template/Service.pm'; }
BEGIN {
#line 0 "Template/Service.pm"
package Template::Service;
use strict;
use warnings;
use base 'Template::Base';
use Template::Config;
use Template::Exception;
use Template::Constants;
use Scalar::Util 'blessed';
use constant EXCEPTION => 'Template::Exception';
our $VERSION = 2.80;
our $DEBUG = 0 unless defined $DEBUG;
our $ERROR = '';
sub process {
my ($self, $template, $params) = @_;
my $context = $self->{ CONTEXT };
my ($name, $output, $procout, $error);
$output = '';
$self->debug("process($template, ",
defined $params ? $params : '<no params>',
')') if $self->{ DEBUG };
$context->reset()
if $self->{ AUTO_RESET };
# pre-request compiled template from context so that we can alias it
# in the stash for pre-processed templates to reference
eval { $template = $context->template($template) };
return $self->error($@)
if $@;
# localise the variable stash with any parameters passed
# and set the 'template' variable
$params ||= { };
# TODO: change this to C<||=> so we can use a template parameter
$params->{ template } = $template
unless ref $template eq 'CODE';
$context->localise($params);
SERVICE: {
# PRE_PROCESS
eval {
foreach $name (@{ $self->{ PRE_PROCESS } }) {
$self->debug("PRE_PROCESS: $name") if $self->{ DEBUG };
$output .= $context->process($name);
}
};
last SERVICE if ($error = $@);
# PROCESS
eval {
foreach $name (@{ $self->{ PROCESS } || [ $template ] }) {
$self->debug("PROCESS: $name") if $self->{ DEBUG };
$procout .= $context->process($name);
}
};
if ($error = $@) {
last SERVICE
unless defined ($procout = $self->_recover(\$error));
}
if (defined $procout) {
# WRAPPER
eval {
foreach $name (reverse @{ $self->{ WRAPPER } }) {
$self->debug("WRAPPER: $name") if $self->{ DEBUG };
$procout = $context->process($name, { content => $procout });
}
};
last SERVICE if ($error = $@);
$output .= $procout;
}
# POST_PROCESS
eval {
foreach $name (@{ $self->{ POST_PROCESS } }) {
$self->debug("POST_PROCESS: $name") if $self->{ DEBUG };
$output .= $context->process($name);
}
};
last SERVICE if ($error = $@);
}
$context->delocalise();
delete $params->{ template };
if ($error) {
# $error = $error->as_string if ref $error;
return $self->error($error);
}
return $output;
}
sub context {
return $_[0]->{ CONTEXT };
}
sub _init {
my ($self, $config) = @_;
my ($item, $data, $context, $block, $blocks);
my $delim = $config->{ DELIMITER };
$delim = ':' unless defined $delim;
# coerce PRE_PROCESS, PROCESS and POST_PROCESS to arrays if necessary,
# by splitting on non-word characters
foreach $item (qw( PRE_PROCESS PROCESS POST_PROCESS WRAPPER )) {
$data = $config->{ $item };
$self->{ $item } = [ ], next unless (defined $data);
$data = [ split($delim, $data || '') ]
unless ref $data eq 'ARRAY';
$self->{ $item } = $data;
}
# unset PROCESS option unless explicitly specified in config
$self->{ PROCESS } = undef
unless defined $config->{ PROCESS };
$self->{ ERROR } = $config->{ ERROR } || $config->{ ERRORS };
$self->{ AUTO_RESET } = defined $config->{ AUTO_RESET }
? $config->{ AUTO_RESET } : 1;
$self->{ DEBUG } = ( $config->{ DEBUG } || 0 )
& Template::Constants::DEBUG_SERVICE;
$context = $self->{ CONTEXT } = $config->{ CONTEXT }
|| Template::Config->context($config)
|| return $self->error(Template::Config->error);
return $self;
}
sub _recover {
my ($self, $error) = @_;
my $context = $self->{ CONTEXT };
my ($hkey, $handler, $output);
# there shouldn't ever be a non-exception object received at this
# point... unless a module like CGI::Carp messes around with the
# DIE handler.
return undef
unless blessed($$error) && $$error->isa(EXCEPTION);
# a 'stop' exception is thrown by [% STOP %] - we return the output
# buffer stored in the exception object
return $$error->text()
if $$error->type() eq 'stop';
my $handlers = $self->{ ERROR }
|| return undef; ## RETURN
if (ref $handlers eq 'HASH') {
if ($hkey = $$error->select_handler(keys %$handlers)) {
$handler = $handlers->{ $hkey };
$self->debug("using error handler for $hkey") if $self->{ DEBUG };
}
elsif ($handler = $handlers->{ default }) {
# use default handler
$self->debug("using default error handler") if $self->{ DEBUG };
}
else {
return undef; ## RETURN
}
}
else {
$handler = $handlers;
$self->debug("using default error handler") if $self->{ DEBUG };
}
eval { $handler = $context->template($handler) };
if ($@) {
$$error = $@;
return undef; ## RETURN
};
$context->stash->set('error', $$error);
eval {
$output .= $context->process($handler);
};
if ($@) {
$$error = $@;
return undef; ## RETURN
}
return $output;
}
sub _dump {
my $self = shift;
my $context = $self->{ CONTEXT }->_dump();
$context =~ s/\n/\n /gm;
my $error = $self->{ ERROR };
$error = join('',
"{\n",
(map { " $_ => $error->{ $_ }\n" }
keys %$error),
"}\n")
if ref $error;
local $" = ', ';
return <<EOF;
$self
PRE_PROCESS => [ @{ $self->{ PRE_PROCESS } } ]
POST_PROCESS => [ @{ $self->{ POST_PROCESS } } ]
ERROR => $error
CONTEXT => $context
EOF
}
1;
}
#
# Inline include of Template/Provider.pm
#
BEGIN { $INC{'Template/Provider.pm'} = 'dummy/Template/Provider.pm'; }
BEGIN {
#line 0 "Template/Provider.pm"
package Template::Provider;
use strict;
use warnings;
use base 'Template::Base';
use Template::Config;
use Template::Constants;
use Template::Document;
use File::Basename;
use File::Spec;
use constant PREV => 0;
use constant NAME => 1; # template name -- indexed by this name in LOOKUP
use constant DATA => 2; # Compiled template
use constant LOAD => 3; # mtime of template
use constant NEXT => 4; # link to next item in cache linked list
use constant STAT => 5; # Time last stat()ed
our $VERSION = 2.94;
our $DEBUG = 0 unless defined $DEBUG;
our $ERROR = '';
our $DOCUMENT = 'Template::Document' unless defined $DOCUMENT;
our $STAT_TTL = 1 unless defined $STAT_TTL;
our $MAX_DIRS = 64 unless defined $MAX_DIRS;
our $UNICODE = $] > 5.007 ? 1 : 0;
my $boms = [
'UTF-8' => "\x{ef}\x{bb}\x{bf}",
'UTF-32BE' => "\x{0}\x{0}\x{fe}\x{ff}",
'UTF-32LE' => "\x{ff}\x{fe}\x{0}\x{0}",
'UTF-16BE' => "\x{fe}\x{ff}",
'UTF-16LE' => "\x{ff}\x{fe}",
];
our $RELATIVE_PATH = qr[(?:^|/)\.+/];
BEGIN {
if ($] < 5.006) {
package bytes;
$INC{'bytes.pm'} = 1;
}
}
sub fetch {
my ($self, $name) = @_;
my ($data, $error);
if (ref $name) {
# $name can be a reference to a scalar, GLOB or file handle
($data, $error) = $self->_load($name);
($data, $error) = $self->_compile($data)
unless $error;
$data = $data->{ data }
unless $error;
}
elsif (File::Spec->file_name_is_absolute($name)) {
# absolute paths (starting '/') allowed if ABSOLUTE set
($data, $error) = $self->{ ABSOLUTE }
? $self->_fetch($name)
: $self->{ TOLERANT }
? (undef, Template::Constants::STATUS_DECLINED)
: ("$name: absolute paths are not allowed (set ABSOLUTE option)",
Template::Constants::STATUS_ERROR);
}
elsif ($name =~ m/$RELATIVE_PATH/o) {
# anything starting "./" is relative to cwd, allowed if RELATIVE set
($data, $error) = $self->{ RELATIVE }
? $self->_fetch($name)
: $self->{ TOLERANT }
? (undef, Template::Constants::STATUS_DECLINED)
: ("$name: relative paths are not allowed (set RELATIVE option)",
Template::Constants::STATUS_ERROR);
}
else {
# otherwise, it's a file name relative to INCLUDE_PATH
($data, $error) = $self->{ INCLUDE_PATH }
? $self->_fetch_path($name)
: (undef, Template::Constants::STATUS_DECLINED);
}
return ($data, $error);
}
sub store {
my ($self, $name, $data) = @_;
$self->_store($name, {
data => $data,
load => 0,
});
}
sub load {
my ($self, $name) = @_;
my ($data, $error);
my $path = $name;
if (File::Spec->file_name_is_absolute($name)) {
# absolute paths (starting '/') allowed if ABSOLUTE set
$error = "$name: absolute paths are not allowed (set ABSOLUTE option)"
unless $self->{ ABSOLUTE };
}
elsif ($name =~ m[$RELATIVE_PATH]o) {
# anything starting "./" is relative to cwd, allowed if RELATIVE set
$error = "$name: relative paths are not allowed (set RELATIVE option)"
unless $self->{ RELATIVE };
}
else {
INCPATH: {
# otherwise, it's a file name relative to INCLUDE_PATH
my $paths = $self->paths()
|| return ($self->error(), Template::Constants::STATUS_ERROR);
foreach my $dir (@$paths) {
$path = File::Spec->catfile($dir, $name);
last INCPATH
if $self->_template_modified($path);
}
undef $path; # not found
}
}
# Now fetch the content
($data, $error) = $self->_template_content($path)
if defined $path && !$error;
if ($error) {
return $self->{ TOLERANT }
? (undef, Template::Constants::STATUS_DECLINED)
: ($error, Template::Constants::STATUS_ERROR);
}
elsif (! defined $path) {
return (undef, Template::Constants::STATUS_DECLINED);
}
else {
return ($data, Template::Constants::STATUS_OK);
}
}
sub include_path {
my ($self, $path) = @_;
$self->{ INCLUDE_PATH } = $path if $path;
return $self->{ INCLUDE_PATH };
}
sub paths {
my $self = shift;
my @ipaths = @{ $self->{ INCLUDE_PATH } };
my (@opaths, $dpaths, $dir);
my $count = $MAX_DIRS;
while (@ipaths && --$count) {
$dir = shift @ipaths || next;
# $dir can be a sub or object ref which returns a reference
# to a dynamically generated list of search paths.
if (ref $dir eq 'CODE') {
eval { $dpaths = &$dir() };
if ($@) {
chomp $@;
return $self->error($@);
}
unshift(@ipaths, @$dpaths);
next;
}
elsif (ref($dir) && UNIVERSAL::can($dir, 'paths')) {
$dpaths = $dir->paths()
|| return $self->error($dir->error());
unshift(@ipaths, @$dpaths);
next;
}
else {
push(@opaths, $dir);
}
}
return $self->error("INCLUDE_PATH exceeds $MAX_DIRS directories")
if @ipaths;
return \@opaths;
}
sub DESTROY {
my $self = shift;
my ($slot, $next);
$slot = $self->{ HEAD };
while ($slot) {
$next = $slot->[ NEXT ];
undef $slot->[ PREV ];
undef $slot->[ NEXT ];
$slot = $next;
}
undef $self->{ HEAD };
undef $self->{ TAIL };
}
sub _init {
my ($self, $params) = @_;
my $size = $params->{ CACHE_SIZE };
my $path = $params->{ INCLUDE_PATH } || '.';
my $cdir = $params->{ COMPILE_DIR } || '';
my $dlim = $params->{ DELIMITER };
my $debug;
# tweak delim to ignore C:/
unless (defined $dlim) {
$dlim = ($^O eq 'MSWin32') ? ':(?!\\/)' : ':';
}
# coerce INCLUDE_PATH to an array ref, if not already so
$path = [ split(/$dlim/, $path) ]
unless ref $path eq 'ARRAY';
# don't allow a CACHE_SIZE 1 because it breaks things and the
# additional checking isn't worth it
$size = 2
if defined $size && ($size == 1 || $size < 0);
if (defined ($debug = $params->{ DEBUG })) {
$self->{ DEBUG } = $debug & ( Template::Constants::DEBUG_PROVIDER
| Template::Constants::DEBUG_FLAGS );
}
else {
$self->{ DEBUG } = $DEBUG;
}
if ($self->{ DEBUG }) {
local $" = ', ';
$self->debug("creating cache of ",
defined $size ? $size : 'unlimited',
" slots for [ @$path ]");
}
# create COMPILE_DIR and sub-directories representing each INCLUDE_PATH
# element in which to store compiled files
if ($cdir) {
require File::Path;
foreach my $dir (@$path) {
next if ref $dir;
my $wdir = $dir;
$wdir =~ s[:][]g if $^O eq 'MSWin32';
$wdir =~ /(.*)/; # untaint
$wdir = "$1"; # quotes work around bug in Strawberry Perl
$wdir = File::Spec->catfile($cdir, $wdir);
File::Path::mkpath($wdir) unless -d $wdir;
}
}
$self->{ LOOKUP } = { };
$self->{ NOTFOUND } = { }; # Tracks templates *not* found.
$self->{ SLOTS } = 0;
$self->{ SIZE } = $size;
$self->{ INCLUDE_PATH } = $path;
$self->{ DELIMITER } = $dlim;
$self->{ COMPILE_DIR } = $cdir;
$self->{ COMPILE_EXT } = $params->{ COMPILE_EXT } || '';
$self->{ ABSOLUTE } = $params->{ ABSOLUTE } || 0;
$self->{ RELATIVE } = $params->{ RELATIVE } || 0;
$self->{ TOLERANT } = $params->{ TOLERANT } || 0;
$self->{ DOCUMENT } = $params->{ DOCUMENT } || $DOCUMENT;
$self->{ PARSER } = $params->{ PARSER };
$self->{ DEFAULT } = $params->{ DEFAULT };
$self->{ ENCODING } = $params->{ ENCODING };
$self->{ STAT_TTL } = $params->{ STAT_TTL } || $STAT_TTL;
$self->{ PARAMS } = $params;
# look for user-provided UNICODE parameter or use default from package var
$self->{ UNICODE } = defined $params->{ UNICODE }
? $params->{ UNICODE } : $UNICODE;
return $self;
}
sub _fetch {
my ($self, $name, $t_name) = @_;
my $stat_ttl = $self->{ STAT_TTL };
$self->debug("_fetch($name)") if $self->{ DEBUG };
# First see if the named template is in the memory cache
if ((my $slot = $self->{ LOOKUP }->{ $name })) {
# Test if cache is fresh, and reload/compile if not.
my ($data, $error) = $self->_refresh($slot);
return $error
? ( $data, $error ) # $data may contain error text
: $slot->[ DATA ]; # returned document object
}
# Otherwise, see if we already know the template is not found
if (my $last_stat_time = $self->{ NOTFOUND }->{ $name }) {
my $expires_in = $last_stat_time + $stat_ttl - time;
if ($expires_in > 0) {
$self->debug(" file [$name] in negative cache. Expires in $expires_in seconds")
if $self->{ DEBUG };
return (undef, Template::Constants::STATUS_DECLINED);
}
else {
delete $self->{ NOTFOUND }->{ $name };
}
}
# Is there an up-to-date compiled version on disk?
if ($self->_compiled_is_current($name)) {
# require() the compiled template.
my $compiled_template = $self->_load_compiled( $self->_compiled_filename($name) );
# Store and return the compiled template
return $self->store( $name, $compiled_template ) if $compiled_template;
# Problem loading compiled template:
# warn and continue to fetch source template
warn($self->error(), "\n");
}
# load template from source
my ($template, $error) = $self->_load($name, $t_name);
if ($error) {
# Template could not be fetched. Add to the negative/notfound cache.
$self->{ NOTFOUND }->{ $name } = time;
return ( $template, $error );
}
# compile template source
($template, $error) = $self->_compile($template, $self->_compiled_filename($name) );
if ($error) {
# return any compile time error
return ($template, $error);
}
else {
# Store compiled template and return it
return $self->store($name, $template->{data}) ;
}
}
sub _fetch_path {
my ($self, $name) = @_;
$self->debug("_fetch_path($name)") if $self->{ DEBUG };
# the template may have been stored using a non-filename name
# so look for the plain name in the cache first
if ((my $slot = $self->{ LOOKUP }->{ $name })) {
# cached entry exists, so refresh slot and extract data
my ($data, $error) = $self->_refresh($slot);
return $error
? ($data, $error)
: ($slot->[ DATA ], $error );
}
my $paths = $self->paths
|| return ( $self->error, Template::Constants::STATUS_ERROR );
# search the INCLUDE_PATH for the file, in cache or on disk
foreach my $dir (@$paths) {
my $path = File::Spec->catfile($dir, $name);
$self->debug("searching path: $path\n") if $self->{ DEBUG };
my ($data, $error) = $self->_fetch( $path, $name );
# Return if no error or if a serious error.
return ( $data, $error )
if !$error || $error == Template::Constants::STATUS_ERROR;
}
# not found in INCLUDE_PATH, now try DEFAULT
return $self->_fetch_path( $self->{DEFAULT} )
if defined $self->{DEFAULT} && $name ne $self->{DEFAULT};
# We could not handle this template name
return (undef, Template::Constants::STATUS_DECLINED);
}
sub _compiled_filename {
my ($self, $file) = @_;
my ($compext, $compdir) = @$self{ qw( COMPILE_EXT COMPILE_DIR ) };
my ($path, $compiled);
return undef
unless $compext || $compdir;
$path = $file;
$path =~ /^(.+)$/s or die "invalid filename: $path";
$path =~ s[:][]g if $^O eq 'MSWin32';
$compiled = "$path$compext";
$compiled = File::Spec->catfile($compdir, $compiled) if length $compdir;
return $compiled;
}
sub _load_compiled {
my ($self, $file) = @_;
my $compiled;
# load compiled template via require(); we zap any
# %INC entry to ensure it is reloaded (we don't
# want 1 returned by require() to say it's in memory)
delete $INC{ $file };
eval { $compiled = require $file; };
return $@
? $self->error("compiled template $compiled: $@")
: $compiled;
}
sub _load {
my ($self, $name, $alias) = @_;
my ($data, $error);
my $tolerant = $self->{ TOLERANT };
my $now = time;
$alias = $name unless defined $alias or ref $name;
$self->debug("_load($name, ", defined $alias ? $alias : '<no alias>',
')') if $self->{ DEBUG };
# SCALAR ref is the template text
if (ref $name eq 'SCALAR') {
# $name can be a SCALAR reference to the input text...
return {
name => defined $alias ? $alias : 'input text',
path => defined $alias ? $alias : 'input text',
text => $$name,
time => $now,
load => 0,
};
}
# Otherwise, assume GLOB as a file handle
if (ref $name) {
local $/;
my $text = <$name>;
$text = $self->_decode_unicode($text) if $self->{ UNICODE };
return {
name => defined $alias ? $alias : 'input file handle',
path => defined $alias ? $alias : 'input file handle',
text => $text,
time => $now,
load => 0,
};
}
# Otherwise, it's the name of the template
if ( $self->_template_modified( $name ) ) { # does template exist?
my ($text, $error, $mtime ) = $self->_template_content( $name );
unless ( $error ) {
$text = $self->_decode_unicode($text) if $self->{ UNICODE };
return {
name => $alias,
path => $name,
text => $text,
time => $mtime,
load => $now,
};
}
return ( "$alias: $!", Template::Constants::STATUS_ERROR )
unless $tolerant;
}
# Unable to process template, pass onto the next Provider.
return (undef, Template::Constants::STATUS_DECLINED);
}
sub _refresh {
my ($self, $slot) = @_;
my $stat_ttl = $self->{ STAT_TTL };
my ($head, $file, $data, $error);
$self->debug("_refresh([ ",
join(', ', map { defined $_ ? $_ : '<undef>' } @$slot),
'])') if $self->{ DEBUG };
# if it's more than $STAT_TTL seconds since we last performed a
# stat() on the file then we need to do it again and see if the file
# time has changed
my $now = time;
my $expires_in_sec = $slot->[ STAT ] + $stat_ttl - $now;
if ( $expires_in_sec <= 0 ) { # Time to check!
$slot->[ STAT ] = $now;
# Grab mtime of template.
# Seems like this should be abstracted to compare to
# just ask for a newer compiled template (if it's newer)
# and let that check for a newer template source.
my $template_mtime = $self->_template_modified( $slot->[ NAME ] );
if ( ! defined $template_mtime || ( $template_mtime != $slot->[ LOAD ] )) {
$self->debug("refreshing cache file ", $slot->[ NAME ])
if $self->{ DEBUG };
($data, $error) = $self->_load($slot->[ NAME ], $slot->[ DATA ]->{ name });
($data, $error) = $self->_compile($data)
unless $error;
if ($error) {
# if the template failed to load/compile then we wipe out the
# STAT entry. This forces the provider to try and reload it
# each time instead of using the previously cached version
# until $STAT_TTL is next up
$slot->[ STAT ] = 0;
}
else {
$slot->[ DATA ] = $data->{ data };
$slot->[ LOAD ] = $data->{ time };
}
}
} elsif ( $self->{ DEBUG } ) {
$self->debug( sprintf('STAT_TTL not met for file [%s]. Expires in %d seconds',
$slot->[ NAME ], $expires_in_sec ) );
}
# Move this slot to the head of the list
unless( $self->{ HEAD } == $slot ) {
# remove existing slot from usage chain...
if ($slot->[ PREV ]) {
$slot->[ PREV ]->[ NEXT ] = $slot->[ NEXT ];
}
else {
$self->{ HEAD } = $slot->[ NEXT ];
}
if ($slot->[ NEXT ]) {
$slot->[ NEXT ]->[ PREV ] = $slot->[ PREV ];
}
else {
$self->{ TAIL } = $slot->[ PREV ];
}
# ..and add to start of list
$head = $self->{ HEAD };
$head->[ PREV ] = $slot if $head;
$slot->[ PREV ] = undef;
$slot->[ NEXT ] = $head;
$self->{ HEAD } = $slot;
}
return ($data, $error);
}
sub _store {
my ($self, $name, $data, $compfile) = @_;
my $size = $self->{ SIZE };
my ($slot, $head);
# Return if memory cache disabled. (overridding code should also check)
# $$$ What's the expected behaviour of store()? Can't tell from the
# docs if you can call store() when SIZE = 0.
return $data->{data} if defined $size and !$size;
# extract the compiled template from the data hash
$data = $data->{ data };
$self->debug("_store($name, $data)") if $self->{ DEBUG };
# check the modification time -- extra stat here
my $load = $self->_modified($name);
if (defined $size && $self->{ SLOTS } >= $size) {
# cache has reached size limit, so reuse oldest entry
$self->debug("reusing oldest cache entry (size limit reached: $size)\nslots: $self->{ SLOTS }") if $self->{ DEBUG };
# remove entry from tail of list
$slot = $self->{ TAIL };
$slot->[ PREV ]->[ NEXT ] = undef;
$self->{ TAIL } = $slot->[ PREV ];
# remove name lookup for old node
delete $self->{ LOOKUP }->{ $slot->[ NAME ] };
# add modified node to head of list
$head = $self->{ HEAD };
$head->[ PREV ] = $slot if $head;
@$slot = ( undef, $name, $data, $load, $head, time );
$self->{ HEAD } = $slot;
# add name lookup for new node
$self->{ LOOKUP }->{ $name } = $slot;
}
else {
# cache is under size limit, or none is defined
$self->debug("adding new cache entry") if $self->{ DEBUG };
# add new node to head of list
$head = $self->{ HEAD };
$slot = [ undef, $name, $data, $load, $head, time ];
$head->[ PREV ] = $slot if $head;
$self->{ HEAD } = $slot;
$self->{ TAIL } = $slot unless $self->{ TAIL };
# add lookup from name to slot and increment nslots
$self->{ LOOKUP }->{ $name } = $slot;
$self->{ SLOTS }++;
}
return $data;
}
sub _compile {
my ($self, $data, $compfile) = @_;
my $text = $data->{ text };
my ($parsedoc, $error);
$self->debug("_compile($data, ",
defined $compfile ? $compfile : '<no compfile>', ')')
if $self->{ DEBUG };
my $parser = $self->{ PARSER }
||= Template::Config->parser($self->{ PARAMS })
|| return (Template::Config->error(), Template::Constants::STATUS_ERROR);
# discard the template text - we don't need it any more
delete $data->{ text };
# call parser to compile template into Perl code
if ($parsedoc = $parser->parse($text, $data)) {
$parsedoc->{ METADATA } = {
'name' => $data->{ name },
'modtime' => $data->{ time },
%{ $parsedoc->{ METADATA } },
};
# write the Perl code to the file $compfile, if defined
if ($compfile) {
my $basedir = &File::Basename::dirname($compfile);
$basedir =~ /(.*)/;
$basedir = $1;
unless (-d $basedir) {
eval { File::Path::mkpath($basedir) };
$error = "failed to create compiled templates directory: $basedir ($@)"
if ($@);
}
unless ($error) {
my $docclass = $self->{ DOCUMENT };
$error = 'cache failed to write '
. &File::Basename::basename($compfile)
. ': ' . $docclass->error()
unless $docclass->write_perl_file($compfile, $parsedoc);
}
# set atime and mtime of newly compiled file, don't bother
# if time is undef
if (!defined($error) && defined $data->{ time }) {
my ($cfile) = $compfile =~ /^(.+)$/s or do {
return("invalid filename: $compfile",
Template::Constants::STATUS_ERROR);
};
my ($ctime) = $data->{ time } =~ /^(\d+)$/;
unless ($ctime || $ctime eq 0) {
return("invalid time: $ctime",
Template::Constants::STATUS_ERROR);
}
utime($ctime, $ctime, $cfile);
$self->debug(" cached compiled template to file [$compfile]")
if $self->{ DEBUG };
}
}
unless ($error) {
return $data ## RETURN ##
if $data->{ data } = $DOCUMENT->new($parsedoc);
$error = $Template::Document::ERROR;
}
}
else {
$error = Template::Exception->new( 'parse', "$data->{ name } " .
$parser->error() );
}
# return STATUS_ERROR, or STATUS_DECLINED if we're being tolerant
return $self->{ TOLERANT }
? (undef, Template::Constants::STATUS_DECLINED)
: ($error, Template::Constants::STATUS_ERROR)
}
sub _compiled_is_current {
my ( $self, $template_name ) = @_;
my $compiled_name = $self->_compiled_filename($template_name) || return;
my $compiled_mtime = (stat($compiled_name))[9] || return;
my $template_mtime = $self->_template_modified( $template_name ) || return;
# This was >= in the 2.15, but meant that downgrading
# a source template would not get picked up.
return $compiled_mtime == $template_mtime;
}
sub _template_modified {
my $self = shift;
my $template = shift || return;
return (stat( $template ))[9];
}
sub _template_content {
my ($self, $path) = @_;
return (undef, "No path specified to fetch content from ")
unless $path;
my $data;
my $mod_date;
my $error;
local *FH;
if (open(FH, "< $path")) {
local $/;
binmode(FH);
$data = <FH>;
$mod_date = (stat($path))[9];
close(FH);
}
else {
$error = "$path: $!";
}
return wantarray
? ( $data, $error, $mod_date )
: $data;
}
sub _modified {
my ($self, $name, $time) = @_;
my $load = $self->_template_modified($name)
|| return $time ? 1 : 0;
return $time
? $load > $time
: $load;
}
sub _dump {
my $self = shift;
my $size = $self->{ SIZE };
my $parser = $self->{ PARSER };
$parser = $parser ? $parser->_dump() : '<no parser>';
$parser =~ s/\n/\n /gm;
$size = 'unlimited' unless defined $size;
my $output = "[Template::Provider] {\n";
my $format = " %-16s => %s\n";
my $key;
$output .= sprintf($format, 'INCLUDE_PATH',
'[ ' . join(', ', @{ $self->{ INCLUDE_PATH } }) . ' ]');
$output .= sprintf($format, 'CACHE_SIZE', $size);
foreach $key (qw( ABSOLUTE RELATIVE TOLERANT DELIMITER
COMPILE_EXT COMPILE_DIR )) {
$output .= sprintf($format, $key, $self->{ $key });
}
$output .= sprintf($format, 'PARSER', $parser);
local $" = ', ';
my $lookup = $self->{ LOOKUP };
$lookup = join('', map {
sprintf(" $format", $_, defined $lookup->{ $_ }
? ('[ ' . join(', ', map { defined $_ ? $_ : '<undef>' }
@{ $lookup->{ $_ } }) . ' ]') : '<undef>');
} sort keys %$lookup);
$lookup = "{\n$lookup }";
$output .= sprintf($format, LOOKUP => $lookup);
$output .= '}';
return $output;
}
sub _dump_cache {
my $self = shift;
my ($node, $lut, $count);
$count = 0;
if ($node = $self->{ HEAD }) {
while ($node) {
$lut->{ $node } = $count++;
$node = $node->[ NEXT ];
}
$node = $self->{ HEAD };
print STDERR "CACHE STATE:\n";
print STDERR " HEAD: ", $self->{ HEAD }->[ NAME ], "\n";
print STDERR " TAIL: ", $self->{ TAIL }->[ NAME ], "\n";
while ($node) {
my ($prev, $name, $data, $load, $next) = @$node;
$prev = $prev ? "#$lut->{ $prev }<-": '<undef>';
$next = $next ? "->#$lut->{ $next }": '<undef>';
print STDERR " #$lut->{ $node } : [ $prev, $name, $data, $load, $next ]\n";
$node = $node->[ NEXT ];
}
}
}
sub _decode_unicode {
my $self = shift;
my $string = shift;
return undef unless defined $string;
use bytes;
require Encode;
return $string if Encode::is_utf8( $string );
# try all the BOMs in order looking for one (order is important
# 32bit BOMs look like 16bit BOMs)
my $count = 0;
while ($count < @{ $boms }) {
my $enc = $boms->[$count++];
my $bom = $boms->[$count++];
# does the string start with the bom?
if ($bom eq substr($string, 0, length($bom))) {
# decode it and hand it back
return Encode::decode($enc, substr($string, length($bom)), 1);
}
}
return $self->{ ENCODING }
? Encode::decode( $self->{ ENCODING }, $string )
: $string;
}
1;
}
#
# Inline include of Template.pm
#
BEGIN { $INC{'Template.pm'} = 'dummy/Template.pm'; }
BEGIN {
#line 0 "Template.pm"
package Template;
use strict;
use warnings;
use 5.006;
use base 'Template::Base';
use Template::Config;
use Template::Constants;
use Template::Provider;
use Template::Service;
use File::Basename;
use File::Path;
use Scalar::Util qw(blessed);
our $VERSION = '2.24';
our $ERROR = '';
our $DEBUG = 0;
our $BINMODE = 0 unless defined $BINMODE;
our $AUTOLOAD;
Template::Config->preload() if $ENV{ MOD_PERL };
sub process {
my ($self, $template, $vars, $outstream, @opts) = @_;
my ($output, $error);
my $options = (@opts == 1) && ref($opts[0]) eq 'HASH'
? shift(@opts) : { @opts };
$options->{ binmode } = $BINMODE
unless defined $options->{ binmode };
# we're using this for testing in t/output.t and t/filter.t so
# don't remove it if you don't want tests to fail...
$self->DEBUG("set binmode\n") if $DEBUG && $options->{ binmode };
$output = $self->{ SERVICE }->process($template, $vars);
if (defined $output) {
$outstream ||= $self->{ OUTPUT };
unless (ref $outstream) {
my $outpath = $self->{ OUTPUT_PATH };
$outstream = "$outpath/$outstream" if $outpath;
}
# send processed template to output stream, checking for error
return ($self->error($error))
if ($error = &_output($outstream, \$output, $options));
return 1;
}
else {
return $self->error($self->{ SERVICE }->error);
}
}
sub service {
my $self = shift;
return $self->{ SERVICE };
}
sub context {
my $self = shift;
return $self->{ SERVICE }->{ CONTEXT };
}
sub template {
shift->context->template(@_);
}
sub _init {
my ($self, $config) = @_;
# convert any textual DEBUG args to numerical form
my $debug = $config->{ DEBUG };
$config->{ DEBUG } = Template::Constants::debug_flags($self, $debug)
|| return if defined $debug && $debug !~ /^\d+$/;
# prepare a namespace handler for any CONSTANTS definition
if (my $constants = $config->{ CONSTANTS }) {
my $ns = $config->{ NAMESPACE } ||= { };
my $cns = $config->{ CONSTANTS_NAMESPACE } || 'constants';
$constants = Template::Config->constants($constants)
|| return $self->error(Template::Config->error);
$ns->{ $cns } = $constants;
}
$self->{ SERVICE } = $config->{ SERVICE }
|| Template::Config->service($config)
|| return $self->error(Template::Config->error);
$self->{ OUTPUT } = $config->{ OUTPUT } || \*STDOUT;
$self->{ OUTPUT_PATH } = $config->{ OUTPUT_PATH };
return $self;
}
sub _output {
my ($where, $textref, $options) = @_;
my $reftype;
my $error = 0;
# call a CODE reference
if (($reftype = ref($where)) eq 'CODE') {
&$where($$textref);
}
# print to a glob (such as \*STDOUT)
elsif ($reftype eq 'GLOB') {
print $where $$textref;
}
# append output to a SCALAR ref
elsif ($reftype eq 'SCALAR') {
$$where .= $$textref;
}
# push onto ARRAY ref
elsif ($reftype eq 'ARRAY') {
push @$where, $$textref;
}
# call the print() method on an object that implements the method
# (e.g. IO::Handle, Apache::Request, etc)
elsif (blessed($where) && $where->can('print')) {
$where->print($$textref);
}
# a simple string is taken as a filename
elsif (! $reftype) {
local *FP;
# make destination directory if it doesn't exist
my $dir = dirname($where);
eval { mkpath($dir) unless -d $dir; };
if ($@) {
# strip file name and line number from error raised by die()
($error = $@) =~ s/ at \S+ line \d+\n?$//;
}
elsif (open(FP, ">$where")) {
# binmode option can be 1 or a specific layer, e.g. :utf8
my $bm = $options->{ binmode };
if ($bm && $bm eq 1) {
binmode FP;
}
elsif ($bm){
binmode FP, $bm;
}
print FP $$textref;
close FP;
}
else {
$error = "$where: $!";
}
}
# give up, we've done our best
else {
$error = "output_handler() cannot determine target type ($where)\n";
}
return $error;
}
1;
}
#
# Inline include of Template/Grammar.pm
#
BEGIN { $INC{'Template/Grammar.pm'} = 'dummy/Template/Grammar.pm'; }
BEGIN {
#line 0 "Template/Grammar.pm"
package Template::Grammar;
use strict;
use warnings;
our $VERSION = 2.25;
my (@RESERVED, %CMPOP, $LEXTABLE, $RULES, $STATES);
my ($factory, $rawstart);
@RESERVED = qw(
GET CALL SET DEFAULT INSERT INCLUDE PROCESS WRAPPER BLOCK END
USE PLUGIN FILTER MACRO PERL RAWPERL TO STEP AND OR NOT DIV MOD
IF UNLESS ELSE ELSIF FOR NEXT WHILE SWITCH CASE META IN
TRY THROW CATCH FINAL LAST RETURN STOP CLEAR VIEW DEBUG
);
%CMPOP = qw(
!= ne
== eq
< <
> >
>= >=
<= <=
);
$LEXTABLE = {
'FOREACH' => 'FOR',
'BREAK' => 'LAST',
'&&' => 'AND',
'||' => 'OR',
'!' => 'NOT',
'|' => 'FILTER',
'.' => 'DOT',
'_' => 'CAT',
'..' => 'TO',
'=' => 'ASSIGN',
'=>' => 'ASSIGN',
',' => 'COMMA',
'\\' => 'REF',
'and' => 'AND', # explicitly specified so that qw( and or
'or' => 'OR', # not ) can always be used in lower case,
'not' => 'NOT', # regardless of ANYCASE flag
'mod' => 'MOD',
'div' => 'DIV',
};
{
my @tokens = qw< ( ) [ ] { } ${ $ + / ; : ? >;
my @cmpop = keys %CMPOP;
my @binop = qw( - * % ); # '+' and '/' above, in @tokens
# fill lexer table, slice by slice, with reserved words and operators
@$LEXTABLE{ @RESERVED, @cmpop, @binop, @tokens }
= ( @RESERVED, ('CMPOP') x @cmpop, ('BINOP') x @binop, @tokens );
}
sub new {
my $class = shift;
bless {
LEXTABLE => $LEXTABLE,
STATES => $STATES,
RULES => $RULES,
}, $class;
}
sub install_factory {
my ($self, $new_factory) = @_;
$factory = $new_factory;
}
$STATES = [
{#State 0
ACTIONS => {
'SET' => 1,
'PERL' => 40,
'NOT' => 38,
'IDENT' => 2,
'CLEAR' => 41,
'UNLESS' => 3,
'IF' => 44,
"\$" => 43,
'STOP' => 6,
'CALL' => 45,
'THROW' => 8,
'GET' => 47,
"[" => 9,
'TRY' => 10,
'LAST' => 49,
'DEBUG' => 51,
'RAWPERL' => 13,
'META' => 15,
'INCLUDE' => 17,
"(" => 53,
'SWITCH' => 54,
'MACRO' => 18,
'WRAPPER' => 55,
";" => -18,
'FOR' => 21,
'LITERAL' => 57,
'NEXT' => 22,
"\"" => 60,
'TEXT' => 24,
'PROCESS' => 61,
'RETURN' => 64,
'FILTER' => 25,
'INSERT' => 65,
'NUMBER' => 26,
'REF' => 27,
'WHILE' => 67,
'BLOCK' => 28,
'DEFAULT' => 69,
"{" => 30,
'USE' => 32,
'VIEW' => 36,
"\${" => 37
},
DEFAULT => -3,
GOTOS => {
'item' => 39,
'loop' => 4,
'capture' => 42,
'statement' => 5,
'view' => 7,
'wrapper' => 46,
'atomexpr' => 48,
'chunk' => 11,
'atomdir' => 12,
'anonblock' => 50,
'template' => 52,
'defblockname' => 14,
'ident' => 16,
'assign' => 19,
'macro' => 20,
'lterm' => 56,
'node' => 23,
'term' => 58,
'rawperl' => 59,
'expr' => 62,
'use' => 63,
'defblock' => 66,
'filter' => 29,
'sterm' => 68,
'perl' => 31,
'chunks' => 33,
'setlist' => 70,
'try' => 35,
'switch' => 34,
'directive' => 71,
'block' => 72,
'condition' => 73
}
},
{#State 1
ACTIONS => {
"\$" => 43,
'LITERAL' => 75,
'IDENT' => 2,
"\${" => 37
},
GOTOS => {
'setlist' => 76,
'item' => 39,
'assign' => 19,
'node' => 23,
'ident' => 74
}
},
{#State 2
DEFAULT => -130
},
{#State 3
ACTIONS => {
'NOT' => 38,
"{" => 30,
'LITERAL' => 78,
'IDENT' => 2,
"\"" => 60,
"(" => 53,
"\$" => 43,
"[" => 9,
'NUMBER' => 26,
'REF' => 27,
"\${" => 37
},
GOTOS => {
'expr' => 79,
'sterm' => 68,
'item' => 39,
'node' => 23,
'ident' => 77,
'term' => 58,
'lterm' => 56
}
},
{#State 4
DEFAULT => -23
},
{#State 5
ACTIONS => {
";" => 80
}
},
{#State 6
DEFAULT => -37
},
{#State 7
DEFAULT => -14
},
{#State 8
ACTIONS => {
"\"" => 89,
"\$" => 86,
'LITERAL' => 88,
'FILENAME' => 83,
'IDENT' => 81,
'NUMBER' => 84
},
GOTOS => {
'filepart' => 87,
'names' => 91,
'nameargs' => 90,
'filename' => 85,
'name' => 82
}
},
{#State 9
ACTIONS => {
"{" => 30,
'LITERAL' => 78,
'IDENT' => 2,
"\"" => 60,
"\$" => 43,
"[" => 9,
'NUMBER' => 26,
'REF' => 27,
"]" => 94,
"\${" => 37
},
GOTOS => {
'sterm' => 96,
'item' => 39,
'range' => 93,
'node' => 23,
'ident' => 77,
'term' => 95,
'lterm' => 56,
'list' => 92
}
},
{#State 10
ACTIONS => {
";" => 97
}
},
{#State 11
DEFAULT => -5
},
{#State 12
ACTIONS => {
";" => -20
},
DEFAULT => -27
},
{#State 13
DEFAULT => -78,
GOTOS => {
'@5-1' => 98
}
},
{#State 14
ACTIONS => {
'IDENT' => 99
},
DEFAULT => -87,
GOTOS => {
'blockargs' => 102,
'metadata' => 101,
'meta' => 100
}
},
{#State 15
ACTIONS => {
'IDENT' => 99
},
GOTOS => {
'metadata' => 103,
'meta' => 100
}
},
{#State 16
ACTIONS => {
'DOT' => 104,
'ASSIGN' => 105
},
DEFAULT => -109
},
{#State 17
ACTIONS => {
"\"" => 89,
"\$" => 86,
'LITERAL' => 88,
'FILENAME' => 83,
'IDENT' => 81,
'NUMBER' => 84
},
GOTOS => {
'filepart' => 87,
'names' => 91,
'nameargs' => 106,
'filename' => 85,
'name' => 82
}
},
{#State 18
ACTIONS => {
'IDENT' => 107
}
},
{#State 19
DEFAULT => -149
},
{#State 20
DEFAULT => -12
},
{#State 21
ACTIONS => {
"{" => 30,
'LITERAL' => 78,
'IDENT' => 108,
"\"" => 60,
"\$" => 43,
"[" => 9,
'NUMBER' => 26,
'REF' => 27,
"\${" => 37
},
GOTOS => {
'sterm' => 68,
'item' => 39,
'loopvar' => 110,
'node' => 23,
'ident' => 77,
'term' => 109,
'lterm' => 56
}
},
{#State 22
DEFAULT => -40
},
{#State 23
DEFAULT => -127
},
{#State 24
DEFAULT => -6
},
{#State 25
ACTIONS => {
"\"" => 117,
"\$" => 114,
'LITERAL' => 116,
'FILENAME' => 83,
'IDENT' => 111,
'NUMBER' => 84,
"\${" => 37
},
GOTOS => {
'names' => 91,
'lvalue' => 112,
'item' => 113,
'name' => 82,
'filepart' => 87,
'filename' => 85,
'nameargs' => 118,
'lnameargs' => 115
}
},
{#State 26
DEFAULT => -113
},
{#State 27
ACTIONS => {
"\$" => 43,
'IDENT' => 2,
"\${" => 37
},
GOTOS => {
'item' => 39,
'node' => 23,
'ident' => 119
}
},
{#State 28
ACTIONS => {
'LITERAL' => 124,
'FILENAME' => 83,
'IDENT' => 120,
'NUMBER' => 84
},
DEFAULT => -87,
GOTOS => {
'blockargs' => 123,
'filepart' => 87,
'filename' => 122,
'blockname' => 121,
'metadata' => 101,
'meta' => 100
}
},
{#State 29
DEFAULT => -43
},
{#State 30
ACTIONS => {
"\$" => 43,
'LITERAL' => 129,
'IDENT' => 2,
"\${" => 37
},
DEFAULT => -119,
GOTOS => {
'params' => 128,
'hash' => 125,
'item' => 126,
'param' => 127
}
},
{#State 31
DEFAULT => -25
},
{#State 32
ACTIONS => {
"\"" => 117,
"\$" => 114,
'LITERAL' => 116,
'FILENAME' => 83,
'IDENT' => 111,
'NUMBER' => 84,
"\${" => 37
},
GOTOS => {
'names' => 91,
'lvalue' => 112,
'item' => 113,
'name' => 82,
'filepart' => 87,
'filename' => 85,
'nameargs' => 118,
'lnameargs' => 130
}
},
{#State 33
ACTIONS => {
'SET' => 1,
'PERL' => 40,
'NOT' => 38,
'IDENT' => 2,
'CLEAR' => 41,
'UNLESS' => 3,
'IF' => 44,
"\$" => 43,
'STOP' => 6,
'CALL' => 45,
'THROW' => 8,
'GET' => 47,
"[" => 9,
'TRY' => 10,
'LAST' => 49,
'DEBUG' => 51,
'RAWPERL' => 13,
'META' => 15,
'INCLUDE' => 17,
"(" => 53,
'SWITCH' => 54,
'MACRO' => 18,
'WRAPPER' => 55,
";" => -18,
'FOR' => 21,
'LITERAL' => 57,
'NEXT' => 22,
"\"" => 60,
'TEXT' => 24,
'PROCESS' => 61,
'RETURN' => 64,
'FILTER' => 25,
'INSERT' => 65,
'NUMBER' => 26,
'REF' => 27,
'WHILE' => 67,
'BLOCK' => 28,
'DEFAULT' => 69,
"{" => 30,
'USE' => 32,
'VIEW' => 36,
"\${" => 37
},
DEFAULT => -2,
GOTOS => {
'item' => 39,
'node' => 23,
'rawperl' => 59,
'term' => 58,
'loop' => 4,
'use' => 63,
'expr' => 62,
'capture' => 42,
'statement' => 5,
'view' => 7,
'wrapper' => 46,
'atomexpr' => 48,
'chunk' => 131,
'defblock' => 66,
'atomdir' => 12,
'anonblock' => 50,
'sterm' => 68,
'defblockname' => 14,
'filter' => 29,
'ident' => 16,
'perl' => 31,
'setlist' => 70,
'try' => 35,
'switch' => 34,
'assign' => 19,
'directive' => 71,
'macro' => 20,
'condition' => 73,
'lterm' => 56
}
},
{#State 34
DEFAULT => -22
},
{#State 35
DEFAULT => -24
},
{#State 36
ACTIONS => {
"\"" => 89,
"\$" => 86,
'LITERAL' => 88,
'FILENAME' => 83,
'IDENT' => 81,
'NUMBER' => 84
},
GOTOS => {
'filepart' => 87,
'names' => 91,
'nameargs' => 132,
'filename' => 85,
'name' => 82
}
},
{#State 37
ACTIONS => {
"\"" => 60,
"\$" => 43,
'LITERAL' => 78,
'IDENT' => 2,
'REF' => 27,
'NUMBER' => 26,
"\${" => 37
},
GOTOS => {
'sterm' => 133,
'item' => 39,
'node' => 23,
'ident' => 77
}
},
{#State 38
ACTIONS => {
'NOT' => 38,
"{" => 30,
'LITERAL' => 78,
'IDENT' => 2,
"\"" => 60,
"(" => 53,
"\$" => 43,
"[" => 9,
'NUMBER' => 26,
'REF' => 27,
"\${" => 37
},
GOTOS => {
'expr' => 134,
'sterm' => 68,
'item' => 39,
'node' => 23,
'ident' => 77,
'term' => 58,
'lterm' => 56
}
},
{#State 39
ACTIONS => {
"(" => 135
},
DEFAULT => -128
},
{#State 40
ACTIONS => {
";" => 136
}
},
{#State 41
DEFAULT => -38
},
{#State 42
DEFAULT => -11
},
{#State 43
ACTIONS => {
'IDENT' => 137
}
},
{#State 44
ACTIONS => {
'NOT' => 38,
"{" => 30,
'LITERAL' => 78,
'IDENT' => 2,
"\"" => 60,
"(" => 53,
"\$" => 43,
"[" => 9,
'NUMBER' => 26,
'REF' => 27,
"\${" => 37
},
GOTOS => {
'expr' => 138,
'sterm' => 68,
'item' => 39,
'node' => 23,
'ident' => 77,
'term' => 58,
'lterm' => 56
}
},
{#State 45
ACTIONS => {
'NOT' => 38,
"{" => 30,
'LITERAL' => 78,
'IDENT' => 2,
"\"" => 60,
"(" => 53,
"\$" => 43,
"[" => 9,
'NUMBER' => 26,
'REF' => 27,
"\${" => 37
},
GOTOS => {
'expr' => 139,
'sterm' => 68,
'item' => 39,
'node' => 23,
'ident' => 77,
'term' => 58,
'lterm' => 56
}
},
{#State 46
DEFAULT => -42
},
{#State 47
ACTIONS => {
'NOT' => 38,
"{" => 30,
'LITERAL' => 78,
'IDENT' => 2,
"\"" => 60,
"(" => 53,
"\$" => 43,
"[" => 9,
'NUMBER' => 26,
'REF' => 27,
"\${" => 37
},
GOTOS => {
'expr' => 140,
'sterm' => 68,
'item' => 39,
'node' => 23,
'ident' => 77,
'term' => 58,
'lterm' => 56
}
},
{#State 48
ACTIONS => {
'IF' => 144,
'FILTER' => 143,
'FOR' => 142,
'WHILE' => 146,
'WRAPPER' => 145,
'UNLESS' => 141
}
},
{#State 49
DEFAULT => -39
},
{#State 50
DEFAULT => -10
},
{#State 51
ACTIONS => {
"\"" => 89,
"\$" => 86,
'LITERAL' => 88,
'FILENAME' => 83,
'IDENT' => 81,
'NUMBER' => 84
},
GOTOS => {
'filepart' => 87,
'names' => 91,
'nameargs' => 147,
'filename' => 85,
'name' => 82
}
},
{#State 52
ACTIONS => {
'' => 148
}
},
{#State 53
ACTIONS => {
'NOT' => 38,
"{" => 30,
'LITERAL' => 57,
'IDENT' => 2,
"\"" => 60,
"(" => 53,
"\$" => 43,
"[" => 9,
'NUMBER' => 26,
'REF' => 27,
"\${" => 37
},
GOTOS => {
'expr' => 151,
'sterm' => 68,
'item' => 39,
'assign' => 150,
'node' => 23,
'ident' => 149,
'term' => 58,
'lterm' => 56
}
},
{#State 54
ACTIONS => {
'NOT' => 38,
"{" => 30,
'LITERAL' => 78,
'IDENT' => 2,
"\"" => 60,
"(" => 53,
"\$" => 43,
"[" => 9,
'NUMBER' => 26,
'REF' => 27,
"\${" => 37
},
GOTOS => {
'expr' => 152,
'sterm' => 68,
'item' => 39,
'node' => 23,
'ident' => 77,
'term' => 58,
'lterm' => 56
}
},
{#State 55
ACTIONS => {
"\"" => 89,
"\$" => 86,
'LITERAL' => 88,
'FILENAME' => 83,
'IDENT' => 81,
'NUMBER' => 84
},
GOTOS => {
'filepart' => 87,
'names' => 91,
'nameargs' => 153,
'filename' => 85,
'name' => 82
}
},
{#State 56
DEFAULT => -103
},
{#State 57
ACTIONS => {
'ASSIGN' => 154
},
DEFAULT => -112
},
{#State 58
DEFAULT => -146
},
{#State 59
DEFAULT => -15
},
{#State 60
DEFAULT => -176,
GOTOS => {
'quoted' => 155
}
},
{#State 61
ACTIONS => {
"\"" => 89,
"\$" => 86,
'LITERAL' => 88,
'FILENAME' => 83,
'IDENT' => 81,
'NUMBER' => 84
},
GOTOS => {
'filepart' => 87,
'names' => 91,
'nameargs' => 156,
'filename' => 85,
'name' => 82
}
},
{#State 62
ACTIONS => {
";" => -16,
"+" => 157,
'CAT' => 163,
'CMPOP' => 164,
"?" => 158,
'DIV' => 159,
'MOD' => 165,
"/" => 166,
'AND' => 160,
'BINOP' => 161,
'OR' => 162
},
DEFAULT => -26
},
{#State 63
DEFAULT => -13
},
{#State 64
DEFAULT => -36
},
{#State 65
ACTIONS => {
"\"" => 89,
"\$" => 86,
'LITERAL' => 88,
'FILENAME' => 83,
'IDENT' => 81,
'NUMBER' => 84
},
GOTOS => {
'filepart' => 87,
'names' => 91,
'nameargs' => 167,
'filename' => 85,
'name' => 82
}
},
{#State 66
DEFAULT => -9
},
{#State 67
ACTIONS => {
'NOT' => 38,
"{" => 30,
'LITERAL' => 78,
'IDENT' => 2,
"\"" => 60,
"(" => 53,
"\$" => 43,
"[" => 9,
'NUMBER' => 26,
'REF' => 27,
"\${" => 37
},
GOTOS => {
'expr' => 168,
'sterm' => 68,
'item' => 39,
'node' => 23,
'ident' => 77,
'term' => 58,
'lterm' => 56
}
},
{#State 68
DEFAULT => -104
},
{#State 69
ACTIONS => {
"\$" => 43,
'LITERAL' => 75,
'IDENT' => 2,
"\${" => 37
},
GOTOS => {
'setlist' => 169,
'item' => 39,
'assign' => 19,
'node' => 23,
'ident' => 74
}
},
{#State 70
ACTIONS => {
"\$" => 43,
'COMMA' => 171,
'LITERAL' => 75,
'IDENT' => 2,
"\${" => 37
},
DEFAULT => -19,
GOTOS => {
'item' => 39,
'assign' => 170,
'node' => 23,
'ident' => 74
}
},
{#State 71
DEFAULT => -8
},
{#State 72
DEFAULT => -1
},
{#State 73
DEFAULT => -21
},
{#State 74
ACTIONS => {
'ASSIGN' => 172,
'DOT' => 104
}
},
{#State 75
ACTIONS => {
'ASSIGN' => 154
}
},
{#State 76
ACTIONS => {
'COMMA' => 171,
'LITERAL' => 75,
'IDENT' => 2,
"\$" => 43,
"\${" => 37
},
DEFAULT => -30,
GOTOS => {
'item' => 39,
'assign' => 170,
'node' => 23,
'ident' => 74
}
},
{#State 77
ACTIONS => {
'DOT' => 104
},
DEFAULT => -109