—

              
package Text::Template::Simple;
use strict;
use warnings;
use vars qw( $VERSION );
$VERSION = '0.84';
use File::Spec;
use Text::Template::Simple::Constants qw(:all);
use Text::Template::Simple::Dummy;
use Text::Template::Simple::Compiler;
use Text::Template::Simple::Compiler::Safe;
use Text::Template::Simple::Caller;
use Text::Template::Simple::Tokenizer;
use Text::Template::Simple::Util qw(:all);
use Text::Template::Simple::Cache::ID;
use Text::Template::Simple::Cache;
use Text::Template::Simple::IO;
use base qw(
   Text::Template::Simple::Base::Compiler
   Text::Template::Simple::Base::Examine
   Text::Template::Simple::Base::Include
   Text::Template::Simple::Base::Parser
);
my %CONNECTOR = ( # Default classes list
   'Cache'     => 'Text::Template::Simple::Cache',
   'Cache::ID' => 'Text::Template::Simple::Cache::ID',
   'IO'        => 'Text::Template::Simple::IO',
   'Tokenizer' => 'Text::Template::Simple::Tokenizer',
);
my %DEFAULT = ( # default object attributes
   delimiters       => [ DELIMS ],   # default delimiters
   cache            =>  0,           # use cache or not
   cache_dir        => EMPTY_STRING, # will use hdd intead of memory for caching...
   strict           =>  1,           # set to false for toleration to un-declared vars
   safe             =>  0,           # use safe compartment?
   header           =>  0,           # template header. i.e. global codes.
   add_args         => EMPTY_STRING, # will unshift template argument list. ARRAYref.
   warn_ids         =>  0,           # warn template ids?
   capture_warnings =>  0,           # bool
   iolayer          => EMPTY_STRING, # I/O layer for filehandles
   stack            => EMPTY_STRING, # dump caller stack?
   user_thandler    => undef,        # user token handler callback
   monolith         =>  0,           # use monolithic template & cache ?
   include_paths    => [],           # list of template dirs
   verbose_errors   =>  0,           # bool
   pre_chomp        => CHOMP_NONE,
   post_chomp       => CHOMP_NONE,
   taint_mode       => TAINT_CHECK_NORMAL,
);
my @EXPORT_OK = qw( tts );
sub import {
   my($class, @args) = @_;
   return if ! @args;
   my $caller = caller;
   my %ok     = map { ($_, $_) } @EXPORT_OK;
   no strict qw( refs );
   foreach my $name ( @args ) {
      fatal('tts.main.import.invalid', $name, $class) if ! $ok{$name};
      fatal('tts.main.import.undef',   $name, $class) if ! defined &{ $name   };
      my $target = $caller . q{::} . $name;
      fatal('tts.main.import.redefine', $name, $caller) if defined &{ $target };
      *{ $target } = \&{ $name }; # install
   }
   return;
}
sub tts {
   my @args = @_;
   fatal('tts.main.tts.args') if ! @args;
   my @new  = ishref($args[0]) ? %{ shift @args } : ();
   return __PACKAGE__->new( @new )->compile( @args );
}
sub new {
   my($class, @args) = @_;
   my %param = @args % 2 ? () : (@args);
   my $self  = [ map { undef } 0 .. MAXOBJFIELD ];
   bless $self, $class;
   LOG( CONSTRUCT => $self->class_id . q{ @ } . (scalar localtime time) )
      if DEBUG();
   my($fid, $fval);
   INITIALIZE: foreach my $field ( keys %DEFAULT ) {
      $fid = uc $field;
      next INITIALIZE if ! $class->can( $fid );
      $fid  = $class->$fid();
      $fval = delete $param{$field};
      $self->[$fid] = defined $fval ? $fval : $DEFAULT{$field};
   }
   foreach my $bogus ( keys %param ) {
      warn "'$bogus' is not a known parameter. Did you make a typo?\n";
   }
   $self->_init;
   return $self;
}
sub connector {
   my $self = shift;
   my $id   = shift || fatal('tts.main.connector.args');
   return $CONNECTOR{ $id } || fatal('tts.main.connector.invalid', $id);
}
sub cache { return shift->[CACHE_OBJECT] }
sub io    { return shift->[IO_OBJECT]    }
sub compile {
   my($self, @args) = @_;
   my $rv    = $self->_compile( @args );
   # we need to reset this to prevent false positives
   # the trick is: this is set in _compile() and sub includes call _compile()
   # instead of compile(), so it will only be reset here
   $self->[COUNTER_INCLUDE] = undef;
   return $rv;
}
# -------------------[ P R I V A T E   M E T H O D S ]------------------- #
sub _init {
   my $self = shift;
   my $d    = $self->[DELIMITERS];
   my $bogus_args = $self->[ADD_ARGS] && ! isaref($self->[ADD_ARGS]);
   fatal('tts.main.bogus_args')   if $bogus_args;
   fatal('tts.main.bogus_delims') if ! isaref( $d ) || $#{ $d } != 1;
   fatal('tts.main.dslen')        if length($d->[DELIM_START]) < 2;
   fatal('tts.main.delen')        if length($d->[DELIM_END])   < 2;
   fatal('tts.main.dsws')         if $d->[DELIM_START] =~ m{\s}xms;
   fatal('tts.main.dews')         if $d->[DELIM_END]   =~ m{\s}xms;
   $self->[TYPE]           = EMPTY_STRING;
   $self->[COUNTER]        = 0;
   $self->[FAKER]          = $self->_output_buffer_var;
   $self->[FAKER_HASH]     = $self->_output_buffer_var('hash');
   $self->[FAKER_SELF]     = $self->_output_buffer_var('self');
   $self->[INSIDE_INCLUDE] = MINUS_ONE; # must be -1 not 0
   $self->[NEEDS_OBJECT]   =  0; # the template needs $self ?
   $self->[DEEP_RECURSION] =  0; # recursion detector
   fatal('tts.main.init.thandler')
      if $self->[USER_THANDLER] && ! iscref($self->[USER_THANDLER]);
   fatal('tts.main.init.include')
      if $self->[INCLUDE_PATHS] && ! isaref($self->[INCLUDE_PATHS]);
   $self->[IO_OBJECT] = $self->connector('IO')->new(
                           @{ $self }[ IOLAYER, INCLUDE_PATHS, TAINT_MODE ],
                        );
   if ( $self->[CACHE_DIR] ) {
      $self->[CACHE_DIR] = $self->io->validate( dir => $self->[CACHE_DIR] )
                           or fatal( 'tts.main.cdir' => $self->[CACHE_DIR] );
   }
   $self->[CACHE_OBJECT] = $self->connector('Cache')->new($self);
   return;
}
sub _output_buffer_var {
   my $self = shift;
   my $type = shift || 'scalar';
   my $id   = $type eq 'hash'  ? {}
            : $type eq 'array' ? []
            :                    \my $fake
            ;
   $id  = "$id";
   $id .= int rand $$; # . rand() . time;
   $id  =~ tr/a-zA-Z_0-9//cd;
   $id  =~ s{SCALAR}{SELF}xms if $type eq 'self';
   return q{$} . $id;
}
sub class_id {
   my $self = shift;
   my $class = ref($self) || $self;
   return sprintf q{%s v%s}, $class, $self->VERSION;
}
sub _tidy { ## no critic (ProhibitUnusedPrivateSubroutines)
   my $self = shift;
   my $code = shift;
   TEST_TIDY: {
      local($@, $SIG{__DIE__});
      my $ok = eval { require Perl::Tidy; 1; };
      if ( ! $ok ) { # :(
         $code =~ s{;}{;\n}xmsgo; # new lines makes it easy to debug
         return $code;
      }
   }
   # We have Perl::Tidy, yay!
   my($buf, $stderr);
   my @argv; # extra arguments
   Perl::Tidy::perltidy(
      source      => \$code,
      destination => \$buf,
      stderr      => \$stderr,
      argv        => \@argv,
   );
   LOG( TIDY_WARNING => $stderr ) if $stderr;
   return $buf;
}
sub DESTROY {
   my $self = shift || return;
   undef $self->[CACHE_OBJECT];
   undef $self->[IO_OBJECT];
   @{ $self } = ();
   LOG( DESTROY => ref $self ) if DEBUG();
   return;
}
1;
__END__
HideShow 461 lines of Pod
=head1 NAME
Text::Template::Simple - Simple text template engine
=head1 SYNOPSIS
   use Text::Template::Simple;
   my $tts = Text::Template::Simple->new();
   print $tts->compile( $FILEHANDLE );
   print $tts->compile('Hello, your perl is at <%= $^X %>');
   print $tts->compile(
            'hello.tts', # the template file
            [ name => 'Burak', location => 'Istanbul' ]
         );
