File Coverage

blib/lib/Text/Template/Simple.pm
Criterion Covered Total %
statement 109 151 72.1
branch 23 52 44.2
condition 10 25 40.0
subroutine 24 27 88.8
pod 7 7 100.0
total 173 262 66.0


line stmt bran cond sub pod time code
1             package Text::Template::Simple;
2 62     62   3828483 use strict;
  62         169  
  62         2866  
3 62     62   7695 use warnings;
  62         133  
  62         3635  
4              
5             our $VERSION = '0.86';
6              
7 62     62   737 use File::Spec;
  62         126  
  62         2029  
8 62     62   55726 use Text::Template::Simple::Constants qw(:all);
  62         249  
  62         62886  
9 62     62   52657 use Text::Template::Simple::Dummy;
  62         594  
  62         1981  
10 62     62   58133 use Text::Template::Simple::Compiler;
  62         174  
  62         2095  
11 62     62   48560 use Text::Template::Simple::Compiler::Safe;
  62         162  
  62         1871  
12 62     62   461 use Text::Template::Simple::Caller;
  62         110  
  62         1569  
13 62     62   42025 use Text::Template::Simple::Tokenizer;
  62         204  
  62         2505  
14 62     62   606 use Text::Template::Simple::Util qw(:all);
  62         148  
  62         16234  
15 62     62   47352 use Text::Template::Simple::Cache::ID;
  62         196  
  62         1998  
16 62     62   62587 use Text::Template::Simple::Cache;
  62         253  
  62         5373  
17 62     62   54984 use Text::Template::Simple::IO;
  62         207  
  62         3157  
18              
19 62         68865 use base qw(
20             Text::Template::Simple::Base::Compiler
21             Text::Template::Simple::Base::Examine
22             Text::Template::Simple::Base::Include
23             Text::Template::Simple::Base::Parser
24 62     62   520 );
  62         139  
