File Coverage

blib/lib/HTML/Template.pm
Criterion Covered Total %
statement 879 987 89.0
branch 532 704 75.5
condition 131 206 63.5
subroutine 55 58 94.8
pod 6 11 54.5
total 1603 1966 81.5


line stmt bran cond sub pod time code
1             package HTML::Template;
2              
3             $HTML::Template::VERSION = '2.95';
4              
5             =head1 NAME
6              
7             HTML::Template - Perl module to use HTML-like templating language
8              
9             =head1 SYNOPSIS
10              
11             First you make a template - this is just a normal HTML file with a few
12             extra tags, the simplest being C<< >>
13              
14             For example, test.tmpl:
15              
16            
17             Test Template
18            
19             My Home Directory is
20            

21             My Path is set to
22            
23            
24              
25             Now you can use it in a small CGI program:
26              
27             #!/usr/bin/perl -w
28             use HTML::Template;
29              
30             # open the html template
31             my $template = HTML::Template->new(filename => 'test.tmpl');
32              
33             # fill in some parameters
34             $template->param(HOME => $ENV{HOME});
35             $template->param(PATH => $ENV{PATH});
36              
37             # send the obligatory Content-Type and print the template output
38             print "Content-Type: text/html\n\n", $template->output;
39              
40             If all is well in the universe this should show something like this in
41             your browser when visiting the CGI:
42              
43             My Home Directory is /home/some/directory
44             My Path is set to /bin;/usr/bin
45              
46             =head1 DESCRIPTION
47              
48             This module attempts to make using HTML templates simple and natural.
49             It extends standard HTML with a few new HTML-esque tags - C<< >>
50             C<< >>, C<< >>, C<< >>, C<< >>
51             and C<< >>. The file written with HTML and these new tags
52             is called a template. It is usually saved separate from your script -
53             possibly even created by someone else! Using this module you fill in the
54             values for the variables, loops and branches declared in the template.
55             This allows you to separate design - the HTML - from the data, which
56             you generate in the Perl script.
57              
58             This module is licensed under the same terms as Perl. See the LICENSE
59             section below for more details.
60              
61             =head1 TUTORIAL
62              
63             If you're new to HTML::Template, I suggest you start with the
64             introductory article available on Perl Monks:
65              
66             http://www.perlmonks.org/?node_id=65642
67              
68             =head1 FAQ
69              
70             Please see L
71              
72             =head1 MOTIVATION
73              
74             It is true that there are a number of packages out there to do HTML
75             templates. On the one hand you have things like L which
76             allows you freely mix Perl with HTML. On the other hand lie home-grown
77             variable substitution solutions. Hopefully the module can find a place
78             between the two.
79              
80             One advantage of this module over a full L-esque solution
81             is that it enforces an important divide - design and programming.
82             By limiting the programmer to just using simple variables and loops
83             in the HTML, the template remains accessible to designers and other
84             non-perl people. The use of HTML-esque syntax goes further to make the
85             format understandable to others. In the future this similarity could be
86             used to extend existing HTML editors/analyzers to support HTML::Template.
87              
88             An advantage of this module over home-grown tag-replacement schemes is
89             the support for loops. In my work I am often called on to produce
90             tables of data in html. Producing them using simplistic HTML
91             templates results in programs containing lots of HTML since the HTML
92             itself cannot represent loops. The introduction of loop statements in
93             the HTML simplifies this situation considerably. The designer can
94             layout a single row and the programmer can fill it in as many times as
95             necessary - all they must agree on is the parameter names.
96              
97             For all that, I think the best thing about this module is that it does
98             just one thing and it does it quickly and carefully. It doesn't try
99             to replace Perl and HTML, it just augments them to interact a little
100             better. And it's pretty fast.
101              
102             =head1 THE TAGS
103              
104             =head2 TMPL_VAR
105              
106            
107              
108             The C<< >> tag is very simple. For each C<< >>
109             tag in the template you call:
110              
111             $template->param(PARAMETER_NAME => "VALUE")
112              
113             When the template is output the C<< >> is replaced with the
114             VALUE text you specified. If you don't set a parameter it just gets
115             skipped in the output.
116              
117             You can also specify the value of the parameter as a code reference in order
118             to have "lazy" variables. These sub routines will only be referenced if the
119             variables are used. See L for more information.
120              
121             =head3 Attributes
122              
123             The following "attributes" can also be specified in template var tags:
124              
125             =over
126              
127             =item * escape
128              
129             This allows you to escape the value before it's put into the output. Th
130              
131             This is useful when you want to use a TMPL_VAR in a context where those characters would
132             cause trouble. For example:
133              
134            
135              
136             If you called C with a value like C you'll get in trouble
137             with HTML's idea of a double-quote. On the other hand, if you use
138             C, like this:
139              
140            
141              
142             You'll get what you wanted no matter what value happens to be passed
143             in for param.
144              
145             The following escape values are supported:
146              
147             =over
148              
149             =item * html
150              
151             Replaces the following characters with their HTML entity equivalent:
152             C<&>, C<">, C<'>, C<< < >>, C<< > >>
153              
154             =item * js
155              
156             Escapes (with a backslash) the following characters: C<\>, C<'>, C<">,
157             C<\n>, C<\r>
158              
159             =item * url
160              
161             URL escapes any ASCII characters except for letters, numbers, C<_>, C<.> and C<->.
162              
163             =item * none
164              
165             Performs no escaping. This is the default, but it's useful to be able to explicitly
166             turn off escaping if you are using the C option.
167              
168             =back
169              
170             =item * default
171              
172             With this attribute you can assign a default value to a variable.
173             For example, this will output "the devil gave me a taco" if the C
174             variable is not set.
175              
176             gave me a taco.
177              
178             =back
179              
180             =head2 TMPL_LOOP
181              
182             ...
183              
184             The C<< >> tag is a bit more complicated than C<< >>.
185             The C<< >> tag allows you to delimit a section of text and
186             give it a name. Inside this named loop you place C<< >>s.
187             Now you pass to C a list (an array ref) of parameter assignments
188             (hash refs) for this loop. The loop iterates over the list and produces
189             output from the text block for each pass. Unset parameters are skipped.
190             Here's an example:
191              
192             In the template:
193              
194            
195             Name:
196             Job:

197            
198              
199             In your Perl code:
200              
201             $template->param(
202             EMPLOYEE_INFO => [{name => 'Sam', job => 'programmer'}, {name => 'Steve', job => 'soda jerk'}]
203             );
204             print $template->output();
205            
206             The output is:
207              
208             Name: Sam
209             Job: programmer
210              
211             Name: Steve
212             Job: soda jerk
213              
214             As you can see above the C<< >> takes a list of variable
215             assignments and then iterates over the loop body producing output.
216              
217             Often you'll want to generate a C<< >>'s contents
218             programmatically. Here's an example of how this can be done (many other
219             ways are possible!):
220              
221             # a couple of arrays of data to put in a loop:
222             my @words = qw(I Am Cool);
223             my @numbers = qw(1 2 3);
224             my @loop_data = (); # initialize an array to hold your loop
225              
226             while (@words and @numbers) {
227             my %row_data; # get a fresh hash for the row data
228              
229             # fill in this row
230             $row_data{WORD} = shift @words;
231             $row_data{NUMBER} = shift @numbers;
232              
233             # the crucial step - push a reference to this row into the loop!
234             push(@loop_data, \%row_data);
235             }
236              
237             # finally, assign the loop data to the loop param, again with a reference:
238             $template->param(THIS_LOOP => \@loop_data);
239              
240             The above example would work with a template like:
241              
242            
243             Word:
244             Number:
245            
246            
247              
248             It would produce output like:
249              
250             Word: I
251             Number: 1
252              
253             Word: Am
254             Number: 2
255              
256             Word: Cool
257             Number: 3
258              
259             C<< >>s within C<< >>s are fine and work as you
260             would expect. If the syntax for the C call has you stumped,
261             here's an example of a param call with one nested loop:
262              
263             $template->param(
264             LOOP => [
265             {
266             name => 'Bobby',
267             nicknames => [{name => 'the big bad wolf'}, {name => 'He-Man'}],
268             },
269             ],
270             );
271              
272             Basically, each C<< >> gets an array reference. Inside the
273             array are any number of hash references. These hashes contain the
274             name=>value pairs for a single pass over the loop template.
275              
276             Inside a C<< >>, the only variables that are usable are the
277             ones from the C<< >>. The variables in the outer blocks
278             are not visible within a template loop. For the computer-science geeks
279             among you, a C<< >> introduces a new scope much like a perl
280             subroutine call. If you want your variables to be global you can use
281             C option to C described below.
282              
283             =head2 TMPL_INCLUDE
284              
285            
286              
287             This tag includes a template directly into the current template at
288             the point where the tag is found. The included template contents are
289             used exactly as if its contents were physically included in the master
290             template.
291              
292             The file specified can be an absolute path (beginning with a '/' under
293             Unix, for example). If it isn't absolute, the path to the enclosing
294             file is tried first. After that the path in the environment variable
295             C is tried, if it exists. Next, the "path" option
296             is consulted, first as-is and then with C prepended
297             if available. As a final attempt, the filename is passed to C
298             directly. See below for more information on C
299             and the C option to C.
300              
301             As a protection against infinitely recursive includes, an arbitrary
302             limit of 10 levels deep is imposed. You can alter this limit with the
303             C option. See the entry for the C option
304             below for more details.
305              
306             =head2 TMPL_IF
307              
308             ...
309              
310             The C<< >> tag allows you to include or not include a block
311             of the template based on the value of a given parameter name. If the
312             parameter is given a value that is true for Perl - like '1' - then the
313             block is included in the output. If it is not defined, or given a false
314             value - like '0' - then it is skipped. The parameters are specified
315             the same way as with C<< >>.
316              
317             Example Template:
318              
319            
320             Some text that only gets displayed if BOOL is true!
321            
322              
323             Now if you call C<< $template->param(BOOL => 1) >> then the above block
324             will be included by output.
325              
326             C<< >> blocks can include any valid HTML::Template
327             construct - Cs and Cs and other C/C blocks. Note,
328             however, that intersecting a C<< >> and a C<< >>
329             is invalid.
330              
331             Not going to work:
332            
333            
334            
335            
336              
337             If the name of a C<< >> is used in a C<< >>,
338             the C block will output if the loop has at least one row. Example:
339              
340            
341             This will output if the loop is not empty.
342            
343              
344            
345             ....
346            
347              
348             WARNING: Much of the benefit of HTML::Template is in decoupling your
349             Perl and HTML. If you introduce numerous cases where you have
350             Cs and matching Perl Cs, you will create a maintenance
351             problem in keeping the two synchronized. I suggest you adopt the
352             practice of only using C if you can do so without requiring a
353             matching C in your Perl code.
354              
355             =head2 TMPL_ELSE
356              
357             ... ...
358              
359             You can include an alternate block in your C<< >> block by using
360             C<< >>. NOTE: You still end the block with C<< >>,
361             not C<< >>!
362            
363             Example:
364            
365             Some text that is included only if BOOL is true
366            
367             Some text that is included only if BOOL is false
368            
369              
370             =head2 TMPL_UNLESS
371              
372             ...
373              
374             This tag is the opposite of C<< >>. The block is output if the
375             C is set false or not defined. You can use
376             C<< >> with C<< >> just as you can with C<< >>.
377              
378             Example:
379            
380             Some text that is output only if BOOL is FALSE.
381            
382             Some text that is output only if BOOL is TRUE.
383            
384              
385             If the name of a C<< >> is used in a C<< >>,
386             the C<< >> block output if the loop has zero rows.
387              
388            
389             This will output if the loop is empty.
390            
391              
392            
393             ....
394            
395              
396             =cut
397              
398             =head2 NOTES
399              
400             HTML::Template's tags are meant to mimic normal HTML tags. However,
401             they are allowed to "break the rules". Something like:
402              
403            
404              
405             is not really valid HTML, but it is a perfectly valid use and will work
406             as planned.
407              
408             The C in the tag is optional, although for extensibility's sake I
409             recommend using it. Example - C<< >> is acceptable.
410              
411             If you're a fanatic about valid HTML and would like your templates
412             to conform to valid HTML syntax, you may optionally type template tags
413             in the form of HTML comments. This may be of use to HTML authors who
414             would like to validate their templates' HTML syntax prior to
415             HTML::Template processing, or who use DTD-savvy editing tools.
416              
417            
418              
419             In order to realize a dramatic savings in bandwidth, the standard
420             (non-comment) tags will be used throughout this documentation.
421              
422             =head1 METHODS
423              
424             =head2 new
425              
426             Call C to create a new Template object:
427              
428             my $template = HTML::Template->new(
429             filename => 'file.tmpl',
430             option => 'value',
431             );
432              
433             You must call C with at least one C value> pair specifying how
434             to access the template text. You can use C<< filename => 'file.tmpl' >>
435             to specify a filename to be opened as the template. Alternately you can
436             use:
437              
438             my $t = HTML::Template->new(
439             scalarref => $ref_to_template_text,
440             option => 'value',
441             );
442              
443             and
444              
445             my $t = HTML::Template->new(
446             arrayref => $ref_to_array_of_lines,
447             option => 'value',
448             );
449              
450             These initialize the template from in-memory resources. In almost every
451             case you'll want to use the filename parameter. If you're worried about
452             all the disk access from reading a template file just use mod_perl and
453             the cache option detailed below.
454              
455             You can also read the template from an already opened filehandle, either
456             traditionally as a glob or as a L:
457              
458             my $t = HTML::Template->new(filehandle => *FH, option => 'value');
459              
460             The four C calling methods can also be accessed as below, if you
461             prefer.
462              
463             my $t = HTML::Template->new_file('file.tmpl', option => 'value');
464              
465             my $t = HTML::Template->new_scalar_ref($ref_to_template_text, option => 'value');
466              
467             my $t = HTML::Template->new_array_ref($ref_to_array_of_lines, option => 'value');
468              
469             my $t = HTML::Template->new_filehandle($fh, option => 'value');
470              
471             And as a final option, for those that might prefer it, you can call new as:
472              
473             my $t = HTML::Template->new(
474             type => 'filename',
475             source => 'file.tmpl',
476             );
477              
478             Which works for all three of the source types.
479              
480             If the environment variable C is set and your
481             filename doesn't begin with "/", then the path will be relative to the
482             value of c.
483              
484             B - if the environment variable C is set to
485             F and I call C<< HTML::Template->new() >> with filename set
486             to "sam.tmpl", HTML::Template will try to open F to
487             access the template file. You can also affect the search path for files
488             with the C option to C - see below for more information.
489              
490             You can modify the Template object's behavior with C. The options
491             are available:
492              
493             =head3 Error Detection Options
494              
495             =over
496              
497             =item * die_on_bad_params
498              
499             If set to 0 the module will let you call:
500              
501             $template->param(param_name => 'value')
502              
503             even if 'param_name' doesn't exist in the template body. Defaults to 1.
504              
505             =item * force_untaint
506              
507             If set to 1 the module will not allow you to set unescaped parameters
508             with tainted values. If set to 2 you will have to untaint all
509             parameters, including ones with the escape attribute. This option
510             makes sure you untaint everything so you don't accidentally introduce
511             e.g. cross-site-scripting (XSS) vulnerabilities. Requires taint
512             mode. Defaults to 0.
513              
514             =item *
515              
516             strict - if set to 0 the module will allow things that look like they
517             might be TMPL_* tags to get by without dieing. Example:
518              
519            
520              
521             Would normally cause an error, but if you call new with C<< strict => 0 >>
522             HTML::Template will ignore it. Defaults to 1.
523              
524             =item * vanguard_compatibility_mode
525              
526             If set to 1 the module will expect to see C<< >>s that
527             look like C<%NAME%> in addition to the standard syntax. Also sets
528             C 0>. If you're not at Vanguard Media trying to
529             use an old format template don't worry about this one. Defaults to 0.
530              
531             =back
532              
533             =head3 Caching Options
534              
535             =over
536              
537             =item * cache
538              
539             If set to 1 the module will cache in memory the parsed templates based
540             on the filename parameter, the modification date of the file and the
541             options passed to C. This only applies to templates opened with
542             the filename parameter specified, not scalarref or arrayref templates.
543             Caching also looks at the modification times of any files included using
544             C<< >> tags, but again, only if the template is opened
545             with filename parameter.
546              
547             This is mainly of use in a persistent environment like Apache/mod_perl.
548             It has absolutely no benefit in a normal CGI environment since the script
549             is unloaded from memory after every request. For a cache that does work
550             for a non-persistent environment see the C option below.
551              
552             My simplistic testing shows that using cache yields a 90% performance
553             increase under mod_perl. Cache defaults to 0.
554              
555             =item * shared_cache
556              
557             If set to 1 the module will store its cache in shared memory using the
558             L module (available from CPAN). The effect of this
559             will be to maintain a single shared copy of each parsed template for
560             all instances of HTML::Template on the same machine to use. This can
561             be a significant reduction in memory usage in an environment with a
562             single machine but multiple servers. As an example, on one of our
563             systems we use 4MB of template cache and maintain 25 httpd processes -
564             shared_cache results in saving almost 100MB! Of course, some reduction
565             in speed versus normal caching is to be expected. Another difference
566             between normal caching and shared_cache is that shared_cache will work
567             in a non-persistent environment (like normal CGI) - normal caching is
568             only useful in a persistent environment like Apache/mod_perl.
569              
570             By default HTML::Template uses the IPC key 'TMPL' as a shared root
571             segment (0x4c504d54 in hex), but this can be changed by setting the
572             C C parameter to another 4-character or integer key.
573             Other options can be used to affect the shared memory cache correspond
574             to L options - C, C and
575             C. See L for a description of how these
576             work - in most cases you shouldn't need to change them from the defaults.
577              
578             For more information about the shared memory cache system used by
579             HTML::Template see L.
580              
581             =item * double_cache
582              
583             If set to 1 the module will use a combination of C and
584             normal cache mode for the best possible caching. Of course, it also uses
585             the most memory of all the cache modes. All the same ipc_* options that
586             work with C apply to C as well. Defaults to 0.
587              
588             =item * blind_cache
589              
590             If set to 1 the module behaves exactly as with normal caching but does
591             not check to see if the file has changed on each request. This option
592             should be used with caution, but could be of use on high-load servers.
593             My tests show C performing only 1 to 2 percent faster than
594             cache under mod_perl.
595              
596             B: Combining this option with shared_cache can result in stale
597             templates stuck permanently in shared memory!
598              
599             =item * file_cache
600              
601             If set to 1 the module will store its cache in a file using
602             the L module. It uses no additional memory, and my
603             simplistic testing shows that it yields a 50% performance advantage.
604             Like C, it will work in a non-persistent environments
605             (like CGI). Default is 0.
606              
607             If you set this option you must set the C option. See
608             below for details.
609              
610             B: L uses C to ensure safe access to cache
611             files. Using C on a system or filesystem (like NFS) without
612             C support is dangerous.
613              
614             =item * file_cache_dir
615              
616             Sets the directory where the module will store the cache files if
617             C is enabled. Your script will need write permissions to
618             this directory. You'll also need to make sure the sufficient space is
619             available to store the cache files.
620              
621             =item * file_cache_dir_mode
622              
623             Sets the file mode for newly created C directories and
624             subdirectories. Defaults to "0700" for security but this may be
625             inconvenient if you do not have access to the account running the
626             webserver.
627              
628             =item * double_file_cache
629              
630             If set to 1 the module will use a combination of C and
631             normal C mode for the best possible caching. The file_cache_*
632             options that work with file_cache apply to C as well.
633             Defaults to 0.
634              
635             =item * cache_lazy_vars
636              
637             The option tells HTML::Template to cache the values returned from code references
638             used for Cs. See L for details.
639              
640             =item * cache_lazy_loops
641              
642             The option tells HTML::Template to cache the values returned from code references
643             used for Cs. See L for details.
644              
645             =back
646              
647             =head3 Filesystem Options
648              
649             =over
650              
651             =item * path
652              
653             You can set this variable with a list of paths to search for files
654             specified with the C option to C and for files included
655             with the C<< >> tag. This list is only consulted when the
656             filename is relative. The C environment variable
657             is always tried first if it exists. Also, if C is
658             set then an attempt will be made to prepend C onto
659             paths in the path array. In the case of a C<< >> file,
660             the path to the including file is also tried before path is consulted.
661              
662             Example:
663              
664             my $template = HTML::Template->new(
665             filename => 'file.tmpl',
666             path => ['/path/to/templates', '/alternate/path'],
667             );
668              
669             B: the paths in the path list must be expressed as UNIX paths,
670             separated by the forward-slash character ('/').
671              
672             =item * search_path_on_include
673              
674             If set to a true value the module will search from the top of the array
675             of paths specified by the path option on every C<< >> and
676             use the first matching template found. The normal behavior is to look
677             only in the current directory for a template to include. Defaults to 0.
678              
679             =item * utf8
680              
681             Setting this to true tells HTML::Template to treat your template files as
682             UTF-8 encoded. This will apply to any file's passed to C or any
683             included files. It won't do anything special to scalars templates passed
684             to C since you should be doing the encoding on those yourself.
685              
686             my $template = HTML::Template->new(
687             filename => 'umlauts_are_awesome.tmpl',
688             utf8 => 1,
689             );
690              
691             Most templates are either ASCII (the default) or UTF-8 encoded
692             Unicode. But if you need some other encoding other than these 2, look
693             at the C option.
694              
695             B: The C and C options cannot be used at the
696             same time.
697              
698             =item * open_mode
699              
700             You can set this option to an opening mode with which all template files
701             will be opened.
702              
703             For example, if you want to use a template that is UTF-16 encoded unicode:
704              
705             my $template = HTML::Template->new(
706             filename => 'file.tmpl',
707             open_mode => '<:encoding(UTF-16)',
708             );
709              
710             That way you can force a different encoding (than the default ASCII
711             or UTF-8), CR/LF properties etc. on the template files. See L
712             for details.
713              
714             B: this only works in perl 5.7.1 and above.
715              
716             B: you have to supply an opening mode that actually permits
717             reading from the file handle.
718              
719             B: The C and C options cannot be used at the
720             same time.
721              
722             =back
723              
724             =head3 Debugging Options
725              
726             =over
727              
728             =item * debug
729              
730             If set to 1 the module will write random debugging information to STDERR.
731             Defaults to 0.
732              
733             =item * stack_debug
734              
735             If set to 1 the module will use Data::Dumper to print out the contents
736             of the parse_stack to STDERR. Defaults to 0.
737              
738             =item * cache_debug
739              
740             If set to 1 the module will send information on cache loads, hits and
741             misses to STDERR. Defaults to 0.
742              
743             =item * shared_cache_debug
744              
745             If set to 1 the module will turn on the debug option in
746             L. Defaults to 0.
747              
748             =item * memory_debug
749              
750             If set to 1 the module will send information on cache memory usage
751             to STDERR. Requires the L module. Defaults to 0.
752              
753             =back
754              
755             =head3 Miscellaneous Options
756              
757             =over
758              
759             =item * associate
760              
761             This option allows you to inherit the parameter values
762             from other objects. The only requirement for the other object is that
763             it have a C method that works like HTML::Template's C. A
764             good candidate would be a L query object. Example:
765              
766             my $query = CGI->new;
767             my $template = HTML::Template->new(
768             filename => 'template.tmpl',
769             associate => $query,
770             );
771              
772             Now, C<< $template->output() >> will act as though
773              
774             $template->param(form_field => $cgi->param('form_field'));
775              
776             had been specified for each key/value pair that would be provided by the
777             C<< $cgi->param() >> method. Parameters you set directly take precedence
778             over associated parameters.
779              
780             You can specify multiple objects to associate by passing an anonymous
781             array to the associate option. They are searched for parameters in the
782             order they appear:
783              
784             my $template = HTML::Template->new(
785             filename => 'template.tmpl',
786             associate => [$query, $other_obj],
787             );
788              
789             B: The parameter names are matched in a case-insensitive manner.
790             If you have two parameters in a CGI object like 'NAME' and 'Name' one
791             will be chosen randomly by associate. This behavior can be changed by
792             the C option.
793              
794             =item * case_sensitive
795              
796             Setting this option to true causes HTML::Template to treat template
797             variable names case-sensitively. The following example would only set
798             one parameter without the C option:
799              
800             my $template = HTML::Template->new(
801             filename => 'template.tmpl',
802             case_sensitive => 1
803             );
804             $template->param(
805             FieldA => 'foo',
806             fIELDa => 'bar',
807             );
808              
809             This option defaults to off.
810              
811             B: with C and C the special
812             loop variables are available in lower-case only.
813              
814             =item * loop_context_vars
815              
816             When this parameter is set to true (it is false by default) extra variables
817             that depend on the loop's context are made available inside a loop. These are:
818              
819             =over
820              
821             =item * __first__
822              
823             Value that is true for the first iteration of the loop and false every other time.
824              
825             =item * __last__
826              
827             Value that is true for the last iteration of the loop and false every other time.
828              
829             =item * __inner__
830              
831             Value that is true for the every iteration of the loop except for the first and last.
832              
833             =item * __outer__
834              
835             Value that is true for the first and last iterations of the loop.
836              
837             =item * __odd__
838              
839             Value that is true for the every odd iteration of the loop.
840              
841             =item * __even__
842              
843             Value that is true for the every even iteration of the loop.
844              
845             =item * __counter__
846              
847             An integer (starting from 1) whose value increments for each iteration of the loop.
848              
849             =item * __index__
850              
851             An integer (starting from 0) whose value increments for each iteration of the loop.
852              
853             =back
854              
855             Just like any other Cs these variables can be used in
856             C<< >>, C<< >> and C<< >> to control
857             how a loop is output.
858              
859             Example:
860              
861            
862            
863             This only outputs on the first pass.
864            
865              
866            
867             This outputs every other pass, on the odd passes.
868            
869              
870            
871             This outputs every other pass, on the even passes.
872            
873              
874            
875             This outputs on passes that are neither first nor last.
876            
877              
878             This is pass number .
879              
880            
881             This only outputs on the last pass.
882            
883            
884              
885             One use of this feature is to provide a "separator" similar in effect
886             to the perl function C. Example:
887              
888            
889             and
890             , .
891            
892              
893             Would output something like:
894              
895             Apples, Oranges, Brains, Toes, and Kiwi.
896              
897             Given an appropriate C call, of course. B: A loop with only
898             a single pass will get both C<__first__> and C<__last__> set to true, but
899             not C<__inner__>.
900              
901             =item * no_includes
902              
903             Set this option to 1 to disallow the C<< >> tag in the
904             template file. This can be used to make opening untrusted templates
905             B less dangerous. Defaults to 0.
906              
907             =item * max_includes
908              
909             Set this variable to determine the maximum depth that includes can reach.
910             Set to 10 by default. Including files to a depth greater than this
911             value causes an error message to be displayed. Set to 0 to disable
912             this protection.
913              
914             =item * die_on_missing_include
915              
916             If true, then HTML::Template will die if it can't find a file for a
917             C<< >>. This defaults to true.
918              
919             =item * global_vars
920              
921             Normally variables declared outside a loop are not available inside
922             a loop. This option makes C<< >>s like global variables in
923             Perl - they have unlimited scope. This option also affects C<< >>
924             and C<< >>.
925              
926             Example:
927              
928             This is a normal variable: .

