File Coverage

blib/lib/Tenjin/Template.pm
Criterion Covered Total %
statement 37 151 24.5
branch 10 80 12.5
condition 4 14 28.5
subroutine 9 27 33.3
pod 20 20 100.0
total 80 292 27.4


line stmt bran cond sub pod time code
1             package Tenjin::Template;
2              
3 7     7   125 use strict;
  7         14  
  7         291  
4 7     7   43 use warnings;
  7         12  
  7         318  
5 7     7   38 use Fcntl qw/:flock/;
  7         13  
  7         1215  
6 7     7   44 use Carp;
  7         12  
  7         23765  
7              
8             our $VERSION = "0.070001";
9             $VERSION = eval $VERSION;
10              
11             =head1 NAME
12              
13             Tenjin::Template - A Tenjin template object, either built from a file or from memory.
14              
15             =head1 VERSION
16              
17             version 0.070001
18              
19             =head1 SYNOPSIS
20              
21             # mostly used internally, but you can manipulate
22             # templates like so
23              
24             my $template = Tenjin::Template->new('/path/to/templates/template.html');
25             my $context = { scalar => 'scalar', arrayref => ['one', 2, "3"] };
26             $template->render($context);
27              
28             =head1 DESCRIPTION
29              
30             This module is in charge of the task of compiling Tenjin templates.
31             Templates in Tenjin are compiled into standard Perl code (combined with
32             any Perl code used inside the templates themselves). Rendering a template
33             means Cuating that Perl code and returning its output.
34              
35             The Tenjin engine reads a template file or a template string, and creates
36             a Template object from it. Then the object compiles itself by traversing
37             the template, parsing Tenjin macros like 'include' and 'start_capture',
38             replaces Tenjin expressions (i.e. C<[== $expr =]> or C<[= $expr =]>) with the
39             appropriate Perl code, etc. This module ties a template object with
40             a context object, but all context manipulation (and the actual Cuation
41             of the Perl code) is done by L.
42              
43             If you're planning on using this module by itself (i.e. without the L
44             engine), keep in mind that template caching and layout templates are not
45             handled by this module.
46              
47             =cut
48              
49             our $MACRO_HANDLER_TABLE = {
50             'include' => sub { my $arg = shift;
51             " \$_buf .= \$_context->{'_engine'}->render($arg, \$_context, 0);";
52             },
53             'start_capture' => sub { my $arg = shift;
54             " my \$_buf_bkup=\$_buf; \$_buf=''; my \$_capture_varname=$arg;";
55             },
56             'stop_capture' => sub { my $arg = shift;
57             " \$_context->{\$_capture_varname}=\$_buf; \$_buf=\$_buf_bkup;";
58             },
59             'start_placeholder' => sub { my $arg = shift;
60             " if (\$_context->{$arg}) { \$_buf .= \$_context->{$arg}; } else {";
61             },
62             'stop_placeholder' => sub { my $arg = shift;
63             " }";
64             },
65             'echo' => sub { my $arg = shift;
66             " \$_buf .= $arg;";
67             },
68             };
69              
70             =head1 METHODS
71              
72             =head2 new( [$filename, \%opts] )
73              
74             Creates a new Tenjin::Template object, possibly from a file on the file
75             system (in which case C<$filename> must be provided and be an absolute
76             path to a template file). Optionally, a hash-ref of options can be
77             passed to set some customizations. Available options are 'escapefunc',
78             which will be in charge of escaping expressions (from C<[= $expr =]>) instead
79             of the internal method (which uses L); and 'rawclass',
80             which can be used to prevent variables and objects of a certain class
81             from being escaped, in which case the variable must be a hash-ref
82             that has a key named 'str', which will be used instead. So, for example,
83             if you have a variable named C<$var> which is a hash-ref, and 'rawclass'
84             is set as 'HASH', then writing C<[= $var =]> on your templates will replace
85             C<$var> with C<< $var->{str} >>.
86              
87             =cut
88              
89             sub new {
90 16     16 1 126 my ($class, $filename, $template_name, $opts) = @_;
91              
92 16 50 33     157 my $escapefunc = defined($opts) && exists($opts->{escapefunc}) ? $opts->{escapefunc} : undef;
93 16 50 33     117 my $rawclass = defined($opts) && exists($opts->{rawclass}) ? $opts->{rawclass} : undef;
94              
95 16         144 my $self = bless {
96             'filename' => $filename,
97             'name' => $template_name,
98             'script' => undef,
99             'escapefunc' => $escapefunc,
100             'rawclass' => $rawclass,
101             'timestamp' => undef,
102             'args' => undef,
103             }, $class;
104            
105 16 50       59 $self->convert_file($filename) if $filename;
106              
107 16         65 return $self;
108             }
109              
110             =head2 render( [$_context] )
111              
112             Renders the template, possibly with a context hash-ref, and returns the
113             rendered output. If errors have occured when rendering the template (which
114             might happen since templates have and are Perl code), then this method
115             will croak.
116              
117             =cut
118              
119             sub render {
120 21     21 1 38 my ($self, $_context) = @_;
121              
122 21   50     146 $_context ||= {};
123              
124 21 50       106 if ($self->{func}) {
125 0         0 return $self->{func}->($_context);
126             } else {
127 21 100       207 $_context = $Tenjin::CONTEXT_CLASS->new($_context) if ref $_context eq 'HASH';
128              
129 21         72 my $script = $self->{script};
130 21 50       157 $script = $_context->_build_decl() . $script unless $self->{args};
131            
132             # rendering is actually done inside the context object
133             # with the evaluate method. We pass either the name of
134             # the template or the filename of the template for debug
135             # purposes
136            
137 21   33     183 return $_context->evaluate($script, $self->{filename} || $self->{name});
138             }
139             }
140              
141             =head1 INTERNAL METHODS
142              
143             =head2 convert_file( $filename )
144              
145             Receives an absolute path to a template file, converts that file
146             to Perl code by calling L and
147             returns that code.
148              
149             =cut
150              
151             sub convert_file {
152 0     0 1 0 my ($self, $filename) = @_;
153              
154 0         0 return $self->convert($self->_read_file($filename, 1), $filename);
155             }
156              
157             =head2 convert( $input, [$filename] )
158              
159             Receives a text of a template (i.e. the template itself) and possibly
160             an absolute path to the template file (if the template comes from a file),
161             and converts the template into Perl code, which is later Cuated
162             for rendering. Conversion is done by parsing the statements in the
163             template (see L).
164              
165             =cut
166              
167             sub convert {
168 0     0 1 0 my ($self, $input, $filename) = @_;
169              
170 0         0 $self->{filename} = $filename;
171 0         0 my @buf = ('my $_buf = ""; my $_V; ', );
172 0         0 $self->parse_stmt(\@buf, $input);
173              
174 0         0 return $self->{script} = $buf[0] . " \$_buf;\n";
175             }
176              
177             =head2 compile_stmt_pattern( $pl )
178              
179             Receives a string which denotes the Perl code delimiter which is used
180             inside templates. Tenjin uses 'C<< >>' and 'C<< >>'
181             (the latter for preprocessing), so C<$pl> will be 'pl'. This method
182             returns a tranlsation regular expression which will be used for reading
183             embedded Perl code.
184              
185             =cut
186              
187             sub compile_stmt_pattern {
188 0     0 1 0 my $pl = shift;
189              
190 0         0 my $pat = '((^[ \t]*)?<\?'.$pl.'( |\t|\r?\n)(.*?) ?\?>([ \t]*\r?\n)?)';
191 0         0 return qr/$pat/sm;
192             }
193              
194             =head2 stmt_pattern
195              
196             Returns the default pattern (which uses 'pl') with the
197             L.
198              
199             =cut
200              
201             sub stmt_pattern {
202 0     0 1 0 return compile_stmt_pattern('pl');
203             }
204              
205             =head2 expr_pattern()
206              
207             Defines how expressions are written in Tenjin templates (C<[== $expr =]>
208             and C<[= $expr =]>).
209              
210             =cut
211              
212             sub expr_pattern {
213 0     0 1 0 return qr/\[=(=?)(.*?)(=?)=\]/s;
214             }
215              
216             =head2 parse_stmt( $bufref, $input )
217              
218             Receives a buffer which is used for saving a template's expressions
219             and the template's text, parses all expressions in the templates and
220             pushes them to the buffer.
221              
222             =cut
223              
224             sub parse_stmt {
225 0     0 1 0 my ($self, $bufref, $input) = @_;
226              
227 0         0 my $pos = 0;
228 0         0 my $pat = $self->stmt_pattern();
229 0         0 while ($input =~ /$pat/g) {
230 0         0 my ($pi, $lspace, $mspace, $stmt, $rspace) = ($1, $2, $3, $4, $5);
231 0         0 my $start = $-[0];
232 0         0 my $text = substr($input, $pos, $start - $pos);
233 0         0 $pos = $start + length($pi);
234 0 0       0 $self->parse_expr($bufref, $text) if $text;
235 0 0       0 $mspace = '' if $mspace eq ' ';
236 0         0 $stmt = $self->hook_stmt($stmt);
237 0 0       0 $stmt .= $rspace if $rspace;
238 0 0       0 $stmt = $mspace . $stmt if $mspace;
239 0 0       0 $stmt = $lspace . $stmt if $lspace;
240 0         0 $self->add_stmt($bufref, $stmt);
241             }
242 0 0       0 my $rest = $pos == 0 ? $input : substr($input, $pos);
243 0 0       0 $self->parse_expr($bufref, $rest) if $rest;
244             }
245              
246             =head2 hook_stmt( $stmt )
247              
248             =cut
249              
250             sub hook_stmt {
251 0     0 1 0 my ($self, $stmt) = @_;
252              
253             ## macro expantion
254 0 0       0 if ($stmt =~ /\A(\s*)(\w+)\((.*?)\);?(\s*)\Z/) {
255 0         0 my ($lspace, $funcname, $arg, $rspace) = ($1, $2, $3, $4);
256 0         0 my $s = $self->expand_macro($funcname, $arg);
257 0 0       0 return $lspace . $s . $rspace if defined($s);
258             }
259              
260             ## template arguments
261 0 0       0 unless ($self->{args}) {
262 0 0       0 if ($stmt =~ m/\A(\s*)\#\@ARGS\s+(.*)(\s*)\Z/) {
263 0         0 my ($lspace, $argstr, $rspace) = ($1, $2, $3);
264 0         0 my @args = ();
265 0         0 my @declares = ();
266 0         0 foreach my $arg (split(/,/, $argstr)) {
267 0         0 $arg =~ s/(^\s+|\s+$)//g;
268 0 0       0 next unless $arg;
269 0 0       0 $arg =~ m/\A([\$\@\%])?([a-zA-Z_]\w*)\Z/ or croak "[Tenjin] $arg: invalid template argument.";
270 0 0 0     0 croak "[Tenjin] $arg: only '\$var' is available for template argument." unless (!$1 || $1 eq '$');
271 0         0 my $name = $2;
272 0         0 push(@args, $name);
273 0         0 push(@declares, "my \$$name = \$_context->{$name}; ");
274             }
275 0         0 $self->{args} = \@args;
276 0         0 return $lspace . join('', @declares) . $rspace;
277             }
278             }
279              
280 0         0 return $stmt;
281             }
282              
283             =head2 expand_macro( $funcname, $arg )
284              
285             This method is in charge of invoking macro functions which might be used
286             inside templates. The following macros are available:
287              
288             =over
289              
290             =item * C
291              
292             Includes another template, whose name is C<$filename>, inside the current
293             template. The included template will be placed inside the template as if
294             they were one unit, so the context variable applies to both.
295              
296             =item * C and C
297              
298             Tells Tenjin to capture the output of the rendered template from the point
299             where C was called to the point where C
300             was called. You must provide a name for the captured portion, which will be
301             made available in the context as C<< $_context->{$name} >> for immediate
302             usage. Note that the captured portion will not be printed unless you do
303             so explicilty with C<< $_context->{$name} >>.
304              
305             =item * C and C
306              
307             This is a special method which can be used for making your templates a bit
308             cleaner. Suppose your context might have a variable whose name is defined
309             in C<$var>. If that variable exists in the context, you simply want to print
310             it, but if it's not, you want to print and/or perform other things. In that
311             case you can call C with the name of the context
312             variable you want printed, and if it's not, anything you do between
313             C and C will be printed instead.
314              
315             =item * echo( $exr )
316              
317             Just prints the provided expression. You might want to use it if you're
318             a little too comfortable with PHP.
319              
320             =back
321              
322             =cut
323              
324             sub expand_macro {
325 0     0 1 0 my ($self, $funcname, $arg) = @_;
326              
327 0         0 my $handler = $MACRO_HANDLER_TABLE->{$funcname};
328 0 0       0 return $handler ? $handler->($arg) : undef;
329             }
330              
331             =head2 get_expr_and_escapeflag( $not_escape, $expr, $delete_newline )
332              
333             =cut
334              
335             ## ex. get_expr_and_escapeflag('=', '$item->{name}', '') => 1, '$item->{name}', 0
336             sub get_expr_and_escapeflag {
337 0     0 1 0 my ($self, $not_escape, $expr, $delete_newline) = @_;
338              
339 0         0 return $expr, $not_escape eq '', $delete_newline eq '=';
340             }
341              
342             =head2 parse_expr( $bufref, $input )
343              
344             =cut
345              
346             sub parse_expr {
347 0     0 1 0 my ($self, $bufref, $input) = @_;
348              
349 0         0 my $pos = 0;
350 0         0 $self->start_text_part($bufref);
351 0         0 my $pat = $self->expr_pattern();
352 0         0 while ($input =~ /$pat/g) {
353 0         0 my $start = $-[0];
354 0         0 my $text = substr($input, $pos, $start - $pos);
355 0         0 my ($expr, $flag_escape, $delete_newline) = $self->get_expr_and_escapeflag($1, $2, $3);
356 0         0 $pos = $start + length($&);
357 0 0       0 $self->add_text($bufref, $text) if $text;
358 0 0       0 $self->add_expr($bufref, $expr, $flag_escape) if $expr;
359 0 0       0 if ($delete_newline) {
360 0         0 my $end = $+[0];
361 0 0       0 if (substr($input, $end + 1, 1) eq "\n") {
362 0         0 $bufref->[0] .= "\n";
363 0         0 $pos++;
364             }
365             }
366             }
367 0 0       0 my $rest = $pos == 0 ? $input : substr($input, $pos);
368 0         0 $self->add_text($bufref, $rest);
369 0         0 $self->stop_text_part($bufref);
370             }
371              
372             =head2 start_text_part( $bufref )
373              
374             =cut
375              
376             sub start_text_part {
377 0     0 1 0 my ($self, $bufref) = @_;
378              
379 0         0 $bufref->[0] .= ' $_buf .= ';
380             }
381              
382             =head2 stop_text_part( $bufref )
383              
384             =cut
385              
386             sub stop_text_part {
387 0     0 1 0 my ($self, $bufref) = @_;
388              
389 0         0 $bufref->[0] .= '; ';
390             }
391              
392             =head2 add_text( $bufref, $text )
393              
394             =cut
395              
396             sub add_text {
397 0     0 1 0 my ($self, $bufref, $text) = @_;
398              
399 0 0       0 return unless $text;
400 0         0 $text =~ s/[`\\]/\\$&/g;
401 0         0 my $is_start = $bufref->[0] =~ / \$_buf \.= \Z/;
402 0 0       0 $bufref->[0] .= $is_start ? "q`$text`" : " . q`$text`";
403             }
404              
405             =head2 add_stmt( $bufref, $stmt )
406              
407             =cut
408              
409             sub add_stmt {
410 0     0 1 0 my ($self, $bufref, $stmt) = @_;
411              
412 0         0 $bufref->[0] .= $stmt;
413             }
414              
415             =head2 add_expr( $bufref, $expr, $flag_escape )
416              
417             =cut
418              
419             sub add_expr {
420 0     0 1 0 my ($self, $bufref, $expr, $flag_escape) = @_;
421              
422 0 0       0 my $dot = $bufref->[0] =~ / \$_buf \.= \Z/ ? '' : ' . ';
423 0 0       0 $bufref->[0] .= $dot . ($flag_escape ? $self->escaped_expr($expr) : "($expr)");
424             }
425              
426             =head2 defun( $funcname, @args )
427              
428             =cut
429              
430             sub defun { ## (experimental)
431 0     0 1 0 my ($self, $funcname, @args) = @_;
432              
433 0 0       0 unless ($funcname) {
434 0         0 my $funcname = $self->{filename};
435 0 0       0 if ($funcname) {
436 0         0 $funcname =~ s/\.\w+$//;
437 0         0 $funcname =~ s/[^\w]/_/g;
438             }
439 0         0 $funcname = 'render_' . $funcname;
440             }
441              
442 0         0 my $str = "sub $funcname { my (\$_context) = \@_; ";
443 0         0 foreach (@args) {
444 0         0 $str .= "my \$$_ = \$_context->{'$_'}; ";
445             }
446 0         0 $str .= $self->{script};
447 0         0 $str .= "}\n";
448              
449 0         0 return $str;
450             }
451              
452             =head2 compile()
453              
454             =cut
455              
456             ## compile $self->{script} into closure.
457             sub compile {
458 16     16 1 45 my $self = shift;
459              
460 16 50       79 if ($self->{args}) {
461 0         0 $self->{func} = $Tenjin::CONTEXT_CLASS->to_func($self->{script}, $self->{name});
462 0         0 return $self->{func};
463             }
464 16         66 return;
465             }
466              
467             =head2 escaped_expr( $expr )
468              
469             Receives a Perl expression (from C<[= $expr =]>) and escapes it. This will
470             happen in one of three ways: with the escape function defined in
471             C<< $opts->{escapefunc} >> (if defined), with a scalar string (if
472             C<< $opts->{rawclass} >> is defined), or with C from
473             L, which uses L.
474              
475             =cut
476              
477             sub escaped_expr {
478 0     0 1 0 my ($self, $expr) = @_;
479              
480 0 0       0 return "$self->{escapefunc}($expr)" if $self->{escapefunc};
481              
482 0 0       0 return "(ref(\$_V = ($expr)) eq '$self->{rawclass}' ? \$_V->{str} : escape_xml($expr)" if $self->{rawclass};
483              
484 0         0 return "escape_xml($expr)";
485             }
486              
487             =head2 _read_file( $filename, [$lock_required] )
488              
489             Receives an absolute path to a template file, reads its content and
490             returns it. If C<$lock_required> is passed (and has a true value), the
491             file will be locked for reading.
492              
493             =cut
494              
495             sub _read_file {
496 16     16   36 my ($self, $filename, $lock_required) = @_;
497              
498 16 50   6   787 open(IN, "<:encoding($Tenjin::ENCODING)", $filename)
  6         66  
  6         19  
  6         67  
499             or croak "[Tenjin] Can't open $filename for reading: $!";
500 16 50       137649 flock(IN, LOCK_SH) if $lock_required;
501              
502 16         452893 read(IN, my $content, -s $filename);
503              
504 16         1029 close(IN);
505              
506 16         216 return $content;
507             }
508              
509             =head2 _write_file( $filename, $content, [$lock_required] )
510              
511             Receives an absolute path to a template file and the templates contents,
512             and creates the file (or truncates it, if existing) with that contents.
513             If C<$lock_required> is passed (and has a true value), the file will be
514             locked exclusively when writing.
515              
516             =cut
517              
518             sub _write_file {
519 0     0   0 my ($self, $filename, $content, $lock_required) = @_;
520              
521 0 0       0 my $enc = $Tenjin::ENCODING eq 'UTF-8' ? '>:utf8' : ">:encoding($Tenjin::ENCODING)";
522              
523 0 0       0 open(OUT, $enc, $filename)
524             or croak "[Tenjin] Can't open $filename for writing: $!";
525 0 0       0 flock(OUT, LOCK_EX) if $lock_required;
526 0         0 print OUT $content;
527 0         0 close(OUT);
528             }
529              
530             1;
531              
532             =head1 SEE ALSO
533              
534             L.
535              
536             =head1 AUTHOR
537              
538             The CPAN version of Tenjin was forked by Ido Perlmuter Eido at ido50.netE
539             from version 0.0.2 of the original plTenjin, which is developed by Makoto Kuwata
540             at L.
541              
542             Development of Tenjin is done with github at L.
543              
544             =head1 LICENSE AND COPYRIGHT
545              
546             Tenjin is licensed under the MIT license.
547              
548             Copyright (c) 2007-2010 the aforementioned authors.
549              
550             Permission is hereby granted, free of charge, to any person obtaining
551             a copy of this software and associated documentation files (the
552             "Software"), to deal in the Software without restriction, including
553             without limitation the rights to use, copy, modify, merge, publish,
554             distribute, sublicense, and/or sell copies of the Software, and to
555             permit persons to whom the Software is furnished to do so, subject to
556             the following conditions:
557              
558             The above copyright notice and this permission notice shall be
559             included in all copies or substantial portions of the Software.
560              
561             THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
562             EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
563             MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
564             NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
565             LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
566             OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
567             WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
568              
569             =cut