Where C<hello.tts> has this content:
   <% my %p = @_; %>
   Hello <%= $p{name} %>,
   I hope it's sunny in <%= $p{location} %>.
   Local time is <%= scalar localtime time %>
=head1 DESCRIPTION
This document describes version C<0.84> of C<Text::Template::Simple>
released on C<15 November 2011>.
This is a simple template module. There is no extra template/mini 
language. Instead, it uses Perl as the template language. Templates
can be cached on disk or inside the memory via the internal cache 
manager. It is also possible to use static/dynamic includes,
pass parameters to includes and apply filters on them.
Also see L<Text::Template::Simple::API> for the full API definiton.
=head1 SYNTAX
Template syntax is very simple. There are few kinds of delimiters:
=over 4
=item *
C<< <% %>  >> Code Blocks
=item *
C<< <%= %> >> Self-printing Blocks
=item *
C<< <%! %> >> Escaped Delimiters
=item *
C<< <%+ %> >> Static Include Directives
=item *
C<< <%* %> >> Dynamic include directives
=item *
C<< <%# %> >> Comment Directives
=item *
C<< <%| %> >> Blocks with commands
=back
A simple example:
   <% foreach my $x (@foo) { %>
      Element is <%= $x %>
   <% } %>
Do not directly use print() statements, since they'll break the template
compilation. Use the self printing C<< <%= %> >> blocks.
It is also possible to alter the delimiters:
   $tts = Text::Template::Simple->new(
      delimiters => [qw/<?perl ?>/],
   );