929              
930            
931             Here it is inside the loop:

932            
933              
934             Normally this wouldn't work as expected, since C<< >>'s
935             value outside the loop is not available inside the loop.
936              
937             The global_vars option also allows you to access the values of an
938             enclosing loop within an inner loop. For example, in this loop the
939             inner loop will have access to the value of C in the correct
940             iteration:
941              
942            
943             OUTER:
944            
945             INNER:
946             INSIDE OUT:
947            
948            
949              
950             One side-effect of C is that variables you set with
951             C that might otherwise be ignored when C
952             is off will stick around. This is necessary to allow inner loops to
953             access values set for outer loops that don't directly use the value.
954              
955             B: C is not C (which does not exist).
956             That means that loops you declare at one scope are not available
957             inside other loops even when C is on.
958              
959             =item * filter
960              
961             This option allows you to specify a filter for your template files.
962             A filter is a subroutine that will be called after HTML::Template reads
963             your template file but before it starts parsing template tags.
964              
965             In the most simple usage, you simply assign a code reference to the
966             filter parameter. This subroutine will receive a single argument -
967             a reference to a string containing the template file text. Here is
968             an example that accepts templates with tags that look like
969             C and transforms them into HTML::Template tags:
970              
971             my $filter = sub {
972             my $text_ref = shift;
973             $$text_ref =~ s/!!!ZAP_(.*?)!!!//g;
974             };
975              
976             # open zap.tmpl using the above filter
977             my $template = HTML::Template->new(
978             filename => 'zap.tmpl',
979             filter => $filter,
980             );
981              
982             More complicated usages are possible. You can request that your
983             filter receives the template text as an array of lines rather than
984             as a single scalar. To do that you need to specify your filter using
985             a hash-ref. In this form you specify the filter using the C key
986             and the desired argument format using the C key. The available
987             formats are C and C. Using the C format will
988             incur a performance penalty but may be more convenient in some situations.
989              
990             my $template = HTML::Template->new(
991             filename => 'zap.tmpl',
992             filter => {
993             sub => $filter,
994             format => 'array',
995             }
996             );
997              
998             You may also have multiple filters. This allows simple filters to be
999             combined for more elaborate functionality. To do this you specify
1000             an array of filters. The filters are applied in the order they are
1001             specified.
1002              
1003             my $template = HTML::Template->new(
1004             filename => 'zap.tmpl',
1005             filter => [
1006             {
1007             sub => \&decompress,
1008             format => 'scalar',
1009             },
1010             {
1011             sub => \&remove_spaces,
1012             format => 'array',
1013             },
1014             ]
1015             );
1016              
1017             The specified filters will be called for any Ced files just
1018             as they are for the main template file.
1019              
1020             =item * default_escape
1021              
1022             Set this parameter to a valid escape type (see the C option)
1023             and HTML::Template will apply the specified escaping to all variables
1024             unless they declare a different escape in the template.
1025              
1026             =back
1027              
1028             =cut
1029              
1030 29     29   306107 use integer; # no floating point math so far!
  29         339  
  29         166  
1031 29     29   1055 use strict; # and no funny business, either.
  29         66  
  29         1045  
1032              
1033 29     29   175 use Carp; # generate better errors with more context
  29         59  
  29         3093  
1034 29     29   176 use File::Spec; # generate paths that work on all platforms
  29         56  
  29         782  
1035 29     29   164 use Digest::MD5 qw(md5_hex); # generate cache keys
  29         53  
  29         1560  
1036 29     29   164 use Scalar::Util qw(tainted);
  29         70  
  29         18457  
