File Coverage

blib/lib/Text/Templet.pm
Criterion Covered Total %
statement 51 59 86.4
branch 17 24 70.8
condition 1 3 33.3
subroutine 7 9 77.7
pod 1 2 50.0
total 77 97 79.3


line stmt bran cond sub pod time code
1             # Copyright (c) 2004, 2005, 2006 Denis Petrov
2             #
3             # This program is free software; you can redistribute it and/or
4             # modify it under the same terms as Perl itself.
5             #
6             # Text::Templet Template Processor
7             #
8             # Text::Templet Home: http://www.denispetrov.com/magic/
9            
10 1     1   8320 use 5.006;
  1         4  
  1         42  
11 1     1   7 use strict;
  1         2  
  1         37  
12 1     1   6 use warnings;
  1         7  
  1         56  
13            
14             package Text::Templet;
15            
16 1     1   5 use Carp;
  1         2  
  1         87  
17            
18             BEGIN {
19 1     1   6 use Exporter ();
  1         2  
  1         158  
20 1     1   3 our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
21            
22 1         8 ($VERSION) = '$Revision: 3.0 $' =~ /\$Revision: (\S+)/;
23            
24 1         17 @ISA = qw(Exporter);
25 1         3 @EXPORT = qw( &Templet );
26 1         3 %EXPORT_TAGS = ( );
27 1         1101 @EXPORT_OK = qw( &Use );
28             }
29            
30             our @_tpl_parsed;
31             our @_tpl_compiled;
32            
33             our $_isect;
34            
35             our %_labels; # label section numbers
36            
37             ### output buffer
38             our $_outt;
39             our $_outf;
40            
41             our $_use_package1;
42             our $_use_package;
43            
44             sub Use($)
45             {
46 0     0 0 0 $_use_package1 = $_[0];
47 0 0       0 eval("use $_use_package1;") if $_use_package1;
48             }
49            
50            
51             sub Templet
52             {
53 15     15 1 140 my ($_caller_package,undef,undef) = caller;
54            
55             ### Make Templet re-entrant by saving values of package variables
56 15         41 local(@_tpl_parsed,@_tpl_compiled,$_isect,%_labels,$_outt);
57            
58 15         21 $_outt = '';
59             ### Return processed template in non-void context, otherwise print it
60 15         21 my $_use_outt = defined(wantarray);
61            
62 15 50   0   75 $_outf = $_use_outt ? sub { $_outt .= join( "", @_ ) } : sub { print @_ };
  4         103  
  0         0  
63            
64 15   33     109 local $_use_package = $_[1] || $_use_package1 || $_caller_package;
65            
66 15         269 @_tpl_parsed = ("<%_%>$_[0]<%END%>") =~ /(<%.+?(?=%>)%>)(.*?)(?=<%|$)/gs;
67            
68             # compile template
69 15         34 for my $section ( @_tpl_parsed ) {
70 118 100       507 if ( $section =~ /<%(\*?[a-zA-z_][a-zA-z0-9_]*)%>/ ) { # label regexp
    100          
    100          
71 44 50       113 if ( exists($_labels{$1}) ) {
72 0         0 croak "Duplicate label '$1'";
73             } else {
74 44 100       124 if ( substr($1,0,1) eq '*' ) {
75             # jump code replacing asterisk label
76 2         112 push @_tpl_compiled,[0,eval("sub{'".substr($1,1)."'}")];
77             }
78 44         127 $_labels{$1} = @_tpl_compiled; # count, pointing to the section following label
79             }
80             } elsif ( $section =~ /<%(.+)%>/s ) {
81             # code section
82             # eval returns a reference to an anonymous subroutine with the section code
83 15         1311 push @_tpl_compiled,[0,eval("package $_use_package;sub{$1}")];
84 15 50       44 if ($@) { chomp $@; croak "Error '$@' in template code section '$1'" }
  0         0  
  0         0  
85             } elsif ( $section ne '' ) {
86             # text section
87             # eval returns a reference to an anonymous subroutine that returns interpolated text
88 28         1948 push @_tpl_compiled,[1,eval("package $_use_package;sub{\"$section\"}")];
89 28 50       89 if ($@) { chomp $@; croak "Error '$@' in template text section '$section'" }
  0         0  
  0         0  
90             }
91            
92             }
93             # dummy text section at the end
94 15         926 push @_tpl_compiled,[1,eval("package $_use_package;sub{\"\"}")];
95            
96             # render template
97 15         26 $_isect = 0;
98 15         38 while ( $_isect < @_tpl_compiled ) {
99            
100 87         105 my $_section = $_tpl_compiled[$_isect];
101            
102 87         2196 my $_output = $_section->[1](); # call the section code
103 87 100       198 if ( $_section->[0] == 0 ) { # code
104 32 100       64 if ( exists $_labels{$_output} ) {
105 24         66 $_isect = $_labels{$_output};
106             } else {
107 8         19 $_isect++;
108             }
109             } else { # text
110 55 50       105 $_use_outt ? $_outt .= $_output : print $_output;
111 55         132 $_isect++;
112             }
113            
114             }
115            
116 15         329 return $_outt;
117             }
118            
119            
120             1;
121             =pod
122            
123             =head1 NAME
124            
125             Text::Templet - general purpose text template processor
126            
127             =head1 SYNOPSIS
128            
129             B
130            
131             use Text::Templet;
132             use vars qw( $dataref $counter );
133             $dataref = ["Money For Nothing","Communique","Sultans Of Swing"];
134            
135             Templet(<<'EOT'
136             Content-type: text/html
137            
138            
139             <% $counter = -1 %>
140             <%SONG_LIST%>
141             <% $counter++; return "SONG_LIST_END" if $counter >= scalar(@$dataref); '' %>
142            
143             $counter: $dataref->[$counter]
144            
145             <%"SONG_LIST"%><%SONG_LIST_END%>
146            
147             EOT
148             );
149            
150             B
151            
152             use Text::Templet;
153             use vars qw( $dataref $counter );
154             $dataref = ["Money For Nothing","Communique","Sultans Of Swing"];
155            
156             Templet(<<'EOT'
157             Content-type: text/html
158            
159            
160             <% $counter = -1 %>
161             <%SONG_LIST%><% $counter++; return "*SONG_LIST" if $counter >= scalar(@$dataref); '' %>
162            
163             $counter: $dataref->[$counter]
164            
165             <%*SONG_LIST%>
166            
167             EOT
168             );
169            
170             B
171            
172             use Text::Templet;
173             use vars qw($super_user);
174             $super_user = 1;
175            
176             Templet(<<'EOT'
177             Content-type: text/html
178            
179            
180             <% "SKIP_CP" unless $super_user %>
181             Admin Options: Control Panel
182             <%SKIP_CP%>
183            
184             EOT
185             );
186            
187             B
188            
189             use Text::Templet;
190             use vars qw($super_user);
191             $super_user = 1;
192            
193             Templet(<<'EOT'
194             Content-type: text/html
195            
196            
197             <% "*SKIP_CP" unless $super_user %>
198             Admin Options: Control Panel
199             <%*SKIP_CP%>
200             No Admin options available.
201             <%SKIP_CP%>
202            
203             EOT
204             );
205            
206             B
207            
208             use Text::Templet;
209             use vars qw($super_user);
210             $select = 1;
211            
212             $select = 0 if ( int($select) < 0 or int($select) > 2 );
213            
214             Templet(<<'EOT'
215             Content-type: text/html
216            
217            
218             <% "*SEL".int($select) %>
219             <%*SEL0%>
220             Select is 0
221             <%SEL0%>
222             <%*SEL1%>
223             Select is 1
224             <%SEL1%>
225             <%*SEL2%>
226             Select is 2
227             <%SEL2%>
228            
229             EOT
230             );
231            
232             B
233            
234             use Text::Templet;
235            
236             sub hello_world()
237             {
238             print "Hello, World!";
239             }
240            
241             Templet(<<'EOT'
242             Content-type: text/html
243            
244            
245             <% hello_world(); '' %>
246            
247             EOT
248             );
249            
250             B
251            
252             use Text::Templet;
253            
254             sub give_me_label()
255             {
256             return 'L1';
257             }
258            
259             Templet(<<'EOT'
260             Content-type: text/html
261            
262            
263             <% give_me_label(); %>
264             This text will be omitted.
265             <%L1%>
266            
267             EOT
268             );
269            
270             B
271            
272             use Text::Templet;
273             use CGI;
274             use vars qw( $title $desc );
275             $title = "Title here!";
276             $desc = "Description Here!";
277             $title = &CGI::escapeHTML($title||'');
278             $desc = &CGI::escapeHTML($desc||'');
279            
280             Templet(<<'EOT'
281             Content-type: text/html
282            
283            
284            
285            
286            
287            
288            
289            
290             EOT
291             );
292            
293             B
294            
295             use Text::Templet;
296             local *FILE;
297             open( FILE, '>page.html' ) or warn("Unable to open file page.html: $!"), return 1;
298             my $saved_stdout = select(*FILE);
299            
300             Templet(<<'EOT'
301            
302             Hello, World!
303            
304             EOT
305             );
306            
307             select($saved_stdout);
308             close FILE;
309            
310             B
311            
312             use Text::Templet;
313            
314             my $output = Templet(<<'EOT'
315            
316             Hello, World!
317            
318             EOT
319             );
320            
321             print $output;
322            
323             B
324            
325             use Text::Templet;
326             use vars qw($title $text);
327             $title = 'Page Title';
328             $text = 'Page Body';
329            
330             sub header
331             {
332             Templet('$title');
333             ''
334             }
335            
336             sub footer
337             {
338             Templet('');
339             ''
340             }
341            
342            
343             Templet(<<'EOT'
344             Content-type: text/html
345            
346             <% header() %>
347            

$title

348            
349             $text
350            
351             <% footer() %>
352             EOT
353             );
354            
355             B
356            
357             use CGI;
358             use Text::Templet;
359             use vars qw($body_sub $title);
360            
361             $Q = new CGI;
362            
363             if ( $Q->param('p') eq 'page1' )
364             {
365             $title = 'Page 1';
366             $body_sub = sub
367             {
368             Templet('Page 1');
369             }
370             }
371             elseif ( $Q->param('p') eq 'page2' )
372             {
373             $title = 'Page 2';
374             $body_sub = sub
375             {
376             Templet('Page 2');
377             }
378             }
379             else
380             {
381             $title = 'Default Page';
382             $body_sub = sub
383             {
384             Templet('Default Page');
385             }
386             }
387            
388             Templet(<<'EOT'
389             Content-type: text/html
390            
391             $title
392            
393            

$title

394            
395             <% &$body_sub(); '' %>
396            
397            
398             EOT
399             );
400            
401             B
402            
403             File Module.pm:
404            
405             package Module;
406            
407             use vars qw($title);
408            
409             $title = 'Page Title';
410            
411             File script.pl:
412            
413             use lib qw(.);
414             use Text::Templet;
415            
416             Templet(<<'EOT'
417             Content-type: text/html
418            
419             <% Text::Templet::Use("Module");'' %>
420             $title
421            
422            

$title

423            
424             EOT
425             );
426            
427             =head1 DESCRIPTION
428            
429             =head2 RATIONALE
430            
431             I was motivated to create C when I was looking for a
432             templating system for a project. A bit of research revealed
433             several major shortcomings of most if not all existing modules:
434             they are bloated, slow, complex and often poorly documented. I did
435             not want to learn a whole new programming language and environment
436             just to create a simple web application, and I felt it was unnecessary
437             to drag thousands of lines of Perl modules along. Looking at Template
438             Toolkit or Mason I was thinking there has to be a better way.
439            
440             C employs Perl's C function which allows you to
441             use Perl syntax for all of its functionality, which greatly simplifies
442             and speeds up processing of the template.
443            
444             =head2 DOCUMENTATION
445            
446             C is a Perl module implementing a very efficient
447             and fast template processor that allows you to embed Perl
448             variables and snippets of Perl code directly into HTML, XML or any
449             other text.
450            
451             In the examples above the template text is embedded into the Perl
452             code, but it could just as easily be loaded from a file or a
453             database. C does not impose any particular
454             application framework or CGI library or information model on you.
455             You can pick any of the existing systems or integrate
456             C into your own.
457            
458             When called, C applies a regular expression matching
459             text enclosed within C<< <% %> >> to create a list of sections.
460             These sections are then passed to the eval() function. Sections
461             containing text outside C<< <% %> >> ("Template text sections") are
462             wrapped into double quotes and passed to C for variable
463             expansion. In void context, the value returned by the C is
464             printed to the standard output, otherwise it is appended to the return
465             value stored in C<$_outt>.
466            
467             Sections with text inside C<< <% %> >> are handled in two different
468             ways. If the text contains only alphanumeric characters without
469             spaces, and the first character is an asterisk, a letter or an underscore,
470             C recognizes the section as a "label", which is then
471             added to the internal list of labels. Labels are used to pass
472             template processing point to the section immediately following the
473             label, very similar to the way labels used in many programming
474             languages to move the execution point of a program.
475            
476             If it is not a label, then it is a template code section, which is
477             passed to C for execution as Perl code. The return value of
478             a code section is then used as the name of the label to jump to, allowing you to implement
479             loops, conditionals and any other control statements using Perl code.
480             A warning is produced if the label with that name is
481             not found in the template, and the text that does not represent a
482             valid label name is discarded.
483            
484             When a portion of a template is contained between two labels, named identically
485             except the first one pre-pended with "*" (asterisk), this portion
486             will be skipped in the normal flow of template processing, and can
487             only be reached by returning the name of the label with the asterisk
488             from a code section. This simplifies the syntax of conditionals, switches
489             and other types of constructs. The following two examples are equivalent,
490             one is written using an asterisk label and the other is not:
491            
492             <% "*SKIP" unless $condition %>
493             Text displayed when the condition is true
494             <%*SKIP%>
495             Text displayed when the condition is false
496             <%SKIP%>
497            
498             <% "ELSE" unless $condition %>
499             Text displayed when the condition is true
500             <%"ELSE_END"%><%ELSE%>
501             Text displayed when the condition is false
502             <%ELSE_END%>
503            
504             All package variables that you plan to use in the template must be
505             declared with C - code and variable names embedded into
506             the template are evaluated in the namespace of the calling package,
507             but are contained in the lexical scope of C. This means that
508             lexical variables declared with C, C or C are inaccessible
509             from "inside" the template.
510            
511             The following variable names are used internally by
512             C and will mask variables declared in your program,
513             making their values inaccessible in the template: C<%_labels>,
514             C<@_tpl_parsed>, C<@_tpl_compiled>, C<$_isect>, C<$_outt>
515            
516             =head2 FUNCTIONS
517            
518             C<&Templet()>
519            
520             Exported. Takes one or two arguments: first argument is the template text, second
521             argument is optional and contains the name of the package to use when
522             evaluating section text and code.
523            
524             In void context, prints processing result to the default output,
525             otherwise accumulates it in an internal variable C<$_outt> and returns
526             it to the caller. If a compilation error occurs in a code section of the
527             template, calls die() with the error code, which allows you to put a call to
528             Templet() into an eval block to process compilation errors. You should check the
529             server's error log to find out which section it is.
530            
531             C<&Text::Templet::Use()>
532            
533             Accepts one argument containing the name of the package to use when evaluating
534             template sections. The value will be used when calling code and interpolating text
535             sections to set the context for any code and variables used in the template.
536             This function can be called either prior to C call or from within
537             the template text, in which case the package name will be used from the code
538             section containing the call onwards until the end of the template
539             or the next call to C.
540            
541             To cancel, call C. Package specified in the call to
542             Templet() takes precedence over package specified in C.
543            
544             =head2 NOTES AND TIPS
545            
546             =over
547            
548             =item * Using interpolating quotes around the template text wreaks
549             havoc as variables are interpolated before C has a
550             chance to look at them. This is the purpose of single quotes around
551             EOT at the examples above - to prevent early interpolation.
552            
553             =item * Warning 'Use of uninitialized value in concatenation (.) or
554             string at (eval ...) line x (#x)' indicates that a variable used in
555             the template contains an undefined value, which may happen when you
556             pull the data from a database and some of the fields in the
557             database record being queried contain NULL. This issue can be
558             resolved either on the data level, by ensuring that there are no
559             NULL values stored in the database, or on the script level by
560             replacing undefined values returned from the database with empty
561             strings. The simple form example above deals with this problem by
562             using C<||> operator during the call to C<&CGI::escapeHTML> to assign an
563             empty string to the variable if it evaluates to false.
564            
565             =item * Label names are case sensitive, and there must be no spaces
566             anywhere between C<< <% >> and C<< %> >> for it to be interpreted as a label. All
567             labels in a template must have unique names.
568            
569             =item * C is compatible with mod_perl. However, make
570             sure that each Perl function has a unique name across all scripts
571             on the server running mod_perl. The best way to ensure that is to
572             put each Perl file into its own package. Reusing function names
573             among different files will result in 'function reload' warnings and
574             functions from wrong files being called.
575            
576             =item * Watch the web server's error log closely when debugging
577             your application. C posts a warning when there is
578             something wrong with the template, including the line number of the
579             beginning of the section where the error occurred.
580            
581             =item * Call C<&$_outf()> from within C<< <% %> >> to append something
582             to the output: C<< <% &$_outf("foo") %> >>. This function takes one
583             argument and will either send it to the standard output or append it
584             to C<$_outt> depending on Templet's calling context.
585            
586             =item * To prevent C from trying to use the result
587             of the processing in the template code section as a label name, add
588             an empty string at the end: C<< <% print "foo"; '' %> >>.
589            
590             =item * Be careful not to create infinite loops in the template as
591             C does not check for them.
592            
593             =item * Call Templet() from void context whenever possible to improve
594             performance. When called from void context all output from the template
595             is printed as soon as it is processed without first accumulating it
596             in a buffer, which saves memory and when used in a web application,
597             allows the browser to start rendering the processed page as soon as
598             the web server has accumulated enough data to send to the browser.
599            
600             =back
601            
602             =head1 AUTHOR
603            
604             Denis Petrov
605            
606             For more examples and support, visit Text::Templet Home at
607             http://www.denispetrov.com/magic/
608            
609             =cut