then you can use them inside templates:
   <?perl
      my @foo = qw(bar baz);
      foreach my $x (@foo) {
   ?>
   Element is <?perl= $x ?>
   <?perl } ?>
If you need to remove a code temporarily without deleting, or need to add
comments:
   <%#
      This
      whole
      block
      will
      be
      ignored
   %>
If you put a space before the pound sign, the block will be a code block:
   <%
      # this is normal code not a comment directive
      my $foo = 42;
   %>
If you want to include a text or html file, you can use the
static include directive:
   <%+ my_other.html %>
   <%+ my_other.txt  %>
Included files won't be parsed and included statically. To enable
parsing for the included files, use the dynamic includes:
   <%* my_other.html %>
   <%* my_other.txt  %>
Interpolation is also supported with both kinds of includes, so the following
is valid code:
   <%+ "/path/to/" . $txt    %>
   <%* "/path/to/" . $myfile %>
=head2 Chomping
Chomping is the removal of whitespace before and after your directives. This
can be useful if you're generating plain text (instead of HTML which'll ignore
spaces most of the time). You can either remove all space or replace multiple
whitespace with a single space (collapse). Chomping can be enabled per
directive or globally via options to the constructor.
See L<Text::Template::Simple::API/pre_chomp> and
L<Text::Template::Simple::API/post_chomp> options to
L<Text::Template::Simple::API/new> to globally enable chomping.
Chomping is enabled with second level commands for all directives. Here is
a list of commands:
   -   Chomp
   ~   Collapse
   ^   No chomp (override global)