1037              
1038             # define accessor constants used to improve readability of array
1039             # accesses into "objects". I used to use 'use constant' but that
1040             # seems to cause occasional irritating warnings in older Perls.
1041             package HTML::Template::LOOP;
1042             sub TEMPLATE_HASH () { 0 }
1043             sub PARAM_SET () { 1 }
1044              
1045             package HTML::Template::COND;
1046             sub VARIABLE () { 0 }
1047             sub VARIABLE_TYPE () { 1 }
1048             sub VARIABLE_TYPE_VAR () { 0 }
1049             sub VARIABLE_TYPE_LOOP () { 1 }
1050             sub JUMP_IF_TRUE () { 2 }
1051             sub JUMP_ADDRESS () { 3 }
1052             sub WHICH () { 4 }
1053             sub UNCONDITIONAL_JUMP () { 5 }
1054             sub IS_ELSE () { 6 }
1055             sub WHICH_IF () { 0 }
1056             sub WHICH_UNLESS () { 1 }
1057              
1058             # back to the main package scope.
1059             package HTML::Template;
1060              
1061             my %OPTIONS;
1062              
1063             # set the default options
1064             BEGIN {
1065 29     29   75341 %OPTIONS = (
1066             debug => 0,
1067             stack_debug => 0,
1068             timing => 0,
1069             search_path_on_include => 0,
1070             cache => 0,
1071             blind_cache => 0,
1072             file_cache => 0,
1073             file_cache_dir => '',
1074             file_cache_dir_mode => 0700,
1075             force_untaint => 0,
1076             cache_debug => 0,
1077             shared_cache_debug => 0,
1078             memory_debug => 0,
1079             die_on_bad_params => 1,
1080             vanguard_compatibility_mode => 0,
1081             associate => [],
1082             path => [],
1083             strict => 1,
1084             loop_context_vars => 0,
1085             max_includes => 10,
1086             shared_cache => 0,
1087             double_cache => 0,
1088             double_file_cache => 0,
1089             ipc_key => 'TMPL',
1090             ipc_mode => 0666,
1091             ipc_segment_size => 65536,
1092             ipc_max_size => 0,
1093             global_vars => 0,
1094             no_includes => 0,
1095             case_sensitive => 0,
1096             filter => [],
1097             open_mode => '',
1098             utf8 => 0,
1099             cache_lazy_vars => 0,
1100             cache_lazy_loops => 0,
1101             die_on_missing_include => 1,
1102             );
1103             }
1104              
1105             # open a new template and return an object handle
1106             sub new {
1107 309     309 1 1245126 my $pkg = shift;
1108 309         550 my $self;
1109 309         461 { my %hash; $self = bless(\%hash, $pkg); }
  309         412  
  309         977  
1110              
1111             # the options hash
1112 309         623 my $options = {};
1113 309         1008 $self->{options} = $options;
1114              
1115             # set default parameters in options hash
1116 309         7317 %$options = %OPTIONS;
1117              
1118             # load in options supplied to new()
1119 309         1856 $options = _load_supplied_options([@_], $options);
1120              
1121             # blind_cache = 1 implies cache = 1
1122 305 100       1462 $options->{blind_cache} and $options->{cache} = 1;
1123              
1124             # shared_cache = 1 implies cache = 1
1125 305 50       812 $options->{shared_cache} and $options->{cache} = 1;
1126              
1127             # file_cache = 1 implies cache = 1
1128 305 100       758 $options->{file_cache} and $options->{cache} = 1;
1129              
1130             # double_cache is a combination of shared_cache and cache.
1131 305 100       903 $options->{double_cache} and $options->{cache} = 1;
1132 305 100       686 $options->{double_cache} and $options->{shared_cache} = 1;
1133              
1134             # double_file_cache is a combination of file_cache and cache.
1135 305 100       675 $options->{double_file_cache} and $options->{cache} = 1;
1136 305 100       757 $options->{double_file_cache} and $options->{file_cache} = 1;
1137              
1138             # vanguard_compatibility_mode implies die_on_bad_params = 0
1139 305 100       875 $options->{vanguard_compatibility_mode}
1140             and $options->{die_on_bad_params} = 0;
1141              
1142             # handle the "type", "source" parameter format (does anyone use it?)
1143 305 100       789 if (exists($options->{type})) {
1144 10 100       199 exists($options->{source})
1145             or croak("HTML::Template->new() called with 'type' parameter set, but no 'source'!");
1146             (
1147 9 100 100     236 $options->{type} eq 'filename'
      100        
      100        
1148             or $options->{type} eq 'scalarref'
1149             or $options->{type} eq 'arrayref'
1150             or $options->{type} eq 'filehandle'
1151             )
1152             or croak("HTML::Template->new() : type parameter must be set to 'filename', 'arrayref', 'scalarref' or 'filehandle'!");
1153              
1154 8         26 $options->{$options->{type}} = $options->{source};
1155 8         14 delete $options->{type};
1156 8         14 delete $options->{source};
1157             }
1158              
1159             # make sure taint mode is on if force_untaint flag is set
1160 303 100       792 if ($options->{force_untaint}) {
1161 2 50       26 if ($] < 5.008000) {
    100          
1162 0         0 warn("HTML::Template->new() : 'force_untaint' option needs at least Perl 5.8.0!");
1163             } elsif (!${^TAINT}) {
1164 1         250 croak("HTML::Template->new() : 'force_untaint' option set but perl does not run in taint mode!");
1165             }
1166             }
1167              
1168             # associate should be an array of one element if it's not
1169             # already an array.
1170 302 100       1229 if (ref($options->{associate}) ne 'ARRAY') {
1171 3         11 $options->{associate} = [$options->{associate}];
1172             }
1173              
1174             # path should be an array if it's not already
1175 302 100       891 if (ref($options->{path}) ne 'ARRAY') {
1176 73         232 $options->{path} = [$options->{path}];
1177             }
1178              
1179             # filter should be an array if it's not already
1180 302 100       1028 if (ref($options->{filter}) ne 'ARRAY') {
1181 4         10 $options->{filter} = [$options->{filter}];
1182             }
1183              
1184             # make sure objects in associate area support param()
1185 302         490 foreach my $object (@{$options->{associate}}) {
  302         771  
1186 3 100       172 defined($object->can('param'))
1187             or croak("HTML::Template->new called with associate option, containing object of type "
1188             . ref($object)
1189             . " which lacks a param() method!");
1190             }
1191              
1192             # check for syntax errors:
1193 301         471 my $source_count = 0;
1194 301 100       1069 exists($options->{filename}) and $source_count++;
1195 301 100       1984 exists($options->{filehandle}) and $source_count++;
1196 301 100       633 exists($options->{arrayref}) and $source_count++;
1197 301 100       766 exists($options->{scalarref}) and $source_count++;
1198 301 100       760 if ($source_count != 1) {
1199 1         232 croak(
1200             "HTML::Template->new called with multiple (or no) template sources specified! A valid call to new() has exactly one filename => 'file' OR exactly one scalarref => \\\$scalar OR exactly one arrayref => \\\@array OR exactly one filehandle => \*FH"
1201             );
1202             }
1203              
1204             # check that cache options are not used with non-cacheable templates
1205 900         2813 croak "Cannot have caching when template source is not file"
1206 1110         2595 if grep { exists($options->{$_}) } qw( filehandle arrayref scalarref)
1207 300 100 100     543 and grep { $options->{$_} }
1208             qw( cache blind_cache file_cache shared_cache
1209             double_cache double_file_cache );
1210              
1211             # check that filenames aren't empty
1212 297 100       1173 if (exists($options->{filename})) {
1213 115 100       786 croak("HTML::Template->new called with empty filename parameter!")
1214             unless length $options->{filename};
1215             }
1216              
1217             # do some memory debugging - this is best started as early as possible
1218 296 50       856 if ($options->{memory_debug}) {
1219             # memory_debug needs GTop
1220 0         0 eval { require GTop; };
  0         0  
1221 0 0       0 croak("Could not load GTop. You must have GTop installed to use HTML::Template in memory_debug mode. The error was: $@")
1222             if ($@);
1223 0         0 $self->{gtop} = GTop->new();
1224 0         0 $self->{proc_mem} = $self->{gtop}->proc_mem($$);
1225 0         0 print STDERR "\n### HTML::Template Memory Debug ### START ", $self->{proc_mem}->size(), "\n";
1226             }
1227              
1228 296 100       676 if ($options->{file_cache}) {
1229             # make sure we have a file_cache_dir option
1230 17 100       461 croak("You must specify the file_cache_dir option if you want to use file_cache.")
1231             unless length $options->{file_cache_dir};
1232              
1233             # file_cache needs some extra modules loaded
1234 16         131 eval { require Storable; };
  16         10358  
1235 16 50       48511 croak(
1236             "Could not load Storable. You must have Storable installed to use HTML::Template in file_cache mode. The error was: $@"
1237             ) if ($@);
1238             }
1239              
1240 295 50       793 if ($options->{shared_cache}) {
1241             # shared_cache needs some extra modules loaded
1242 0         0 eval { require IPC::SharedCache; };
  0         0  
1243 0 0       0 croak(
1244             "Could not load IPC::SharedCache. You must have IPC::SharedCache installed to use HTML::Template in shared_cache mode. The error was: $@"
1245             ) if ($@);
1246              
1247             # initialize the shared cache
1248 0         0 my %cache;
1249 0         0 tie %cache, 'IPC::SharedCache',
1250             ipc_key => $options->{ipc_key},
1251             load_callback => [\&_load_shared_cache, $self],
1252             validate_callback => [\&_validate_shared_cache, $self],
1253             debug => $options->{shared_cache_debug},
1254             ipc_mode => $options->{ipc_mode},
1255             max_size => $options->{ipc_max_size},
1256             ipc_segment_size => $options->{ipc_segment_size};
1257 0         0 $self->{cache} = \%cache;
1258             }
1259              
1260 295 100       841 if ($options->{default_escape}) {
1261 122         255 $options->{default_escape} = uc $options->{default_escape};
1262 122 100       550 unless ($options->{default_escape} =~ /^(NONE|HTML|URL|JS)$/i) {
1263 1         188 croak(
1264             "HTML::Template->new(): Invalid setting for default_escape - '$options->{default_escape}'. Valid values are 'none', 'html', 'url', or 'js'."
1265             );
1266             }
1267             }
1268              
1269             # no 3 args form of open before perl 5.7.1
1270 294 50 66     898 if ($options->{open_mode} && $] < 5.007001) {
1271 0         0 croak("HTML::Template->new(): open_mode cannot be used in Perl < 5.7.1");
1272             }
1273              
1274 294 100       861 if($options->{utf8}) {
1275 6 50       21 croak("HTML::Template->new(): utf8 cannot be used in Perl < 5.7.1") if $] < 5.007001;
1276 6 100       291 croak("HTML::Template->new(): utf8 and open_mode cannot be used at the same time") if $options->{open_mode};
1277              
1278             # utf8 is just a short-cut for a common open_mode
1279 5         10 $options->{open_mode} = '<:encoding(utf8)';
1280             }
1281              
1282 293 50       639 print STDERR "### HTML::Template Memory Debug ### POST CACHE INIT ", $self->{proc_mem}->size(), "\n"
1283             if $options->{memory_debug};
1284              
1285             # initialize data structures
1286 293         845 $self->_init;
1287              
1288 281 50       907 print STDERR "### HTML::Template Memory Debug ### POST _INIT CALL ", $self->{proc_mem}->size(), "\n"
1289             if $options->{memory_debug};
1290              
1291             # drop the shared cache - leaving out this step results in the
1292             # template object evading garbage collection since the callbacks in
1293             # the shared cache tie hold references to $self! This was not easy
1294             # to find, by the way.
1295 281 50       635 delete $self->{cache} if $options->{shared_cache};
1296              
1297 281         1146 return $self;
1298             }
1299              
1300             sub _load_supplied_options {
1301 395     395   586 my $argsref = shift;
1302 395         528 my $options = shift;
1303 395         621 for (my $x = 0 ; $x < @{$argsref} ; $x += 2) {
  1794         7419  
1304 1403 100       1905 defined(${$argsref}[($x + 1)])
  1403         4338  
1305             or croak("HTML::Template->new() called with odd number of option parameters - should be of the form option => value");
1306 1399         1560 $options->{lc(${$argsref}[$x])} = ${$argsref}[($x + 1)];
  1399         3794  
  1399         2548  
1307             }
1308 391         1453 return $options;
1309             }
1310              
1311             # an internally used new that receives its parse_stack and param_map as input
1312             sub _new_from_loop {
1313 86     86   148 my $pkg = shift;
1314 86         103 my $self;
1315 86         105 { my %hash; $self = bless(\%hash, $pkg); }
  86         111  
  86         306  
1316              
1317             # the options hash
1318 86         475 my $options = {
1319             debug => $OPTIONS{debug},
1320             stack_debug => $OPTIONS{stack_debug},
1321             die_on_bad_params => $OPTIONS{die_on_bad_params},
1322 86         226 associate => [@{$OPTIONS{associate}}],
1323             loop_context_vars => $OPTIONS{loop_context_vars},
1324             };
1325 86         210 $self->{options} = $options;
1326 86         441 $options = _load_supplied_options([@_], $options);
1327              
1328 86         308 $self->{param_map} = $options->{param_map};
1329 86         181 $self->{parse_stack} = $options->{parse_stack};
1330 86         179 delete($options->{param_map});
1331 86         134 delete($options->{parse_stack});
1332              
1333 86         1047 return $self;
1334             }
1335              
1336             # a few shortcuts to new(), of possible use...
1337             sub new_file {
1338 1     1 0 7 my $pkg = shift;
1339 1         3 return $pkg->new('filename', @_);
1340             }
1341              
1342             sub new_filehandle {
1343 2     2 0 9 my $pkg = shift;
1344 2         10 return $pkg->new('filehandle', @_);
1345             }
1346              
1347             sub new_array_ref {
1348 1     1 0 7 my $pkg = shift;
1349 1         3 return $pkg->new('arrayref', @_);
1350             }
1351              
1352             sub new_scalar_ref {
1353 36     36 0 41153 my $pkg = shift;
1354 36         122 return $pkg->new('scalarref', @_);
1355             }
1356              
1357             # initializes all the object data structures, either from cache or by
1358             # calling the appropriate routines.
1359             sub _init {
1360 293     293   484 my $self = shift;
1361 293         514 my $options = $self->{options};
1362              
1363 293 50       2043 if ($options->{double_cache}) {
    100          
    50          
    100          
    100          
1364             # try the normal cache, return if we have it.
1365 0         0 $self->_fetch_from_cache();
1366 0 0 0     0 return if (defined $self->{param_map} and defined $self->{parse_stack});
1367              
1368             # try the shared cache
1369 0         0 $self->_fetch_from_shared_cache();
1370              
1371             # put it in the local cache if we got it.
1372 0 0 0     0 $self->_commit_to_cache()
1373             if (defined $self->{param_map} and defined $self->{parse_stack});
1374             } elsif ($options->{double_file_cache}) {
1375             # try the normal cache, return if we have it.
1376 3         12 $self->_fetch_from_cache();
1377 3 100       25 return if (defined $self->{param_map});
1378              
1379             # try the file cache
1380 1         11 $self->_fetch_from_file_cache();
1381              
1382             # put it in the local cache if we got it.
1383 1 50       4 $self->_commit_to_cache()
1384             if (defined $self->{param_map});
1385             } elsif ($options->{shared_cache}) {
1386             # try the shared cache
1387 0         0 $self->_fetch_from_shared_cache();
1388             } elsif ($options->{file_cache}) {
1389             # try the file cache
1390 13         57 $self->_fetch_from_file_cache();
1391             } elsif ($options->{cache}) {
1392             # try the normal cache
1393 11         39 $self->_fetch_from_cache();
1394             }
1395              
1396             # if we got a cache hit, return
1397 291 100       783 return if (defined $self->{param_map});
1398              
1399             # if we're here, then we didn't get a cached copy, so do a full
1400             # init.
1401 282         749 $self->_init_template();
1402 279         768 $self->_parse();
1403              
1404             # now that we have a full init, cache the structures if caching is
1405             # on. shared cache is already cool.
1406 270 100       748 if ($options->{file_cache}) {
1407 10         41 $self->_commit_to_file_cache();
1408             }
1409             $self->_commit_to_cache()
1410 270 100 66     2823 if ( ($options->{cache} and not $options->{shared_cache} and not $options->{file_cache})
      100        
      66        
      100        
1411             or ($options->{double_cache})
1412             or ($options->{double_file_cache}));
1413             }
1414              
1415             # Caching subroutines - they handle getting and validating cache
1416             # records from either the in-memory or shared caches.
1417              
1418             # handles the normal in memory cache
1419 29     29   297 use vars qw( %CACHE );
  29         575  
  29         118587  
