1package HTML::Template; 2 3$HTML::Template::VERSION = '2.97'; 4 5=head1 NAME 6 7HTML::Template - Perl module to use HTML-like templating language 8 9=head1 SYNOPSIS 10 11First you make a template - this is just a normal HTML file with a few 12extra tags, the simplest being C<< <TMPL_VAR> >> 13 14For 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 25Now 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 40If all is well in the universe this should show something like this in 41your 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 48This module attempts to make using HTML templates simple and natural. 49It extends standard HTML with a few new HTML-esque tags - C<< <TMPL_VAR> >> 50C<< <TMPL_LOOP> >>, C<< <TMPL_INCLUDE> >>, C<< <TMPL_IF> >>, C<< <TMPL_ELSE> >> 51and C<< <TMPL_UNLESS> >>. The file written with HTML and these new tags 52is called a template. It is usually saved separate from your script - 53possibly even created by someone else! Using this module you fill in the 54values for the variables, loops and branches declared in the template. 55This allows you to separate design - the HTML - from the data, which 56you generate in the Perl script. 57 58This module is licensed under the same terms as Perl. See the LICENSE 59section below for more details. 60 61=head1 TUTORIAL 62 63If you're new to HTML::Template, I suggest you start with the 64introductory article available on Perl Monks: 65 66 http://www.perlmonks.org/?node_id=65642 67 68=head1 FAQ 69 70Please see L<HTML::Template::FAQ> 71 72=head1 MOTIVATION 73 74It is true that there are a number of packages out there to do HTML 75templates. On the one hand you have things like L<HTML::Embperl> which 76allows you freely mix Perl with HTML. On the other hand lie home-grown 77variable substitution solutions. Hopefully the module can find a place 78between the two. 79 80One advantage of this module over a full L<HTML::Embperl>-esque solution 81is that it enforces an important divide - design and programming. 82By limiting the programmer to just using simple variables and loops 83in the HTML, the template remains accessible to designers and other 84non-perl people. The use of HTML-esque syntax goes further to make the 85format understandable to others. In the future this similarity could be 86used to extend existing HTML editors/analyzers to support HTML::Template. 87 88An advantage of this module over home-grown tag-replacement schemes is 89the support for loops. In my work I am often called on to produce 90tables of data in html. Producing them using simplistic HTML 91templates results in programs containing lots of HTML since the HTML 92itself cannot represent loops. The introduction of loop statements in 93the HTML simplifies this situation considerably. The designer can 94layout a single row and the programmer can fill it in as many times as 95necessary - all they must agree on is the parameter names. 96 97For all that, I think the best thing about this module is that it does 98just one thing and it does it quickly and carefully. It doesn't try 99to replace Perl and HTML, it just augments them to interact a little 100better. And it's pretty fast. 101 102=head1 THE TAGS 103 104=head2 TMPL_VAR 105 106 <TMPL_VAR NAME="PARAMETER_NAME"> 107 108The C<< <TMPL_VAR> >> tag is very simple. For each C<< <TMPL_VAR> >> 109tag in the template you call: 110 111 $template->param(PARAMETER_NAME => "VALUE") 112 113When the template is output the C<< <TMPL_VAR> >> is replaced with the 114VALUE text you specified. If you don't set a parameter it just gets 115skipped in the output. 116 117You can also specify the value of the parameter as a code reference in order 118to have "lazy" variables. These sub routines will only be referenced if the 119variables are used. See L<LAZY VALUES> for more information. 120 121=head3 Attributes 122 123The following "attributes" can also be specified in template var tags: 124 125=over 126 127=item * escape 128 129This allows you to escape the value before it's put into the output. 130 131This is useful when you want to use a TMPL_VAR in a context where those characters would 132cause trouble. For example: 133 134 <input name=param type=text value="<TMPL_VAR PARAM>"> 135 136If you called C<param()> with a value like C<sam"my> you'll get in trouble 137with HTML's idea of a double-quote. On the other hand, if you use 138C<escape=html>, like this: 139 140 <input name=param type=text value="<TMPL_VAR PARAM ESCAPE=HTML>"> 141 142You'll get what you wanted no matter what value happens to be passed 143in for param. 144 145The following escape values are supported: 146 147=over 148 149=item * html 150 151Replaces the following characters with their HTML entity equivalent: 152C<&>, C<">, C<'>, C<< < >>, C<< > >> 153 154=item * js 155 156Escapes (with a backslash) the following characters: C<\>, C<'>, C<">, 157C<\n>, C<\r> 158 159=item * url 160 161URL escapes any ASCII characters except for letters, numbers, C<_>, C<.> and C<->. 162 163=item * none 164 165Performs no escaping. This is the default, but it's useful to be able to explicitly 166turn off escaping if you are using the C<default_escape> option. 167 168=back 169 170=item * default 171 172With this attribute you can assign a default value to a variable. 173For example, this will output "the devil gave me a taco" if the C<who> 174variable 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 184The C<< <TMPL_LOOP> >> tag is a bit more complicated than C<< <TMPL_VAR> >>. 185The C<< <TMPL_LOOP> >> tag allows you to delimit a section of text and 186give it a name. Inside this named loop you place C<< <TMPL_VAR> >>s. 187Now 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 189output from the text block for each pass. Unset parameters are skipped. 190Here's an example: 191 192In 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 199In 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 206The output is: 207 208 Name: Sam 209 Job: programmer 210 211 Name: Steve 212 Job: soda jerk 213 214As you can see above the C<< <TMPL_LOOP> >> takes a list of variable 215assignments and then iterates over the loop body producing output. 216 217Often you'll want to generate a C<< <TMPL_LOOP> >>'s contents 218programmatically. Here's an example of how this can be done (many other 219ways 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 240The 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 248It 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 259C<< <TMPL_LOOP> >>s within C<< <TMPL_LOOP> >>s are fine and work as you 260would expect. If the syntax for the C<param()> call has you stumped, 261here'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 272Basically, each C<< <TMPL_LOOP> >> gets an array reference. Inside the 273array are any number of hash references. These hashes contain the 274name=>value pairs for a single pass over the loop template. 275 276Inside a C<< <TMPL_LOOP> >>, the only variables that are usable are the 277ones from the C<< <TMPL_LOOP> >>. The variables in the outer blocks 278are not visible within a template loop. For the computer-science geeks 279among you, a C<< <TMPL_LOOP> >> introduces a new scope much like a perl 280subroutine call. If you want your variables to be global you can use 281C<global_vars> option to C<new()> described below. 282 283=head2 TMPL_INCLUDE 284 285 <TMPL_INCLUDE NAME="filename.tmpl"> 286 287This tag includes a template directly into the current template at 288the point where the tag is found. The included template contents are 289used exactly as if its contents were physically included in the master 290template. 291 292The file specified can be an absolute path (beginning with a '/' under 293Unix, for example). If it isn't absolute, the path to the enclosing 294file is tried first. After that the path in the environment variable 295C<HTML_TEMPLATE_ROOT> is tried, if it exists. Next, the "path" option 296is consulted, first as-is and then with C<HTML_TEMPLATE_ROOT> prepended 297if available. As a final attempt, the filename is passed to C<open()> 298directly. See below for more information on C<HTML_TEMPLATE_ROOT> 299and the C<path> option to C<new()>. 300 301As a protection against infinitely recursive includes, an arbitrary 302limit of 10 levels deep is imposed. You can alter this limit with the 303C<max_includes> option. See the entry for the C<max_includes> option 304below for more details. 305 306=head2 TMPL_IF 307 308 <TMPL_IF NAME="PARAMETER_NAME"> ... </TMPL_IF> 309 310The C<< <TMPL_IF> >> tag allows you to include or not include a block 311of the template based on the value of a given parameter name. If the 312parameter is given a value that is true for Perl - like '1' - then the 313block is included in the output. If it is not defined, or given a false 314value - like '0' - then it is skipped. The parameters are specified 315the same way as with C<< <TMPL_VAR> >>. 316 317Example Template: 318 319 <TMPL_IF NAME="BOOL"> 320 Some text that only gets displayed if BOOL is true! 321 </TMPL_IF> 322 323Now if you call C<< $template->param(BOOL => 1) >> then the above block 324will be included by output. 325 326C<< <TMPL_IF> </TMPL_IF> >> blocks can include any valid HTML::Template 327construct - C<VAR>s and C<LOOP>s and other C<IF>/C<ELSE> blocks. Note, 328however, that intersecting a C<< <TMPL_IF> >> and a C<< <TMPL_LOOP> >> 329is invalid. 330 331 Not going to work: 332 <TMPL_IF BOOL> 333 <TMPL_LOOP SOME_LOOP> 334 </TMPL_IF> 335 </TMPL_LOOP> 336 337If the name of a C<< <TMPL_LOOP> >> is used in a C<< <TMPL_IF> >>, 338the 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 348WARNING: Much of the benefit of HTML::Template is in decoupling your 349Perl and HTML. If you introduce numerous cases where you have 350C<TMPL_IF>s and matching Perl C<if>s, you will create a maintenance 351problem in keeping the two synchronized. I suggest you adopt the 352practice of only using C<TMPL_IF> if you can do so without requiring a 353matching C<if> in your Perl code. 354 355=head2 TMPL_ELSE 356 357 <TMPL_IF NAME="PARAMETER_NAME"> ... <TMPL_ELSE> ... </TMPL_IF> 358 359You can include an alternate block in your C<< <TMPL_IF> >> block by using 360C<< <TMPL_ELSE> >>. NOTE: You still end the block with C<< </TMPL_IF> >>, 361not 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 374This tag is the opposite of C<< <TMPL_IF> >>. The block is output if the 375C<PARAMETER_NAME> is set false or not defined. You can use 376C<< <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 385If the name of a C<< <TMPL_LOOP> >> is used in a C<< <TMPL_UNLESS> >>, 386the 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 400HTML::Template's tags are meant to mimic normal HTML tags. However, 401they are allowed to "break the rules". Something like: 402 403 <img src="<TMPL_VAR IMAGE_SRC>"> 404 405is not really valid HTML, but it is a perfectly valid use and will work 406as planned. 407 408The C<NAME=> in the tag is optional, although for extensibility's sake I 409recommend using it. Example - C<< <TMPL_LOOP LOOP_NAME> >> is acceptable. 410 411If you're a fanatic about valid HTML and would like your templates 412to conform to valid HTML syntax, you may optionally type template tags 413in the form of HTML comments. This may be of use to HTML authors who 414would like to validate their templates' HTML syntax prior to 415HTML::Template processing, or who use DTD-savvy editing tools. 416 417 <!-- TMPL_VAR NAME=PARAM1 --> 418 419In 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 426Call C<new()> to create a new Template object: 427 428 my $template = HTML::Template->new( 429 filename => 'file.tmpl', 430 option => 'value', 431 ); 432 433You must call C<new()> with at least one C<name => value> pair specifying how 434to access the template text. You can use C<< filename => 'file.tmpl' >> 435to specify a filename to be opened as the template. Alternately you can 436use: 437 438 my $t = HTML::Template->new( 439 scalarref => $ref_to_template_text, 440 option => 'value', 441 ); 442 443and 444 445 my $t = HTML::Template->new( 446 arrayref => $ref_to_array_of_lines, 447 option => 'value', 448 ); 449 450These initialize the template from in-memory resources. In almost every 451case you'll want to use the filename parameter. If you're worried about 452all the disk access from reading a template file just use mod_perl and 453the cache option detailed below. 454 455You can also read the template from an already opened filehandle, either 456traditionally as a glob or as a L<FileHandle>: 457 458 my $t = HTML::Template->new(filehandle => *FH, option => 'value'); 459 460The four C<new()> calling methods can also be accessed as below, if you 461prefer. 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 471And 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 478Which works for all three of the source types. 479 480If the environment variable C<HTML_TEMPLATE_ROOT> is set and your 481filename doesn't begin with "/", then the path will be relative to the 482value of c<HTML_TEMPLATE_ROOT>. 483 484B<Example> - if the environment variable C<HTML_TEMPLATE_ROOT> is set to 485F</home/sam> and I call C<< HTML::Template->new() >> with filename set 486to "sam.tmpl", HTML::Template will try to open F</home/sam/sam.tmpl> to 487access the template file. You can also affect the search path for files 488with the C<path> option to C<new()> - see below for more information. 489 490You can modify the Template object's behavior with C<new()>. The options 491are available: 492 493=head3 Error Detection Options 494 495=over 496 497=item * die_on_bad_params 498 499If set to 0 the module will let you call: 500 501 $template->param(param_name => 'value') 502 503even if 'param_name' doesn't exist in the template body. Defaults to 1. 504 505=item * force_untaint 506 507If set to 1 the module will not allow you to set unescaped parameters 508with tainted values. If set to 2 you will have to untaint all 509parameters, including ones with the escape attribute. This option 510makes sure you untaint everything so you don't accidentally introduce 511e.g. cross-site-scripting (XSS) vulnerabilities. Requires taint 512mode. Defaults to 0. 513 514=item * 515 516strict - if set to 0 the module will allow things that look like they 517might be TMPL_* tags to get by without dieing. Example: 518 519 <TMPL_HUH NAME=ZUH> 520 521Would normally cause an error, but if you call new with C<< strict => 0 >> 522HTML::Template will ignore it. Defaults to 1. 523 524=item * vanguard_compatibility_mode 525 526If set to 1 the module will expect to see C<< <TMPL_VAR> >>s that 527look like C<%NAME%> in addition to the standard syntax. Also sets 528C<die_on_bad_params => 0>. If you're not at Vanguard Media trying to 529use 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 539If set to 1 the module will cache in memory the parsed templates based 540on the filename parameter, the modification date of the file and the 541options passed to C<new()>. This only applies to templates opened with 542the filename parameter specified, not scalarref or arrayref templates. 543Caching also looks at the modification times of any files included using 544C<< <TMPL_INCLUDE> >> tags, but again, only if the template is opened 545with filename parameter. 546 547This is mainly of use in a persistent environment like Apache/mod_perl. 548It has absolutely no benefit in a normal CGI environment since the script 549is unloaded from memory after every request. For a cache that does work 550for a non-persistent environment see the C<shared_cache> option below. 551 552My simplistic testing shows that using cache yields a 90% performance 553increase under mod_perl. Cache defaults to 0. 554 555=item * shared_cache 556 557If set to 1 the module will store its cache in shared memory using the 558L<IPC::SharedCache> module (available from CPAN). The effect of this 559will be to maintain a single shared copy of each parsed template for 560all instances of HTML::Template on the same machine to use. This can 561be a significant reduction in memory usage in an environment with a 562single machine but multiple servers. As an example, on one of our 563systems we use 4MB of template cache and maintain 25 httpd processes - 564shared_cache results in saving almost 100MB! Of course, some reduction 565in speed versus normal caching is to be expected. Another difference 566between normal caching and shared_cache is that shared_cache will work 567in a non-persistent environment (like normal CGI) - normal caching is 568only useful in a persistent environment like Apache/mod_perl. 569 570By default HTML::Template uses the IPC key 'TMPL' as a shared root 571segment (0x4c504d54 in hex), but this can be changed by setting the 572C<ipc_key> C<new()> parameter to another 4-character or integer key. 573Other options can be used to affect the shared memory cache correspond 574to L<IPC::SharedCache> options - C<ipc_mode>, C<ipc_segment_size> and 575C<ipc_max_size>. See L<IPC::SharedCache> for a description of how these 576work - in most cases you shouldn't need to change them from the defaults. 577 578For more information about the shared memory cache system used by 579HTML::Template see L<IPC::SharedCache>. 580 581=item * double_cache 582 583If set to 1 the module will use a combination of C<shared_cache> and 584normal cache mode for the best possible caching. Of course, it also uses 585the most memory of all the cache modes. All the same ipc_* options that 586work with C<shared_cache> apply to C<double_cache> as well. Defaults to 0. 587 588=item * blind_cache 589 590If set to 1 the module behaves exactly as with normal caching but does 591not check to see if the file has changed on each request. This option 592should be used with caution, but could be of use on high-load servers. 593My tests show C<blind_cache> performing only 1 to 2 percent faster than 594cache under mod_perl. 595 596B<NOTE>: Combining this option with shared_cache can result in stale 597templates stuck permanently in shared memory! 598 599=item * file_cache 600 601If set to 1 the module will store its cache in a file using 602the L<Storable> module. It uses no additional memory, and my 603simplistic testing shows that it yields a 50% performance advantage. 604Like C<shared_cache>, it will work in a non-persistent environments 605(like CGI). Default is 0. 606 607If you set this option you must set the C<file_cache_dir> option. See 608below for details. 609 610B<NOTE>: L<Storable> uses C<flock()> to ensure safe access to cache 611files. Using C<file_cache> on a system or filesystem (like NFS) without 612C<flock()> support is dangerous. 613 614=item * file_cache_dir 615 616Sets the directory where the module will store the cache files if 617C<file_cache> is enabled. Your script will need write permissions to 618this directory. You'll also need to make sure the sufficient space is 619available to store the cache files. 620 621=item * file_cache_dir_mode 622 623Sets the file mode for newly created C<file_cache> directories and 624subdirectories. Defaults to "0700" for security but this may be 625inconvenient if you do not have access to the account running the 626webserver. 627 628=item * double_file_cache 629 630If set to 1 the module will use a combination of C<file_cache> and 631normal C<cache> mode for the best possible caching. The file_cache_* 632options that work with file_cache apply to C<double_file_cache> as well. 633Defaults to 0. 634 635=item * cache_lazy_vars 636 637The option tells HTML::Template to cache the values returned from code references 638used for C<TMPL_VAR>s. See L<LAZY VALUES> for details. 639 640=item * cache_lazy_loops 641 642The option tells HTML::Template to cache the values returned from code references 643used 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 653You can set this variable with a list of paths to search for files 654specified with the C<filename> option to C<new()> and for files included 655with the C<< <TMPL_INCLUDE> >> tag. This list is only consulted when the 656filename is relative. The C<HTML_TEMPLATE_ROOT> environment variable 657is always tried first if it exists. Also, if C<HTML_TEMPLATE_ROOT> is 658set then an attempt will be made to prepend C<HTML_TEMPLATE_ROOT> onto 659paths in the path array. In the case of a C<< <TMPL_INCLUDE> >> file, 660the path to the including file is also tried before path is consulted. 661 662Example: 663 664 my $template = HTML::Template->new( 665 filename => 'file.tmpl', 666 path => ['/path/to/templates', '/alternate/path'], 667 ); 668 669B<NOTE>: the paths in the path list must be expressed as UNIX paths, 670separated by the forward-slash character ('/'). 671 672=item * search_path_on_include 673 674If set to a true value the module will search from the top of the array 675of paths specified by the path option on every C<< <TMPL_INCLUDE> >> and 676use the first matching template found. The normal behavior is to look 677only in the current directory for a template to include. Defaults to 0. 678 679=item * utf8 680 681Setting this to true tells HTML::Template to treat your template files as 682UTF-8 encoded. This will apply to any file's passed to C<new()> or any 683included files. It won't do anything special to scalars templates passed 684to 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 691Most templates are either ASCII (the default) or UTF-8 encoded 692Unicode. But if you need some other encoding other than these 2, look 693at the C<open_mode> option. 694 695B<NOTE>: The C<utf8> and C<open_mode> options cannot be used at the 696same time. 697 698=item * open_mode 699 700You can set this option to an opening mode with which all template files 701will be opened. 702 703For 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 710That way you can force a different encoding (than the default ASCII 711or UTF-8), CR/LF properties etc. on the template files. See L<PerlIO> 712for details. 713 714B<NOTE>: this only works in perl 5.7.1 and above. 715 716B<NOTE>: you have to supply an opening mode that actually permits 717reading from the file handle. 718 719B<NOTE>: The C<utf8> and C<open_mode> options cannot be used at the 720same time. 721 722=back 723 724=head3 Debugging Options 725 726=over 727 728=item * debug 729 730If set to 1 the module will write random debugging information to STDERR. 731Defaults to 0. 732 733=item * stack_debug 734 735If set to 1 the module will use Data::Dumper to print out the contents 736of the parse_stack to STDERR. Defaults to 0. 737 738=item * cache_debug 739 740If set to 1 the module will send information on cache loads, hits and 741misses to STDERR. Defaults to 0. 742 743=item * shared_cache_debug 744 745If set to 1 the module will turn on the debug option in 746L<IPC::SharedCache>. Defaults to 0. 747 748=item * memory_debug 749 750If set to 1 the module will send information on cache memory usage 751to 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 761This option allows you to inherit the parameter values 762from other objects. The only requirement for the other object is that 763it have a C<param()> method that works like HTML::Template's C<param()>. A 764good 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 772Now, C<< $template->output() >> will act as though 773 774 $template->param(form_field => $cgi->param('form_field')); 775 776had been specified for each key/value pair that would be provided by the 777C<< $cgi->param() >> method. Parameters you set directly take precedence 778over associated parameters. 779 780You can specify multiple objects to associate by passing an anonymous 781array to the associate option. They are searched for parameters in the 782order they appear: 783 784 my $template = HTML::Template->new( 785 filename => 'template.tmpl', 786 associate => [$query, $other_obj], 787 ); 788 789B<NOTE>: The parameter names are matched in a case-insensitive manner. 790If you have two parameters in a CGI object like 'NAME' and 'Name' one 791will be chosen randomly by associate. This behavior can be changed by 792the C<case_sensitive> option. 793 794=item * case_sensitive 795 796Setting this option to true causes HTML::Template to treat template 797variable names case-sensitively. The following example would only set 798one 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 809This option defaults to off. 810 811B<NOTE>: with C<case_sensitive> and C<loop_context_vars> the special 812loop variables are available in lower-case only. 813 814=item * loop_context_vars 815 816When this parameter is set to true (it is false by default) extra variables 817that depend on the loop's context are made available inside a loop. These are: 818 819=over 820 821=item * __first__ 822 823Value that is true for the first iteration of the loop and false every other time. 824 825=item * __last__ 826 827Value that is true for the last iteration of the loop and false every other time. 828 829=item * __inner__ 830 831Value that is true for the every iteration of the loop except for the first and last. 832 833=item * __outer__ 834 835Value that is true for the first and last iterations of the loop. 836 837=item * __odd__ 838 839Value that is true for the every odd iteration of the loop. 840 841=item * __even__ 842 843Value that is true for the every even iteration of the loop. 844 845=item * __counter__ 846 847An integer (starting from 1) whose value increments for each iteration of the loop. 848 849=item * __index__ 850 851An integer (starting from 0) whose value increments for each iteration of the loop. 852 853=back 854 855Just like any other C<TMPL_VAR>s these variables can be used in 856C<< <TMPL_IF> >>, C<< <TMPL_UNLESS> >> and C<< <TMPL_ELSE> >> to control 857how a loop is output. 858 859Example: 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 885One use of this feature is to provide a "separator" similar in effect 886to 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 893Would output something like: 894 895 Apples, Oranges, Brains, Toes, and Kiwi. 896 897Given an appropriate C<param()> call, of course. B<NOTE>: A loop with only 898a single pass will get both C<__first__> and C<__last__> set to true, but 899not C<__inner__>. 900 901=item * no_includes 902 903Set this option to 1 to disallow the C<< <TMPL_INCLUDE> >> tag in the 904template file. This can be used to make opening untrusted templates 905B<slightly> less dangerous. Defaults to 0. 906 907=item * max_includes 908 909Set this variable to determine the maximum depth that includes can reach. 910Set to 10 by default. Including files to a depth greater than this 911value causes an error message to be displayed. Set to 0 to disable 912this protection. 913 914=item * die_on_missing_include 915 916If true, then HTML::Template will die if it can't find a file for a 917C<< <TMPL_INCLUDE> >>. This defaults to true. 918 919=item * global_vars 920 921Normally variables declared outside a loop are not available inside 922a loop. This option makes C<< <TMPL_VAR> >>s like global variables in 923Perl - they have unlimited scope. This option also affects C<< <TMPL_IF> >> 924and C<< <TMPL_UNLESS> >>. 925 926Example: 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 934Normally this wouldn't work as expected, since C<< <TMPL_VAR NORMAL> >>'s 935value outside the loop is not available inside the loop. 936 937The global_vars option also allows you to access the values of an 938enclosing loop within an inner loop. For example, in this loop the 939inner loop will have access to the value of C<OUTER_VAR> in the correct 940iteration: 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 950One side-effect of C<global_vars> is that variables you set with 951C<param()> that might otherwise be ignored when C<die_on_bad_params> 952is off will stick around. This is necessary to allow inner loops to 953access values set for outer loops that don't directly use the value. 954 955B<NOTE>: C<global_vars> is not C<global_loops> (which does not exist). 956That means that loops you declare at one scope are not available 957inside other loops even when C<global_vars> is on. 958 959=item * filter 960 961This option allows you to specify a filter for your template files. 962A filter is a subroutine that will be called after HTML::Template reads 963your template file but before it starts parsing template tags. 964 965In the most simple usage, you simply assign a code reference to the 966filter parameter. This subroutine will receive a single argument - 967a reference to a string containing the template file text. Here is 968an example that accepts templates with tags that look like 969C<!!!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 982More complicated usages are possible. You can request that your 983filter receives the template text as an array of lines rather than 984as a single scalar. To do that you need to specify your filter using 985a hash-ref. In this form you specify the filter using the C<sub> key 986and the desired argument format using the C<format> key. The available 987formats are C<scalar> and C<array>. Using the C<array> format will 988incur 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 998You may also have multiple filters. This allows simple filters to be 999combined for more elaborate functionality. To do this you specify 1000an array of filters. The filters are applied in the order they are 1001specified. 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 1017The specified filters will be called for any C<TMPL_INCLUDE>ed files just 1018as they are for the main template file. 1019 1020=item * default_escape 1021 1022Set this parameter to a valid escape type (see the C<escape> option) 1023and HTML::Template will apply the specified escaping to all variables 1024unless they declare a different escape in the template. 1025 1026=back 1027 1028=cut 1029 1030use integer; # no floating point math so far! 1031use strict; # and no funny business, either. 1032 1033use Carp; # generate better errors with more context 1034use File::Spec; # generate paths that work on all platforms 1035use Digest::MD5 qw(md5_hex); # generate cache keys 1036use 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. 1041package HTML::Template::LOOP; 1042sub TEMPLATE_HASH () { 0 } 1043sub PARAM_SET () { 1 } 1044 1045package HTML::Template::COND; 1046sub VARIABLE () { 0 } 1047sub VARIABLE_TYPE () { 1 } 1048sub VARIABLE_TYPE_VAR () { 0 } 1049sub VARIABLE_TYPE_LOOP () { 1 } 1050sub JUMP_IF_TRUE () { 2 } 1051sub JUMP_ADDRESS () { 3 } 1052sub WHICH () { 4 } 1053sub UNCONDITIONAL_JUMP () { 5 } 1054sub IS_ELSE () { 6 } 1055sub WHICH_IF () { 0 } 1056sub WHICH_UNLESS () { 1 } 1057 1058# back to the main package scope. 1059package HTML::Template; 1060 1061my %OPTIONS; 1062 1063# set the default options 1064BEGIN { 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 1106sub 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 1300sub _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 1312sub _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... 1337sub new_file { 1338 my $pkg = shift; 1339 return $pkg->new('filename', @_); 1340} 1341 1342sub new_filehandle { 1343 my $pkg = shift; 1344 return $pkg->new('filehandle', @_); 1345} 1346 1347sub new_array_ref { 1348 my $pkg = shift; 1349 return $pkg->new('arrayref', @_); 1350} 1351 1352sub 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. 1359sub _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 1419use vars qw( %CACHE ); 1420 1421sub _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 1480sub _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. 1500sub _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 1518sub _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 1538sub _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 1600sub _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. 1637sub _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 1661sub _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 1700sub _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. 1719sub _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 1762sub _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. 1778sub _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 1802sub _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 1865sub _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(). 1922sub _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) 2591sub _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 2606sub _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 2620A package method that is used to set/get the global default configuration options. 2621For instance, if you want to set the C<utf8> flag to always be on for every 2622template loaded by this process you would do: 2623 2624 HTML::Template->config(utf8 => 1); 2625 2626Or 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 2633Any configuration options that are valid for C<new()> are acceptable to be 2634passed to this method. 2635 2636=cut 2637 2638sub 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 2654C<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 2706An error occurs if you try to set a value that is tainted if the C<force_untaint> 2707option is set. 2708 2709=back 2710 2711=cut 2712 2713sub 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 2812Sets all the parameters to undef. Useful internally, if nowhere else! 2813 2814=cut 2815 2816sub 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 2829sub 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 2840C<output()> returns the final result of the template. In most situations 2841you'll want to print this, like: 2842 2843 print $template->output(); 2844 2845When output is called each occurrence of C<< <TMPL_VAR NAME=name> >> is 2846replaced with the value assigned to "name" via C<param()>. If a named 2847parameter is unset it is simply replaced with ''. C<< <TMPL_LOOP> >>s 2848are evaluated once per parameter set, accumulating output on each pass. 2849 2850Calling C<output()> is guaranteed not to change the state of the 2851HTML::Template object, in case you were wondering. This property is 2852mostly important for the internal implementation of loops. 2853 2854You may optionally supply a filehandle to print to automatically as the 2855template is generated. This may improve performance and lower memory 2856consumption. Example: 2857 2858 $template->output(print_to => *STDOUT); 2859 2860The return value is undefined when using the C<print_to> option. 2861 2862=cut 2863 2864use vars qw(%URLESCAPE_MAP); 2865 2866sub 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/&/&/g; 3061 $tmp_val =~ s/\"/"/g; 3062 $tmp_val =~ s/>/>/g; 3063 $tmp_val =~ s/</</g; 3064 $tmp_val =~ s/'/'/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 3136This method allow you to get information about the template structure. 3137It can be called in a number of ways. The simplest usage of query is 3138simply to check whether a parameter name exists in the template, using 3139the 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 3145This same usage returns the type of the parameter. The type is the same 3146as the tag minus the leading 'TMPL_'. So, for example, a C<TMPL_VAR> 3147parameter 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 3153Note that the variables associated with C<TMPL_IF>s and C<TMPL_UNLESS>s 3154will be identified as 'VAR' unless they are also used in a C<TMPL_LOOP>, 3155in which case they will return 'LOOP'. 3156 3157C<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 3169And 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 3193As you can see above the C<loop> option returns a list of parameter 3194names and both C<name> and C<loop> take array refs in order to refer to 3195parameters inside loops. It is an error to use C<loop> with a parameter 3196that is not a loop. 3197 3198Note that all the names are returned in lowercase and the types are 3199uppercase. 3200 3201Just like C<param()>, C<query()> with no arguments returns all the 3202parameter names in the template at the top level. 3203 3204=cut 3205 3206sub 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. 3263sub _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 3285package HTML::Template::VAR; 3286 3287sub new { 3288 my $value; 3289 return bless(\$value, $_[0]); 3290} 3291 3292package HTML::Template::DEF; 3293 3294sub new { 3295 my $value = $_[1]; 3296 return bless(\$value, $_[0]); 3297} 3298 3299package HTML::Template::LOOP; 3300 3301sub new { 3302 return bless([], $_[0]); 3303} 3304 3305sub 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 3351package HTML::Template::COND; 3352 3353sub 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 3363package HTML::Template::NOOP; 3364 3365sub new { 3366 my $unused; 3367 my $self = \$unused; 3368 bless($self, $_[0]); 3369 return $self; 3370} 3371 3372package HTML::Template::ESCAPE; 3373 3374sub new { 3375 my $unused; 3376 my $self = \$unused; 3377 bless($self, $_[0]); 3378 return $self; 3379} 3380 3381package HTML::Template::JSESCAPE; 3382 3383sub new { 3384 my $unused; 3385 my $self = \$unused; 3386 bless($self, $_[0]); 3387 return $self; 3388} 3389 3390package HTML::Template::URLESCAPE; 3391 3392sub 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 3400package HTML::Template::PRINTSCALAR; 3401use strict; 3402 3403sub TIESCALAR { bless \$_[1], $_[0]; } 3404sub FETCH { } 3405 3406sub STORE { 3407 my $self = shift; 3408 local *FH = $$self; 3409 print FH @_; 3410} 34111; 3412__END__ 3413 3414=head1 LAZY VALUES 3415 3416As mentioned above, both C<TMPL_VAR> and C<TMPL_LOOP> values can be code 3417references. These code references are only executed if the variable or 3418loop is used in the template. This is extremely useful if you want to 3419make a variable available to template designers but it can be expensive 3420to calculate, so you only want to do so if you have to. 3421 3422Maybe an example will help to illustrate. Let's say you have a template 3423like this: 3424 3425 <tmpl_if we_care> 3426 <tmpl_if life_universe_and_everything> 3427 </tmpl_if> 3428 3429If C<life_universe_and_everything> is expensive to calculate we can 3430wrap it's calculation in a code reference and HTML::Template will only 3431execute that code if C<we_care> is also true. 3432 3433 $tmpl->param(life_universe_and_everything => sub { calculate_42() }); 3434 3435Your code reference will be given a single argument, the HTML::Template 3436object in use. In the above example, if we wanted C<calculate_42()> 3437to have this object we'd do something like this: 3438 3439 $tmpl->param(life_universe_and_everything => sub { calculate_42(shift) }); 3440 3441This 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 3449And in your Perl code: 3450 3451 $tmpl->param(needles_in_haystack => sub { find_needles() }); 3452 3453The only difference in the C<TMPL_LOOP> case is that the subroutine 3454needs to return a reference to an ARRAY, not just a scalar value. 3455 3456=head2 Multiple Calls 3457 3458It's important to recognize that while this feature is designed 3459to save processing time when things aren't needed, if you're not 3460careful it can actually increase the number of times you perform your 3461calculation. HTML::Template calls your code reference each time it seems 3462your loop in the template, this includes the times that you might use 3463the 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 3475This will actually call C<find_needles()> twice which will be even worse 3476than you had before. One way to work around this is to cache the return 3477value yourself: 3478 3479 my $needles; 3480 $tmpl->param(needles_in_haystack => sub { defined $needles ? $needles : $needles = find_needles() }); 3481 3482=head1 BUGS 3483 3484I am aware of no bugs - if you find one, join the mailing list and 3485tell us about it. You can join the HTML::Template mailing-list by 3486visiting: 3487 3488 http://lists.sourceforge.net/lists/listinfo/html-template-users 3489 3490Of course, you can still email me directly (C<sam@tregar.com>) with bugs, 3491but I reserve the right to forward bug reports to the mailing list. 3492 3493When submitting bug reports, be sure to include full details, 3494including the VERSION of the module, a test script and a test template 3495demonstrating the problem! 3496 3497If you're feeling really adventurous, HTML::Template has a publically 3498available Git repository. See below for more information in the 3499PUBLIC GIT REPOSITORY section. 3500 3501=head1 CREDITS 3502 3503This module was the brain child of my boss, Jesse Erlbaum 3504(C<jesse@vm.com>) at Vanguard Media (http://vm.com) . The most original 3505idea in this module - the C<< <TMPL_LOOP> >> - was entirely his. 3506 3507Fixes, Bug Reports, Optimizations and Ideas have been generously 3508provided 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 3624Thanks! 3625 3626=head1 WEBSITE 3627 3628You 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 3634HTML::Template now has a publicly accessible Git repository 3635provided by GitHub (github.com). You can access it by 3636going to https://github.com/mpeters/html-template. Give it a try! 3637 3638=head1 AUTHOR 3639 3640Sam Tregar, C<sam@tregar.com> 3641 3642=head1 CO-MAINTAINER 3643 3644Michael 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 3675