All directives can be chomped. Here are some examples:
Chomp:
   raw content
   <%- my $foo = 42; -%>
   raw content
   <%=- $foo -%>
   raw content
   <%*- /mt/dynamic.tts  -%>
   raw content
Collapse:
   raw content
   <%~ my $foo = 42; ~%>
   raw content
   <%=~ $foo ~%>
   raw content
   <%*~ /mt/dynamic.tts  ~%>
   raw content
No chomp:
   raw content
   <%^ my $foo = 42; ^%>
   raw content
   <%=^ $foo ^%>
   raw content
   <%*^ /mt/dynamic.tts  ^%>
   raw content
It is also possible to mix the chomping types:
   raw content
   <%- my $foo = 42; ^%>
   raw content
   <%=^ $foo ~%>
   raw content
   <%*^ /mt/dynamic.tts  -%>
   raw content
For example this template:
   Foo
   <%- $prehistoric = $] < 5.008 -%>
   Bar
Will become:
   FooBar
And this one:
   Foo
   <%~ $prehistoric = $] < 5.008 -%>
   Bar
Will become:
   Foo Bar
Chomping is inspired by Template Toolkit (mostly the same functionality,
although TT seems to miss collapse/no-chomp per directive option).
=head2 Accessing Template Names
You can use C<$0> to get the template path/name inside the template:
   I am <%= $0 %>
=head2 Escaping Delimiters
If you have to build templates like this:
   Test: <%abc>
or this:
   Test: <%abc%>
This will result with a template compilation error. You have to use the
delimiter escape command C<!>:
   Test: <%!abc>
   Test: <%!abc%>
Those will be compiled as:
   Test: <%abc>
   Test: <%abc%>
Alternatively, you can change the default delimiters to solve this issue.
See the L<Text::Template::Simple::API/delimiters> option for
L<Text::Template::Simple::API/new> for more information on how to
do this.
=head2 Template Parameters
You can fetch parameters (passed to compile) in the usual perl way:
   <%
      my $foo = shift;
      my %bar = @_;
   %>
   Baz is <%= $bar{baz} %>
=head2 INCLUDE COMMANDS
Include commands are separated by pipes in an include directive.
Currently supported parameters are:
=over 4
=item *
PARAM
=item *
FILTER
=item *
SHARE
=back
   <%+ /path/to/static.tts  | FILTER: MyFilter %>
   <%* /path/to/dynamic.tts | FILTER: MyFilter | PARAM: test => 123 %>
C<PARAM:> defines the parameter list to pass to the included file.
C<FILTER:> defines the list of filters to apply to the output of the include.
C<SHARE:> used to list the variables to share with the included template when
the monolith option is disabled.
=head3 INCLUDE FILTERS
Use the include command C<FILTER:> (notice the colon in the command):
   <%+ /path/to/static.tts  | FILTER: First, Second        %>
   <%* /path/to/dynamic.tts | FILTER: Third, Fourth, Fifth %>
=head4 IMPLEMENTING INCLUDE FILTERS
Define the filter inside C<Text::Template::Simple::Dummy> with a C<filter_>
prefix:
   package Text::Template::Simple::Dummy;
   sub filter_MyFilter {
      # $tts is the current Text::Template::Simple object
      # $output_ref is the scalar reference to the output of
      #    the template.
      my($tts, $output_ref) = @_;
      $$output_ref .= "FILTER APPLIED"; # add to output
      return;
   }