1420              
1421             sub _fetch_from_cache {
1422 14     14   23 my $self = shift;
1423 14         30 my $options = $self->{options};
1424              
1425             # return if there's no file here
1426 14         51 my $filepath = $self->_find_file($options->{filename});
1427 14 50       116 return unless (defined($filepath));
1428 14         120 $options->{filepath} = $filepath;
1429              
1430             # return if there's no cache entry for this key
1431 14         49 my $key = $self->_cache_key();
1432 14 100       56 return unless exists($CACHE{$key});
1433              
1434             # validate the cache
1435 7         86 my $mtime = $self->_mtime($filepath);
1436 7 100       112 if (defined $mtime) {
1437             # return if the mtime doesn't match the cache
1438 6 50 33     55 if (defined($CACHE{$key}{mtime})
1439             and ($mtime != $CACHE{$key}{mtime}))
1440             {
1441 0 0       0 $options->{cache_debug}
1442             and print STDERR "CACHE MISS : $filepath : $mtime\n";
1443 0         0 return;
1444             }
1445              
1446             # if the template has includes, check each included file's mtime
1447             # and return if different
1448 6 100       33 if (exists($CACHE{$key}{included_mtimes})) {
1449 1         3 foreach my $filename (keys %{$CACHE{$key}{included_mtimes}}) {
  1         6  
1450             next
1451 2 50       8 unless defined($CACHE{$key}{included_mtimes}{$filename});
1452              
1453 2         27 my $included_mtime = (stat($filename))[9];
1454 2 50       11 if ($included_mtime != $CACHE{$key}{included_mtimes}{$filename}) {
1455 0 0       0 $options->{cache_debug}
1456             and print STDERR
1457             "### HTML::Template Cache Debug ### CACHE MISS : $filepath : INCLUDE $filename : $included_mtime\n";
1458              
1459 0         0 return;
1460             }
1461             }
1462             }
1463             }
1464              
1465             # got a cache hit!
1466              
1467 7 100       33 $options->{cache_debug}
1468             and print STDERR "### HTML::Template Cache Debug ### CACHE HIT : $filepath => $key\n";
1469              
1470 7         28 $self->{param_map} = $CACHE{$key}{param_map};
1471 7         19 $self->{parse_stack} = $CACHE{$key}{parse_stack};
1472 7 100       31 exists($CACHE{$key}{included_mtimes})
1473             and $self->{included_mtimes} = $CACHE{$key}{included_mtimes};
1474              
1475             # clear out values from param_map from last run
1476 7         25 $self->_normalize_options();
1477 7         32 $self->clear_params();
1478             }
1479              
1480             sub _commit_to_cache {
1481 7     7   13 my $self = shift;
1482 7         136 my $options = $self->{options};
1483 7         31 my $key = $self->_cache_key();
1484 7         19 my $filepath = $options->{filepath};
1485              
1486 7 100       36 $options->{cache_debug}
1487             and print STDERR "### HTML::Template Cache Debug ### CACHE LOAD : $filepath => $key\n";
1488              
1489 7 100       46 $options->{blind_cache}
1490             or $CACHE{$key}{mtime} = $self->_mtime($filepath);
1491 7         27 $CACHE{$key}{param_map} = $self->{param_map};
1492 7         21 $CACHE{$key}{parse_stack} = $self->{parse_stack};
1493 7 100       38 exists($self->{included_mtimes})
1494             and $CACHE{$key}{included_mtimes} = $self->{included_mtimes};
1495             }
1496              
1497             # create a cache key from a template object. The cache key includes
1498             # the full path to the template and options which affect template
1499             # loading.
1500             sub _cache_key {
1501 45     45   70 my $self = shift;
1502 45         81 my $options = $self->{options};
1503              
1504             # assemble pieces of the key
1505 45         287 my @key = ($options->{filepath});
1506 45         60 push(@key, @{$options->{path}});
  45         204  
1507              
1508 45   100     221 push(@key, $options->{search_path_on_include} || 0);
1509 45   50     193 push(@key, $options->{loop_context_vars} || 0);
1510 45   100     180 push(@key, $options->{global_vars} || 0);
1511 45   100     170 push(@key, $options->{open_mode} || 0);
1512              
1513             # compute the md5 and return it
1514 45         381 return md5_hex(@key);
1515             }
1516              
1517             # generates MD5 from filepath to determine filename for cache file
1518             sub _get_cache_filename {
1519 24     24   48 my ($self, $filepath) = @_;
1520              
1521             # get a cache key
1522 24         61 $self->{options}{filepath} = $filepath;
1523 24         72 my $hash = $self->_cache_key();
1524              
1525             # ... and build a path out of it. Using the first two characters
1526             # gives us 255 buckets. This means you can have 255,000 templates
1527             # in the cache before any one directory gets over a few thousand
1528             # files in it. That's probably pretty good for this planet. If not
1529             # then it should be configurable.
1530 24 100       71 if (wantarray) {
1531 10         51 return (substr($hash, 0, 2), substr($hash, 2));
1532             } else {
1533 14         480 return File::Spec->join($self->{options}{file_cache_dir}, substr($hash, 0, 2), substr($hash, 2));
1534             }
1535             }
1536              
1537             # handles the file cache
1538             sub _fetch_from_file_cache {
1539 14     14   27 my $self = shift;
1540 14         33 my $options = $self->{options};
1541              
1542             # return if there's no cache entry for this filename
1543 14         61 my $filepath = $self->_find_file($options->{filename});
1544 14 50       57 return unless defined $filepath;
1545 14         61 my $cache_filename = $self->_get_cache_filename($filepath);
1546 14 100       750 return unless -e $cache_filename;
1547              
1548 4         10 eval { $self->{record} = Storable::lock_retrieve($cache_filename); };
  4         28  
1549 4 50       598 croak("HTML::Template::new() - Problem reading cache file $cache_filename (file_cache => 1) : $@")
1550             if $@;
1551 4 50       44 croak("HTML::Template::new() - Problem reading cache file $cache_filename (file_cache => 1) : $!")
1552             unless defined $self->{record};
1553              
1554 4         7 ($self->{mtime}, $self->{included_mtimes}, $self->{param_map}, $self->{parse_stack}) = @{$self->{record}};
  4         31  
1555              
1556 4         12 $options->{filepath} = $filepath;
1557              
1558             # validate the cache
1559 4         23 my $mtime = $self->_mtime($filepath);
1560 4 50       21 if (defined $mtime) {
1561             # return if the mtime doesn't match the cache
1562 4 50 33     38 if (defined($self->{mtime})
1563             and ($mtime != $self->{mtime}))
1564             {
1565 0 0       0 $options->{cache_debug}
1566             and print STDERR "### HTML::Template Cache Debug ### FILE CACHE MISS : $filepath : $mtime\n";
1567 0         0 ($self->{mtime}, $self->{included_mtimes}, $self->{param_map}, $self->{parse_stack}) = (undef, undef, undef, undef);
1568 0         0 return;
1569             }
1570              
1571             # if the template has includes, check each included file's mtime
1572             # and return if different
1573 4 50       17 if (exists($self->{included_mtimes})) {
1574 4         10 foreach my $filename (keys %{$self->{included_mtimes}}) {
  4         63  
1575             next
1576 0 0       0 unless defined($self->{included_mtimes}{$filename});
1577              
1578 0         0 my $included_mtime = (stat($filename))[9];
1579 0 0       0 if ($included_mtime != $self->{included_mtimes}{$filename}) {
1580 0 0       0 $options->{cache_debug}
1581             and print STDERR
1582             "### HTML::Template Cache Debug ### FILE CACHE MISS : $filepath : INCLUDE $filename : $included_mtime\n";
1583 0         0 ($self->{mtime}, $self->{included_mtimes}, $self->{param_map}, $self->{parse_stack}) =
1584             (undef, undef, undef, undef);
1585 0         0 return;
1586             }
1587             }
1588             }
1589             }
1590              
1591             # got a cache hit!
1592 4 100       26 $options->{cache_debug}
1593             and print STDERR "### HTML::Template Cache Debug ### FILE CACHE HIT : $filepath\n";
1594              
1595             # clear out values from param_map from last run
1596 4         27 $self->_normalize_options();
1597 4         20 $self->clear_params();
1598             }
1599              
1600             sub _commit_to_file_cache {
1601 10     10   28 my $self = shift;
1602 10         24 my $options = $self->{options};
1603              
1604 10         30 my $filepath = $options->{filepath};
1605 10 50       32 if (not defined $filepath) {
1606 0         0 $filepath = $self->_find_file($options->{filename});
1607 0 0       0 confess("HTML::Template->new() : Cannot open included file $options->{filename} : file not found.")
1608             unless defined($filepath);
1609 0         0 $options->{filepath} = $filepath;
1610             }
1611              
1612 10         36 my ($cache_dir, $cache_file) = $self->_get_cache_filename($filepath);
1613 10         137 $cache_dir = File::Spec->join($options->{file_cache_dir}, $cache_dir);
1614 10 50       381 if (not -d $cache_dir) {
1615 10 50       115 if (not -d $options->{file_cache_dir}) {
1616 0 0       0 mkdir($options->{file_cache_dir}, $options->{file_cache_dir_mode})
1617             or croak("HTML::Template->new() : can't mkdir $options->{file_cache_dir} (file_cache => 1): $!");
1618             }
1619 10 50       1296 mkdir($cache_dir, $options->{file_cache_dir_mode})
1620             or croak("HTML::Template->new() : can't mkdir $cache_dir (file_cache => 1): $!");
1621             }
1622              
1623 10 100       48 $options->{cache_debug}
1624             and print STDERR "### HTML::Template Cache Debug ### FILE CACHE LOAD : $options->{filepath}\n";
1625              
1626 10         25 my $result;
1627 10         20 eval {
1628 10         271 $result = Storable::lock_store([$self->{mtime}, $self->{included_mtimes}, $self->{param_map}, $self->{parse_stack}],
1629             scalar File::Spec->join($cache_dir, $cache_file));
1630             };
1631 10 50       55537 croak("HTML::Template::new() - Problem writing cache file $cache_dir/$cache_file (file_cache => 1) : $@") if $@;
1632 10 50       58 croak("HTML::Template::new() - Problem writing cache file $cache_dir/$cache_file (file_cache => 1) : $!")
1633             unless defined $result;
1634             }
1635              
1636             # Shared cache routines.
1637             sub _fetch_from_shared_cache {
1638 0     0   0 my $self = shift;
1639 0         0 my $options = $self->{options};
1640              
1641 0         0 my $filepath = $self->_find_file($options->{filename});
1642 0 0       0 return unless defined $filepath;
1643              
1644             # fetch from the shared cache.
1645 0         0 $self->{record} = $self->{cache}{$filepath};
1646              
1647 0 0       0 ($self->{mtime}, $self->{included_mtimes}, $self->{param_map}, $self->{parse_stack}) = @{$self->{record}}
  0         0  
1648             if defined($self->{record});
1649              
1650 0 0 0     0 $options->{cache_debug}
1651             and defined($self->{record})
1652             and print STDERR "### HTML::Template Cache Debug ### CACHE HIT : $filepath\n";
1653             # clear out values from param_map from last run
1654 0 0       0 $self->_normalize_options(), $self->clear_params()
1655             if (defined($self->{record}));
1656 0         0 delete($self->{record});
1657              
1658 0         0 return $self;
1659             }
1660              
1661             sub _validate_shared_cache {
1662 0     0   0 my ($self, $filename, $record) = @_;
1663 0         0 my $options = $self->{options};
1664              
1665 0 0       0 $options->{shared_cache_debug}
1666             and print STDERR "### HTML::Template Cache Debug ### SHARED CACHE VALIDATE : $filename\n";
1667              
1668 0 0       0 return 1 if $options->{blind_cache};
1669              
1670 0         0 my ($c_mtime, $included_mtimes, $param_map, $parse_stack) = @$record;
1671              
1672             # if the modification time has changed return false
1673 0         0 my $mtime = $self->_mtime($filename);
1674 0 0 0     0 if ( defined $mtime
      0        
1675             and defined $c_mtime
1676             and $mtime != $c_mtime)
1677             {
1678 0 0       0 $options->{cache_debug}
1679             and print STDERR "### HTML::Template Cache Debug ### SHARED CACHE MISS : $filename : $mtime\n";
1680 0         0 return 0;
1681             }
1682              
1683             # if the template has includes, check each included file's mtime
1684             # and return false if different
1685 0 0 0     0 if (defined $mtime and defined $included_mtimes) {
1686 0         0 foreach my $fname (keys %$included_mtimes) {
1687 0 0       0 next unless defined($included_mtimes->{$fname});
1688 0 0       0 if ($included_mtimes->{$fname} != (stat($fname))[9]) {
1689 0 0       0 $options->{cache_debug}
1690             and print STDERR "### HTML::Template Cache Debug ### SHARED CACHE MISS : $filename : INCLUDE $fname\n";
1691 0         0 return 0;
1692             }
1693             }
1694             }
1695              
1696             # all done - return true
1697 0         0 return 1;
1698             }
1699              
1700             sub _load_shared_cache {
1701 0     0   0 my ($self, $filename) = @_;
1702 0         0 my $options = $self->{options};
1703 0         0 my $cache = $self->{cache};
1704              
1705 0         0 $self->_init_template();
1706 0         0 $self->_parse();
1707              
1708 0 0       0 $options->{cache_debug}
1709             and print STDERR "### HTML::Template Cache Debug ### SHARED CACHE LOAD : $options->{filepath}\n";
1710              
1711 0 0       0 print STDERR "### HTML::Template Memory Debug ### END CACHE LOAD ", $self->{proc_mem}->size(), "\n"
1712             if $options->{memory_debug};
1713              
1714 0         0 return [$self->{mtime}, $self->{included_mtimes}, $self->{param_map}, $self->{parse_stack}];
1715             }
1716              
1717             # utility function - given a filename performs documented search and
1718             # returns a full path or undef if the file cannot be found.
1719             sub _find_file {
1720 185     185   550 my ($self, $filename, $extra_path) = @_;
1721 185         303 my $options = $self->{options};
1722 185         284 my $filepath;
1723              
1724             # first check for a full path
1725 185 100 66     1648 return File::Spec->canonpath($filename)
1726             if (File::Spec->file_name_is_absolute($filename) and (-e $filename));
1727              
1728             # try the extra_path if one was specified
1729 181 100       455 if (defined($extra_path)) {
1730 65         84 $extra_path->[$#{$extra_path}] = $filename;
  65         119  
1731 65         783 $filepath = File::Spec->canonpath(File::Spec->catfile(@$extra_path));
1732 65 100       1623 return File::Spec->canonpath($filepath) if -e $filepath;
1733             }
1734              
1735             # try pre-prending HTML_Template_Root
1736 140 100       464 if (defined($ENV{HTML_TEMPLATE_ROOT})) {
1737 4         57 $filepath = File::Spec->catfile($ENV{HTML_TEMPLATE_ROOT}, $filename);
1738 4 100       88 return File::Spec->canonpath($filepath) if -e $filepath;
1739             }
1740              
1741             # try "path" option list..
1742 139         331 foreach my $path (@{$options->{path}}) {
  139         370  
1743 119         2192 $filepath = File::Spec->catfile($path, $filename);
1744 119 100       3376 return File::Spec->canonpath($filepath) if -e $filepath;
1745             }
1746              
1747             # try even a relative path from the current directory...
1748 28 100       634 return File::Spec->canonpath($filename) if -e $filename;
1749              
1750             # try "path" option list with HTML_TEMPLATE_ROOT prepended...
1751 8 100       28 if (defined($ENV{HTML_TEMPLATE_ROOT})) {
1752 3         5 foreach my $path (@{$options->{path}}) {
  3         8  
1753 2         18 $filepath = File::Spec->catfile($ENV{HTML_TEMPLATE_ROOT}, $path, $filename);
1754 2 100       34 return File::Spec->canonpath($filepath) if -e $filepath;
1755             }
1756             }
1757              
1758 7         16 return undef;
1759             }
1760              
1761             # utility function - computes the mtime for $filename
1762             sub _mtime {
1763 114     114   225 my ($self, $filepath) = @_;
1764 114         210 my $options = $self->{options};
1765              
1766 114 100       463 return (undef) if ($options->{blind_cache});
1767              
1768             # make sure it still exists in the filesystem
1769 112 50       2493 (-r $filepath)
1770             or Carp::confess("HTML::Template : template file $filepath does not exist or is unreadable.");
1771              
1772             # get the modification time
1773 112         640 return (stat(_))[9];
1774             }
1775              
1776             # utility function - enforces new() options across LOOPs that have
1777             # come from a cache. Otherwise they would have stale options hashes.
1778             sub _normalize_options {
1779 11     11   23 my $self = shift;
1780 11         26 my $options = $self->{options};
1781              
1782 11         33 my @pstacks = ($self->{parse_stack});
1783 11         44 while (@pstacks) {
1784 11         24 my $pstack = pop(@pstacks);
1785 11         33 foreach my $item (@$pstack) {
1786 27 50       177 next unless (ref($item) eq 'HTML::Template::LOOP');
1787 0         0 foreach my $template (values %{$item->[HTML::Template::LOOP::TEMPLATE_HASH]}) {
  0         0  
1788             # must be the same list as the call to _new_from_loop...
1789 0         0 $template->{options}{debug} = $options->{debug};
1790 0         0 $template->{options}{stack_debug} = $options->{stack_debug};
1791 0         0 $template->{options}{die_on_bad_params} = $options->{die_on_bad_params};
1792 0         0 $template->{options}{case_sensitive} = $options->{case_sensitive};
1793 0         0 $template->{options}{parent_global_vars} = $options->{parent_global_vars};
1794              
1795 0         0 push(@pstacks, $template->{parse_stack});
1796             }
1797             }
1798             }
1799             }
1800              
1801             # initialize the template buffer
1802             sub _init_template {
1803 282     282   388 my $self = shift;
1804 282         629 my $options = $self->{options};
1805              
1806 282 50       708 print STDERR "### HTML::Template Memory Debug ### START INIT_TEMPLATE ", $self->{proc_mem}->size(), "\n"
1807             if $options->{memory_debug};
1808              
1809 282 100       983 if (exists($options->{filename})) {
    100          
    100          
    50          
1810 100         187 my $filepath = $options->{filepath};
1811 100 100       426 if (not defined $filepath) {
1812 84         479 $filepath = $self->_find_file($options->{filename});
1813 84 100       827 confess("HTML::Template->new() : Cannot open included file $options->{filename} : file not found.")
1814             unless defined($filepath);
1815             # we'll need this for future reference - to call stat() for example.
1816 81         206 $options->{filepath} = $filepath;
1817             }
1818              
1819             # use the open_mode if we have one
1820 97 100       269 if (my $mode = $options->{open_mode}) {
1821 6 50   3   334 open(TEMPLATE, $mode, $filepath)
  3         38  
  3         6  
  3         23  
1822             || confess("HTML::Template->new() : Cannot open included file $filepath with mode $mode: $!");
1823             } else {
1824 91 50       4868 open(TEMPLATE, $filepath)
1825             or confess("HTML::Template->new() : Cannot open included file $filepath : $!");
1826             }
1827              
1828 97         50101 $self->{mtime} = $self->_mtime($filepath);
1829              
1830             # read into scalar, note the mtime for the record
1831 97         258 $self->{template} = "";
1832 97         33192 while (read(TEMPLATE, $self->{template}, 10240, length($self->{template}))) { }
1833 97         2183 close(TEMPLATE);
1834              
1835             } elsif (exists($options->{scalarref})) {
1836             # copy in the template text
1837 176         225 $self->{template} = ${$options->{scalarref}};
  176         392  
1838              
1839 176         394 delete($options->{scalarref});
1840             } elsif (exists($options->{arrayref})) {
1841             # if we have an array ref, join and store the template text
1842 2         4 $self->{template} = join("", @{$options->{arrayref}});
  2         9  
1843              
1844 2         6 delete($options->{arrayref});
1845             } elsif (exists($options->{filehandle})) {
1846             # just read everything in in one go
1847 4         18 local $/ = undef;
1848 4         90 $self->{template} = readline($options->{filehandle});
1849              
1850 4         21 delete($options->{filehandle});
1851             } else {
1852 0         0 confess("HTML::Template : Need to call new with filename, filehandle, scalarref or arrayref parameter specified.");
1853             }
1854              
1855 279 50       731 print STDERR "### HTML::Template Memory Debug ### END INIT_TEMPLATE ", $self->{proc_mem}->size(), "\n"
1856             if $options->{memory_debug};
1857              
1858             # handle filters if necessary
1859 279 100       334 $self->_call_filters(\$self->{template}) if @{$options->{filter}};
  279         1201  
1860              
1861 279         461 return $self;
1862             }
1863              
1864             # handle calling user defined filters
1865             sub _call_filters {
1866 9     9   13 my $self = shift;
1867 9         12 my $template_ref = shift;
1868 9         14 my $options = $self->{options};
1869              
1870 9         11 my ($format, $sub);
1871 9         10 foreach my $filter (@{$options->{filter}}) {
  9         18  
1872 11 50       33 croak("HTML::Template->new() : bad value set for filter parameter - must be a code ref or a hash ref.")
1873             unless ref $filter;
1874              
1875             # translate into CODE->HASH
1876 11 100       29 $filter = {'format' => 'scalar', 'sub' => $filter}
1877             if (ref $filter eq 'CODE');
1878              
1879 11 50       25 if (ref $filter eq 'HASH') {
1880 11         17 $format = $filter->{'format'};
1881 11         13 $sub = $filter->{'sub'};
1882              
1883             # check types and values
1884 11 50 33     50 croak(
1885             "HTML::Template->new() : bad value set for filter parameter - hash must contain \"format\" key and \"sub\" key.")
1886             unless defined $format and defined $sub;
1887 11 50 66     43 croak("HTML::Template->new() : bad value set for filter parameter - \"format\" must be either 'array' or 'scalar'")
1888             unless $format eq 'array'
1889             or $format eq 'scalar';
1890 11 50 33     50 croak("HTML::Template->new() : bad value set for filter parameter - \"sub\" must be a code ref")
1891             unless ref $sub and ref $sub eq 'CODE';
1892              
1893             # catch errors
1894 11         14 eval {
1895 11 100       21 if ($format eq 'scalar')
1896             {
1897             # call
1898 8         24 $sub->($template_ref);
1899             } else {
1900             # modulate
1901 3         13 my @array = map { $_ . "\n" } split("\n", $$template_ref);
  15         31  
1902             # call
1903 3         13 $sub->(\@array);
1904             # demodulate
1905 3         54 $$template_ref = join("", @array);
1906             }
1907             };
1908 11 50       70 croak("HTML::Template->new() : fatal error occurred during filter call: $@") if $@;
1909             } else {
1910 0         0 croak("HTML::Template->new() : bad value set for filter parameter - must be code ref or hash ref");
1911             }
1912             }
1913             # all done
1914 9         20 return $template_ref;
1915             }
1916              
1917             # _parse sifts through a template building up the param_map and
1918             # parse_stack structures.
1919             #
1920             # The end result is a Template object that is fully ready for
1921             # output().
1922             sub _parse {
1923 279     279   485 my $self = shift;
1924 279         553 my $options = $self->{options};
1925              
1926 279 50       644 $options->{debug} and print STDERR "### HTML::Template Debug ### In _parse:\n";
1927              
1928             # setup the stacks and maps - they're accessed by typeglobs that
1929             # reference the top of the stack. They are masked so that a loop
1930             # can transparently have its own versions.
1931 29     29   1261 use vars qw(@pstack %pmap @ifstack @ucstack %top_pmap);
  29         62  
  29         6050  
1932 279         1605 local (*pstack, *ifstack, *pmap, *ucstack, *top_pmap);
1933              
1934             # the pstack is the array of scalar refs (plain text from the
1935             # template file), VARs, LOOPs, IFs and ELSEs that output() works on
1936             # to produce output. Looking at output() should make it clear what
1937             # _parse is trying to accomplish.
1938 279         713 my @pstacks = ([]);
1939 279         599 *pstack = $pstacks[0];
1940 279         576 $self->{parse_stack} = $pstacks[0];
1941              
1942             # the pmap binds names to VARs, LOOPs and IFs. It allows param() to
1943             # access the right variable. NOTE: output() does not look at the
1944             # pmap at all!
1945 279         518 my @pmaps = ({});
1946 279         390 *pmap = $pmaps[0];
1947 279         388 *top_pmap = $pmaps[0];
1948 279         2302 $self->{param_map} = $pmaps[0];
1949              
1950             # the ifstack is a temporary stack containing pending ifs and elses
1951             # waiting for a /if.
1952 279         504 my @ifstacks = ([]);
1953 279         387 *ifstack = $ifstacks[0];
1954              
1955             # the ucstack is a temporary stack containing conditions that need
1956             # to be bound to param_map entries when their block is finished.
1957             # This happens when a conditional is encountered before any other
1958             # reference to its NAME. Since a conditional can reference VARs and
1959             # LOOPs it isn't possible to make the link right away.
1960 279         968 my @ucstacks = ([]);
1961 279         375 *ucstack = $ucstacks[0];
1962              
1963             # the loopstack is another temp stack for closing loops. unlike
1964             # those above it doesn't get scoped inside loops, therefore it
1965             # doesn't need the typeglob magic.
1966 279         359 my @loopstack = ();
1967              
1968             # the fstack is a stack of filenames and counters that keeps track
1969             # of which file we're in and where we are in it. This allows
1970             # accurate error messages even inside included files!
1971             # fcounter, fmax and fname are aliases for the current file's info
1972 29     29   808 use vars qw($fcounter $fname $fmax);
  29         62  
  29         224547  
1973 279         980 local (*fcounter, *fname, *fmax);
1974              
1975 279   100     1065 my @fstack = ([$options->{filepath} || "/fake/path/for/non/file/template", 1, scalar @{[$self->{template} =~ m/(\n)/g]} + 1]);
  279         4198  
1976 279         644 (*fname, *fcounter, *fmax) = \(@{$fstack[0]});
  279         826  
1977              
1978 279         1071 my $NOOP = HTML::Template::NOOP->new();
1979 279         793 my $ESCAPE = HTML::Template::ESCAPE->new();
1980 279         929 my $JSESCAPE = HTML::Template::JSESCAPE->new();
1981 279         853 my $URLESCAPE = HTML::Template::URLESCAPE->new();
1982              
1983             # all the tags that need NAMEs:
1984 279         522 my %need_names = map { $_ => 1 } qw(TMPL_VAR TMPL_LOOP TMPL_IF TMPL_UNLESS TMPL_INCLUDE);
  1395         3759  
1985              
1986             # variables used below that don't need to be my'd in the loop
1987 279         515 my ($name, $which, $escape, $default);
1988              
1989             # handle the old vanguard format
1990 279 100       838 $options->{vanguard_compatibility_mode}
1991             and $self->{template} =~ s/%([-\w\/\.+]+)%//g;
1992              
1993             # now split up template on '<', leaving them in
1994 279         3083 my @chunks = split(m/(?=<)/, $self->{template});
1995              
1996             # all done with template
1997 279         649 delete $self->{template};
1998              
1999             # loop through chunks, filling up pstack
2000 279         497 my $last_chunk = $#chunks;
2001 279         832 CHUNK: for (my $chunk_number = 0 ; $chunk_number <= $last_chunk ; $chunk_number++) {
2002 1541 50       3453 next unless defined $chunks[$chunk_number];
2003 1541         2085 my $chunk = $chunks[$chunk_number];
2004              
2005             # a general regex to match any and all TMPL_* tags
2006 1541 100       13519 if (
2007             $chunk =~ /^<
2008             (?:!--\s*)?
2009             (
2010             \/?tmpl_
2011             (?:
2012             (?:var) | (?:loop) | (?:if) | (?:else) | (?:unless) | (?:include)
2013             )
2014             ) # $1 => $which - start of the tag
2015              
2016             \s*
2017              
2018             # DEFAULT attribute
2019             (?: default \s*=\s*
2020             (?:
2021             "([^">]*)" # $2 => double-quoted DEFAULT value "
2022             |
2023             '([^'>]*)' # $3 => single-quoted DEFAULT value
2024             |
2025             ([^\s=>]*) # $4 => unquoted DEFAULT value
2026             )
2027             )?
2028              
2029             \s*
2030              
2031             # ESCAPE attribute
2032             (?: escape \s*=\s*
2033             (?:
2034             (
2035             (?:["']?0["']?)|
2036             (?:["']?1["']?)|
2037             (?:["']?html["']?) |
2038             (?:["']?url["']?) |
2039             (?:["']?js["']?) |
2040             (?:["']?none["']?)
2041             ) # $5 => ESCAPE on
2042             )
2043             )* # allow multiple ESCAPEs
2044              
2045             \s*
2046              
2047             # DEFAULT attribute
2048             (?: default \s*=\s*
2049             (?:
2050             "([^">]*)" # $6 => double-quoted DEFAULT value "
2051             |
2052             '([^'>]*)' # $7 => single-quoted DEFAULT value
2053             |
2054             ([^\s=>]*) # $8 => unquoted DEFAULT value
2055             )
2056             )?
2057              
2058             \s*
2059              
2060             # NAME attribute
2061             (?:
2062             (?: name \s*=\s*)?
2063             (?:
2064             "([^">]*)" # $9 => double-quoted NAME value "
2065             |
2066             '([^'>]*)' # $10 => single-quoted NAME value
2067             |
2068             ([^\s=>]*) # $11 => unquoted NAME value
2069             )
2070             )?
2071            
2072             \s*
2073              
2074             # DEFAULT attribute
2075             (?: default \s*=\s*
2076             (?:
2077             "([^">]*)" # $12 => double-quoted DEFAULT value "
2078             |
2079             '([^'>]*)' # $13 => single-quoted DEFAULT value
2080             |
2081             ([^\s=>]*) # $14 => unquoted DEFAULT value
2082             )
2083             )?
2084              
2085             \s*
2086              
2087             # ESCAPE attribute
2088             (?: escape \s*=\s*
2089             (?:
2090             (
2091             (?:["']?0["']?)|
2092             (?:["']?1["']?)|
2093             (?:["']?html["']?) |
2094             (?:["']?url["']?) |
2095             (?:["']?js["']?) |
2096             (?:["']?none["']?)
2097             ) # $15 => ESCAPE on
2098             )
2099             )* # allow multiple ESCAPEs
2100              
2101             \s*
2102              
2103             # DEFAULT attribute
2104             (?: default \s*=\s*
2105             (?:
2106             "([^">]*)" # $16 => double-quoted DEFAULT value "
2107             |
2108             '([^'>]*)' # $17 => single-quoted DEFAULT value
2109             |
2110             ([^\s=>]*) # $18 => unquoted DEFAULT value
2111             )
2112             )?
2113              
2114             \s*
2115              
2116             (?:--)?\/?>
2117             (.*) # $19 => $post - text that comes after the tag
2118             $/isx
2119             )
2120             {
2121              
2122 750         1904 $which = uc($1); # which tag is it
2123              
2124 750 100 100     4319 $escape =
    100          
    100          
2125             defined $5 ? $5
2126             : defined $15 ? $15
2127             : (defined $options->{default_escape} && $which eq 'TMPL_VAR') ? $options->{default_escape}
2128             : 0; # escape set?
2129              
2130             # what name for the tag? undef for a /tag at most, one of the
2131             # following three will be defined
2132 750 50       3177 $name = defined $9 ? $9 : defined $10 ? $10 : defined $11 ? $11 : undef;
    100          
    100          
2133              
2134             # is there a default?
2135 750 100       7299 $default =
    50          
    100          
    100          
    100          
    100          
    50          
    50          
    100          
    100          
    50          
    50          
2136             defined $2 ? $2
2137             : defined $3 ? $3
2138             : defined $4 ? $4
2139             : defined $6 ? $6
2140             : defined $7 ? $7
2141             : defined $8 ? $8
2142             : defined $12 ? $12
2143             : defined $13 ? $13
2144             : defined $14 ? $14
2145             : defined $16 ? $16
2146             : defined $17 ? $17
2147             : defined $18 ? $18
2148             : undef;
2149              
2150 750         1422 my $post = $19; # what comes after on the line
2151              
2152             # allow mixed case in filenames, otherwise flatten
2153 750 100 66     5710 $name = lc($name)
      100        
2154             unless (not defined $name or $which eq 'TMPL_INCLUDE' or $options->{case_sensitive});
2155              
2156             # die if we need a name and didn't get one
2157 750 100 66     5534 die "HTML::Template->new() : No NAME given to a $which tag at $fname : line $fcounter."
      100        
2158             if ($need_names{$which} and (not defined $name or not length $name));
2159              
2160             # die if we got an escape but can't use one
2161 749 100 100     2628 die "HTML::Template->new() : ESCAPE option invalid in a $which tag at $fname : line $fcounter."
2162             if ($escape and ($which ne 'TMPL_VAR'));
2163              
2164             # die if we got a default but can't use one
2165 748 100 100     1964 die "HTML::Template->new() : DEFAULT option invalid in a $which tag at $fname : line $fcounter."
2166             if (defined $default and ($which ne 'TMPL_VAR'));
2167              
2168             # take actions depending on which tag found
2169 747 100 100     3595 if ($which eq 'TMPL_VAR') {
    100 100        
    100          
    100          
    100          
    100          
    50          
2170 363 50       840 print STDERR "### HTML::Template Debug ### $fname : line $fcounter : parsed VAR $name\n" if $options->{debug};
2171              
2172             # if we already have this var, then simply link to the existing
2173             # HTML::Template::VAR, else create a new one.
2174 363         408 my $var;
2175 363 100       786 if (exists $pmap{$name}) {
2176 32         56 $var = $pmap{$name};
2177 32 50 66     176 if( $options->{die_on_bad_params} && ref($var) ne 'HTML::Template::VAR') {
2178 0         0 die "HTML::Template->new() : Already used param name $name as a TMPL_LOOP, found in a TMPL_VAR at $fname : line $fcounter.";
2179             }
2180             } else {
2181 331         1012 $var = HTML::Template::VAR->new();
2182 331         841 $pmap{$name} = $var;
2183 331 100 100     1112 $top_pmap{$name} = HTML::Template::VAR->new()
2184             if $options->{global_vars} and not exists $top_pmap{$name};
2185             }
2186              
2187             # if a DEFAULT was provided, push a DEFAULT object on the
2188             # stack before the variable.
2189 363 100       747 if (defined $default) {
2190 43         137 push(@pstack, HTML::Template::DEFAULT->new($default));
2191             }
2192              
2193             # if ESCAPE was set, push an ESCAPE op on the stack before
2194             # the variable. output will handle the actual work.
2195             # unless of course, they have set escape=0 or escape=none
2196 363 100       710 if ($escape) {
2197 171 100       1132 if ($escape =~ /^["']?url["']?$/i) {
    100          
    100          
    100          
2198 39         88 push(@pstack, $URLESCAPE);
2199             } elsif ($escape =~ /^["']?js["']?$/i) {
2200 27         55 push(@pstack, $JSESCAPE);
2201             } elsif ($escape =~ /^["']?0["']?$/) {
2202             # do nothing if escape=0
2203             } elsif ($escape =~ /^["']?none["']?$/i) {
2204             # do nothing if escape=none
2205             } else {
2206 64         118 push(@pstack, $ESCAPE);
2207             }
2208             }
2209              
2210 363         861 push(@pstack, $var);
2211              
2212             } elsif ($which eq 'TMPL_LOOP') {
2213             # we've got a loop start
2214 86 50       236 print STDERR "### HTML::Template Debug ### $fname : line $fcounter : LOOP $name start\n" if $options->{debug};
2215              
2216             # if we already have this loop, then simply link to the existing
2217             # HTML::Template::LOOP, else create a new one.
2218 86         98 my $loop;
2219 86 100       207 if (exists $pmap{$name}) {
2220 14         24 $loop = $pmap{$name};
2221 14 50 33     75 if( $options->{die_on_bad_params} && ref($loop) ne 'HTML::Template::LOOP') {
2222 0         0 die "HTML::Template->new() : Already used param name $name as a TMPL_VAR, TMPL_IF or TMPL_UNLESS, found in a TMPL_LOOP at $fname : line $fcounter!";
2223             }
2224              
2225             } else {
2226             # store the results in a LOOP object - actually just a
2227             # thin wrapper around another HTML::Template object.
2228 72         288 $loop = HTML::Template::LOOP->new();
2229 72         206 $pmap{$name} = $loop;
2230             }
2231              
2232             # get it on the loopstack, pstack of the enclosing block
2233 86         191 push(@pstack, $loop);
2234 86         208 push(@loopstack, [$loop, $#pstack]);
2235              
2236             # magic time - push on a fresh pmap and pstack, adjust the typeglobs.
2237             # this gives the loop a separate namespace (i.e. pmap and pstack).
2238 86         151 push(@pstacks, []);
2239 86         162 *pstack = $pstacks[$#pstacks];
2240 86         157 push(@pmaps, {});
2241 86         140 *pmap = $pmaps[$#pmaps];
2242 86         143 push(@ifstacks, []);
2243 86         179 *ifstack = $ifstacks[$#ifstacks];
2244 86         269 push(@ucstacks, []);
2245 86         181 *ucstack = $ucstacks[$#ucstacks];
2246              
2247             # auto-vivify __FIRST__, __LAST__ and __INNER__ if
2248             # loop_context_vars is set. Otherwise, with
2249             # die_on_bad_params set output() will might cause errors
2250             # when it tries to set them.
2251 86 100       289 if ($options->{loop_context_vars}) {
2252 14         41 $pmap{__first__} = HTML::Template::VAR->new();
2253 14         37 $pmap{__inner__} = HTML::Template::VAR->new();
2254 14         35 $pmap{__outer__} = HTML::Template::VAR->new();
2255 14         31 $pmap{__last__} = HTML::Template::VAR->new();
2256 14         35 $pmap{__odd__} = HTML::Template::VAR->new();
2257 14         34 $pmap{__even__} = HTML::Template::VAR->new();
2258 14         31 $pmap{__counter__} = HTML::Template::VAR->new();
2259 14         40 $pmap{__index__} = HTML::Template::VAR->new();
2260             }
2261              
2262             } elsif ($which eq '/TMPL_LOOP') {
2263 86 50       213 $options->{debug}
2264             and print STDERR "### HTML::Template Debug ### $fname : line $fcounter : LOOP end\n";
2265              
2266 86         135 my $loopdata = pop(@loopstack);
2267 86 50       198 die "HTML::Template->new() : found with no matching at $fname : line $fcounter!"
2268             unless defined $loopdata;
2269              
2270 86         179 my ($loop, $starts_at) = @$loopdata;
2271              
2272             # resolve pending conditionals
2273 86         196 foreach my $uc (@ucstack) {
2274 15         33 my $var = $uc->[HTML::Template::COND::VARIABLE];
2275 15 100       42 if (exists($pmap{$var})) {
2276 11         24 $uc->[HTML::Template::COND::VARIABLE] = $pmap{$var};
2277             } else {
2278 4         19 $pmap{$var} = HTML::Template::VAR->new();
2279 4 100 66     25 $top_pmap{$var} = HTML::Template::VAR->new()
2280             if $options->{global_vars} and not exists $top_pmap{$var};
2281 4         11 $uc->[HTML::Template::COND::VARIABLE] = $pmap{$var};
2282             }
2283 15 50       53 if (ref($pmap{$var}) eq 'HTML::Template::VAR') {
2284 15         45 $uc->[HTML::Template::COND::VARIABLE_TYPE] = HTML::Template::COND::VARIABLE_TYPE_VAR;
2285             } else {
2286 0         0 $uc->[HTML::Template::COND::VARIABLE_TYPE] = HTML::Template::COND::VARIABLE_TYPE_LOOP;
2287             }
2288             }
2289              
2290             # get pmap and pstack for the loop, adjust the typeglobs to
2291             # the enclosing block.
2292 86         131 my $param_map = pop(@pmaps);
2293 86         161 *pmap = $pmaps[$#pmaps];
2294 86         126 my $parse_stack = pop(@pstacks);
2295 86         138 *pstack = $pstacks[$#pstacks];
2296              
2297 86 50       204 scalar(@ifstack)
2298             and die
2299             "HTML::Template->new() : Dangling or in loop ending at $fname : line $fcounter.";
2300 86         102 pop(@ifstacks);
2301 86         199 *ifstack = $ifstacks[$#ifstacks];
2302 86         135 pop(@ucstacks);
2303 86         152 *ucstack = $ucstacks[$#ucstacks];
2304              
2305             # instantiate the sub-Template, feeding it parse_stack and
2306             # param_map. This means that only the enclosing template
2307             # does _parse() - sub-templates get their parse_stack and
2308             # param_map fed to them already filled in.
2309 86   100     912 $loop->[HTML::Template::LOOP::TEMPLATE_HASH]{$starts_at} = ref($self)->_new_from_loop(
2310             parse_stack => $parse_stack,
2311             param_map => $param_map,
2312             debug => $options->{debug},
2313             die_on_bad_params => $options->{die_on_bad_params},
2314             loop_context_vars => $options->{loop_context_vars},
2315             case_sensitive => $options->{case_sensitive},
2316             force_untaint => $options->{force_untaint},
2317             parent_global_vars => ($options->{global_vars} || $options->{parent_global_vars} || 0)
2318             );
2319              
2320             # if this loop has been used multiple times we need to merge the "param_map" between them
2321             # all so that die_on_bad_params doesn't complain if we try to use different vars in
2322             # each instance of the same loop
2323 86 100       353 if ($options->{die_on_bad_params}) {
2324 67         108 my $loops = $loop->[HTML::Template::LOOP::TEMPLATE_HASH];
2325 67         286 my @loop_keys = sort { $a <=> $b } keys %$loops;
  19         254  
2326 67 100       257 if (@loop_keys > 1) {
2327 14         23 my $last_loop = pop(@loop_keys);
2328 14         29 foreach my $loop (@loop_keys) {
2329             # make sure all the params in the last loop are also in this loop
2330 18         22 foreach my $param (keys %{$loops->{$last_loop}->{param_map}}) {
  18         63  
2331 40 100       116 next if $loops->{$loop}->{param_map}->{$param};
2332 14         43 $loops->{$loop}->{param_map}->{$param} = $loops->{$last_loop}->{param_map}->{$param};
2333             }
2334             # make sure all the params in this loop are also in the last loop
2335 18         30 foreach my $param (keys %{$loops->{$loop}->{param_map}}) {
  18         46  
2336 48 100       159 next if $loops->{$last_loop}->{param_map}->{$param};
2337 8         26 $loops->{$last_loop}->{param_map}->{$param} = $loops->{$loop}->{param_map}->{$param};
2338             }
2339             }
2340             }
2341             }
2342              
2343             } elsif ($which eq 'TMPL_IF' or $which eq 'TMPL_UNLESS') {
2344 55 50       139 $options->{debug}
2345             and print STDERR "### HTML::Template Debug ### $fname : line $fcounter : $which $name start\n";
2346              
2347             # if we already have this var, then simply link to the existing
2348             # HTML::Template::VAR/LOOP, else defer the mapping
2349 55         62 my $var;
2350 55 100       137 if (exists $pmap{$name}) {
2351 13         23 $var = $pmap{$name};
2352             } else {
2353 42         76 $var = $name;
2354             }
2355              
2356             # connect the var to a conditional
2357 55         218 my $cond = HTML::Template::COND->new($var);
2358 55 100       147 if ($which eq 'TMPL_IF') {
2359 46         163 $cond->[HTML::Template::COND::WHICH] = HTML::Template::COND::WHICH_IF;
2360 46         108 $cond->[HTML::Template::COND::JUMP_IF_TRUE] = 0;
2361             } else {
2362 9         17 $cond->[HTML::Template::COND::WHICH] = HTML::Template::COND::WHICH_UNLESS;
2363 9         15 $cond->[HTML::Template::COND::JUMP_IF_TRUE] = 1;
2364             }
2365              
2366             # push unconnected conditionals onto the ucstack for
2367             # resolution later. Otherwise, save type information now.
2368 55 100       135 if ($var eq $name) {
2369 42         312 push(@ucstack, $cond);
2370             } else {
2371 13 50       32 if (ref($var) eq 'HTML::Template::VAR') {
2372 13         22 $cond->[HTML::Template::COND::VARIABLE_TYPE] = HTML::Template::COND::VARIABLE_TYPE_VAR;
2373             } else {
2374 0         0 $cond->[HTML::Template::COND::VARIABLE_TYPE] = HTML::Template::COND::VARIABLE_TYPE_LOOP;
2375             }
2376             }
2377              
2378             # push what we've got onto the stacks
2379 55         92 push(@pstack, $cond);
2380 55         100 push(@ifstack, $cond);
2381              
2382             } elsif ($which eq '/TMPL_IF' or $which eq '/TMPL_UNLESS') {
2383 54 50       297 $options->{debug}
2384             and print STDERR "### HTML::Template Debug ### $fname : line $fcounter : $which end\n";
2385              
2386 54         86 my $cond = pop(@ifstack);
2387 54 50       122 die "HTML::Template->new() : found with no matching at $fname : line $fcounter."
2388             unless defined $cond;
2389 54 100       196 if ($which eq '/TMPL_IF') {
2390 45 50       201 die
2391             "HTML::Template->new() : found incorrectly terminating a (use ) at $fname : line $fcounter.\n"
2392             if ($cond->[HTML::Template::COND::WHICH] == HTML::Template::COND::WHICH_UNLESS);
2393             } else {
2394 9 50       26 die
2395             "HTML::Template->new() : found incorrectly terminating a (use ) at $fname : line $fcounter.\n"
2396             if ($cond->[HTML::Template::COND::WHICH] == HTML::Template::COND::WHICH_IF);
2397             }
2398              
2399             # connect the matching to this "address" - place a NOOP to
2400             # hold the spot. This allows output() to treat an IF in the
2401             # assembler-esque "Conditional Jump" mode.
2402 54         99 push(@pstack, $NOOP);
2403 54         223 $cond->[HTML::Template::COND::JUMP_ADDRESS] = $#pstack;
2404              
2405             } elsif ($which eq 'TMPL_ELSE') {
2406 29 50       84 $options->{debug}
2407             and print STDERR "### HTML::Template Debug ### $fname : line $fcounter : ELSE\n";
2408              
2409 29         52 my $cond = pop(@ifstack);
2410 29 50       72 die
2411             "HTML::Template->new() : found with no matching or at $fname : line $fcounter."
2412             unless defined $cond;
2413 29 100       140 die
2414             "HTML::Template->new() : found second tag for or at $fname : line $fcounter."
2415             if $cond->[HTML::Template::COND::IS_ELSE];
2416              
2417 28         89 my $else = HTML::Template::COND->new($cond->[HTML::Template::COND::VARIABLE]);
2418 28         77 $else->[HTML::Template::COND::WHICH] = $cond->[HTML::Template::COND::WHICH];
2419 28         60 $else->[HTML::Template::COND::UNCONDITIONAL_JUMP] = 1;
2420 28         53 $else->[HTML::Template::COND::IS_ELSE] = 1;
2421              
2422             # need end-block resolution?
2423 28 100       66 if (defined($cond->[HTML::Template::COND::VARIABLE_TYPE])) {
2424 8         13 $else->[HTML::Template::COND::VARIABLE_TYPE] = $cond->[HTML::Template::COND::VARIABLE_TYPE];
2425             } else {
2426 20         36 push(@ucstack, $else);
2427             }
2428              
2429 28         44 push(@pstack, $else);
2430 28         43 push(@ifstack, $else);
2431              
2432             # connect the matching to this "address" - thus the if,
2433             # failing jumps to the ELSE address. The else then gets
2434             # elaborated, and of course succeeds. On the other hand, if
2435             # the IF fails and falls though, output will reach the else
2436             # and jump to the /if address.
2437 28         57 $cond->[HTML::Template::COND::JUMP_ADDRESS] = $#pstack;
2438              
2439             } elsif ($which eq 'TMPL_INCLUDE') {
2440             # handle TMPL_INCLUDEs
2441 74 50       155 $options->{debug}
2442             and print STDERR "### HTML::Template Debug ### $fname : line $fcounter : INCLUDE $name \n";
2443              
2444             # no includes here, bub
2445 74 100       507 $options->{no_includes}
2446             and croak("HTML::Template : Illegal attempt to use TMPL_INCLUDE in template file : (no_includes => 1)");
2447              
2448 73         94 my $filename = $name;
2449              
2450             # look for the included file...
2451 73         68 my $filepath;
2452 73 100       130 if ($options->{search_path_on_include}) {
2453 6         19 $filepath = $self->_find_file($filename);
2454             } else {
2455 67         548 $filepath = $self->_find_file($filename, [File::Spec->splitdir($fstack[-1][0])]);
2456             }
2457 73 100 100     316 die "HTML::Template->new() : Cannot open included file $filename : file not found."
2458             if !defined $filepath && $options->{die_on_missing_include};
2459              
2460 71         99 my $included_template = "";
2461 71 100       130 if( $filepath ) {
2462             # use the open_mode if we have one
2463 69 50       176 if (my $mode = $options->{open_mode}) {
2464 0 0       0 open(TEMPLATE, $mode, $filepath)
2465             || confess("HTML::Template->new() : Cannot open included file $filepath with mode $mode: $!");
2466             } else {
2467 69 50       2260 open(TEMPLATE, $filepath)
2468             or confess("HTML::Template->new() : Cannot open included file $filepath : $!");
2469             }
2470              
2471             # read into the array
2472 69         5251 while (read(TEMPLATE, $included_template, 10240, length($included_template))) { }
2473 69         737 close(TEMPLATE);
2474             }
2475              
2476             # call filters if necessary
2477 71 100       85 $self->_call_filters(\$included_template) if @{$options->{filter}};
  71         192  
2478              
2479 71 100       6094 if ($included_template) { # not empty
2480             # handle the old vanguard format - this needs to happen here
2481             # since we're not about to do a next CHUNKS.
2482 69 100       161 $options->{vanguard_compatibility_mode}
2483             and $included_template =~ s/%([-\w\/\.+]+)%//g;
2484              
2485             # collect mtimes for included files
2486 69 100 66     178 if ($options->{cache} and !$options->{blind_cache}) {
2487 6         100 $self->{included_mtimes}{$filepath} = (stat($filepath))[9];
2488             }
2489              
2490             # adjust the fstack to point to the included file info
2491 69         80 push(@fstack, [$filepath, 1, scalar @{[$included_template =~ m/(\n)/g]} + 1]);
  69         552  
2492 69         209 (*fname, *fcounter, *fmax) = \(@{$fstack[$#fstack]});
  69         199  
2493              
2494             # make sure we aren't infinitely recursing
2495 69 100 66     564 die
2496             "HTML::Template->new() : likely recursive includes - parsed $options->{max_includes} files deep and giving up (set max_includes higher to allow deeper recursion)."
2497             if ($options->{max_includes}
2498             and (scalar(@fstack) > $options->{max_includes}));
2499              
2500             # stick the remains of this chunk onto the bottom of the
2501             # included text.
2502 68         253 $included_template .= $post;
2503 68         132 $post = undef;
2504              
2505             # move the new chunks into place.
2506 68         744 splice(@chunks, $chunk_number, 1, split(m/(?=<)/, $included_template));
2507              
2508             # recalculate stopping point
2509 68         416 $last_chunk = $#chunks;
2510              
2511             # start in on the first line of the included text - nothing
2512             # else to do on this line.
2513 68         94 $chunk = $chunks[$chunk_number];
2514              
2515 68         141 redo CHUNK;
2516             }
2517             } else {
2518             # zuh!?
2519 0         0 die "HTML::Template->new() : Unknown or unmatched TMPL construct at $fname : line $fcounter.";
2520             }
2521             # push the rest after the tag
2522 674 50       1565 if (defined($post)) {
2523 674 100       2139 if (ref($pstack[$#pstack]) eq 'SCALAR') {
2524 2         3 ${$pstack[$#pstack]} .= $post;
  2         5  
2525             } else {
2526 672         1520 push(@pstack, \$post);
2527             }
2528             }
2529             } else { # just your ordinary markup
2530             # make sure we didn't reject something TMPL_* but badly formed
2531 791 100       2147 if ($options->{strict}) {
2532 786 100       3417 die "HTML::Template->new() : Syntax error in tag at $fname : $fcounter."
2533             if ($chunk =~ /<(?:!--\s*)?\/?tmpl_/i);
2534             }
2535              
2536             # push the rest and get next chunk
2537 790 50       1635 if (defined($chunk)) {
2538 790 100       2014 if (ref($pstack[$#pstack]) eq 'SCALAR') {
2539 688         767 ${$pstack[$#pstack]} .= $chunk;
  688         2722  
2540             } else {
2541 102         220 push(@pstack, \$chunk);
2542             }
2543             }
2544             }
2545             # count newlines in chunk and advance line count
2546 1464         2354 $fcounter += scalar(@{[$chunk =~ m/(\n)/g]});
  1464         6281  
2547             # if we just crossed the end of an included file
2548             # pop off the record and re-alias to the enclosing file's info
2549 1464 100       7578 pop(@fstack), (*fname, *fcounter, *fmax) = \(@{$fstack[$#fstack]})
  28         145  
2550             if ($fcounter > $fmax);
2551              
2552             } # next CHUNK
2553              
2554             # make sure we don't have dangling IF or LOOP blocks
2555 270 50       600 scalar(@ifstack)
2556             and die "HTML::Template->new() : At least one or not terminated at end of file!";
2557 270 50       576 scalar(@loopstack)
2558             and die "HTML::Template->new() : At least one not terminated at end of file!";
2559              
2560             # resolve pending conditionals
2561 270         592 foreach my $uc (@ucstack) {
2562 45         282 my $var = $uc->[HTML::Template::COND::VARIABLE];
2563 45 100       94 if (exists($pmap{$var})) {
2564 33         69 $uc->[HTML::Template::COND::VARIABLE] = $pmap{$var};
2565             } else {
2566 12         253 $pmap{$var} = HTML::Template::VAR->new();
2567 12 50 33     48 $top_pmap{$var} = HTML::Template::VAR->new()
2568             if $options->{global_vars} and not exists $top_pmap{$var};
2569 12         31 $uc->[HTML::Template::COND::VARIABLE] = $pmap{$var};
2570             }
2571 45 100       106 if (ref($pmap{$var}) eq 'HTML::Template::VAR') {
2572 23         59 $uc->[HTML::Template::COND::VARIABLE_TYPE] = HTML::Template::COND::VARIABLE_TYPE_VAR;
2573             } else {
2574 22         100 $uc->[HTML::Template::COND::VARIABLE_TYPE] = HTML::Template::COND::VARIABLE_TYPE_LOOP;
2575             }
2576             }
2577              
2578             # want a stack dump?
2579 270 50       656 if ($options->{stack_debug}) {
2580 0         0 require 'Data/Dumper.pm';
2581 0         0 print STDERR "### HTML::Template _param Stack Dump ###\n\n", Data::Dumper::Dumper($self->{parse_stack}), "\n";
2582             }
2583              
2584             # get rid of filters - they cause runtime errors if Storable tries
2585             # to store them. This can happen under global_vars.
2586 270         4051 delete $options->{filter};
2587             }
2588              
2589             # a recursive sub that associates each loop with the loops above
2590             # (treating the top-level as a loop)
2591             sub _globalize_vars {
2592 24     24   44 my $self = shift;
2593              
2594             # associate with the loop (and top-level templates) above in the tree.
2595 24         34 push(@{$self->{options}{associate}}, @_);
  24         60  
2596              
2597             # recurse down into the template tree, adding ourself to the end of
2598             # list.
2599 24         43 push(@_, $self);
2600 15         58 map { $_->_globalize_vars(@_) }
  15         54  
2601 15         22 map { values %{$_->[HTML::Template::LOOP::TEMPLATE_HASH]} }
  107         251  
2602 24         29 grep { ref($_) eq 'HTML::Template::LOOP' } @{$self->{parse_stack}};
  24         45  
2603             }
2604              
2605             # method used to recursively un-hook associate
2606             sub _unglobalize_vars {
2607 24     24   42 my $self = shift;
2608              
2609             # disassociate
2610 24         203 $self->{options}{associate} = undef;
2611              
2612             # recurse down into the template tree disassociating
2613 15         60 map { $_->_unglobalize_vars() }
  15         54  
2614 15         17 map { values %{$_->[HTML::Template::LOOP::TEMPLATE_HASH]} }
  107         237  
2615 24         39 grep { ref($_) eq 'HTML::Template::LOOP' } @{$self->{parse_stack}};
  24         41  
2616             }
2617              
2618             =head2 config
2619              
2620             A package method that is used to set/get the global default configuration options.
2621             For instance, if you want to set the C flag to always be on for every
2622             template loaded by this process you would do:
2623              
2624             HTML::Template->config(utf8 => 1);
2625              
2626             Or if you wanted to check if the C flag was on or not, you could do:
2627              
2628             my %config = HTML::Template->config;
2629             if( $config{utf8} ) {
2630             ...
2631             }
2632              
2633             Any configuration options that are valid for C are acceptable to be
2634             passed to this method.
2635              
2636             =cut
2637              
2638             sub config {
2639 6     6 1 4148 my ($pkg, %options) = @_;
2640              
2641 6         19 foreach my $opt (keys %options) {
2642 4 100 33     47 if( $opt eq 'associate' || $opt eq 'filter' || $opt eq 'path' ) {
      66        
2643 1         2 push(@{$OPTIONS{$opt}}, $options{$opt});
  1         4  
2644             } else {
2645 3         11 $OPTIONS{$opt} = $options{$opt};
2646             }
2647             }
2648              
2649 6         140 return %OPTIONS;
2650             }
2651              
2652             =head2 param
2653              
2654             C can be called in a number of ways
2655              
2656             =over
2657              
2658             =item 1 - To return a list of parameters in the template :
2659              
2660             my @parameter_names = $self->param();
2661              
2662             =item 2 - To return the value set to a param :
2663              
2664             my $value = $self->param('PARAM');
2665              
2666             =item 3 - To set the value of a parameter :
2667              
2668             # For simple TMPL_VARs:
2669             $self->param(PARAM => 'value');
2670              
2671             # with a subroutine reference that gets called to get the value
2672             # of the scalar. The sub will receive the template object as a
2673             # parameter.
2674             $self->param(PARAM => sub { return 'value' });
2675              
2676             # And TMPL_LOOPs:
2677             $self->param(LOOP_PARAM => [{PARAM => VALUE_FOR_FIRST_PASS}, {PARAM => VALUE_FOR_SECOND_PASS}]);
2678              
2679             =item 4 - To set the value of a number of parameters :
2680              
2681             # For simple TMPL_VARs:
2682             $self->param(
2683             PARAM => 'value',
2684             PARAM2 => 'value'
2685             );
2686              
2687             # And with some TMPL_LOOPs:
2688             $self->param(
2689             PARAM => 'value',
2690             PARAM2 => 'value',
2691             LOOP_PARAM => [{PARAM => VALUE_FOR_FIRST_PASS}, {PARAM => VALUE_FOR_SECOND_PASS}],
2692             ANOTHER_LOOP_PARAM => [{PARAM => VALUE_FOR_FIRST_PASS}, {PARAM => VALUE_FOR_SECOND_PASS}],
2693             );
2694              
2695             =item 5 - To set the value of a a number of parameters using a hash-ref :
2696              
2697             $self->param(
2698             {
2699             PARAM => 'value',
2700             PARAM2 => 'value',
2701             LOOP_PARAM => [{PARAM => VALUE_FOR_FIRST_PASS}, {PARAM => VALUE_FOR_SECOND_PASS}],
2702             ANOTHER_LOOP_PARAM => [{PARAM => VALUE_FOR_FIRST_PASS}, {PARAM => VALUE_FOR_SECOND_PASS}],
2703             }
2704             );
2705              
2706             An error occurs if you try to set a value that is tainted if the C
2707             option is set.
2708              
2709             =back
2710              
2711             =cut
2712              
2713             sub param {
2714 611     611 1 19589 my $self = shift;
2715 611         1453 my $options = $self->{options};
2716 611         848 my $param_map = $self->{param_map};
2717              
2718             # the no-parameter case - return list of parameters in the template.
2719 611 100       2004 return keys(%$param_map) unless scalar(@_);
2720              
2721 566         713 my $first = shift;
2722 566         964 my $type = ref $first;
2723              
2724             # the one-parameter case - could be a parameter value request or a
2725             # hash-ref.
2726 566 100 66     1678 if (!scalar(@_) and !length($type)) {
2727 121 100       291 my $param = $options->{case_sensitive} ? $first : lc $first;
2728              
2729             # check for parameter existence
2730 121 100 100     604 $options->{die_on_bad_params}
2731             and !exists($param_map->{$param})
2732             and croak(
2733             "HTML::Template : Attempt to get nonexistent parameter '$param' - this parameter name doesn't match any declarations in the template file : (die_on_bad_params set => 1)"
2734             );
2735              
2736 120 100 66     564 return undef unless (exists($param_map->{$param})
2737             and defined($param_map->{$param}));
2738              
2739 118 100       312 return ${$param_map->{$param}}
  107         512  
2740             if (ref($param_map->{$param}) eq 'HTML::Template::VAR');
2741 11         81 return $param_map->{$param}[HTML::Template::LOOP::PARAM_SET];
2742             }
2743              
2744 445 100       851 if (!scalar(@_)) {
2745 159 100 100     1384 croak("HTML::Template->param() : Single reference arg to param() must be a hash-ref! You gave me a $type.")
2746             unless $type eq 'HASH'
2747             or UNIVERSAL::isa($first, 'HASH');
2748 157         846 push(@_, %$first);
2749             } else {
2750 286         708 unshift(@_, $first);
2751             }
2752              
2753 443 100       1426 croak("HTML::Template->param() : You gave me an odd number of parameters to param()!")
2754             unless ((@_ % 2) == 0);
2755              
2756             # strangely, changing this to a "while(@_) { shift, shift }" type
2757             # loop causes perl 5.004_04 to die with some nonsense about a
2758             # read-only value.
2759 442         1411 for (my $x = 0 ; $x <= $#_ ; $x += 2) {
2760 1000 100       3364 my $param = $options->{case_sensitive} ? $_[$x] : lc $_[$x];
2761 1000         1428 my $value = $_[($x + 1)];
2762              
2763             # check that this param exists in the template
2764 1000 50 66     3603 $options->{die_on_bad_params}
2765             and !exists($param_map->{$param})
2766             and croak(
2767             "HTML::Template : Attempt to set nonexistent parameter '$param' - this parameter name doesn't match any declarations in the template file : (die_on_bad_params => 1)"
2768             );
2769              
2770             # if we're not going to die from bad param names, we need to ignore
2771             # them...
2772 1000 100       2382 unless (exists($param_map->{$param})) {
2773 45 100       213 next if not $options->{parent_global_vars};
2774              
2775             # ... unless global vars is on - in which case we can't be
2776             # sure we won't need it in a lower loop.
2777 4 100       11 if (ref($value) eq 'ARRAY') {
2778 1         5 $param_map->{$param} = HTML::Template::LOOP->new();
2779             } else {
2780 3         17 $param_map->{$param} = HTML::Template::VAR->new();
2781             }
2782             }
2783              
2784             # figure out what we've got, taking special care to allow for
2785             # objects that are compatible underneath.
2786 959   100     3090 my $type = ref $value || '';
2787 959 100 66     4342 if ($type eq 'REF') {
    100 66        
    100          
2788 1         132 croak("HTML::Template::param() : attempt to set parameter '$param' with a reference to a reference!");
2789             } elsif ($type && ($type eq 'ARRAY' || ($type !~ /^(CODE)|(HASH)|(SCALAR)$/ && $value->isa('ARRAY')))) {
2790 50 50       171 ref($param_map->{$param}) eq 'HTML::Template::LOOP'
2791             || croak(
2792             "HTML::Template::param() : attempt to set parameter '$param' with an array ref - parameter is not a TMPL_LOOP!");
2793 50         70 $param_map->{$param}[HTML::Template::LOOP::PARAM_SET] = [@{$value}];
  50         389  
2794             } elsif( $type eq 'CODE' ) {
2795             # code can be used for a var or a loop
2796 30 100       107 if( ref($param_map->{$param}) eq 'HTML::Template::LOOP' ) {
2797 11         79 $param_map->{$param}[HTML::Template::LOOP::PARAM_SET] = $value;
2798             } else {
2799 19         34 ${$param_map->{$param}} = $value;
  19         177  
2800             }
2801             } else {
2802 878 50       2308 ref($param_map->{$param}) eq 'HTML::Template::VAR'
2803             || croak(
2804             "HTML::Template::param() : attempt to set parameter '$param' with a scalar - parameter is not a TMPL_VAR!");
2805 878         945 ${$param_map->{$param}} = $value;
  878         4335  
2806             }
2807             }
2808             }
2809              
2810             =head2 clear_params
2811              
2812             Sets all the parameters to undef. Useful internally, if nowhere else!
2813              
2814             =cut
2815              
2816             sub clear_params {
2817 166     166 1 235 my $self = shift;
2818 166         199 my $type;
2819 166         277 foreach my $name (keys %{$self->{param_map}}) {
  166         16267  
2820 723         1296 $type = ref($self->{param_map}{$name});
2821 723 100       2041 undef(${$self->{param_map}{$name}})
  710         1780  
2822             if ($type eq 'HTML::Template::VAR');
2823 723 100       7808 undef($self->{param_map}{$name}[HTML::Template::LOOP::PARAM_SET])
2824             if ($type eq 'HTML::Template::LOOP');
2825             }
2826             }
2827              
2828             # obsolete implementation of associate
2829             sub associateCGI {
2830 2     2 0 6559 my $self = shift;
2831 2         5 my $cgi = shift;
2832 2 100       178 (ref($cgi) eq 'CGI')
2833             or croak("Warning! non-CGI object was passed to HTML::Template::associateCGI()!\n");
2834 1         1 push(@{$self->{options}{associate}}, $cgi);
  1         5  
2835 1         3 return 1;
2836             }
2837              
2838             =head2 output
2839              
2840             C returns the final result of the template. In most situations
2841             you'll want to print this, like:
2842              
2843             print $template->output();
2844              
2845             When output is called each occurrence of C<< >> is
2846             replaced with the value assigned to "name" via C. If a named
2847             parameter is unset it is simply replaced with ''. C<< >>s
2848             are evaluated once per parameter set, accumulating output on each pass.
2849              
2850             Calling C is guaranteed not to change the state of the
2851             HTML::Template object, in case you were wondering. This property is
2852             mostly important for the internal implementation of loops.
2853              
2854             You may optionally supply a filehandle to print to automatically as the
2855             template is generated. This may improve performance and lower memory
2856             consumption. Example:
2857              
2858             $template->output(print_to => *STDOUT);
2859              
2860             The return value is undefined when using the C option.
2861              
2862             =cut
2863              
2864 29     29   339 use vars qw(%URLESCAPE_MAP);
  29         65  
  29         12368  
2865              
2866             sub output {
2867 624     624 1 103736 my $self = shift;
2868 624         1117 my $options = $self->{options};
2869 624         1023 local $_;
2870              
2871 624 50       1577 croak("HTML::Template->output() : You gave me an odd number of parameters to output()!")
2872             unless ((@_ % 2) == 0);
2873 624         1104 my %args = @_;
2874              
2875 624 50       1991 print STDERR "### HTML::Template Memory Debug ### START OUTPUT ", $self->{proc_mem}->size(), "\n"
2876             if $options->{memory_debug};
2877              
2878 624 50       1284 $options->{debug} and print STDERR "### HTML::Template Debug ### In output\n";
2879              
2880             # want a stack dump?
2881 624 50       1413 if ($options->{stack_debug}) {
2882 0         0 require 'Data/Dumper.pm';
2883 0         0 print STDERR "### HTML::Template output Stack Dump ###\n\n", Data::Dumper::Dumper($self->{parse_stack}), "\n";
2884             }
2885              
2886             # globalize vars - this happens here to localize the circular
2887             # references created by global_vars.
2888 624 100       1272 $self->_globalize_vars() if ($options->{global_vars});
2889              
2890             # support the associate magic, searching for undefined params and
2891             # attempting to fill them from the associated objects.
2892 624 100       1070 if (scalar(@{$options->{associate}})) {
  624         1914  
2893             # prepare case-mapping hashes to do case-insensitive matching
2894             # against associated objects. This allows CGI.pm to be
2895             # case-sensitive and still work with associate.
2896 29         36 my (%case_map, $lparam);
2897 29         33 foreach my $associated_object (@{$options->{associate}}) {
  29         64  
2898             # what a hack! This should really be optimized out for case_sensitive.
2899 44 50       98 if ($options->{case_sensitive}) {
2900 0         0 map { $case_map{$associated_object}{$_} = $_ } $associated_object->param();
  0         0  
2901             } else {
2902 44         94 map { $case_map{$associated_object}{lc($_)} = $_ } $associated_object->param();
  129         512  
2903             }
2904             }
2905              
2906 29         45 foreach my $param (keys %{$self->{param_map}}) {
  29         86  
2907 70 100       153 unless (defined($self->param($param))) {
2908 35         192 OBJ: foreach my $associated_object (reverse @{$options->{associate}}) {
  35         66  
2909 45 100       223 $self->param($param, scalar $associated_object->param($case_map{$associated_object}{$param})), last OBJ
2910             if (exists($case_map{$associated_object}{$param}));
2911             }
2912             }
2913             }
2914             }
2915              
2916 29     29   175 use vars qw($line @parse_stack);
  29         140  
  29         116438  
2917 624         2122 local (*line, *parse_stack);
2918              
2919             # walk the parse stack, accumulating output in $result
2920 624         1137 *parse_stack = $self->{parse_stack};
2921 624         858 my $result = '';
2922              
2923             tie $result, 'HTML::Template::PRINTSCALAR', $args{print_to}
2924 624 100 66     1817 if defined $args{print_to} && !eval { tied *{$args{print_to}} };
  1         2  
  1         12  
2925              
2926 624         817 my $type;
2927 624         1197 my $parse_stack_length = $#parse_stack;
2928 624         3626 for (my $x = 0 ; $x <= $parse_stack_length ; $x++) {
2929 2431         4546 *line = \$parse_stack[$x];
2930 2431         4385 $type = ref($line);
2931              
2932 2431 100 100     9484 if ($type eq 'SCALAR') {
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    50          
2933 1333         6577 $result .= $$line;
2934             } elsif ($type eq 'HTML::Template::VAR' and ref($$line) eq 'CODE') {
2935 15 50       66 if (defined($$line)) {
2936 15         48 my $tmp_val = $$line->($self);
2937 15 100 66     229 croak("HTML::Template->output() : 'force_untaint' option but coderef returns tainted value")
2938             if $options->{force_untaint} && tainted($tmp_val);
2939 14         32 $result .= $tmp_val;
2940              
2941             # change the reference to point to the value now not the code reference
2942 14 100       65 $$line = $tmp_val if $options->{cache_lazy_vars}
2943             }
2944             } elsif ($type eq 'HTML::Template::VAR') {
2945 293 100       644 if (defined $$line) {
2946 287 100 66     767 if ($options->{force_untaint} && tainted($$line)) {
2947 1         188 croak("HTML::Template->output() : tainted value with 'force_untaint' option");
2948             }
2949 286         936 $result .= $$line;
2950             }
2951             } elsif ($type eq 'HTML::Template::LOOP') {
2952 73 100       339 if (defined($line->[HTML::Template::LOOP::PARAM_SET])) {
2953 66         99 eval { $result .= $line->output($x, $options->{loop_context_vars}); };
  66         243  
2954 66 50       3630 croak("HTML::Template->output() : fatal error in loop output : $@")
2955             if $@;
2956             }
2957             } elsif ($type eq 'HTML::Template::COND') {
2958              
2959 436 100       974 if ($line->[HTML::Template::COND::UNCONDITIONAL_JUMP]) {
2960 139         368 $x = $line->[HTML::Template::COND::JUMP_ADDRESS];
2961             } else {
2962 297 100       593 if ($line->[HTML::Template::COND::JUMP_IF_TRUE]) {
2963 14 50       30 if ($line->[HTML::Template::COND::VARIABLE_TYPE] == HTML::Template::COND::VARIABLE_TYPE_VAR) {
2964 14 100       16 if (defined ${$line->[HTML::Template::COND::VARIABLE]}) {
  14         41  
2965 13 100       17 if (ref(${$line->[HTML::Template::COND::VARIABLE]}) eq 'CODE') {
  13         38  
2966 3         7 my $tmp_val = ${$line->[HTML::Template::COND::VARIABLE]}->($self);
  3         10  
2967 3 100       16 $x = $line->[HTML::Template::COND::JUMP_ADDRESS] if $tmp_val;
2968 3 50       20 ${$line->[HTML::Template::COND::VARIABLE]} = $tmp_val if $options->{cache_lazy_vars};
  0         0  
2969             } else {
2970 10 100       14 $x = $line->[HTML::Template::COND::JUMP_ADDRESS] if ${$line->[HTML::Template::COND::VARIABLE]};
  10         42  
2971             }
2972             }
2973             } else {
2974             # if it's a code reference, execute it to get the values
2975 0         0 my $loop_values = $line->[HTML::Template::COND::VARIABLE][HTML::Template::LOOP::PARAM_SET];
2976 0 0 0     0 if (defined $loop_values && ref $loop_values eq 'CODE') {
2977 0         0 $loop_values = $loop_values->($self);
2978 0 0       0 $line->[HTML::Template::COND::VARIABLE][HTML::Template::LOOP::PARAM_SET] = $loop_values
2979             if $options->{cache_lazy_loops};
2980             }
2981              
2982             # if we have anything for the loop, jump to the next part
2983 0 0 0     0 if (defined $loop_values && @$loop_values) {
2984 0         0 $x = $line->[HTML::Template::COND::JUMP_ADDRESS];
2985             }
2986             }
2987             } else {
2988 283 100       515 if ($line->[HTML::Template::COND::VARIABLE_TYPE] == HTML::Template::COND::VARIABLE_TYPE_VAR) {
2989 272 100       277 if (defined ${$line->[HTML::Template::COND::VARIABLE]}) {
  272         608  
2990 262 100       279 if (ref(${$line->[HTML::Template::COND::VARIABLE]}) eq 'CODE') {
  262         628  
2991 205         291 my $tmp_val = ${$line->[HTML::Template::COND::VARIABLE]}->($self);
  205         487  
2992 205 100       1087 $x = $line->[HTML::Template::COND::JUMP_ADDRESS] unless $tmp_val;
2993 205 100       1123 ${$line->[HTML::Template::COND::VARIABLE]} = $tmp_val if $options->{cache_lazy_vars};
  2         13  
2994             } else {
2995 57         266 $x = $line->[HTML::Template::COND::JUMP_ADDRESS]
2996 57 100       63 unless ${$line->[HTML::Template::COND::VARIABLE]};
2997             }
2998             } else {
2999 10         34 $x = $line->[HTML::Template::COND::JUMP_ADDRESS];
3000             }
3001             } else {
3002             # if we don't have anything for the loop, jump to the next part
3003 11         23 my $loop_values = $line->[HTML::Template::COND::VARIABLE][HTML::Template::LOOP::PARAM_SET];
3004 11 100       27 if(!defined $loop_values) {
3005 1         4 $x = $line->[HTML::Template::COND::JUMP_ADDRESS];
3006             } else {
3007             # check to see if the loop is a code ref and if it is execute it to get the values
3008 10 100       38 if( ref $loop_values eq 'CODE' ) {
3009 6         22 $loop_values = $line->[HTML::Template::COND::VARIABLE][HTML::Template::LOOP::PARAM_SET]->($self);
3010 6 100       106 $line->[HTML::Template::COND::VARIABLE][HTML::Template::LOOP::PARAM_SET] = $loop_values
3011             if $options->{cache_lazy_loops};
3012             }
3013              
3014             # if we don't have anything in the loop, jump to the next part
3015 10 100       48 if(!@$loop_values) {
3016 3         14 $x = $line->[HTML::Template::COND::JUMP_ADDRESS];
3017             }
3018             }
3019             }
3020             }
3021             }
3022             } elsif ($type eq 'HTML::Template::NOOP') {
3023 145         352 next;
3024             } elsif ($type eq 'HTML::Template::DEFAULT') {
3025 43         59 $_ = $x; # remember default place in stack
3026              
3027             # find next VAR, there might be an ESCAPE in the way
3028 43         72 *line = \$parse_stack[++$x];
3029 43 100 100     226 *line = \$parse_stack[++$x]
      100        
3030             if ref $line eq 'HTML::Template::ESCAPE'
3031             or ref $line eq 'HTML::Template::JSESCAPE'
3032             or ref $line eq 'HTML::Template::URLESCAPE';
3033              
3034             # either output the default or go back
3035 43 100       91 if (defined $$line) {
3036 13         18 $x = $_;
3037             } else {
3038 30         36 $result .= ${$parse_stack[$_]};
  30         74  
3039             }
3040 43         114 next;
3041             } elsif ($type eq 'HTML::Template::ESCAPE') {
3042 37         66 *line = \$parse_stack[++$x];
3043 37 100       89 if (defined($$line)) {
3044 34         39 my $tmp_val;
3045 34 100       89 if (ref($$line) eq 'CODE') {
3046 2         5 $tmp_val = $$line->($self);
3047 2 50 33     23 if ($options->{force_untaint} > 1 && tainted($_)) {
3048 0         0 croak("HTML::Template->output() : 'force_untaint' option but coderef returns tainted value");
3049             }
3050              
3051 2 50       6 $$line = $tmp_val if $options->{cache_lazy_vars};
3052             } else {
3053 32         49 $tmp_val = $$line;
3054 32 50 33     178 if ($options->{force_untaint} > 1 && tainted($_)) {
3055 0         0 croak("HTML::Template->output() : tainted value with 'force_untaint' option");
3056             }
3057             }
3058              
3059             # straight from the CGI.pm bible.
3060 34         67 $tmp_val =~ s/&/&/g;
3061 34         61 $tmp_val =~ s/\"/"/g;
3062 34         122 $tmp_val =~ s/>/>/g;
3063 34         89 $tmp_val =~ s/
3064 34         61 $tmp_val =~ s/'/'/g;
3065              
3066 34         74 $result .= $tmp_val;
3067             }
3068 37         100 next;
3069             } elsif ($type eq 'HTML::Template::JSESCAPE') {
3070 27         30 $x++;
3071 27         42 *line = \$parse_stack[$x];
3072 27 50       64 if (defined($$line)) {
3073 27         33 my $tmp_val;
3074 27 100       57 if (ref($$line) eq 'CODE') {
3075 2         5 $tmp_val = $$line->($self);
3076 2 50 33     13 if ($options->{force_untaint} > 1 && tainted($_)) {
3077 0         0 croak("HTML::Template->output() : 'force_untaint' option but coderef returns tainted value");
3078             }
3079 2 50       6 $$line = $tmp_val if $options->{cache_lazy_vars};
3080             } else {
3081 25         33 $tmp_val = $$line;
3082 25 50 33     75 if ($options->{force_untaint} > 1 && tainted($_)) {
3083 0         0 croak("HTML::Template->output() : tainted value with 'force_untaint' option");
3084             }
3085             }
3086 27         81 $tmp_val =~ s/\\/\\\\/g;
3087 27         60 $tmp_val =~ s/'/\\'/g;
3088 27         36 $tmp_val =~ s/"/\\"/g;
3089 27         57 $tmp_val =~ s/[\n\x{2028}]/\\n/g;
3090 27         67 $tmp_val =~ s/\x{2029}/\\n\\n/g;
3091 27         38 $tmp_val =~ s/\r/\\r/g;
3092 27         102 $result .= $tmp_val;
3093             }
3094             } elsif ($type eq 'HTML::Template::URLESCAPE') {
3095 29         36 $x++;
3096 29         50 *line = \$parse_stack[$x];
3097 29 100       73 if (defined($$line)) {
3098 28         32 my $tmp_val;
3099 28 100       5534 if (ref($$line) eq 'CODE') {
3100 2         6 $tmp_val = $$line->($self);
3101 2 50 33     12 if ($options->{force_untaint} > 1 && tainted($_)) {
3102 0         0 croak("HTML::Template->output() : 'force_untaint' option but coderef returns tainted value");
3103             }
3104 2 50       6 $$line = $tmp_val if $options->{cache_lazy_vars};
3105             } else {
3106 26         40 $tmp_val = $$line;
3107 26 50 33     80 if ($options->{force_untaint} > 1 && tainted($_)) {
3108 0         0 croak("HTML::Template->output() : tainted value with 'force_untaint' option");
3109             }
3110             }
3111             # Build a char->hex map if one isn't already available
3112 28 100       69 unless (exists($URLESCAPE_MAP{chr(1)})) {
3113 3         12 for (0 .. 255) { $URLESCAPE_MAP{chr($_)} = sprintf('%%%02X', $_); }
  768         2225  
3114             }
3115             # do the translation (RFC 2396 ^uric)
3116 28         340 $tmp_val =~ s!([^a-zA-Z0-9_.\-])!$URLESCAPE_MAP{$1}!g;
3117 28         115 $result .= $tmp_val;
3118             }
3119             } else {
3120 0         0 confess("HTML::Template::output() : Unknown item in parse_stack : " . $type);
3121             }
3122             }
3123              
3124             # undo the globalization circular refs
3125 622 100       1661 $self->_unglobalize_vars() if ($options->{global_vars});
3126              
3127 622 50       1571 print STDERR "### HTML::Template Memory Debug ### END OUTPUT ", $self->{proc_mem}->size(), "\n"
3128             if $options->{memory_debug};
3129              
3130 622 100       1730 return undef if defined $args{print_to};
3131 621         3171 return $result;
3132             }
3133              
3134             =head2 query
3135              
3136             This method allow you to get information about the template structure.
3137             It can be called in a number of ways. The simplest usage of query is
3138             simply to check whether a parameter name exists in the template, using
3139             the C option:
3140              
3141             if ($template->query(name => 'foo')) {
3142             # do something if a variable of any type named FOO is in the template
3143             }
3144              
3145             This same usage returns the type of the parameter. The type is the same
3146             as the tag minus the leading 'TMPL_'. So, for example, a C
3147             parameter returns 'VAR' from C.
3148              
3149             if ($template->query(name => 'foo') eq 'VAR') {
3150             # do something if FOO exists and is a TMPL_VAR
3151             }
3152              
3153             Note that the variables associated with Cs and Cs
3154             will be identified as 'VAR' unless they are also used in a C,
3155             in which case they will return 'LOOP'.
3156              
3157             C also allows you to get a list of parameters inside a loop
3158             (and inside loops inside loops). Example loop:
3159              
3160            
3161            
3162            
3163            
3164            
3165            
3166            
3167            
3168              
3169             And some query calls:
3170            
3171             # returns 'LOOP'
3172             $type = $template->query(name => 'EXAMPLE_LOOP');
3173              
3174             # returns ('bop', 'bee', 'example_inner_loop')
3175             @param_names = $template->query(loop => 'EXAMPLE_LOOP');
3176              
3177             # both return 'VAR'
3178             $type = $template->query(name => ['EXAMPLE_LOOP', 'BEE']);
3179             $type = $template->query(name => ['EXAMPLE_LOOP', 'BOP']);
3180              
3181             # and this one returns 'LOOP'
3182             $type = $template->query(name => ['EXAMPLE_LOOP', 'EXAMPLE_INNER_LOOP']);
3183              
3184             # and finally, this returns ('inner_bee', 'inner_bop')
3185             @inner_param_names = $template->query(loop => ['EXAMPLE_LOOP', 'EXAMPLE_INNER_LOOP']);
3186              
3187             # for non existent parameter names you get undef this returns undef.
3188             $type = $template->query(name => 'DWEAZLE_ZAPPA');
3189              
3190             # calling loop on a non-loop parameter name will cause an error. This dies:
3191             $type = $template->query(loop => 'DWEAZLE_ZAPPA');
3192              
3193             As you can see above the C option returns a list of parameter
3194             names and both C and C take array refs in order to refer to
3195             parameters inside loops. It is an error to use C with a parameter
3196             that is not a loop.
3197              
3198             Note that all the names are returned in lowercase and the types are
3199             uppercase.
3200              
3201             Just like C, C with no arguments returns all the
3202             parameter names in the template at the top level.
3203              
3204             =cut
3205              
3206             sub query {
3207 24     24 1 5814 my $self = shift;
3208 24 50       88 $self->{options}{debug}
3209             and print STDERR "### HTML::Template Debug ### query(", join(', ', @_), ")\n";
3210              
3211             # the no-parameter case - return $self->param()
3212 24 100       59 return $self->param() unless scalar(@_);
3213              
3214 22 50       121 croak("HTML::Template::query() : Odd number of parameters passed to query!")
3215             if (scalar(@_) % 2);
3216 22 50       61 croak("HTML::Template::query() : Wrong number of parameters passed to query - should be 2.")
3217             if (scalar(@_) != 2);
3218              
3219 22         53 my ($opt, $path) = (lc shift, shift);
3220 22 50 66     89 croak("HTML::Template::query() : invalid parameter ($opt)")
3221             unless ($opt eq 'name' or $opt eq 'loop');
3222              
3223             # make path an array unless it already is
3224 22 100       73 $path = [$path] unless (ref $path);
3225              
3226             # find the param in question.
3227 22         66 my @objs = $self->_find_param(@$path);
3228 22 100       92 return undef unless scalar(@objs);
3229 21         29 my ($obj, $type);
3230              
3231             # do what the user asked with the object
3232 21 100       69 if ($opt eq 'name') {
    50          
3233             # we only look at the first one. new() should make sure they're
3234             # all the same.
3235 13         29 ($obj, $type) = (shift(@objs), shift(@objs));
3236 13 50       33 return undef unless defined $obj;
3237 13 100       67 return 'VAR' if $type eq 'HTML::Template::VAR';
3238 6 50       363 return 'LOOP' if $type eq 'HTML::Template::LOOP';
3239 0         0 croak("HTML::Template::query() : unknown object ($type) in param_map!");
3240              
3241             } elsif ($opt eq 'loop') {
3242 8         9 my %results;
3243 8         36 while (@objs) {
3244 12         31 ($obj, $type) = (shift(@objs), shift(@objs));
3245 12 100 66     482 croak(
3246             "HTML::Template::query() : Search path [",
3247             join(', ', @$path),
3248             "] doesn't end in a TMPL_LOOP - it is an error to use the 'loop' option on a non-loop parameter. To avoid this problem you can use the 'name' option to query() to check the type first."
3249             ) unless ((defined $obj) and ($type eq 'HTML::Template::LOOP'));
3250              
3251             # SHAZAM! This bit extracts all the parameter names from all the
3252             # loop objects for this name.
3253 32         76 map { $results{$_} = 1 }
  15         55  
3254 10         15 map { keys(%{$_->{'param_map'}}) } values(%{$obj->[HTML::Template::LOOP::TEMPLATE_HASH]});
  15         19  
  10         27  
3255             }
3256             # this is our loop list, return it.
3257 6         65 return keys(%results);
3258             }
3259             }
3260              
3261             # a function that returns the object(s) corresponding to a given path and
3262             # its (their) ref()(s). Used by query() in the obvious way.
3263             sub _find_param {
3264 61     61   74 my $self = shift;
3265 61 50       167 my $spot = $self->{options}{case_sensitive} ? shift : lc shift;
3266              
3267             # get the obj and type for this spot
3268 61         111 my $obj = $self->{'param_map'}{$spot};
3269 61 100       122 return unless defined $obj;
3270 57         86 my $type = ref $obj;
3271              
3272             # return if we're here or if we're not but this isn't a loop
3273 57 100       204 return ($obj, $type) unless @_;
3274 21 50       50 return unless ($type eq 'HTML::Template::LOOP');
3275              
3276             # recurse. this is a depth first search on the template tree, for
3277             # the algorithm geeks in the audience.
3278 21         27 return map { $_->_find_param(@_) } values(%{$obj->[HTML::Template::LOOP::TEMPLATE_HASH]});
  39         99  
  21         55  
3279             }
3280              
3281             # HTML::Template::VAR, LOOP, etc are *light* objects - their internal
3282             # spec is used above. No encapsulation or information hiding is to be
3283             # assumed.
3284              
3285             package HTML::Template::VAR;
3286              
3287             sub new {
3288 470     470   556 my $value;
3289 470         1579 return bless(\$value, $_[0]);
3290             }
3291              
3292             package HTML::Template::DEFAULT;
3293              
3294             sub new {
3295 43     43   84 my $value = $_[1];
3296 43         144 return bless(\$value, $_[0]);
3297             }
3298              
3299             package HTML::Template::LOOP;
3300              
3301             sub new {
3302 73     73   281 return bless([], $_[0]);
3303             }
3304              
3305             sub output {
3306 66     66   105 my $self = shift;
3307 66         86 my $index = shift;
3308 66         87 my $loop_context_vars = shift;
3309 66         256 my $template = $self->[TEMPLATE_HASH]{$index};
3310 66         163 my $value_sets_array = $self->[PARAM_SET];
3311 66 50       154 return unless defined($value_sets_array);
3312              
3313 66         92 my $result = '';
3314 66         88 my $count = 0;
3315 66         91 my $odd = 0;
3316              
3317             # execute the code to get the values if it's a code reference
3318 66 100       197 if( ref $value_sets_array eq 'CODE' ) {
3319 6         20 $value_sets_array = $value_sets_array->($template);
3320 6 50 33     776 croak("HTML::Template->output: TMPL_LOOP code reference did not return an ARRAY reference!")
3321             unless ref $value_sets_array && ref $value_sets_array eq 'ARRAY';
3322 6 50       20 $self->[PARAM_SET] = $value_sets_array if $template->{options}->{cache_lazy_loops};
3323             }
3324              
3325 66         131 foreach my $value_set (@$value_sets_array) {
3326 155 100       343 if ($loop_context_vars) {
3327 63 100       128 if ($count == 0) {
  48 100       108  
3328 15         27 @{$value_set}{qw(__first__ __inner__ __outer__ __last__)} = (1, 0, 1, $#{$value_sets_array} == 0);
  15         60  
  15         75  
3329             } elsif ($count == $#{$value_sets_array}) {
3330 14         28 @{$value_set}{qw(__first__ __inner__ __outer__ __last__)} = (0, 0, 1, 1);
  14         47  
3331             } else {
3332 34         53 @{$value_set}{qw(__first__ __inner__ __outer__ __last__)} = (0, 1, 0, 0);
  34         96  
3333             }
3334 63         156 $odd = $value_set->{__odd__} = !$odd;
3335 63         105 $value_set->{__even__} = !$odd;
3336            
3337 63         130 $value_set->{__counter__} = $count + 1;
3338 63         96 $value_set->{__index__} = $count;
3339             }
3340 155         362 $template->param($value_set);
3341 155         584 $result .= $template->output;
3342 155         704 $template->clear_params;
3343 155 100       461 @{$value_set}{qw(__first__ __last__ __inner__ __outer__ __odd__ __even__ __counter__ __index__)} = (0, 0, 0, 0, 0, 0, 0)
  63         199  
3344             if ($loop_context_vars);
3345 155         298 $count++;
3346             }
3347              
3348 66         218 return $result;
3349             }
3350              
3351             package HTML::Template::COND;
3352              
3353             sub new {
3354 83     83   117 my $pkg = shift;
3355 83         123 my $var = shift;
3356 83         301 my $self = [];
3357 83         180 $self->[VARIABLE] = $var;
3358              
3359 83         198 bless($self, $pkg);
3360 83         207 return $self;
3361             }
3362              
3363             package HTML::Template::NOOP;
3364              
3365             sub new {
3366 279     279   301 my $unused;
3367 279         386 my $self = \$unused;
3368 279         773 bless($self, $_[0]);
3369 279         548 return $self;
3370             }
3371              
3372             package HTML::Template::ESCAPE;
3373              
3374             sub new {
3375 279     279   377 my $unused;
3376 279         355 my $self = \$unused;
3377 279         633 bless($self, $_[0]);
3378 279         549 return $self;
3379             }
3380              
3381             package HTML::Template::JSESCAPE;
3382              
3383             sub new {
3384 279     279   305 my $unused;
3385 279         341 my $self = \$unused;
3386 279         740 bless($self, $_[0]);
3387 279         507 return $self;
3388             }
3389              
3390             package HTML::Template::URLESCAPE;
3391              
3392             sub new {
3393 279     279   301 my $unused;
3394 279         334 my $self = \$unused;
3395 279         800 bless($self, $_[0]);
3396 279         468 return $self;
3397             }
3398              
3399             # scalar-tying package for output(print_to => *HANDLE) implementation
3400             package HTML::Template::PRINTSCALAR;
3401 29     29   275 use strict;
  29         68  
  29         5536  
3402              
3403 1     1   4 sub TIESCALAR { bless \$_[1], $_[0]; }
3404 1     1   5 sub FETCH { }
3405              
3406             sub STORE {
3407 1     1   2 my $self = shift;
3408 1         9 local *FH = $$self;
3409 1         10 print FH @_;
3410             }
3411             1;
3412             __END__