package Template::Tiny; # Load overhead: 40k use 5.00503; use strict; $Template::Tiny::VERSION = '1.12'; # Evaluatable expression my $EXPR = qr/ [a-z_][\w.]* /xs; # Opening [% tag including whitespace chomping rules my $LEFT = qr/ (?: (?: (?:^|\n) [ \t]* )? \[\%\- | \[\% \+? ) \s* /xs; # Closing %] tag including whitespace chomping rules my $RIGHT = qr/ \s* (?: \+? \%\] | \-\%\] (?: [ \t]* \n )? ) /xs; # Preparsing run for nesting tags my $PREPARSE = qr/ $LEFT ( IF | UNLESS | FOREACH ) \s+ ( (?: \S+ \s+ IN \s+ )? \S+ ) $RIGHT (?! .*? $LEFT (?: IF | UNLESS | FOREACH ) \b ) ( .*? ) (?: $LEFT ELSE $RIGHT (?! .*? $LEFT (?: IF | UNLESS | FOREACH ) \b ) ( .+? ) )? $LEFT END $RIGHT /xs; # Condition set my $CONDITION = qr/ \[\%\s ( ([IUF])\d+ ) \s+ (?: ([a-z]\w*) \s+ IN \s+ )? ( $EXPR ) \s\%\] ( .*? ) (?: \[\%\s \1 \s\%\] ( .+? ) )? \[\%\s \1 \s\%\] /xs; sub new { bless { @_[1..$#_] }, $_[0]; } # Copy and modify sub preprocess { my $self = shift; my $text = shift; $self->_preprocess(\$text); return $text; } sub process { my $self = shift; my $copy = ${shift()}; my $stash = shift || {}; local $@ = ''; local $^W = 0; # Preprocess to establish unique matching tag sets $self->_preprocess( \$copy ); # Process down the nested tree of conditions my $result = $self->_process( $stash, $copy ); if ( @_ ) { ${$_[0]} = $result; } elsif ( defined wantarray ) { require Carp; Carp::carp('Returning of template results is deprecated in Template::Tiny 0.11'); return $result; } else { print $result; } } ###################################################################### # Support Methods # The only reason this is a standalone is so we can # do more in-depth testing. sub _preprocess { my $self = shift; my $copy = shift; # Preprocess to establish unique matching tag sets my $id = 0; 1 while $$copy =~ s/ $PREPARSE / my $tag = substr($1, 0, 1) . ++$id; "\[\% $tag $2 \%\]$3\[\% $tag \%\]" . (defined($4) ? "$4\[\% $tag \%\]" : ''); /sex; } sub _process { my ($self, $stash, $text) = @_; $text =~ s/ $CONDITION / ($2 eq 'F') ? $self->_foreach($stash, $3, $4, $5) : eval { $2 eq 'U' xor !! # Force boolification $self->_expression($stash, $4) } ? $self->_process($stash, $5) : $self->_process($stash, $6) /gsex; # Resolve expressions $text =~ s/ $LEFT ( $EXPR ) $RIGHT / eval { $self->_expression($stash, $1) . '' # Force stringification } /gsex; # Trim the document $text =~ s/^\s*(.+?)\s*\z/$1/s if $self->{TRIM}; return $text; } # Special handling for foreach sub _foreach { my ($self, $stash, $term, $expr, $text) = @_; # Resolve the expression my $list = $self->_expression($stash, $expr); unless ( ref $list eq 'ARRAY' ) { return ''; } # Iterate return join '', map { $self->_process( { %$stash, $term => $_ }, $text ) } @$list; } # Evaluates a stash expression sub _expression { my $cursor = $_[1]; my @path = split /\./, $_[2]; foreach ( @path ) { # Support for private keys return undef if substr($_, 0, 1) eq '_'; # Split by data type my $type = ref $cursor; if ( $type eq 'ARRAY' ) { return '' unless /^(?:0|[0-9]\d*)\z/; $cursor = $cursor->[$_]; } elsif ( $type eq 'HASH' ) { $cursor = $cursor->{$_}; } elsif ( $type ) { $cursor = $cursor->$_(); } else { return ''; } } return $cursor; } 1; __END__ =pod =head1 NAME Template::Tiny - Template Toolkit reimplemented in as little code as possible =head1 SYNOPSIS my $template = Template::Tiny->new( TRIM => 1, ); # Print the template results to STDOUT $template->process( <<'END_TEMPLATE', { foo => 'World' } ); Hello [% foo %]! END_TEMPLATE =head1 DESCRIPTION B is a reimplementation of a subset of the functionality from L