=head3 INCLUDE PARAMETERS
Just pass the parameters as described above and fetch them via C<@_> inside
the included file.
=head3 SHARED VARIABLES
C<Text::Template::Simple> compiles every template individually with separate
scopes. A variable defined in the master template is not accessible from a
dynamic include. The exception to this rule is the C<monolith> option to C<new>.
If it is enabled; the master template and any includes it has will be compiled
into a single document, thus making every variable defined at the top available
to the includes below. But this method has several drawbacks, it disables cache
check for the sub files (includes) --you'll need to edit the master template
to force a cache reload-- and it can not be used with interpolated includes.
If you use an interpolated include with monolith enabled, you'll get an error.
If you don't use C<monolith> (disabled by default), then you'll need to share
the variables somehow to don't repeat yourself. Variable sharing is demonstrated
in the below template:
   <%
      my $foo = 42;
      my $bar = 23;
   %>
   <%* dyna.inc | SHARE: $foo, $bar %>
And then you can access C<$foo> and C<$bar> inside C<dyna.inc>. There is one
drawback by shared variables: only SCALARs can be shared. You can not share
anything else. If you want to share an array, use an array reference instead:
   <%
      my @foo = (1..10);
      my $fooref = \@foo;
   %>
   <%* dyna.inc | SHARE: $fooref %>
=head2 BLOCKS
A block consists of a header part and the content.
   <%| HEADER;
       BODY
   %>
C<HEADER> includes the commands and terminated with a semicolon. C<BODY> is the
actual block content.
=head3 BLOCK FILTERS
B<WARNING> Block filters are considered to be experimental. They may be changed
or completely removed in the future.
Identical to include filters, but works on blocks of text:
   <%| FILTER: HTML, OtherFilter;
      <p>&FooBar=42</p>
   %>
Note that you can not use any variables in these blocks. They are static.
=head1 METHODS & FUNCTIONS
=head2 new
=head2 cache
=head2 class_id
=head2 compile
=head2 connector
=head2 io
=head2 tts
See L<Text::Template::Simple::API> for the technical/gory details.
=head1 EXAMPLES
TODO
=head1 ERROR HANDLING
You may need to C<eval> your code blocks to trap exceptions. Some recoverable
failures are silently ignored, but you can display them as warnings 
if you enable debugging.
=head1 BUGS
Contact the author if you find any bugs.
=head1 CAVEATS
=head2 No mini language
There is no mini-language. Only perl is used as the template
language. So, this may or may not be I<safe> from your point
of view. If this is a problem for you, just don't use this 
module. There are plenty of template modules with mini-languages
inside I<CPAN>.
=head2 Speed
There is an initialization cost and this'll show itself after
the first compilation process. The second and any following compilations
will be much faster. Using cache can also improve speed, since this'll
eliminate the parsing phase. Also, using memory cache will make
the program run more faster under persistent environments. But the 
overall speed really depends on your environment.
Internal cache manager generates ids for all templates. If you supply 
your own id parameter, this will improve performance.
=head2 Optional Dependencies
Some methods/functionality of the module needs these optional modules:
   Devel::Size
   Text::Table
   Perl::Tidy
=head1 SEE ALSO
L<Text::Template::Simple::API>, L<Apache::SimpleTemplate>, L<Text::Template>,
L<Text::ScriptTemplate>, L<Safe>, L<Opcode>.
=head2 MONOLITHIC VERSION
C<Text::Template::Simple> consists of C<15+> separate modules. If you are
after a single C<.pm> file to ease deployment, download the distribution
from a C<CPAN> mirror near you to get a monolithic C<Text::Template::Simple>.
It is automatically generated from the separate modules and distributed in
the C<monolithic_version> directory.
However, be aware that the monolithic version is B<not supported>.
=head1 AUTHOR
Burak Gursoy <burak@cpan.org>.
=head1 COPYRIGHT
Copyright 2004 - 2011 Burak Gursoy. All rights reserved.
=head1 LICENSE
This library is free software; you can redistribute it and/or modify 
it under the same terms as Perl itself, either Perl version 5.12.3 or, 
at your option, any later version of Perl 5 you may have available.
=cut