25              
26             my %CONNECTOR = ( # Default classes list
27             'Cache' => 'Text::Template::Simple::Cache',
28             'Cache::ID' => 'Text::Template::Simple::Cache::ID',
29             'IO' => 'Text::Template::Simple::IO',
30             'Tokenizer' => 'Text::Template::Simple::Tokenizer',
31             );
32              
33             my %DEFAULT = ( # default object attributes
34             delimiters => [ DELIMS ], # default delimiters
35             cache => 0, # use cache or not
36             cache_dir => EMPTY_STRING, # will use hdd intead of memory for caching...
37             strict => 1, # set to false for toleration to un-declared vars
38             safe => 0, # use safe compartment?
39             header => 0, # template header. i.e. global codes.
40             add_args => EMPTY_STRING, # will unshift template argument list. ARRAYref.
41             warn_ids => 0, # warn template ids?
42             capture_warnings => 0, # bool
43             iolayer => EMPTY_STRING, # I/O layer for filehandles
44             stack => EMPTY_STRING, # dump caller stack?
45             user_thandler => undef, # user token handler callback
46             monolith => 0, # use monolithic template & cache ?
47             include_paths => [], # list of template dirs
48             verbose_errors => 0, # bool
49             pre_chomp => CHOMP_NONE,
50             post_chomp => CHOMP_NONE,
51             taint_mode => TAINT_CHECK_NORMAL,
52             );
53              
54             my @EXPORT_OK = qw( tts );
55              
56             sub import {
57 60     60   176367 my($class, @args) = @_;
58 60 50       40190 return if ! @args;
59 0         0 my $caller = caller;
60 0         0 my %ok = map { ($_, $_) } @EXPORT_OK;
  0         0  
61              
62 62     62   673 no strict qw( refs );
  62         161  
  62         127579  
63 0         0 foreach my $name ( @args ) {
64 0 0       0 fatal('tts.main.import.invalid', $name, $class) if ! $ok{$name};
65 0 0       0 fatal('tts.main.import.undef', $name, $class) if ! defined &{ $name };
  0         0  
66 0         0 my $target = $caller . q{::} . $name;
67 0 0       0 fatal('tts.main.import.redefine', $name, $caller) if defined &{ $target };
  0         0  
68 0         0 *{ $target } = \&{ $name }; # install
  0         0  
  0         0  
69             }
70              
71 0         0 return;
72             }
73              
74             sub tts {
75 0     0 1 0 my @args = @_;
76 0 0       0 fatal('tts.main.tts.args') if ! @args;
77 0 0       0 my @new = ishref($args[0]) ? %{ shift @args } : ();
  0         0  
78 0         0 return __PACKAGE__->new( @new )->compile( @args );
79             }
80              
81             sub new {
82 90     90 1 45971 my($class, @args) = @_;
83 90 50       707 my %param = @args % 2 ? () : (@args);
84 90         374 my $self = [ map { undef } 0 .. MAXOBJFIELD ];
  3150         5021  
85 90         396 bless $self, $class;
86              
87 90 50       665 LOG( CONSTRUCT => $self->class_id . q{ @ } . (scalar localtime time) )
88             if DEBUG();
89              
90 90         212 my($fid, $fval);
91 90         818 INITIALIZE: foreach my $field ( keys %DEFAULT ) {
92 1620         2548 $fid = uc $field;
93 1620 50       10435 next INITIALIZE if ! $class->can( $fid );
94 1620         4573 $fid = $class->$fid();
95 1620         2191 $fval = delete $param{$field};
96 1620 100       6992 $self->[$fid] = defined $fval ? $fval : $DEFAULT{$field};
97             }
98              
99 90         496 foreach my $bogus ( keys %param ) {
100 0         0 warn "'$bogus' is not a known parameter. Did you make a typo?\n";
101             }
102              
103 90         906 $self->_init;
104 90         1437 return $self;
105             }
106              
107             sub connector {
108 724     724 1 1856 my $self = shift;
109 724   33     2640 my $id = shift || fatal('tts.main.connector.args');
110 724   33     21876 return $CONNECTOR{ $id } || fatal('tts.main.connector.invalid', $id);
111             }
112              
113 1292     1292 1 25119 sub cache { return shift->[CACHE_OBJECT] }
114 2444     2444 1 14246 sub io { return shift->[IO_OBJECT] }
115              
116             sub compile {
117 488     488 1 156478 my($self, @args) = @_;
118 488         9068 my $rv = $self->_compile( @args );
119             # we need to reset this to prevent false positives
120             # the trick is: this is set in _compile() and sub includes call _compile()
121             # instead of compile(), so it will only be reset here
122 482         1375 $self->[COUNTER_INCLUDE] = undef;
123 482         5185 return $rv;
124             }
125              
126             # -------------------[ P R I V A T E M E T H O D S ]------------------- #
127              
128             sub _init {
129 90     90   223 my $self = shift;
130 90         234 my $d = $self->[DELIMITERS];
131 90   66     465 my $bogus_args = $self->[ADD_ARGS] && ! isaref($self->[ADD_ARGS]);
132              
133 90 50       367 fatal('tts.main.bogus_args') if $bogus_args;
134 90 50 33     557 fatal('tts.main.bogus_delims') if ! isaref( $d ) || $#{ $d } != 1;
  90         1371  
135 90 50       490 fatal('tts.main.dslen') if length($d->[DELIM_START]) < 2;
136 90 50       426 fatal('tts.main.delen') if length($d->[DELIM_END]) < 2;
137 90 50       561 fatal('tts.main.dsws') if $d->[DELIM_START] =~ m{\s}xms;
138 90 50       488 fatal('tts.main.dews') if $d->[DELIM_END] =~ m{\s}xms;
139              
140 90         265 $self->[TYPE] = EMPTY_STRING;
141 90         293 $self->[COUNTER] = 0;
142 90         432 $self->[FAKER] = $self->_output_buffer_var;
143 90         793 $self->[FAKER_HASH] = $self->_output_buffer_var('hash');
144 90         396 $self->[FAKER_SELF] = $self->_output_buffer_var('self');
145 90         270 $self->[INSIDE_INCLUDE] = RESET_FIELD;
146 90         303 $self->[NEEDS_OBJECT] = 0; # the template needs $self ?
147 90         335 $self->[DEEP_RECURSION] = 0; # recursion detector
148              
149 90 50 33     648 fatal('tts.main.init.thandler')
150             if $self->[USER_THANDLER] && ! iscref($self->[USER_THANDLER]);
151              
152 90 50 33     945 fatal('tts.main.init.include')
153             if $self->[INCLUDE_PATHS] && ! isaref($self->[INCLUDE_PATHS]);
154              
155 90         3194 $self->[IO_OBJECT] = $self->connector('IO')->new(
156 90         511 @{ $self }[ IOLAYER, INCLUDE_PATHS, TAINT_MODE ],
157             );
158              
159 90 100       490 if ( $self->[CACHE_DIR] ) {
160 4 50       22 $self->[CACHE_DIR] = $self->io->validate( dir => $self->[CACHE_DIR] )
161             or fatal( 'tts.main.cdir' => $self->[CACHE_DIR] );
162             }
163              
164 90         467 $self->[CACHE_OBJECT] = $self->connector('Cache')->new($self);
165              
166 90         276 return;
167             }
168              
169             sub _output_buffer_var {
170 764     764   6519 my $self = shift;
171 764   100     4963 my $type = shift || 'scalar';
172 764 100       3863 my $id = $type eq 'hash' ? {}
    100          
173             : $type eq 'array' ? []
174             : \my $fake
175             ;
176 764         2173 $id = "$id";
177 764         15091 $id .= int rand $$; # . rand() . time;
178 764         2180 $id =~ tr/a-zA-Z_0-9//cd;
179 764 100       3451 $id =~ s{SCALAR}{SELF}xms if $type eq 'self';
180 764         3178 return q{$} . $id;
181             }
182              
183             sub class_id {
184 6     6 1 13 my $self = shift;
185 6   33     51 my $class = ref($self) || $self;
186 6         646 return sprintf q{%s v%s}, $class, $self->VERSION;
187             }
188              
189             sub _tidy { ## no critic (ProhibitUnusedPrivateSubroutines)
190 0     0     my $self = shift;
191 0           my $code = shift;
192              
193 0           TEST_TIDY: {
194 0           local($@, $SIG{__DIE__});
195 0           my $ok = eval { require Perl::Tidy; 1; };
  0            
  0            
196 0 0         if ( ! $ok ) { # :(
197 0           $code =~ s{;}{;\n}xmsgo; # new lines makes it easy to debug
198 0           return $code;
199             }
200             }
201              
202             # We have Perl::Tidy, yay!
203 0           my($buf, $stderr);
204 0           my @argv; # extra arguments
205              
206 0           Perl::Tidy::perltidy(
207             source => \$code,
208             destination => \$buf,
209             stderr => \$stderr,
210             argv => \@argv,
211             );
212              
213 0 0         LOG( TIDY_WARNING => $stderr ) if $stderr;
214 0           return $buf;
215             }
216              
217             sub DESTROY {
218 0   0 0     my $self = shift || return;
219 0           undef $self->[CACHE_OBJECT];
220 0           undef $self->[IO_OBJECT];
221 0           @{ $self } = ();
  0            
222 0 0         LOG( DESTROY => ref $self ) if DEBUG();
223 0           return;
224             }
225              
226             1;
227              
228             __END__
229              
230             =head1 NAME
231              
232             Text::Template::Simple - Simple text template engine
233              
234             =head1 SYNOPSIS
235              
236             use Text::Template::Simple;
237             my $tts = Text::Template::Simple->new();
238             print $tts->compile( $FILEHANDLE );
239             print $tts->compile('Hello, your perl is at <%= $^X %>');
240             print $tts->compile(
241             'hello.tts', # the template file
242             [ name => 'Burak', location => 'Istanbul' ]
243             );
244              
245             Where C<hello.tts> has this content:
246              
247             <% my %p = @_; %>
248             Hello <%= $p{name} %>,
249             I hope it's sunny in <%= $p{location} %>.
250             Local time is <%= scalar localtime time %>
251              
252             =head1 DESCRIPTION
253              
254             This document describes version C<0.86> of C<Text::Template::Simple>
255             released on C<5 March 2012>.
256              
257             This is a simple template module. There is no extra template/mini
258             language. Instead, it uses Perl as the template language. Templates
259             can be cached on disk or inside the memory via the internal cache
260             manager. It is also possible to use static/dynamic includes,
261             pass parameters to includes and apply filters on them.
262             Also see L<Text::Template::Simple::API> for the full API definiton.
263              
264             =head1 SYNTAX
265              
266             Template syntax is very simple. There are few kinds of delimiters:
267              
268             =over 4
269              
270             =item *
271              
272             C<< <% %> >> Code Blocks
273              
274             =item *
275              
276             C<< <%= %> >> Self-printing Blocks
277              
278             =item *
279              
280             C<< <%! %> >> Escaped Delimiters
281              
282             =item *
283              
284             C<< <%+ %> >> Static Include Directives
285              
286             =item *
287              
288             C<< <%* %> >> Dynamic include directives
289              
290             =item *
291              
292             C<< <%# %> >> Comment Directives
293              
294             =item *
295              
296             C<< <%| %> >> Blocks with commands
297              
298             =back
299              
300             A simple example:
301              
302             <% foreach my $x (@foo) { %>
303             Element is <%= $x %>
304             <% } %>
305              
306             Do not directly use print() statements, since they'll break the template
307             compilation. Use the self printing C<< <%= %> >> blocks.
308              
309             It is also possible to alter the delimiters:
310              
311             $tts = Text::Template::Simple->new(
312             delimiters => [qw/<?perl ?>/],
313             );
314              
315             then you can use them inside templates:
316              
317             <?perl
318             my @foo = qw(bar baz);
319             foreach my $x (@foo) {
320             ?>
321             Element is <?perl= $x ?>
322             <?perl } ?>
323              
324             If you need to remove a code temporarily without deleting, or need to add
325             comments:
326              
327             <%#
328             This
329             whole
330             block
331             will
332             be
333             ignored
334             %>
335              
336             If you put a space before the pound sign, the block will be a code block:
337              
338             <%
339             # this is normal code not a comment directive
340             my $foo = 42;
341             %>
342              
343             If you want to include a text or html file, you can use the
344             static include directive:
345              
346             <%+ my_other.html %>
347             <%+ my_other.txt %>
348              
349             Included files won't be parsed and included statically. To enable
350             parsing for the included files, use the dynamic includes:
351              
352             <%* my_other.html %>
353             <%* my_other.txt %>
354              
355             Interpolation is also supported with both kinds of includes, so the following
356             is valid code:
357              
358             <%+ "/path/to/" . $txt %>
359             <%* "/path/to/" . $myfile %>
360              
361             =head2 Chomping
362              
363             Chomping is the removal of whitespace before and after your directives. This
364             can be useful if you're generating plain text (instead of HTML which'll ignore
365             spaces most of the time). You can either remove all space or replace multiple
366             whitespace with a single space (collapse). Chomping can be enabled per
367             directive or globally via options to the constructor.
368             See L<Text::Template::Simple::API/pre_chomp> and
369             L<Text::Template::Simple::API/post_chomp> options to
370             L<Text::Template::Simple::API/new> to globally enable chomping.
371              
372             Chomping is enabled with second level commands for all directives. Here is
373             a list of commands:
374              
375             - Chomp
376             ~ Collapse
377             ^ No chomp (override global)
378              
379             All directives can be chomped. Here are some examples:
380              
381             Chomp:
382              
383             raw content
384             <%- my $foo = 42; -%>
385             raw content
386             <%=- $foo -%>
387             raw content
388             <%*- /mt/dynamic.tts -%>
389             raw content
390              
391             Collapse:
392              
393             raw content
394             <%~ my $foo = 42; ~%>
395             raw content
396             <%=~ $foo ~%>
397             raw content
398             <%*~ /mt/dynamic.tts ~%>
399             raw content
400              
401             No chomp:
402              
403             raw content
404             <%^ my $foo = 42; ^%>
405             raw content
406             <%=^ $foo ^%>
407             raw content
408             <%*^ /mt/dynamic.tts ^%>
409             raw content
410              
411             It is also possible to mix the chomping types:
412              
413             raw content
414             <%- my $foo = 42; ^%>
415             raw content
416             <%=^ $foo ~%>
417             raw content
418             <%*^ /mt/dynamic.tts -%>
419             raw content
420              
421             For example this template:
422              
423             Foo
424             <%- $prehistoric = $] < 5.008 -%>
425             Bar
426              
427             Will become:
428              
429             FooBar
430              
431             And this one:
432              
433             Foo
434             <%~ $prehistoric = $] < 5.008 -%>
435             Bar
436              
437             Will become:
438              
439             Foo Bar
440              
441             Chomping is inspired by Template Toolkit (mostly the same functionality,
442             although TT seems to miss collapse/no-chomp per directive option).
443              
444             =head2 Accessing Template Names
445              
446             You can use C<$0> to get the template path/name inside the template:
447              
448             I am <%= $0 %>
449              
450             =head2 Escaping Delimiters
451              
452             If you have to build templates like this:
453              
454             Test: <%abc>
455              
456             or this:
457              
458             Test: <%abc%>
459              
460             This will result with a template compilation error. You have to use the
461             delimiter escape command C<!>:
462              
463             Test: <%!abc>
464             Test: <%!abc%>
465              
466             Those will be compiled as:
467              
468             Test: <%abc>
469             Test: <%abc%>
470              
471             Alternatively, you can change the default delimiters to solve this issue.
472             See the L<Text::Template::Simple::API/delimiters> option for
473             L<Text::Template::Simple::API/new> for more information on how to
474             do this.
475              
476             =head2 Template Parameters
477              
478             You can fetch parameters (passed to compile) in the usual perl way:
479              
480             <%
481             my $foo = shift;
482             my %bar = @_;
483             %>
484             Baz is <%= $bar{baz} %>
485              
486             =head2 INCLUDE COMMANDS
487              
488             Include commands are separated by pipes in an include directive.
489             Currently supported parameters are:
490              
491             =over 4
492              
493             =item *
494              
495             PARAM
496              
497             =item *
498              
499             FILTER
500              
501             =item *
502              
503             SHARE
504              
505             =back
506              
507             <%+ /path/to/static.tts | FILTER: MyFilter %>
508             <%* /path/to/dynamic.tts | FILTER: MyFilter | PARAM: test => 123 %>
509              
510             C<PARAM:> defines the parameter list to pass to the included file.
511             C<FILTER:> defines the list of filters to apply to the output of the include.
512             C<SHARE:> used to list the variables to share with the included template when
513             the monolith option is disabled.
514              
515             =head3 INCLUDE FILTERS
516              
517             Use the include command C<FILTER:> (notice the colon in the command):
518              
519             <%+ /path/to/static.tts | FILTER: First, Second %>
520             <%* /path/to/dynamic.tts | FILTER: Third, Fourth, Fifth %>
521              
522             =head4 IMPLEMENTING INCLUDE FILTERS
523              
524             Define the filter inside C<Text::Template::Simple::Dummy> with a C<filter_>
525             prefix:
526              
527             package Text::Template::Simple::Dummy;
528             sub filter_MyFilter {
529             # $tts is the current Text::Template::Simple object
530             # $output_ref is the scalar reference to the output of
531             # the template.
532             my($tts, $output_ref) = @_;
533             $$output_ref .= "FILTER APPLIED"; # add to output
534             return;
535             }
536              
537             =head3 INCLUDE PARAMETERS
538              
539             Just pass the parameters as described above and fetch them via C<@_> inside
540             the included file.
541              
542             =head3 SHARED VARIABLES
543              
544             C<Text::Template::Simple> compiles every template individually with separate
545             scopes. A variable defined in the master template is not accessible from a
546             dynamic include. The exception to this rule is the C<monolith> option to C<new>.
547             If it is enabled; the master template and any includes it has will be compiled
548             into a single document, thus making every variable defined at the top available
549             to the includes below. But this method has several drawbacks, it disables cache
550             check for the sub files (includes) --you'll need to edit the master template
551             to force a cache reload-- and it can not be used with interpolated includes.
552             If you use an interpolated include with monolith enabled, you'll get an error.
553              
554             If you don't use C<monolith> (disabled by default), then you'll need to share
555             the variables somehow to don't repeat yourself. Variable sharing is demonstrated
556             in the below template:
557              
558             <%
559             my $foo = 42;
560             my $bar = 23;
561             %>
562             <%* dyna.inc | SHARE: $foo, $bar %>
563              
564             And then you can access C<$foo> and C<$bar> inside C<dyna.inc>. There is one
565             drawback by shared variables: only SCALARs can be shared. You can not share
566             anything else. If you want to share an array, use an array reference instead:
567              
568             <%
569             my @foo = (1..10);
570             my $fooref = \@foo;
571             %>
572             <%* dyna.inc | SHARE: $fooref %>
573              
574             =head2 BLOCKS
575              
576             A block consists of a header part and the content.
577              
578             <%| HEADER;
579             BODY
580             %>
581              
582             C<HEADER> includes the commands and terminated with a semicolon. C<BODY> is the
583             actual block content.
584              
585             =head3 BLOCK FILTERS
586              
587             B<WARNING> Block filters are considered to be experimental. They may be changed
588             or completely removed in the future.
589              
590             Identical to include filters, but works on blocks of text:
591              
592             <%| FILTER: HTML, OtherFilter;
593             <p>&FooBar=42</p>
594             %>
595              
596             Note that you can not use any variables in these blocks. They are static.
597              
598             =head1 METHODS & FUNCTIONS
599              
600             =head2 new
601              
602             =head2 cache
603              
604             =head2 class_id
605              
606             =head2 compile
607              
608             =head2 connector
609              
610             =head2 io
611              
612             =head2 tts
613              
614             See L<Text::Template::Simple::API> for the technical/gory details.
615              
616             =head1 EXAMPLES
617              
618             TODO
619              
620             =head1 ERROR HANDLING
621              
622             You may need to C<eval> your code blocks to trap exceptions. Some recoverable
623             failures are silently ignored, but you can display them as warnings
624             if you enable debugging.
625              
626             =head1 BUGS
627              
628             Contact the author if you find any bugs.
629              
630             =head1 CAVEATS
631              
632             =head2 No mini language
633              
634             There is no mini-language. Only perl is used as the template
635             language. So, this may or may not be I<safe> from your point
636             of view. If this is a problem for you, just don't use this
637             module. There are plenty of template modules with mini-languages
638             inside I<CPAN>.
639              
640             =head2 Speed
641              
642             There is an initialization cost and this'll show itself after
643             the first compilation process. The second and any following compilations
644             will be much faster. Using cache can also improve speed, since this'll
645             eliminate the parsing phase. Also, using memory cache will make
646             the program run more faster under persistent environments. But the
647             overall speed really depends on your environment.
648              
649             Internal cache manager generates ids for all templates. If you supply
650             your own id parameter, this will improve performance.
651              
652             =head2 Optional Dependencies
653              
654             Some methods/functionality of the module needs these optional modules:
655              
656             Devel::Size
657             Text::Table
658             Perl::Tidy
659              
660             =head1 SEE ALSO
661              
662             L<Text::Template::Simple::API>, L<Apache::SimpleTemplate>, L<Text::Template>,
663             L<Text::ScriptTemplate>, L<Safe>, L<Opcode>.
664              
665             =head2 MONOLITHIC VERSION
666              
667             C<Text::Template::Simple> consists of C<15+> separate modules. If you are
668             after a single C<.pm> file to ease deployment, download the distribution
669             from a C<CPAN> mirror near you to get a monolithic C<Text::Template::Simple>.
670             It is automatically generated from the separate modules and distributed in
671             the C<monolithic_version> directory.
672              
673             However, be aware that the monolithic version is B<not supported>.
674              
675             =head1 AUTHOR
676              
677             Burak Gursoy <burak@cpan.org>.
678              
679             =head1 COPYRIGHT
680              
681             Copyright 2004 - 2012 Burak Gursoy. All rights reserved.
682              
683             =head1 LICENSE
684              
685             This library is free software; you can redistribute it and/or modify
686             it under the same terms as Perl itself, either Perl version 5.12.3 or,
687             at your option, any later version of Perl 5 you may have available.
688              
689             =cut