"Fossies" - the Fresh Open Source Software Archive

Member "HTML-Template-2.97/lib/HTML/Template.pm" (18 May 2017, 134236 Bytes) of package /linux/www/HTML-Template-2.97.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "Template.pm" see the Fossies "Dox" file reference documentation and the latest Fossies "Diffs" side-by-side code changes report: 2.95_vs_2.97.

A hint: This file contains one or more very long lines, so maybe it is better readable using the pure text view mode that shows the contents as wrapped lines within the browser window.


    1 package HTML::Template;
    2 
    3 $HTML::Template::VERSION = '2.97';
    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<< <TMPL_VAR> >>
   13 
   14 For example, test.tmpl:
   15 
   16     <html>
   17     <head><title>Test Template</title></head>
   18     <body>
   19     My Home Directory is <TMPL_VAR NAME=HOME>
   20     <p>
   21     My Path is set to <TMPL_VAR NAME=PATH>
   22     </body>
   23     </html>
   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<< <TMPL_VAR> >> 
   50 C<< <TMPL_LOOP> >>, C<< <TMPL_INCLUDE> >>, C<< <TMPL_IF> >>, C<< <TMPL_ELSE> >> 
   51 and C<< <TMPL_UNLESS> >>.  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<HTML::Template::FAQ>
   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<HTML::Embperl> 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<HTML::Embperl>-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     <TMPL_VAR NAME="PARAMETER_NAME">
  107 
  108 The C<< <TMPL_VAR> >> tag is very simple.  For each C<< <TMPL_VAR> >>
  109 tag in the template you call:
  110 
  111     $template->param(PARAMETER_NAME => "VALUE") 
  112 
  113 When the template is output the C<< <TMPL_VAR>  >> 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<LAZY VALUES> 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.
  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    <input name=param type=text value="<TMPL_VAR PARAM>">
  135 
  136 If you called C<param()> with a value like C<sam"my> you'll get in trouble
  137 with HTML's idea of a double-quote.  On the other hand, if you use
  138 C<escape=html>, like this:
  139 
  140    <input name=param type=text value="<TMPL_VAR PARAM ESCAPE=HTML>">
  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<default_escape> 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<who>
  174 variable is not set.
  175 
  176     <TMPL_VAR WHO DEFAULT="the devil"> gave me a taco.
  177 
  178 =back
  179 
  180 =head2 TMPL_LOOP
  181 
  182     <TMPL_LOOP NAME="LOOP_NAME"> ... </TMPL_LOOP>
  183 
  184 The C<< <TMPL_LOOP> >> tag is a bit more complicated than C<< <TMPL_VAR> >>.  
  185 The C<< <TMPL_LOOP> >> tag allows you to delimit a section of text and
  186 give it a name.  Inside this named loop you place C<< <TMPL_VAR> >>s.
  187 Now you pass to C<param()> 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    <TMPL_LOOP NAME=EMPLOYEE_INFO>
  195       Name: <TMPL_VAR NAME=NAME> <br>
  196       Job:  <TMPL_VAR NAME=JOB>  <p>
  197    </TMPL_LOOP>
  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<< <TMPL_LOOP> >> 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<< <TMPL_LOOP> >>'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     <TMPL_LOOP NAME="THIS_LOOP">
  243       Word: <TMPL_VAR NAME="WORD">     
  244       Number: <TMPL_VAR NAME="NUMBER">
  245  
  246     </TMPL_LOOP>
  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<< <TMPL_LOOP> >>s within C<< <TMPL_LOOP> >>s are fine and work as you
  260 would expect.  If the syntax for the C<param()> 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<< <TMPL_LOOP> >> 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<< <TMPL_LOOP> >>, the only variables that are usable are the
  277 ones from the C<< <TMPL_LOOP> >>.  The variables in the outer blocks
  278 are not visible within a template loop.  For the computer-science geeks
  279 among you, a C<< <TMPL_LOOP> >> introduces a new scope much like a perl
  280 subroutine call.  If you want your variables to be global you can use
  281 C<global_vars> option to C<new()> described below.
  282 
  283 =head2 TMPL_INCLUDE
  284 
  285     <TMPL_INCLUDE NAME="filename.tmpl">
  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<HTML_TEMPLATE_ROOT> is tried, if it exists.  Next, the "path" option
  296 is consulted, first as-is and then with C<HTML_TEMPLATE_ROOT> prepended
  297 if available.  As a final attempt, the filename is passed to C<open()>
  298 directly.  See below for more information on C<HTML_TEMPLATE_ROOT>
  299 and the C<path> option to C<new()>.
  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<max_includes> option.  See the entry for the C<max_includes> option
  304 below for more details.
  305 
  306 =head2 TMPL_IF
  307 
  308     <TMPL_IF NAME="PARAMETER_NAME"> ... </TMPL_IF>
  309 
  310 The C<< <TMPL_IF> >> 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<< <TMPL_VAR> >>.
  316 
  317 Example Template:
  318 
  319     <TMPL_IF NAME="BOOL">
  320       Some text that only gets displayed if BOOL is true!
  321     </TMPL_IF>
  322 
  323 Now if you call C<< $template->param(BOOL => 1) >> then the above block
  324 will be included by output.
  325 
  326 C<< <TMPL_IF> </TMPL_IF> >> blocks can include any valid HTML::Template
  327 construct - C<VAR>s and C<LOOP>s and other C<IF>/C<ELSE> blocks.  Note,
  328 however, that intersecting a C<< <TMPL_IF> >> and a C<< <TMPL_LOOP> >>
  329 is invalid.
  330 
  331     Not going to work:
  332     <TMPL_IF BOOL>
  333       <TMPL_LOOP SOME_LOOP>
  334     </TMPL_IF>
  335       </TMPL_LOOP>
  336 
  337 If the name of a C<< <TMPL_LOOP> >> is used in a C<< <TMPL_IF> >>,
  338 the C<IF> block will output if the loop has at least one row.  Example:
  339 
  340     <TMPL_IF LOOP_ONE>
  341       This will output if the loop is not empty.
  342     </TMPL_IF>
  343 
  344     <TMPL_LOOP LOOP_ONE>
  345       ....
  346     </TMPL_LOOP>
  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 C<TMPL_IF>s and matching Perl C<if>s, you will create a maintenance
  351 problem in keeping the two synchronized.  I suggest you adopt the
  352 practice of only using C<TMPL_IF> if you can do so without requiring a
  353 matching C<if> in your Perl code.
  354 
  355 =head2 TMPL_ELSE
  356 
  357     <TMPL_IF NAME="PARAMETER_NAME"> ... <TMPL_ELSE> ... </TMPL_IF>
  358 
  359 You can include an alternate block in your C<< <TMPL_IF> >> block by using
  360 C<< <TMPL_ELSE> >>.  NOTE: You still end the block with C<< </TMPL_IF> >>, 
  361 not C<< </TMPL_ELSE> >>!
  362  
  363    Example:
  364     <TMPL_IF BOOL>
  365       Some text that is included only if BOOL is true
  366     <TMPL_ELSE>
  367       Some text that is included only if BOOL is false
  368     </TMPL_IF>
  369 
  370 =head2 TMPL_UNLESS
  371 
  372     <TMPL_UNLESS NAME="PARAMETER_NAME"> ... </TMPL_UNLESS>
  373 
  374 This tag is the opposite of C<< <TMPL_IF> >>.  The block is output if the
  375 C<PARAMETER_NAME> is set false or not defined.  You can use
  376 C<< <TMPL_ELSE> >> with C<< <TMPL_UNLESS> >> just as you can with C<< <TMPL_IF> >>.
  377 
  378     Example:
  379     <TMPL_UNLESS BOOL>
  380       Some text that is output only if BOOL is FALSE.
  381     <TMPL_ELSE>
  382       Some text that is output only if BOOL is TRUE.
  383     </TMPL_UNLESS>
  384 
  385 If the name of a C<< <TMPL_LOOP> >> is used in a C<< <TMPL_UNLESS> >>,
  386 the C<< <UNLESS> >> block output if the loop has zero rows.
  387 
  388     <TMPL_UNLESS LOOP_ONE>
  389       This will output if the loop is empty.
  390     </TMPL_UNLESS>
  391 
  392     <TMPL_LOOP LOOP_ONE>
  393       ....
  394     </TMPL_LOOP>
  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     <img src="<TMPL_VAR IMAGE_SRC>">
  404 
  405 is not really valid HTML, but it is a perfectly valid use and will work
  406 as planned.
  407 
  408 The C<NAME=> in the tag is optional, although for extensibility's sake I
  409 recommend using it.  Example - C<< <TMPL_LOOP LOOP_NAME> >> 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   <!-- TMPL_VAR NAME=PARAM1 -->
  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<new()> 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<new()> with at least one C<name => 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<FileHandle>:
  457 
  458     my $t = HTML::Template->new(filehandle => *FH, option => 'value');
  459 
  460 The four C<new()> 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<HTML_TEMPLATE_ROOT> is set and your
  481 filename doesn't begin with "/", then the path will be relative to the
  482 value of c<HTML_TEMPLATE_ROOT>.  
  483 
  484 B<Example> - if the environment variable C<HTML_TEMPLATE_ROOT> is set to
  485 F</home/sam> and I call C<< HTML::Template->new() >> with filename set
  486 to "sam.tmpl", HTML::Template will try to open F</home/sam/sam.tmpl> to
  487 access the template file.  You can also affect the search path for files
  488 with the C<path> option to C<new()> - see below for more information.
  489 
  490 You can modify the Template object's behavior with C<new()>. 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     <TMPL_HUH NAME=ZUH>
  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<< <TMPL_VAR> >>s that
  527 look like C<%NAME%> in addition to the standard syntax.  Also sets
  528 C<die_on_bad_params => 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<new()>. 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<< <TMPL_INCLUDE> >> 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<shared_cache> 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<IPC::SharedCache> 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<ipc_key> C<new()> parameter to another 4-character or integer key.
  573 Other options can be used to affect the shared memory cache correspond
  574 to L<IPC::SharedCache> options - C<ipc_mode>, C<ipc_segment_size> and
  575 C<ipc_max_size>.  See L<IPC::SharedCache> 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<IPC::SharedCache>.
  580 
  581 =item * double_cache
  582 
  583 If set to 1 the module will use a combination of C<shared_cache> 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<shared_cache> apply to C<double_cache> 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<blind_cache> performing only 1 to 2 percent faster than
  594 cache under mod_perl.
  595 
  596 B<NOTE>: 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<Storable> module.  It uses no additional memory, and my
  603 simplistic testing shows that it yields a 50% performance advantage.
  604 Like C<shared_cache>, 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<file_cache_dir> option. See
  608 below for details.
  609 
  610 B<NOTE>: L<Storable> uses C<flock()> to ensure safe access to cache
  611 files.  Using C<file_cache> on a system or filesystem (like NFS) without
  612 C<flock()> 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<file_cache> 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<file_cache> 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<file_cache> and
  631 normal C<cache> mode for the best possible caching.  The file_cache_*
  632 options that work with file_cache apply to C<double_file_cache> 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 C<TMPL_VAR>s. See L<LAZY VALUES> 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 C<TMPL_LOOP>s. See L<LAZY VALUES> 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<filename> option to C<new()> and for files included
  655 with the C<< <TMPL_INCLUDE> >> tag.  This list is only consulted when the
  656 filename is relative.  The C<HTML_TEMPLATE_ROOT> environment variable
  657 is always tried first if it exists.  Also, if C<HTML_TEMPLATE_ROOT> is
  658 set then an attempt will be made to prepend C<HTML_TEMPLATE_ROOT> onto
  659 paths in the path array.  In the case of a C<< <TMPL_INCLUDE> >> 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<NOTE>: 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<< <TMPL_INCLUDE> >> 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<new()> or any
  683 included files. It won't do anything special to scalars templates passed
  684 to C<new()> 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<open_mode> option.
  694 
  695 B<NOTE>: The C<utf8> and C<open_mode> 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<PerlIO>
  712 for details.
  713 
  714 B<NOTE>: this only works in perl 5.7.1 and above. 
  715 
  716 B<NOTE>: you have to supply an opening mode that actually permits
  717 reading from the file handle.
  718 
  719 B<NOTE>: The C<utf8> and C<open_mode> 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<IPC::SharedCache>. 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<GTop> 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<param()> method that works like HTML::Template's C<param()>.  A
  764 good candidate would be a L<CGI> 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<NOTE>: 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<case_sensitive> 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<case_sensitive> 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<NOTE>: with C<case_sensitive> and C<loop_context_vars> 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 C<TMPL_VAR>s these variables can be used in 
  856 C<< <TMPL_IF> >>, C<< <TMPL_UNLESS> >> and C<< <TMPL_ELSE> >> to control
  857 how a loop is output.
  858 
  859 Example:
  860 
  861     <TMPL_LOOP NAME="FOO">
  862       <TMPL_IF NAME="__first__">
  863         This only outputs on the first pass.
  864       </TMPL_IF>
  865 
  866       <TMPL_IF NAME="__odd__">
  867         This outputs every other pass, on the odd passes.
  868       </TMPL_IF>
  869 
  870       <TMPL_UNLESS NAME="__odd__">
  871         This outputs every other pass, on the even passes.
  872       </TMPL_UNLESS>
  873 
  874       <TMPL_IF NAME="__inner__">
  875         This outputs on passes that are neither first nor last.
  876       </TMPL_IF>
  877 
  878       This is pass number <TMPL_VAR NAME="__counter__">.
  879 
  880       <TMPL_IF NAME="__last__">
  881         This only outputs on the last pass.
  882       </TMPL_IF>
  883     </TMPL_LOOP>
  884 
  885 One use of this feature is to provide a "separator" similar in effect
  886 to the perl function C<join()>.  Example:
  887 
  888     <TMPL_LOOP FRUIT>
  889       <TMPL_IF __last__> and </TMPL_IF>
  890       <TMPL_VAR KIND><TMPL_UNLESS __last__>, <TMPL_ELSE>.</TMPL_UNLESS>
  891     </TMPL_LOOP>
  892 
  893 Would output something like:
  894 
  895   Apples, Oranges, Brains, Toes, and Kiwi.
  896 
  897 Given an appropriate C<param()> call, of course. B<NOTE>: 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<< <TMPL_INCLUDE> >> tag in the
  904 template file.  This can be used to make opening untrusted templates
  905 B<slightly> 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<< <TMPL_INCLUDE> >>. 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<< <TMPL_VAR> >>s like global variables in
  923 Perl - they have unlimited scope.  This option also affects C<< <TMPL_IF> >> 
  924 and C<< <TMPL_UNLESS> >>.
  925 
  926 Example:
  927 
  928     This is a normal variable: <TMPL_VAR NORMAL>.<P>
  929 
  930     <TMPL_LOOP NAME=FROOT_LOOP>
  931       Here it is inside the loop: <TMPL_VAR NORMAL><P>
  932     </TMPL_LOOP>
  933 
  934 Normally this wouldn't work as expected, since C<< <TMPL_VAR NORMAL> >>'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<OUTER_VAR> in the correct
  940 iteration:
  941 
  942     <TMPL_LOOP OUTER_LOOP>
  943       OUTER: <TMPL_VAR OUTER_VAR>
  944         <TMPL_LOOP INNER_LOOP>
  945            INNER: <TMPL_VAR INNER_VAR>
  946            INSIDE OUT: <TMPL_VAR OUTER_VAR>
  947         </TMPL_LOOP>
  948     </TMPL_LOOP>
  949 
  950 One side-effect of C<global_vars> is that variables you set with
  951 C<param()> that might otherwise be ignored when C<die_on_bad_params>
  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<NOTE>: C<global_vars> is not C<global_loops> (which does not exist).
  956 That means that loops you declare at one scope are not available
  957 inside other loops even when C<global_vars> 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<!!!ZAP_VAR FOO!!!> and transforms them into HTML::Template tags:
  970 
  971     my $filter = sub {
  972         my $text_ref = shift;
  973         $$text_ref =~ s/!!!ZAP_(.*?)!!!/<TMPL_$1>/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<sub> key
  986 and the desired argument format using the C<format> key.  The available
  987 formats are C<scalar> and C<array>.  Using the C<array> 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 C<TMPL_INCLUDE>ed 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<escape> 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 use integer;    # no floating point math so far!
 1031 use strict;     # and no funny business, either.
 1032 
 1033 use Carp;                       # generate better errors with more context
 1034 use File::Spec;                 # generate paths that work on all platforms
 1035 use Digest::MD5 qw(md5_hex);    # generate cache keys
 1036 use Scalar::Util qw(tainted);
 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     %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     my $pkg = shift;
 1108     my $self;
 1109     { my %hash; $self = bless(\%hash, $pkg); }
 1110 
 1111     # the options hash
 1112     my $options = {};
 1113     $self->{options} = $options;
 1114 
 1115     # set default parameters in options hash
 1116     %$options = %OPTIONS;
 1117 
 1118     # load in options supplied to new()
 1119     $options = _load_supplied_options([@_], $options);
 1120 
 1121     # blind_cache = 1 implies cache = 1
 1122     $options->{blind_cache} and $options->{cache} = 1;
 1123 
 1124     # shared_cache = 1 implies cache = 1
 1125     $options->{shared_cache} and $options->{cache} = 1;
 1126 
 1127     # file_cache = 1 implies cache = 1
 1128     $options->{file_cache} and $options->{cache} = 1;
 1129 
 1130     # double_cache is a combination of shared_cache and cache.
 1131     $options->{double_cache} and $options->{cache}        = 1;
 1132     $options->{double_cache} and $options->{shared_cache} = 1;
 1133 
 1134     # double_file_cache is a combination of file_cache and cache.
 1135     $options->{double_file_cache} and $options->{cache}      = 1;
 1136     $options->{double_file_cache} and $options->{file_cache} = 1;
 1137 
 1138     # vanguard_compatibility_mode implies die_on_bad_params = 0
 1139     $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     if (exists($options->{type})) {
 1144         exists($options->{source})
 1145           or croak("HTML::Template->new() called with 'type' parameter set, but no 'source'!");
 1146         (
 1147                  $options->{type} eq 'filename'
 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         $options->{$options->{type}} = $options->{source};
 1155         delete $options->{type};
 1156         delete $options->{source};
 1157     }
 1158 
 1159     # make sure taint mode is on if force_untaint flag is set
 1160     if ($options->{force_untaint}) {
 1161         if ($] < 5.008000) {
 1162             warn("HTML::Template->new() : 'force_untaint' option needs at least Perl 5.8.0!");
 1163         } elsif (!${^TAINT}) {
 1164             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     if (ref($options->{associate}) ne 'ARRAY') {
 1171         $options->{associate} = [$options->{associate}];
 1172     }
 1173 
 1174     # path should be an array if it's not already
 1175     if (ref($options->{path}) ne 'ARRAY') {
 1176         $options->{path} = [$options->{path}];
 1177     }
 1178 
 1179     # filter should be an array if it's not already
 1180     if (ref($options->{filter}) ne 'ARRAY') {
 1181         $options->{filter} = [$options->{filter}];
 1182     }
 1183 
 1184     # make sure objects in associate area support param()
 1185     foreach my $object (@{$options->{associate}}) {
 1186         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     my $source_count = 0;
 1194     exists($options->{filename})   and $source_count++;
 1195     exists($options->{filehandle}) and $source_count++;
 1196     exists($options->{arrayref})   and $source_count++;
 1197     exists($options->{scalarref})  and $source_count++;
 1198     if ($source_count != 1) {
 1199         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     croak "Cannot have caching when template source is not file"
 1206       if grep { exists($options->{$_}) } qw( filehandle arrayref scalarref)
 1207           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     if (exists($options->{filename})) {
 1213         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     if ($options->{memory_debug}) {
 1219         # memory_debug needs GTop
 1220         eval { require GTop; };
 1221         croak("Could not load GTop.  You must have GTop installed to use HTML::Template in memory_debug mode.  The error was: $@")
 1222           if ($@);
 1223         $self->{gtop}     = GTop->new();
 1224         $self->{proc_mem} = $self->{gtop}->proc_mem($$);
 1225         print STDERR "\n### HTML::Template Memory Debug ### START ", $self->{proc_mem}->size(), "\n";
 1226     }
 1227 
 1228     if ($options->{file_cache}) {
 1229         # make sure we have a file_cache_dir option
 1230         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         eval { require Storable; };
 1235         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     if ($options->{shared_cache}) {
 1241         # shared_cache needs some extra modules loaded
 1242         eval { require IPC::SharedCache; };
 1243         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         my %cache;
 1249         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         $self->{cache} = \%cache;
 1258     }
 1259 
 1260     if ($options->{default_escape}) {
 1261         $options->{default_escape} = uc $options->{default_escape};
 1262         unless ($options->{default_escape} =~ /^(NONE|HTML|URL|JS)$/i) {
 1263             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     if ($options->{open_mode} && $] < 5.007001) {
 1271         croak("HTML::Template->new(): open_mode cannot be used in Perl < 5.7.1");
 1272     }
 1273 
 1274     if($options->{utf8}) {
 1275         croak("HTML::Template->new(): utf8 cannot be used in Perl < 5.7.1") if $] < 5.007001;
 1276         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         $options->{open_mode} = '<:encoding(utf8)';
 1280     }
 1281 
 1282     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     $self->_init;
 1287 
 1288     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     delete $self->{cache} if $options->{shared_cache};
 1296 
 1297     return $self;
 1298 }
 1299 
 1300 sub _load_supplied_options {
 1301     my $argsref = shift;
 1302     my $options = shift;
 1303     for (my $x = 0 ; $x < @{$argsref} ; $x += 2) {
 1304         defined(${$argsref}[($x + 1)])
 1305           or croak("HTML::Template->new() called with odd number of option parameters - should be of the form option => value");
 1306         $options->{lc(${$argsref}[$x])} = ${$argsref}[($x + 1)];
 1307     }
 1308     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     my $pkg = shift;
 1314     my $self;
 1315     { my %hash; $self = bless(\%hash, $pkg); }
 1316 
 1317     # the options hash
 1318     my $options = {
 1319         debug             => $OPTIONS{debug},
 1320         stack_debug       => $OPTIONS{stack_debug},
 1321         die_on_bad_params => $OPTIONS{die_on_bad_params},
 1322         associate         => [@{$OPTIONS{associate}}],
 1323         loop_context_vars => $OPTIONS{loop_context_vars},
 1324     };
 1325     $self->{options} = $options;
 1326     $options = _load_supplied_options([@_], $options);
 1327 
 1328     $self->{param_map}   = $options->{param_map};
 1329     $self->{parse_stack} = $options->{parse_stack};
 1330     delete($options->{param_map});
 1331     delete($options->{parse_stack});
 1332 
 1333     return $self;
 1334 }
 1335 
 1336 # a few shortcuts to new(), of possible use...
 1337 sub new_file {
 1338     my $pkg = shift;
 1339     return $pkg->new('filename', @_);
 1340 }
 1341 
 1342 sub new_filehandle {
 1343     my $pkg = shift;
 1344     return $pkg->new('filehandle', @_);
 1345 }
 1346 
 1347 sub new_array_ref {
 1348     my $pkg = shift;
 1349     return $pkg->new('arrayref', @_);
 1350 }
 1351 
 1352 sub new_scalar_ref {
 1353     my $pkg = shift;
 1354     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     my $self    = shift;
 1361     my $options = $self->{options};
 1362 
 1363     if ($options->{double_cache}) {
 1364         # try the normal cache, return if we have it.
 1365         $self->_fetch_from_cache();
 1366         return if (defined $self->{param_map} and defined $self->{parse_stack});
 1367 
 1368         # try the shared cache
 1369         $self->_fetch_from_shared_cache();
 1370 
 1371         # put it in the local cache if we got it.
 1372         $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         $self->_fetch_from_cache();
 1377         return if (defined $self->{param_map});
 1378 
 1379         # try the file cache
 1380         $self->_fetch_from_file_cache();
 1381 
 1382         # put it in the local cache if we got it.
 1383         $self->_commit_to_cache()
 1384           if (defined $self->{param_map});
 1385     } elsif ($options->{shared_cache}) {
 1386         # try the shared cache
 1387         $self->_fetch_from_shared_cache();
 1388     } elsif ($options->{file_cache}) {
 1389         # try the file cache
 1390         $self->_fetch_from_file_cache();
 1391     } elsif ($options->{cache}) {
 1392         # try the normal cache
 1393         $self->_fetch_from_cache();
 1394     }
 1395 
 1396     # if we got a cache hit, return
 1397     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     $self->_init_template();
 1402     $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     if ($options->{file_cache}) {
 1407         $self->_commit_to_file_cache();
 1408     }
 1409     $self->_commit_to_cache()
 1410       if ( ($options->{cache} and not $options->{shared_cache} and not $options->{file_cache})
 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 use vars qw( %CACHE );
 1420 
 1421 sub _fetch_from_cache {
 1422     my $self    = shift;
 1423     my $options = $self->{options};
 1424 
 1425     # return if there's no file here
 1426     my $filepath = $self->_find_file($options->{filename});
 1427     return unless (defined($filepath));
 1428     $options->{filepath} = $filepath;
 1429 
 1430     # return if there's no cache entry for this key
 1431     my $key = $self->_cache_key();
 1432     return unless exists($CACHE{$key});
 1433 
 1434     # validate the cache
 1435     my $mtime = $self->_mtime($filepath);
 1436     if (defined $mtime) {
 1437         # return if the mtime doesn't match the cache
 1438         if (defined($CACHE{$key}{mtime})
 1439             and ($mtime != $CACHE{$key}{mtime}))
 1440         {
 1441             $options->{cache_debug}
 1442               and print STDERR "CACHE MISS : $filepath : $mtime\n";
 1443             return;
 1444         }
 1445 
 1446         # if the template has includes, check each included file's mtime
 1447         # and return if different
 1448         if (exists($CACHE{$key}{included_mtimes})) {
 1449             foreach my $filename (keys %{$CACHE{$key}{included_mtimes}}) {
 1450                 next
 1451                   unless defined($CACHE{$key}{included_mtimes}{$filename});
 1452 
 1453                 my $included_mtime = (stat($filename))[9];
 1454                 if ($included_mtime != $CACHE{$key}{included_mtimes}{$filename}) {
 1455                     $options->{cache_debug}
 1456                       and print STDERR
 1457                       "### HTML::Template Cache Debug ### CACHE MISS : $filepath : INCLUDE $filename : $included_mtime\n";
 1458 
 1459                     return;
 1460                 }
 1461             }
 1462         }
 1463     }
 1464 
 1465     # got a cache hit!
 1466 
 1467     $options->{cache_debug}
 1468       and print STDERR "### HTML::Template Cache Debug ### CACHE HIT : $filepath => $key\n";
 1469 
 1470     $self->{param_map}   = $CACHE{$key}{param_map};
 1471     $self->{parse_stack} = $CACHE{$key}{parse_stack};
 1472     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     $self->_normalize_options();
 1477     $self->clear_params();
 1478 }
 1479 
 1480 sub _commit_to_cache {
 1481     my $self     = shift;
 1482     my $options  = $self->{options};
 1483     my $key      = $self->_cache_key();
 1484     my $filepath = $options->{filepath};
 1485 
 1486     $options->{cache_debug}
 1487       and print STDERR "### HTML::Template Cache Debug ### CACHE LOAD : $filepath => $key\n";
 1488 
 1489     $options->{blind_cache}
 1490       or $CACHE{$key}{mtime} = $self->_mtime($filepath);
 1491     $CACHE{$key}{param_map}   = $self->{param_map};
 1492     $CACHE{$key}{parse_stack} = $self->{parse_stack};
 1493     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     my $self    = shift;
 1502     my $options = $self->{options};
 1503 
 1504     # assemble pieces of the key
 1505     my @key = ($options->{filepath});
 1506     push(@key, @{$options->{path}});
 1507 
 1508     push(@key, $options->{search_path_on_include} || 0);
 1509     push(@key, $options->{loop_context_vars}      || 0);
 1510     push(@key, $options->{global_vars}            || 0);
 1511     push(@key, $options->{open_mode}              || 0);
 1512 
 1513     # compute the md5 and return it
 1514     return md5_hex(@key);
 1515 }
 1516 
 1517 # generates MD5 from filepath to determine filename for cache file
 1518 sub _get_cache_filename {
 1519     my ($self, $filepath) = @_;
 1520 
 1521     # get a cache key
 1522     $self->{options}{filepath} = $filepath;
 1523     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     if (wantarray) {
 1531         return (substr($hash, 0, 2), substr($hash, 2));
 1532     } else {
 1533         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     my $self    = shift;
 1540     my $options = $self->{options};
 1541 
 1542     # return if there's no cache entry for this filename
 1543     my $filepath = $self->_find_file($options->{filename});
 1544     return unless defined $filepath;
 1545     my $cache_filename = $self->_get_cache_filename($filepath);
 1546     return unless -e $cache_filename;
 1547 
 1548     eval { $self->{record} = Storable::lock_retrieve($cache_filename); };
 1549     croak("HTML::Template::new() - Problem reading cache file $cache_filename (file_cache => 1) : $@")
 1550       if $@;
 1551     croak("HTML::Template::new() - Problem reading cache file $cache_filename (file_cache => 1) : $!")
 1552       unless defined $self->{record};
 1553 
 1554     ($self->{mtime}, $self->{included_mtimes}, $self->{param_map}, $self->{parse_stack}) = @{$self->{record}};
 1555 
 1556     $options->{filepath} = $filepath;
 1557 
 1558     # validate the cache
 1559     my $mtime = $self->_mtime($filepath);
 1560     if (defined $mtime) {
 1561         # return if the mtime doesn't match the cache
 1562         if (defined($self->{mtime})
 1563             and ($mtime != $self->{mtime}))
 1564         {
 1565             $options->{cache_debug}
 1566               and print STDERR "### HTML::Template Cache Debug ### FILE CACHE MISS : $filepath : $mtime\n";
 1567             ($self->{mtime}, $self->{included_mtimes}, $self->{param_map}, $self->{parse_stack}) = (undef, undef, undef, undef);
 1568             return;
 1569         }
 1570 
 1571         # if the template has includes, check each included file's mtime
 1572         # and return if different
 1573         if (exists($self->{included_mtimes})) {
 1574             foreach my $filename (keys %{$self->{included_mtimes}}) {
 1575                 next
 1576                   unless defined($self->{included_mtimes}{$filename});
 1577 
 1578                 my $included_mtime = (stat($filename))[9];
 1579                 if ($included_mtime != $self->{included_mtimes}{$filename}) {
 1580                     $options->{cache_debug}
 1581                       and print STDERR
 1582                       "### HTML::Template Cache Debug ### FILE CACHE MISS : $filepath : INCLUDE $filename : $included_mtime\n";
 1583                     ($self->{mtime}, $self->{included_mtimes}, $self->{param_map}, $self->{parse_stack}) =
 1584                       (undef, undef, undef, undef);
 1585                     return;
 1586                 }
 1587             }
 1588         }
 1589     }
 1590 
 1591     # got a cache hit!
 1592     $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     $self->_normalize_options();
 1597     $self->clear_params();
 1598 }
 1599 
 1600 sub _commit_to_file_cache {
 1601     my $self    = shift;
 1602     my $options = $self->{options};
 1603 
 1604     my $filepath = $options->{filepath};
 1605     if (not defined $filepath) {
 1606         $filepath = $self->_find_file($options->{filename});
 1607         confess("HTML::Template->new() : Cannot open included file $options->{filename} : file not found.")
 1608           unless defined($filepath);
 1609         $options->{filepath} = $filepath;
 1610     }
 1611 
 1612     my ($cache_dir, $cache_file) = $self->_get_cache_filename($filepath);
 1613     $cache_dir = File::Spec->join($options->{file_cache_dir}, $cache_dir);
 1614     if (not -d $cache_dir) {
 1615         if (not -d $options->{file_cache_dir}) {
 1616             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         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     $options->{cache_debug}
 1624       and print STDERR "### HTML::Template Cache Debug ### FILE CACHE LOAD : $options->{filepath}\n";
 1625 
 1626     my $result;
 1627     eval {
 1628         $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     croak("HTML::Template::new() - Problem writing cache file $cache_dir/$cache_file (file_cache => 1) : $@") if $@;
 1632     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     my $self    = shift;
 1639     my $options = $self->{options};
 1640 
 1641     my $filepath = $self->_find_file($options->{filename});
 1642     return unless defined $filepath;
 1643 
 1644     # fetch from the shared cache.
 1645     $self->{record} = $self->{cache}{$filepath};
 1646 
 1647     ($self->{mtime}, $self->{included_mtimes}, $self->{param_map}, $self->{parse_stack}) = @{$self->{record}}
 1648       if defined($self->{record});
 1649 
 1650     $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     $self->_normalize_options(), $self->clear_params()
 1655       if (defined($self->{record}));
 1656     delete($self->{record});
 1657 
 1658     return $self;
 1659 }
 1660 
 1661 sub _validate_shared_cache {
 1662     my ($self, $filename, $record) = @_;
 1663     my $options = $self->{options};
 1664 
 1665     $options->{shared_cache_debug}
 1666       and print STDERR "### HTML::Template Cache Debug ### SHARED CACHE VALIDATE : $filename\n";
 1667 
 1668     return 1 if $options->{blind_cache};
 1669 
 1670     my ($c_mtime, $included_mtimes, $param_map, $parse_stack) = @$record;
 1671 
 1672     # if the modification time has changed return false
 1673     my $mtime = $self->_mtime($filename);
 1674     if (    defined $mtime
 1675         and defined $c_mtime
 1676         and $mtime != $c_mtime)
 1677     {
 1678         $options->{cache_debug}
 1679           and print STDERR "### HTML::Template Cache Debug ### SHARED CACHE MISS : $filename : $mtime\n";
 1680         return 0;
 1681     }
 1682 
 1683     # if the template has includes, check each included file's mtime
 1684     # and return false if different
 1685     if (defined $mtime and defined $included_mtimes) {
 1686         foreach my $fname (keys %$included_mtimes) {
 1687             next unless defined($included_mtimes->{$fname});
 1688             if ($included_mtimes->{$fname} != (stat($fname))[9]) {
 1689                 $options->{cache_debug}
 1690                   and print STDERR "### HTML::Template Cache Debug ### SHARED CACHE MISS : $filename : INCLUDE $fname\n";
 1691                 return 0;
 1692             }
 1693         }
 1694     }
 1695 
 1696     # all done - return true
 1697     return 1;
 1698 }
 1699 
 1700 sub _load_shared_cache {
 1701     my ($self, $filename) = @_;
 1702     my $options = $self->{options};
 1703     my $cache   = $self->{cache};
 1704 
 1705     $self->_init_template();
 1706     $self->_parse();
 1707 
 1708     $options->{cache_debug}
 1709       and print STDERR "### HTML::Template Cache Debug ### SHARED CACHE LOAD : $options->{filepath}\n";
 1710 
 1711     print STDERR "### HTML::Template Memory Debug ### END CACHE LOAD ", $self->{proc_mem}->size(), "\n"
 1712       if $options->{memory_debug};
 1713 
 1714     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     my ($self, $filename, $extra_path) = @_;
 1721     my $options = $self->{options};
 1722     my $filepath;
 1723 
 1724     # first check for a full path
 1725     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     if (defined($extra_path)) {
 1730         $extra_path->[$#{$extra_path}] = $filename;
 1731         $filepath = File::Spec->canonpath(File::Spec->catfile(@$extra_path));
 1732         return File::Spec->canonpath($filepath) if -e $filepath;
 1733     }
 1734 
 1735     # try pre-prending HTML_Template_Root
 1736     if (defined($ENV{HTML_TEMPLATE_ROOT})) {
 1737         $filepath = File::Spec->catfile($ENV{HTML_TEMPLATE_ROOT}, $filename);
 1738         return File::Spec->canonpath($filepath) if -e $filepath;
 1739     }
 1740 
 1741     # try "path" option list..
 1742     foreach my $path (@{$options->{path}}) {
 1743         $filepath = File::Spec->catfile($path, $filename);
 1744         return File::Spec->canonpath($filepath) if -e $filepath;
 1745     }
 1746 
 1747     # try even a relative path from the current directory...
 1748     return File::Spec->canonpath($filename) if -e $filename;
 1749 
 1750     # try "path" option list with HTML_TEMPLATE_ROOT prepended...
 1751     if (defined($ENV{HTML_TEMPLATE_ROOT})) {
 1752         foreach my $path (@{$options->{path}}) {
 1753             $filepath = File::Spec->catfile($ENV{HTML_TEMPLATE_ROOT}, $path, $filename);
 1754             return File::Spec->canonpath($filepath) if -e $filepath;
 1755         }
 1756     }
 1757 
 1758     return undef;
 1759 }
 1760 
 1761 # utility function - computes the mtime for $filename
 1762 sub _mtime {
 1763     my ($self, $filepath) = @_;
 1764     my $options = $self->{options};
 1765 
 1766     return (undef) if ($options->{blind_cache});
 1767 
 1768     # make sure it still exists in the filesystem
 1769     (-r $filepath)
 1770       or Carp::confess("HTML::Template : template file $filepath does not exist or is unreadable.");
 1771 
 1772     # get the modification time
 1773     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     my $self    = shift;
 1780     my $options = $self->{options};
 1781 
 1782     my @pstacks = ($self->{parse_stack});
 1783     while (@pstacks) {
 1784         my $pstack = pop(@pstacks);
 1785         foreach my $item (@$pstack) {
 1786             next unless (ref($item) eq 'HTML::Template::LOOP');
 1787             foreach my $template (values %{$item->[HTML::Template::LOOP::TEMPLATE_HASH]}) {
 1788                 # must be the same list as the call to _new_from_loop...
 1789                 $template->{options}{debug}              = $options->{debug};
 1790                 $template->{options}{stack_debug}        = $options->{stack_debug};
 1791                 $template->{options}{die_on_bad_params}  = $options->{die_on_bad_params};
 1792                 $template->{options}{case_sensitive}     = $options->{case_sensitive};
 1793                 $template->{options}{parent_global_vars} = $options->{parent_global_vars};
 1794 
 1795                 push(@pstacks, $template->{parse_stack});
 1796             }
 1797         }
 1798     }
 1799 }
 1800 
 1801 # initialize the template buffer
 1802 sub _init_template {
 1803     my $self    = shift;
 1804     my $options = $self->{options};
 1805 
 1806     print STDERR "### HTML::Template Memory Debug ### START INIT_TEMPLATE ", $self->{proc_mem}->size(), "\n"
 1807       if $options->{memory_debug};
 1808 
 1809     if (exists($options->{filename})) {
 1810         my $filepath = $options->{filepath};
 1811         if (not defined $filepath) {
 1812             $filepath = $self->_find_file($options->{filename});
 1813             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             $options->{filepath} = $filepath;
 1817         }
 1818 
 1819         # use the open_mode if we have one
 1820         if (my $mode = $options->{open_mode}) {
 1821             open(TEMPLATE, $mode, $filepath)
 1822               || confess("HTML::Template->new() : Cannot open included file $filepath with mode $mode: $!");
 1823         } else {
 1824             open(TEMPLATE, $filepath)
 1825               or confess("HTML::Template->new() : Cannot open included file $filepath : $!");
 1826         }
 1827 
 1828         $self->{mtime} = $self->_mtime($filepath);
 1829 
 1830         # read into scalar, note the mtime for the record
 1831         $self->{template} = "";
 1832         while (read(TEMPLATE, $self->{template}, 10240, length($self->{template}))) { }
 1833         close(TEMPLATE);
 1834 
 1835     } elsif (exists($options->{scalarref})) {
 1836         # copy in the template text
 1837         $self->{template} = ${$options->{scalarref}};
 1838 
 1839         delete($options->{scalarref});
 1840     } elsif (exists($options->{arrayref})) {
 1841         # if we have an array ref, join and store the template text
 1842         $self->{template} = join("", @{$options->{arrayref}});
 1843 
 1844         delete($options->{arrayref});
 1845     } elsif (exists($options->{filehandle})) {
 1846         # just read everything in in one go
 1847         local $/ = undef;
 1848         $self->{template} = readline($options->{filehandle});
 1849 
 1850         delete($options->{filehandle});
 1851     } else {
 1852         confess("HTML::Template : Need to call new with filename, filehandle, scalarref or arrayref parameter specified.");
 1853     }
 1854 
 1855     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     $self->_call_filters(\$self->{template}) if @{$options->{filter}};
 1860 
 1861     return $self;
 1862 }
 1863 
 1864 # handle calling user defined filters
 1865 sub _call_filters {
 1866     my $self         = shift;
 1867     my $template_ref = shift;
 1868     my $options      = $self->{options};
 1869 
 1870     my ($format, $sub);
 1871     foreach my $filter (@{$options->{filter}}) {
 1872         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         $filter = {'format' => 'scalar', 'sub' => $filter}
 1877           if (ref $filter eq 'CODE');
 1878 
 1879         if (ref $filter eq 'HASH') {
 1880             $format = $filter->{'format'};
 1881             $sub    = $filter->{'sub'};
 1882 
 1883             # check types and values
 1884             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             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             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             eval {
 1895                 if ($format eq 'scalar')
 1896                 {
 1897                     # call
 1898                     $sub->($template_ref);
 1899                 } else {
 1900                     # modulate
 1901                     my @array = map { $_ . "\n" } split("\n", $$template_ref);
 1902                     # call
 1903                     $sub->(\@array);
 1904                     # demodulate
 1905                     $$template_ref = join("", @array);
 1906                 }
 1907             };
 1908             croak("HTML::Template->new() : fatal error occurred during filter call: $@") if $@;
 1909         } else {
 1910             croak("HTML::Template->new() : bad value set for filter parameter - must be code ref or hash ref");
 1911         }
 1912     }
 1913     # all done
 1914     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     my $self    = shift;
 1924     my $options = $self->{options};
 1925 
 1926     $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     use vars qw(@pstack %pmap @ifstack @ucstack %top_pmap);
 1932     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     my @pstacks = ([]);
 1939     *pstack = $pstacks[0];
 1940     $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     my @pmaps = ({});
 1946     *pmap              = $pmaps[0];
 1947     *top_pmap          = $pmaps[0];
 1948     $self->{param_map} = $pmaps[0];
 1949 
 1950     # the ifstack is a temporary stack containing pending ifs and elses
 1951     # waiting for a /if.
 1952     my @ifstacks = ([]);
 1953     *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     my @ucstacks = ([]);
 1961     *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     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     use vars qw($fcounter $fname $fmax);
 1973     local (*fcounter, *fname, *fmax);
 1974 
 1975     my @fstack = ([$options->{filepath} || "/fake/path/for/non/file/template", 1, scalar @{[$self->{template} =~ m/(\n)/g]} + 1]);
 1976     (*fname, *fcounter, *fmax) = \(@{$fstack[0]});
 1977 
 1978     my $NOOP      = HTML::Template::NOOP->new();
 1979     my $ESCAPE    = HTML::Template::ESCAPE->new();
 1980     my $JSESCAPE  = HTML::Template::JSESCAPE->new();
 1981     my $URLESCAPE = HTML::Template::URLESCAPE->new();
 1982 
 1983     # all the tags that need NAMEs:
 1984     my %need_names = map { $_ => 1 } qw(TMPL_VAR TMPL_LOOP TMPL_IF TMPL_UNLESS TMPL_INCLUDE);
 1985 
 1986     # variables used below that don't need to be my'd in the loop
 1987     my ($name, $which, $escape, $default);
 1988 
 1989     # handle the old vanguard format
 1990     $options->{vanguard_compatibility_mode}
 1991       and $self->{template} =~ s/%([-\w\/\.+]+)%/<TMPL_VAR NAME=$1>/g;
 1992 
 1993     # now split up template on '<', leaving them in
 1994     my @chunks = split(m/(?=<)/, $self->{template});
 1995 
 1996     # all done with template
 1997     delete $self->{template};
 1998 
 1999     # loop through chunks, filling up pstack
 2000     my $last_chunk = $#chunks;
 2001   CHUNK: for (my $chunk_number = 0 ; $chunk_number <= $last_chunk ; $chunk_number++) {
 2002         next unless defined $chunks[$chunk_number];
 2003         my $chunk = $chunks[$chunk_number];
 2004 
 2005         # a general regex to match any and all TMPL_* tags
 2006         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             $which = uc($1);    # which tag is it
 2123 
 2124             $escape =
 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             $name = defined $9 ? $9 : defined $10 ? $10 : defined $11 ? $11 : undef;
 2133 
 2134             # is there a default?
 2135             $default =
 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             my $post = $19;    # what comes after on the line
 2151 
 2152             # allow mixed case in filenames, otherwise flatten
 2153             $name = lc($name)
 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             die "HTML::Template->new() : No NAME given to a $which tag at $fname : line $fcounter."
 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             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             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             if ($which eq 'TMPL_VAR') {
 2170                 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                 my $var;
 2175                 if (exists $pmap{$name}) {
 2176                     $var = $pmap{$name};
 2177                     if( $options->{die_on_bad_params} && ref($var) ne 'HTML::Template::VAR') {
 2178                         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                     $var             = HTML::Template::VAR->new();
 2182                     $pmap{$name}     = $var;
 2183                     $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                 if (defined $default) {
 2190                     push(@pstack, HTML::Template::DEF->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                 if ($escape) {
 2197                     if ($escape =~ /^["']?url["']?$/i) {
 2198                         push(@pstack, $URLESCAPE);
 2199                     } elsif ($escape =~ /^["']?js["']?$/i) {
 2200                         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                         push(@pstack, $ESCAPE);
 2207                     }
 2208                 }
 2209 
 2210                 push(@pstack, $var);
 2211 
 2212             } elsif ($which eq 'TMPL_LOOP') {
 2213                 # we've got a loop start
 2214                 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                 my $loop;
 2219                 if (exists $pmap{$name}) {
 2220                     $loop = $pmap{$name};
 2221                     if( $options->{die_on_bad_params} && ref($loop) ne 'HTML::Template::LOOP') {
 2222                         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                     $loop = HTML::Template::LOOP->new();
 2229                     $pmap{$name} = $loop;
 2230                 }
 2231 
 2232                 # get it on the loopstack, pstack of the enclosing block
 2233                 push(@pstack, $loop);
 2234                 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                 push(@pstacks, []);
 2239                 *pstack = $pstacks[$#pstacks];
 2240                 push(@pmaps, {});
 2241                 *pmap = $pmaps[$#pmaps];
 2242                 push(@ifstacks, []);
 2243                 *ifstack = $ifstacks[$#ifstacks];
 2244                 push(@ucstacks, []);
 2245                 *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                 if ($options->{loop_context_vars}) {
 2252                     $pmap{__first__}   = HTML::Template::VAR->new();
 2253                     $pmap{__inner__}   = HTML::Template::VAR->new();
 2254                     $pmap{__outer__}   = HTML::Template::VAR->new();
 2255                     $pmap{__last__}    = HTML::Template::VAR->new();
 2256                     $pmap{__odd__}     = HTML::Template::VAR->new();
 2257                     $pmap{__even__}    = HTML::Template::VAR->new();
 2258                     $pmap{__counter__} = HTML::Template::VAR->new();
 2259                     $pmap{__index__}   = HTML::Template::VAR->new();
 2260                 }
 2261 
 2262             } elsif ($which eq '/TMPL_LOOP') {
 2263                 $options->{debug}
 2264                   and print STDERR "### HTML::Template Debug ### $fname : line $fcounter : LOOP end\n";
 2265 
 2266                 my $loopdata = pop(@loopstack);
 2267                 die "HTML::Template->new() : found </TMPL_LOOP> with no matching <TMPL_LOOP> at $fname : line $fcounter!"
 2268                   unless defined $loopdata;
 2269 
 2270                 my ($loop, $starts_at) = @$loopdata;
 2271 
 2272                 # resolve pending conditionals
 2273                 foreach my $uc (@ucstack) {
 2274                     my $var = $uc->[HTML::Template::COND::VARIABLE];
 2275                     if (exists($pmap{$var})) {
 2276                         $uc->[HTML::Template::COND::VARIABLE] = $pmap{$var};
 2277                     } else {
 2278                         $pmap{$var}     = HTML::Template::VAR->new();
 2279                         $top_pmap{$var} = HTML::Template::VAR->new()
 2280                           if $options->{global_vars} and not exists $top_pmap{$var};
 2281                         $uc->[HTML::Template::COND::VARIABLE] = $pmap{$var};
 2282                     }
 2283                     if (ref($pmap{$var}) eq 'HTML::Template::VAR') {
 2284                         $uc->[HTML::Template::COND::VARIABLE_TYPE] = HTML::Template::COND::VARIABLE_TYPE_VAR;
 2285                     } else {
 2286                         $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                 my $param_map = pop(@pmaps);
 2293                 *pmap = $pmaps[$#pmaps];
 2294                 my $parse_stack = pop(@pstacks);
 2295                 *pstack = $pstacks[$#pstacks];
 2296 
 2297                 scalar(@ifstack)
 2298                   and die
 2299                   "HTML::Template->new() : Dangling <TMPL_IF> or <TMPL_UNLESS> in loop ending at $fname : line $fcounter.";
 2300                 pop(@ifstacks);
 2301                 *ifstack = $ifstacks[$#ifstacks];
 2302                 pop(@ucstacks);
 2303                 *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                 $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                 if ($options->{die_on_bad_params}) {
 2324                     my $loops = $loop->[HTML::Template::LOOP::TEMPLATE_HASH];
 2325                     my @loop_keys = sort { $a <=> $b } keys %$loops;
 2326                     if (@loop_keys > 1) {
 2327                         my $last_loop = pop(@loop_keys);
 2328                         foreach my $loop (@loop_keys) {
 2329                             # make sure all the params in the last loop are also in this loop
 2330                             foreach my $param (keys %{$loops->{$last_loop}->{param_map}}) {
 2331                                 next if $loops->{$loop}->{param_map}->{$param};
 2332                                 $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                             foreach my $param (keys %{$loops->{$loop}->{param_map}}) {
 2336                                 next if $loops->{$last_loop}->{param_map}->{$param};
 2337                                 $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                 $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                 my $var;
 2350                 if (exists $pmap{$name}) {
 2351                     $var = $pmap{$name};
 2352                 } else {
 2353                     $var = $name;
 2354                 }
 2355 
 2356                 # connect the var to a conditional
 2357                 my $cond = HTML::Template::COND->new($var);
 2358                 if ($which eq 'TMPL_IF') {
 2359                     $cond->[HTML::Template::COND::WHICH]        = HTML::Template::COND::WHICH_IF;
 2360                     $cond->[HTML::Template::COND::JUMP_IF_TRUE] = 0;
 2361                 } else {
 2362                     $cond->[HTML::Template::COND::WHICH]        = HTML::Template::COND::WHICH_UNLESS;
 2363                     $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                 if ($var eq $name) {
 2369                     push(@ucstack, $cond);
 2370                 } else {
 2371                     if (ref($var) eq 'HTML::Template::VAR') {
 2372                         $cond->[HTML::Template::COND::VARIABLE_TYPE] = HTML::Template::COND::VARIABLE_TYPE_VAR;
 2373                     } else {
 2374                         $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                 push(@pstack,  $cond);
 2380                 push(@ifstack, $cond);
 2381 
 2382             } elsif ($which eq '/TMPL_IF' or $which eq '/TMPL_UNLESS') {
 2383                 $options->{debug}
 2384                   and print STDERR "### HTML::Template Debug ### $fname : line $fcounter : $which end\n";
 2385 
 2386                 my $cond = pop(@ifstack);
 2387                 die "HTML::Template->new() : found </${which}> with no matching <TMPL_IF> at $fname : line $fcounter."
 2388                   unless defined $cond;
 2389                 if ($which eq '/TMPL_IF') {
 2390                     die
 2391                       "HTML::Template->new() : found </TMPL_IF> incorrectly terminating a <TMPL_UNLESS> (use </TMPL_UNLESS>) at $fname : line $fcounter.\n"
 2392                       if ($cond->[HTML::Template::COND::WHICH] == HTML::Template::COND::WHICH_UNLESS);
 2393                 } else {
 2394                     die
 2395                       "HTML::Template->new() : found </TMPL_UNLESS> incorrectly terminating a <TMPL_IF> (use </TMPL_IF>) 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                 push(@pstack, $NOOP);
 2403                 $cond->[HTML::Template::COND::JUMP_ADDRESS] = $#pstack;
 2404 
 2405             } elsif ($which eq 'TMPL_ELSE') {
 2406                 $options->{debug}
 2407                   and print STDERR "### HTML::Template Debug ### $fname : line $fcounter : ELSE\n";
 2408 
 2409                 my $cond = pop(@ifstack);
 2410                 die
 2411                   "HTML::Template->new() : found <TMPL_ELSE> with no matching <TMPL_IF> or <TMPL_UNLESS> at $fname : line $fcounter."
 2412                   unless defined $cond;
 2413                 die
 2414                   "HTML::Template->new() : found second <TMPL_ELSE> tag for  <TMPL_IF> or <TMPL_UNLESS> at $fname : line $fcounter."
 2415                   if $cond->[HTML::Template::COND::IS_ELSE];
 2416 
 2417                 my $else = HTML::Template::COND->new($cond->[HTML::Template::COND::VARIABLE]);
 2418                 $else->[HTML::Template::COND::WHICH]              = $cond->[HTML::Template::COND::WHICH];
 2419                 $else->[HTML::Template::COND::UNCONDITIONAL_JUMP] = 1;
 2420                 $else->[HTML::Template::COND::IS_ELSE]            = 1;
 2421 
 2422                 # need end-block resolution?
 2423                 if (defined($cond->[HTML::Template::COND::VARIABLE_TYPE])) {
 2424                     $else->[HTML::Template::COND::VARIABLE_TYPE] = $cond->[HTML::Template::COND::VARIABLE_TYPE];
 2425                 } else {
 2426                     push(@ucstack, $else);
 2427                 }
 2428 
 2429                 push(@pstack,  $else);
 2430                 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                 $cond->[HTML::Template::COND::JUMP_ADDRESS] = $#pstack;
 2438 
 2439             } elsif ($which eq 'TMPL_INCLUDE') {
 2440                 # handle TMPL_INCLUDEs
 2441                 $options->{debug}
 2442                   and print STDERR "### HTML::Template Debug ### $fname : line $fcounter : INCLUDE $name \n";
 2443 
 2444                 # no includes here, bub
 2445                 $options->{no_includes}
 2446                   and croak("HTML::Template : Illegal attempt to use TMPL_INCLUDE in template file : (no_includes => 1)");
 2447 
 2448                 my $filename = $name;
 2449 
 2450                 # look for the included file...
 2451                 my $filepath;
 2452                 if ($options->{search_path_on_include}) {
 2453                     $filepath = $self->_find_file($filename);
 2454                 } else {
 2455                     $filepath = $self->_find_file($filename, [File::Spec->splitdir($fstack[-1][0])]);
 2456                 }
 2457                 die "HTML::Template->new() : Cannot open included file $filename : file not found."
 2458                   if !defined $filepath  && $options->{die_on_missing_include};
 2459 
 2460                 my $included_template = "";
 2461                 if( $filepath ) {
 2462                     # use the open_mode if we have one
 2463                     if (my $mode = $options->{open_mode}) {
 2464                         open(TEMPLATE, $mode, $filepath)
 2465                           || confess("HTML::Template->new() : Cannot open included file $filepath with mode $mode: $!");
 2466                     } else {
 2467                         open(TEMPLATE, $filepath)
 2468                           or confess("HTML::Template->new() : Cannot open included file $filepath : $!");
 2469                     }
 2470 
 2471                     # read into the array
 2472                     while (read(TEMPLATE, $included_template, 10240, length($included_template))) { }
 2473                     close(TEMPLATE);
 2474                 }
 2475 
 2476                 # call filters if necessary
 2477                 $self->_call_filters(\$included_template) if @{$options->{filter}};
 2478 
 2479                 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                     $options->{vanguard_compatibility_mode}
 2483                       and $included_template =~ s/%([-\w\/\.+]+)%/<TMPL_VAR NAME=$1>/g;
 2484 
 2485                     # collect mtimes for included files
 2486                     if ($options->{cache} and !$options->{blind_cache}) {
 2487                         $self->{included_mtimes}{$filepath} = (stat($filepath))[9];
 2488                     }
 2489 
 2490                     # adjust the fstack to point to the included file info
 2491                     push(@fstack, [$filepath, 1, scalar @{[$included_template =~ m/(\n)/g]} + 1]);
 2492                     (*fname, *fcounter, *fmax) = \(@{$fstack[$#fstack]});
 2493 
 2494                     # make sure we aren't infinitely recursing
 2495                     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                     $included_template .= $post;
 2503                     $post = undef;
 2504 
 2505                     # move the new chunks into place.
 2506                     splice(@chunks, $chunk_number, 1, split(m/(?=<)/, $included_template));
 2507 
 2508                     # recalculate stopping point
 2509                     $last_chunk = $#chunks;
 2510 
 2511                     # start in on the first line of the included text - nothing
 2512                     # else to do on this line.
 2513                     $chunk = $chunks[$chunk_number];
 2514 
 2515                     redo CHUNK;
 2516                 }
 2517             } else {
 2518                 # zuh!?
 2519                 die "HTML::Template->new() : Unknown or unmatched TMPL construct at $fname : line $fcounter.";
 2520             }
 2521             # push the rest after the tag
 2522             if (defined($post)) {
 2523                 if (ref($pstack[$#pstack]) eq 'SCALAR') {
 2524                     ${$pstack[$#pstack]} .= $post;
 2525                 } else {
 2526                     push(@pstack, \$post);
 2527                 }
 2528             }
 2529         } else {    # just your ordinary markup
 2530                     # make sure we didn't reject something TMPL_* but badly formed
 2531             if ($options->{strict}) {
 2532                 die "HTML::Template->new() : Syntax error in <TMPL_*> tag at $fname : $fcounter."
 2533                   if ($chunk =~ /<(?:!--\s*)?\/?tmpl_/i);
 2534             }
 2535 
 2536             # push the rest and get next chunk
 2537             if (defined($chunk)) {
 2538                 if (ref($pstack[$#pstack]) eq 'SCALAR') {
 2539                     ${$pstack[$#pstack]} .= $chunk;
 2540                 } else {
 2541                     push(@pstack, \$chunk);
 2542                 }
 2543             }
 2544         }
 2545         # count newlines in chunk and advance line count
 2546         $fcounter += scalar(@{[$chunk =~ m/(\n)/g]});
 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         pop(@fstack), (*fname, *fcounter, *fmax) = \(@{$fstack[$#fstack]})
 2550           if ($fcounter > $fmax);
 2551 
 2552     }    # next CHUNK
 2553 
 2554     # make sure we don't have dangling IF or LOOP blocks
 2555     scalar(@ifstack)
 2556       and die "HTML::Template->new() : At least one <TMPL_IF> or <TMPL_UNLESS> not terminated at end of file!";
 2557     scalar(@loopstack)
 2558       and die "HTML::Template->new() : At least one <TMPL_LOOP> not terminated at end of file!";
 2559 
 2560     # resolve pending conditionals
 2561     foreach my $uc (@ucstack) {
 2562         my $var = $uc->[HTML::Template::COND::VARIABLE];
 2563         if (exists($pmap{$var})) {
 2564             $uc->[HTML::Template::COND::VARIABLE] = $pmap{$var};
 2565         } else {
 2566             $pmap{$var}     = HTML::Template::VAR->new();
 2567             $top_pmap{$var} = HTML::Template::VAR->new()
 2568               if $options->{global_vars} and not exists $top_pmap{$var};
 2569             $uc->[HTML::Template::COND::VARIABLE] = $pmap{$var};
 2570         }
 2571         if (ref($pmap{$var}) eq 'HTML::Template::VAR') {
 2572             $uc->[HTML::Template::COND::VARIABLE_TYPE] = HTML::Template::COND::VARIABLE_TYPE_VAR;
 2573         } else {
 2574             $uc->[HTML::Template::COND::VARIABLE_TYPE] = HTML::Template::COND::VARIABLE_TYPE_LOOP;
 2575         }
 2576     }
 2577 
 2578     # want a stack dump?
 2579     if ($options->{stack_debug}) {
 2580         require 'Data/Dumper.pm';
 2581         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     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     my $self = shift;
 2593 
 2594     # associate with the loop (and top-level templates) above in the tree.
 2595     push(@{$self->{options}{associate}}, @_);
 2596 
 2597     # recurse down into the template tree, adding ourself to the end of
 2598     # list.
 2599     push(@_, $self);
 2600     map   { $_->_globalize_vars(@_) }
 2601       map { values %{$_->[HTML::Template::LOOP::TEMPLATE_HASH]} }
 2602       grep { ref($_) eq 'HTML::Template::LOOP' } @{$self->{parse_stack}};
 2603 }
 2604 
 2605 # method used to recursively un-hook associate
 2606 sub _unglobalize_vars {
 2607     my $self = shift;
 2608 
 2609     # disassociate
 2610     $self->{options}{associate} = undef;
 2611 
 2612     # recurse down into the template tree disassociating
 2613     map   { $_->_unglobalize_vars() }
 2614       map { values %{$_->[HTML::Template::LOOP::TEMPLATE_HASH]} }
 2615       grep { ref($_) eq 'HTML::Template::LOOP' } @{$self->{parse_stack}};
 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<utf8> 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<utf8> 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<new()> are acceptable to be
 2634 passed to this method.
 2635 
 2636 =cut
 2637 
 2638 sub config {
 2639     my ($pkg, %options) = @_;
 2640 
 2641     foreach my $opt (keys %options) {
 2642         if( $opt eq 'associate' || $opt eq 'filter' || $opt eq 'path' ) {
 2643             push(@{$OPTIONS{$opt}}, $options{$opt});
 2644         } else {
 2645             $OPTIONS{$opt} = $options{$opt};
 2646         }
 2647     }
 2648 
 2649     return %OPTIONS;
 2650 }
 2651 
 2652 =head2 param
 2653 
 2654 C<param()> 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 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<force_untaint>
 2707 option is set.
 2708 
 2709 =back
 2710 
 2711 =cut
 2712 
 2713 sub param {
 2714     my $self      = shift;
 2715     my $options   = $self->{options};
 2716     my $param_map = $self->{param_map};
 2717 
 2718     # the no-parameter case - return list of parameters in the template.
 2719     return keys(%$param_map) unless scalar(@_);
 2720 
 2721     my $first = shift;
 2722     my $type  = ref $first;
 2723 
 2724     # the one-parameter case - could be a parameter value request or a
 2725     # hash-ref.
 2726     if (!scalar(@_) and !length($type)) {
 2727         my $param = $options->{case_sensitive} ? $first : lc $first;
 2728 
 2729         # check for parameter existence
 2730         $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         return undef unless (exists($param_map->{$param})
 2737             and defined($param_map->{$param}));
 2738 
 2739         return ${$param_map->{$param}}
 2740           if (ref($param_map->{$param}) eq 'HTML::Template::VAR');
 2741         return $param_map->{$param}[HTML::Template::LOOP::PARAM_SET];
 2742     }
 2743 
 2744     if (!scalar(@_)) {
 2745         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         push(@_, %$first);
 2749     } else {
 2750         unshift(@_, $first);
 2751     }
 2752 
 2753     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     for (my $x = 0 ; $x <= $#_ ; $x += 2) {
 2760         my $param = $options->{case_sensitive} ? $_[$x] : lc $_[$x];
 2761         my $value = $_[($x + 1)];
 2762 
 2763         # check that this param exists in the template
 2764         $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         unless (exists($param_map->{$param})) {
 2773             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             if (ref($value) eq 'ARRAY') {
 2778                 $param_map->{$param} = HTML::Template::LOOP->new();
 2779             } else {
 2780                 $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         my $type = ref $value || '';
 2787         if ($type eq 'REF') {
 2788             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             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             $param_map->{$param}[HTML::Template::LOOP::PARAM_SET] = [@{$value}];
 2794         } elsif( $type eq 'CODE' ) {
 2795             # code can be used for a var or a loop
 2796             if( ref($param_map->{$param}) eq 'HTML::Template::LOOP' ) {
 2797                 $param_map->{$param}[HTML::Template::LOOP::PARAM_SET] = $value;
 2798             } else {
 2799                 ${$param_map->{$param}} = $value;
 2800             }
 2801         } else {
 2802             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             ${$param_map->{$param}} = $value;
 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     my $self = shift;
 2818     my $type;
 2819     foreach my $name (keys %{$self->{param_map}}) {
 2820         $type = ref($self->{param_map}{$name});
 2821         undef(${$self->{param_map}{$name}})
 2822           if ($type eq 'HTML::Template::VAR');
 2823         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     my $self = shift;
 2831     my $cgi  = shift;
 2832     (ref($cgi) eq 'CGI')
 2833       or croak("Warning! non-CGI object was passed to HTML::Template::associateCGI()!\n");
 2834     push(@{$self->{options}{associate}}, $cgi);
 2835     return 1;
 2836 }
 2837 
 2838 =head2 output
 2839 
 2840 C<output()> 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<< <TMPL_VAR NAME=name> >> is
 2846 replaced with the value assigned to "name" via C<param()>.  If a named
 2847 parameter is unset it is simply replaced with ''.  C<< <TMPL_LOOP> >>s
 2848 are evaluated once per parameter set, accumulating output on each pass.
 2849 
 2850 Calling C<output()> 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<print_to> option.
 2861 
 2862 =cut
 2863 
 2864 use vars qw(%URLESCAPE_MAP);
 2865 
 2866 sub output {
 2867     my $self    = shift;
 2868     my $options = $self->{options};
 2869     local $_;
 2870 
 2871     croak("HTML::Template->output() : You gave me an odd number of parameters to output()!")
 2872       unless ((@_ % 2) == 0);
 2873     my %args = @_;
 2874 
 2875     print STDERR "### HTML::Template Memory Debug ### START OUTPUT ", $self->{proc_mem}->size(), "\n"
 2876       if $options->{memory_debug};
 2877 
 2878     $options->{debug} and print STDERR "### HTML::Template Debug ### In output\n";
 2879 
 2880     # want a stack dump?
 2881     if ($options->{stack_debug}) {
 2882         require 'Data/Dumper.pm';
 2883         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     $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     if (scalar(@{$options->{associate}})) {
 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         my (%case_map, $lparam);
 2897         foreach my $associated_object (@{$options->{associate}}) {
 2898             # what a hack!  This should really be optimized out for case_sensitive.
 2899             if ($options->{case_sensitive}) {
 2900                 map { $case_map{$associated_object}{$_} = $_ } $associated_object->param();
 2901             } else {
 2902                 map { $case_map{$associated_object}{lc($_)} = $_ } $associated_object->param();
 2903             }
 2904         }
 2905 
 2906         foreach my $param (keys %{$self->{param_map}}) {
 2907             unless (defined($self->param($param))) {
 2908               OBJ: foreach my $associated_object (reverse @{$options->{associate}}) {
 2909                     $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     use vars qw($line @parse_stack);
 2917     local (*line, *parse_stack);
 2918 
 2919     # walk the parse stack, accumulating output in $result
 2920     *parse_stack = $self->{parse_stack};
 2921     my $result = '';
 2922 
 2923     tie $result, 'HTML::Template::PRINTSCALAR', $args{print_to}
 2924       if defined $args{print_to} && !eval { tied *{$args{print_to}} };
 2925 
 2926     my $type;
 2927     my $parse_stack_length = $#parse_stack;
 2928     for (my $x = 0 ; $x <= $parse_stack_length ; $x++) {
 2929         *line = \$parse_stack[$x];
 2930         $type = ref($line);
 2931 
 2932         if ($type eq 'SCALAR') {
 2933             $result .= $$line;
 2934         } elsif ($type eq 'HTML::Template::VAR' and ref($$line) eq 'CODE') {
 2935             if (defined($$line)) {
 2936                 my $tmp_val = $$line->($self);
 2937                 croak("HTML::Template->output() : 'force_untaint' option but coderef returns tainted value") 
 2938                   if $options->{force_untaint} && tainted($tmp_val);
 2939                 $result .= $tmp_val;
 2940 
 2941                 # change the reference to point to the value now not the code reference
 2942                 $$line = $tmp_val if $options->{cache_lazy_vars}
 2943             }
 2944         } elsif ($type eq 'HTML::Template::VAR') {
 2945             if (defined $$line) {
 2946                 if ($options->{force_untaint} && tainted($$line)) {
 2947                     croak("HTML::Template->output() : tainted value with 'force_untaint' option");
 2948                 }
 2949                 $result .= $$line;
 2950             }
 2951         } elsif ($type eq 'HTML::Template::LOOP') {
 2952             if (defined($line->[HTML::Template::LOOP::PARAM_SET])) {
 2953                 eval { $result .= $line->output($x, $options->{loop_context_vars}); };
 2954                 croak("HTML::Template->output() : fatal error in loop output : $@")
 2955                   if $@;
 2956             }
 2957         } elsif ($type eq 'HTML::Template::COND') {
 2958 
 2959             if ($line->[HTML::Template::COND::UNCONDITIONAL_JUMP]) {
 2960                 $x = $line->[HTML::Template::COND::JUMP_ADDRESS];
 2961             } else {
 2962                 if ($line->[HTML::Template::COND::JUMP_IF_TRUE]) {
 2963                     if ($line->[HTML::Template::COND::VARIABLE_TYPE] == HTML::Template::COND::VARIABLE_TYPE_VAR) {
 2964                         if (defined ${$line->[HTML::Template::COND::VARIABLE]}) {
 2965                             if (ref(${$line->[HTML::Template::COND::VARIABLE]}) eq 'CODE') {
 2966                                 my $tmp_val = ${$line->[HTML::Template::COND::VARIABLE]}->($self); 
 2967                                 $x = $line->[HTML::Template::COND::JUMP_ADDRESS] if $tmp_val;
 2968                                 ${$line->[HTML::Template::COND::VARIABLE]} = $tmp_val if $options->{cache_lazy_vars};
 2969                             } else {
 2970                                 $x = $line->[HTML::Template::COND::JUMP_ADDRESS] if ${$line->[HTML::Template::COND::VARIABLE]};
 2971                             }
 2972                         }
 2973                     } else {
 2974                         # if it's a code reference, execute it to get the values
 2975                         my $loop_values = $line->[HTML::Template::COND::VARIABLE][HTML::Template::LOOP::PARAM_SET];
 2976                         if (defined $loop_values && ref $loop_values eq 'CODE') {
 2977                             $loop_values = $loop_values->($self);
 2978                             $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                         if (defined $loop_values && @$loop_values) {
 2984                             $x = $line->[HTML::Template::COND::JUMP_ADDRESS];
 2985                         }
 2986                     }
 2987                 } else {
 2988                     if ($line->[HTML::Template::COND::VARIABLE_TYPE] == HTML::Template::COND::VARIABLE_TYPE_VAR) {
 2989                         if (defined ${$line->[HTML::Template::COND::VARIABLE]}) {
 2990                             if (ref(${$line->[HTML::Template::COND::VARIABLE]}) eq 'CODE') {
 2991                                 my $tmp_val = ${$line->[HTML::Template::COND::VARIABLE]}->($self);
 2992                                 $x = $line->[HTML::Template::COND::JUMP_ADDRESS] unless $tmp_val;
 2993                                 ${$line->[HTML::Template::COND::VARIABLE]} = $tmp_val if $options->{cache_lazy_vars};
 2994                             } else {
 2995                                 $x = $line->[HTML::Template::COND::JUMP_ADDRESS]
 2996                                   unless ${$line->[HTML::Template::COND::VARIABLE]};
 2997                             }
 2998                         } else {
 2999                             $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                         my $loop_values = $line->[HTML::Template::COND::VARIABLE][HTML::Template::LOOP::PARAM_SET];
 3004                         if(!defined $loop_values) {
 3005                             $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                             if( ref $loop_values eq 'CODE' ) {
 3009                                 $loop_values = $line->[HTML::Template::COND::VARIABLE][HTML::Template::LOOP::PARAM_SET]->($self);
 3010                                 $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                             if(!@$loop_values) {
 3016                                 $x = $line->[HTML::Template::COND::JUMP_ADDRESS];
 3017                             }
 3018                         }
 3019                     }
 3020                 }
 3021             }
 3022         } elsif ($type eq 'HTML::Template::NOOP') {
 3023             next;
 3024         } elsif ($type eq 'HTML::Template::DEF') {
 3025             $_ = $x;    # remember default place in stack
 3026 
 3027             # find next VAR, there might be an ESCAPE in the way
 3028             *line = \$parse_stack[++$x];
 3029             *line = \$parse_stack[++$x]
 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             if (defined $$line) {
 3036                 $x = $_;
 3037             } else {
 3038                 $result .= ${$parse_stack[$_]};
 3039             }
 3040             next;
 3041         } elsif ($type eq 'HTML::Template::ESCAPE') {
 3042             *line = \$parse_stack[++$x];
 3043             if (defined($$line)) {
 3044                 my $tmp_val;
 3045                 if (ref($$line) eq 'CODE') {
 3046                     $tmp_val = $$line->($self);
 3047                     if ($options->{force_untaint} > 1 && tainted($_)) {
 3048                         croak("HTML::Template->output() : 'force_untaint' option but coderef returns tainted value");
 3049                     }
 3050 
 3051                     $$line = $tmp_val if $options->{cache_lazy_vars};
 3052                 } else {
 3053                     $tmp_val = $$line;
 3054                     if ($options->{force_untaint} > 1 && tainted($_)) {
 3055                         croak("HTML::Template->output() : tainted value with 'force_untaint' option");
 3056                     }
 3057                 }
 3058 
 3059                 # straight from the CGI.pm bible.
 3060                 $tmp_val =~ s/&/&amp;/g;
 3061                 $tmp_val =~ s/\"/&quot;/g;
 3062                 $tmp_val =~ s/>/&gt;/g;
 3063                 $tmp_val =~ s/</&lt;/g;
 3064                 $tmp_val =~ s/'/&#39;/g; 
 3065 
 3066                 $result .= $tmp_val;
 3067             }
 3068             next;
 3069         } elsif ($type eq 'HTML::Template::JSESCAPE') {
 3070             $x++;
 3071             *line = \$parse_stack[$x];
 3072             if (defined($$line)) {
 3073                 my $tmp_val;
 3074                 if (ref($$line) eq 'CODE') {
 3075                     $tmp_val = $$line->($self);
 3076                     if ($options->{force_untaint} > 1 && tainted($_)) {
 3077                         croak("HTML::Template->output() : 'force_untaint' option but coderef returns tainted value");
 3078                     }
 3079                     $$line = $tmp_val if $options->{cache_lazy_vars};
 3080                 } else {
 3081                     $tmp_val = $$line;
 3082                     if ($options->{force_untaint} > 1 && tainted($_)) {
 3083                         croak("HTML::Template->output() : tainted value with 'force_untaint' option");
 3084                     }
 3085                 }
 3086                 $tmp_val =~ s/\\/\\\\/g;
 3087                 $tmp_val =~ s/'/\\'/g;
 3088                 $tmp_val =~ s/"/\\"/g;
 3089                 $tmp_val =~ s/[\n\x{2028}]/\\n/g;
 3090                 $tmp_val =~ s/\x{2029}/\\n\\n/g;
 3091                 $tmp_val =~ s/\r/\\r/g;
 3092                 $result .= $tmp_val;
 3093             }
 3094         } elsif ($type eq 'HTML::Template::URLESCAPE') {
 3095             $x++;
 3096             *line = \$parse_stack[$x];
 3097             if (defined($$line)) {
 3098                 my $tmp_val;
 3099                 if (ref($$line) eq 'CODE') {
 3100                     $tmp_val = $$line->($self);
 3101                     if ($options->{force_untaint} > 1 && tainted($_)) {
 3102                         croak("HTML::Template->output() : 'force_untaint' option but coderef returns tainted value");
 3103                     }
 3104                     $$line = $tmp_val if $options->{cache_lazy_vars};
 3105                 } else {
 3106                     $tmp_val = $$line;
 3107                     if ($options->{force_untaint} > 1 && tainted($_)) {
 3108                         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                 unless (exists($URLESCAPE_MAP{chr(1)})) {
 3113                     for (0 .. 255) { $URLESCAPE_MAP{chr($_)} = sprintf('%%%02X', $_); }
 3114                 }
 3115                 # do the translation (RFC 2396 ^uric)
 3116                 $tmp_val =~ s!([^a-zA-Z0-9_.\-])!$URLESCAPE_MAP{$1}!g;
 3117                 $result .= $tmp_val;
 3118             }
 3119         } else {
 3120             confess("HTML::Template::output() : Unknown item in parse_stack : " . $type);
 3121         }
 3122     }
 3123 
 3124     # undo the globalization circular refs
 3125     $self->_unglobalize_vars() if ($options->{global_vars});
 3126 
 3127     print STDERR "### HTML::Template Memory Debug ### END OUTPUT ", $self->{proc_mem}->size(), "\n"
 3128       if $options->{memory_debug};
 3129 
 3130     return undef if defined $args{print_to};
 3131     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<name> 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<TMPL_VAR>
 3147 parameter returns 'VAR' from C<query()>.
 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 C<TMPL_IF>s and C<TMPL_UNLESS>s
 3154 will be identified as 'VAR' unless they are also used in a C<TMPL_LOOP>,
 3155 in which case they will return 'LOOP'.
 3156 
 3157 C<query()> also allows you to get a list of parameters inside a loop
 3158 (and inside loops inside loops).  Example loop:
 3159 
 3160     <TMPL_LOOP NAME="EXAMPLE_LOOP">
 3161       <TMPL_VAR NAME="BEE">
 3162       <TMPL_VAR NAME="BOP">
 3163       <TMPL_LOOP NAME="EXAMPLE_INNER_LOOP">
 3164         <TMPL_VAR NAME="INNER_BEE">
 3165         <TMPL_VAR NAME="INNER_BOP">
 3166       </TMPL_LOOP>
 3167     </TMPL_LOOP>
 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<loop> option returns a list of parameter
 3194 names and both C<name> and C<loop> take array refs in order to refer to
 3195 parameters inside loops.  It is an error to use C<loop> 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<param()>, C<query()> with no arguments returns all the
 3202 parameter names in the template at the top level.
 3203 
 3204 =cut
 3205 
 3206 sub query {
 3207     my $self = shift;
 3208     $self->{options}{debug}
 3209       and print STDERR "### HTML::Template Debug ### query(", join(', ', @_), ")\n";
 3210 
 3211     # the no-parameter case - return $self->param()
 3212     return $self->param() unless scalar(@_);
 3213 
 3214     croak("HTML::Template::query() : Odd number of parameters passed to query!")
 3215       if (scalar(@_) % 2);
 3216     croak("HTML::Template::query() : Wrong number of parameters passed to query - should be 2.")
 3217       if (scalar(@_) != 2);
 3218 
 3219     my ($opt, $path) = (lc shift, shift);
 3220     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     $path = [$path] unless (ref $path);
 3225 
 3226     # find the param in question.
 3227     my @objs = $self->_find_param(@$path);
 3228     return undef unless scalar(@objs);
 3229     my ($obj, $type);
 3230 
 3231     # do what the user asked with the object
 3232     if ($opt eq 'name') {
 3233         # we only look at the first one.  new() should make sure they're
 3234         # all the same.
 3235         ($obj, $type) = (shift(@objs), shift(@objs));
 3236         return undef unless defined $obj;
 3237         return 'VAR'  if $type eq 'HTML::Template::VAR';
 3238         return 'LOOP' if $type eq 'HTML::Template::LOOP';
 3239         croak("HTML::Template::query() : unknown object ($type) in param_map!");
 3240 
 3241     } elsif ($opt eq 'loop') {
 3242         my %results;
 3243         while (@objs) {
 3244             ($obj, $type) = (shift(@objs), shift(@objs));
 3245             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             map { $results{$_} = 1 }
 3254               map { keys(%{$_->{'param_map'}}) } values(%{$obj->[HTML::Template::LOOP::TEMPLATE_HASH]});
 3255         }
 3256         # this is our loop list, return it.
 3257         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     my $self = shift;
 3265     my $spot = $self->{options}{case_sensitive} ? shift : lc shift;
 3266 
 3267     # get the obj and type for this spot
 3268     my $obj = $self->{'param_map'}{$spot};
 3269     return unless defined $obj;
 3270     my $type = ref $obj;
 3271 
 3272     # return if we're here or if we're not but this isn't a loop
 3273     return ($obj, $type) unless @_;
 3274     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     return map { $_->_find_param(@_) } values(%{$obj->[HTML::Template::LOOP::TEMPLATE_HASH]});
 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     my $value;
 3289     return bless(\$value, $_[0]);
 3290 }
 3291 
 3292 package HTML::Template::DEF;
 3293 
 3294 sub new {
 3295     my $value = $_[1];
 3296     return bless(\$value, $_[0]);
 3297 }
 3298 
 3299 package HTML::Template::LOOP;
 3300 
 3301 sub new {
 3302     return bless([], $_[0]);
 3303 }
 3304 
 3305 sub output {
 3306     my $self              = shift;
 3307     my $index             = shift;
 3308     my $loop_context_vars = shift;
 3309     my $template          = $self->[TEMPLATE_HASH]{$index};
 3310     my $value_sets_array  = $self->[PARAM_SET];
 3311     return unless defined($value_sets_array);
 3312 
 3313     my $result = '';
 3314     my $count  = 0;
 3315     my $odd    = 0;
 3316 
 3317     # execute the code to get the values if it's a code reference
 3318     if( ref $value_sets_array eq 'CODE' ) {
 3319         $value_sets_array = $value_sets_array->($template);
 3320         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         $self->[PARAM_SET] = $value_sets_array if $template->{options}->{cache_lazy_loops};
 3323     }
 3324 
 3325     foreach my $value_set (@$value_sets_array) {
 3326         if ($loop_context_vars) {
 3327             if ($count == 0) {
 3328                 @{$value_set}{qw(__first__ __inner__ __outer__ __last__)} = (1, 0, 1, $#{$value_sets_array} == 0);
 3329             } elsif ($count == $#{$value_sets_array}) {
 3330                 @{$value_set}{qw(__first__ __inner__ __outer__ __last__)} = (0, 0, 1, 1);
 3331             } else {
 3332                 @{$value_set}{qw(__first__ __inner__ __outer__ __last__)} = (0, 1, 0, 0);
 3333             }
 3334             $odd = $value_set->{__odd__} = !$odd;
 3335             $value_set->{__even__} = !$odd;
 3336             
 3337             $value_set->{__counter__} = $count + 1;
 3338             $value_set->{__index__}   = $count;
 3339         }
 3340         $template->param($value_set);
 3341         $result .= $template->output;
 3342         $template->clear_params;
 3343         @{$value_set}{qw(__first__ __last__ __inner__ __outer__ __odd__ __even__ __counter__ __index__)} = (0, 0, 0, 0, 0, 0, 0)
 3344           if ($loop_context_vars);
 3345         $count++;
 3346     }
 3347 
 3348     return $result;
 3349 }
 3350 
 3351 package HTML::Template::COND;
 3352 
 3353 sub new {
 3354     my $pkg  = shift;
 3355     my $var  = shift;
 3356     my $self = [];
 3357     $self->[VARIABLE] = $var;
 3358 
 3359     bless($self, $pkg);
 3360     return $self;
 3361 }
 3362 
 3363 package HTML::Template::NOOP;
 3364 
 3365 sub new {
 3366     my $unused;
 3367     my $self = \$unused;
 3368     bless($self, $_[0]);
 3369     return $self;
 3370 }
 3371 
 3372 package HTML::Template::ESCAPE;
 3373 
 3374 sub new {
 3375     my $unused;
 3376     my $self = \$unused;
 3377     bless($self, $_[0]);
 3378     return $self;
 3379 }
 3380 
 3381 package HTML::Template::JSESCAPE;
 3382 
 3383 sub new {
 3384     my $unused;
 3385     my $self = \$unused;
 3386     bless($self, $_[0]);
 3387     return $self;
 3388 }
 3389 
 3390 package HTML::Template::URLESCAPE;
 3391 
 3392 sub new {
 3393     my $unused;
 3394     my $self = \$unused;
 3395     bless($self, $_[0]);
 3396     return $self;
 3397 }
 3398 
 3399 # scalar-tying package for output(print_to => *HANDLE) implementation
 3400 package HTML::Template::PRINTSCALAR;
 3401 use strict;
 3402 
 3403 sub TIESCALAR { bless \$_[1], $_[0]; }
 3404 sub FETCH { }
 3405 
 3406 sub STORE {
 3407     my $self = shift;
 3408     local *FH = $$self;
 3409     print FH @_;
 3410 }
 3411 1;
 3412 __END__
 3413 
 3414 =head1 LAZY VALUES
 3415 
 3416 As mentioned above, both C<TMPL_VAR> and C<TMPL_LOOP> values can be code
 3417 references.  These code references are only executed if the variable or
 3418 loop is used in the template.  This is extremely useful if you want to
 3419 make a variable available to template designers but it can be expensive
 3420 to calculate, so you only want to do so if you have to.
 3421 
 3422 Maybe an example will help to illustrate. Let's say you have a template
 3423 like this:
 3424 
 3425     <tmpl_if we_care>
 3426       <tmpl_if life_universe_and_everything>
 3427     </tmpl_if>
 3428 
 3429 If C<life_universe_and_everything> is expensive to calculate we can
 3430 wrap it's calculation in a code reference and HTML::Template will only
 3431 execute that code if C<we_care> is also true.
 3432 
 3433     $tmpl->param(life_universe_and_everything => sub { calculate_42() });
 3434 
 3435 Your code reference will be given a single argument, the HTML::Template
 3436 object in use. In the above example, if we wanted C<calculate_42()>
 3437 to have this object we'd do something like this:
 3438 
 3439     $tmpl->param(life_universe_and_everything => sub { calculate_42(shift) });
 3440 
 3441 This same approach can be used for C<TMPL_LOOP>s too:
 3442 
 3443     <tmpl_if we_care>
 3444       <tmpl_loop needles_in_haystack>
 3445         Found <tmpl_var __counter>!
 3446       </tmpl_loop>
 3447     </tmpl_if>
 3448 
 3449 And in your Perl code:
 3450 
 3451     $tmpl->param(needles_in_haystack => sub { find_needles() });
 3452 
 3453 The only difference in the C<TMPL_LOOP> case is that the subroutine
 3454 needs to return a reference to an ARRAY, not just a scalar value.
 3455 
 3456 =head2 Multiple Calls
 3457 
 3458 It's important to recognize that while this feature is designed
 3459 to save processing time when things aren't needed, if you're not
 3460 careful it can actually increase the number of times you perform your
 3461 calculation. HTML::Template calls your code reference each time it seems
 3462 your loop in the template, this includes the times that you might use
 3463 the loop in a conditional (C<TMPL_IF> or C<TMPL_UNLESS>). For instance:
 3464 
 3465     <tmpl_if we care>
 3466       <tmpl_if needles_in_haystack>
 3467           <tmpl_loop needles_in_haystack>
 3468             Found <tmpl_var __counter>!
 3469           </tmpl_loop>
 3470       <tmpl_else>
 3471         No needles found!
 3472       </tmpl_if>
 3473     </tmpl_if>
 3474 
 3475 This will actually call C<find_needles()> twice which will be even worse
 3476 than you had before.  One way to work around this is to cache the return
 3477 value yourself:
 3478 
 3479     my $needles;
 3480     $tmpl->param(needles_in_haystack => sub { defined $needles ? $needles : $needles = find_needles() });
 3481 
 3482 =head1 BUGS
 3483 
 3484 I am aware of no bugs - if you find one, join the mailing list and
 3485 tell us about it.  You can join the HTML::Template mailing-list by
 3486 visiting:
 3487 
 3488     http://lists.sourceforge.net/lists/listinfo/html-template-users
 3489 
 3490 Of course, you can still email me directly (C<sam@tregar.com>) with bugs,
 3491 but I reserve the right to forward bug reports to the mailing list.
 3492 
 3493 When submitting bug reports, be sure to include full details,
 3494 including the VERSION of the module, a test script and a test template
 3495 demonstrating the problem!
 3496 
 3497 If you're feeling really adventurous, HTML::Template has a publically
 3498 available Git repository.  See below for more information in the
 3499 PUBLIC GIT REPOSITORY section.
 3500 
 3501 =head1 CREDITS
 3502 
 3503 This module was the brain child of my boss, Jesse Erlbaum
 3504 (C<jesse@vm.com>) at Vanguard Media (http://vm.com) .  The most original
 3505 idea in this module - the C<< <TMPL_LOOP> >> - was entirely his.
 3506 
 3507 Fixes, Bug Reports, Optimizations and Ideas have been generously
 3508 provided by:
 3509 
 3510 =over
 3511 
 3512 =item * Richard Chen
 3513 
 3514 =item * Mike Blazer
 3515 
 3516 =item * Adriano Nagelschmidt Rodrigues
 3517 
 3518 =item * Andrej Mikus
 3519 
 3520 =item * Ilya Obshadko
 3521 
 3522 =item * Kevin Puetz
 3523 
 3524 =item * Steve Reppucci
 3525 
 3526 =item * Richard Dice
 3527 
 3528 =item * Tom Hukins
 3529 
 3530 =item * Eric Zylberstejn
 3531 
 3532 =item * David Glasser
 3533 
 3534 =item * Peter Marelas
 3535 
 3536 =item * James William Carlson
 3537 
 3538 =item * Frank D. Cringle
 3539 
 3540 =item * Winfried Koenig
 3541 
 3542 =item * Matthew Wickline
 3543 
 3544 =item * Doug Steinwand
 3545 
 3546 =item * Drew Taylor
 3547 
 3548 =item * Tobias Brox
 3549 
 3550 =item * Michael Lloyd
 3551 
 3552 =item * Simran Gambhir
 3553 
 3554 =item * Chris Houser <chouser@bluweb.com>
 3555 
 3556 =item * Larry Moore
 3557 
 3558 =item * Todd Larason
 3559 
 3560 =item * Jody Biggs
 3561 
 3562 =item * T.J. Mather
 3563 
 3564 =item * Martin Schroth
 3565 
 3566 =item * Dave Wolfe
 3567 
 3568 =item * uchum
 3569 
 3570 =item * Kawai Takanori
 3571 
 3572 =item * Peter Guelich
 3573 
 3574 =item * Chris Nokleberg
 3575 
 3576 =item * Ralph Corderoy
 3577 
 3578 =item * William Ward
 3579 
 3580 =item * Ade Olonoh
 3581 
 3582 =item * Mark Stosberg
 3583 
 3584 =item * Lance Thomas
 3585 
 3586 =item * Roland Giersig
 3587 
 3588 =item * Jere Julian
 3589 
 3590 =item * Peter Leonard
 3591 
 3592 =item * Kenny Smith
 3593 
 3594 =item * Sean P. Scanlon
 3595 
 3596 =item * Martin Pfeffer
 3597 
 3598 =item * David Ferrance
 3599 
 3600 =item * Gyepi Sam  
 3601 
 3602 =item * Darren Chamberlain
 3603 
 3604 =item * Paul Baker
 3605 
 3606 =item * Gabor Szabo
 3607 
 3608 =item * Craig Manley
 3609 
 3610 =item * Richard Fein
 3611 
 3612 =item * The Phalanx Project
 3613 
 3614 =item * Sven Neuhaus
 3615 
 3616 =item * Michael Peters
 3617 
 3618 =item * Jan Dubois
 3619 
 3620 =item * Moritz Lenz
 3621 
 3622 =back
 3623 
 3624 Thanks!
 3625 
 3626 =head1 WEBSITE
 3627 
 3628 You can find information about HTML::Template and other related modules at:
 3629 
 3630    http://html-template.sourceforge.net
 3631 
 3632 =head1 PUBLIC GIT REPOSITORY
 3633 
 3634 HTML::Template now has a publicly accessible Git repository
 3635 provided by GitHub (github.com).  You can access it by
 3636 going to https://github.com/mpeters/html-template.  Give it a try!
 3637 
 3638 =head1 AUTHOR
 3639 
 3640 Sam Tregar, C<sam@tregar.com>
 3641 
 3642 =head1 CO-MAINTAINER
 3643 
 3644 Michael Peters, C<mpeters@plusthree.com>
 3645 
 3646 =head1 LICENSE
 3647 
 3648   HTML::Template : A module for using HTML Templates with Perl
 3649   Copyright (C) 2000-2011 Sam Tregar (sam@tregar.com)
 3650 
 3651   This module is free software; you can redistribute it and/or modify it
 3652   under the same terms as Perl itself, which means using either:
 3653 
 3654   a) the GNU General Public License as published by the Free Software
 3655   Foundation; either version 1, or (at your option) any later version,
 3656   
 3657   or
 3658 
 3659   b) the "Artistic License" which comes with this module.
 3660 
 3661   This program is distributed in the hope that it will be useful,
 3662   but WITHOUT ANY WARRANTY; without even the implied warranty of
 3663   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See either
 3664   the GNU General Public License or the Artistic License for more details.
 3665 
 3666   You should have received a copy of the Artistic License with this
 3667   module.  If not, I'll be glad to provide one.
 3668 
 3669   You should have received a copy of the GNU General Public License
 3670   along with this program. If not, write to the Free Software
 3671   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
 3672   USA
 3673 
 3674 =cut