blib/lib/HTML/Template.pm | |||
---|---|---|---|
Criterion | Covered | Total | % |
statement | 1044 | 1259 | 82.9 |
branch | 541 | 834 | 64.8 |
condition | 178 | 295 | 60.3 |
subroutine | 76 | 81 | 93.8 |
pod | 5 | 13 | 38.4 |
total | 1844 | 2482 | 74.2 |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | package HTML::Template; | ||||||
2 | |||||||
3 | $HTML::Template::VERSION = '2.9_01'; | ||||||
4 | |||||||
5 | =head1 NAME | ||||||
6 | |||||||
7 | HTML::Template - Perl module to use HTML Templates from CGI scripts | ||||||
8 | |||||||
9 | =head1 SYNOPSIS | ||||||
10 | |||||||
11 | First you make a template - this is just a normal HTML file with a few | ||||||
12 | extra tags, the simplest being |
||||||
13 | |||||||
14 | For example, test.tmpl: | ||||||
15 | |||||||
16 | |||||||
17 | |
||||||
18 | |||||||
19 | My Home Directory is |
||||||
20 |
|
||||||
21 | My Path is set to |
||||||
22 | |||||||
23 | |||||||
24 | |||||||
25 | Now create a small CGI program: | ||||||
26 | |||||||
27 | #!/usr/bin/perl -w | ||||||
28 | use HTML::Template; | ||||||
29 | |||||||
30 | # open the html template | ||||||
31 | my $template = HTML::Template->new(filename => 'test.tmpl'); | ||||||
32 | |||||||
33 | # fill in some parameters | ||||||
34 | $template->param(HOME => $ENV{HOME}); | ||||||
35 | $template->param(PATH => $ENV{PATH}); | ||||||
36 | |||||||
37 | # send the obligatory Content-Type and print the template output | ||||||
38 | print "Content-Type: text/html\n\n", $template->output; | ||||||
39 | |||||||
40 | If all is well in the universe this should show something like this in | ||||||
41 | your browser when visiting the CGI: | ||||||
42 | |||||||
43 | My Home Directory is /home/some/directory | ||||||
44 | My Path is set to /bin;/usr/bin | ||||||
45 | |||||||
46 | =head1 DESCRIPTION | ||||||
47 | |||||||
48 | This module attempts to make using HTML templates simple and natural. | ||||||
49 | It extends standard HTML with a few new HTML-esque tags - |
||||||
50 | |
||||||
51 | |
||||||
52 | HTML::Template (or HTML::Template::Expr) so that you can then create | ||||||
53 | your own application specific tags, eg. |
||||||
54 | |
||||||
55 | |||||||
56 | The file written with HTML and these new tags is called a template. | ||||||
57 | It is usually saved separate from your script - possibly even created | ||||||
58 | by someone else! Using this module you fill in the values for the | ||||||
59 | variables, loops and branches declared in the template. This allows | ||||||
60 | you to separate design - the HTML - from the data, which you generate | ||||||
61 | in the Perl script. | ||||||
62 | |||||||
63 | This module is licensed under the GPL. See the LICENSE section | ||||||
64 | below for more details. | ||||||
65 | |||||||
66 | =head1 TUTORIAL | ||||||
67 | |||||||
68 | If you're new to HTML::Template, I suggest you start with the | ||||||
69 | introductory article available on the HTML::Template website: | ||||||
70 | |||||||
71 | http://html-template.sourceforge.net | ||||||
72 | |||||||
73 | =head1 MOTIVATION | ||||||
74 | |||||||
75 | It is true that there are a number of packages out there to do HTML | ||||||
76 | templates. On the one hand you have things like HTML::Embperl which | ||||||
77 | allows you freely mix Perl with HTML. On the other hand lie | ||||||
78 | home-grown variable substitution solutions. Hopefully the module can | ||||||
79 | find a place between the two. | ||||||
80 | |||||||
81 | One advantage of this module over a full HTML::Embperl-esque solution | ||||||
82 | is that it enforces an important divide - design and programming. By | ||||||
83 | limiting the programmer to just using simple variables and loops in | ||||||
84 | the HTML, the template remains accessible to designers and other | ||||||
85 | non-perl people. The use of HTML-esque syntax goes further to make | ||||||
86 | the format understandable to others. In the future this similarity | ||||||
87 | could be used to extend existing HTML editors/analyzers to support | ||||||
88 | HTML::Template. | ||||||
89 | |||||||
90 | An advantage of this module over home-grown tag-replacement schemes is | ||||||
91 | the support for loops. In my work I am often called on to produce | ||||||
92 | tables of data in html. Producing them using simplistic HTML | ||||||
93 | templates results in CGIs containing lots of HTML since the HTML | ||||||
94 | itself cannot represent loops. The introduction of loop statements in | ||||||
95 | the HTML simplifies this situation considerably. The designer can | ||||||
96 | layout a single row and the programmer can fill it in as many times as | ||||||
97 | necessary - all they must agree on is the parameter names. | ||||||
98 | |||||||
99 | For all that, I think the best thing about this module is that it does | ||||||
100 | just one thing and it does it quickly and carefully. It doesn't try | ||||||
101 | to replace Perl and HTML, it just augments them to interact a little | ||||||
102 | better. And it's pretty fast. | ||||||
103 | |||||||
104 | =head1 THE TAGS | ||||||
105 | |||||||
106 | =head2 TMPL_VAR | ||||||
107 | |||||||
108 | |
||||||
109 | |||||||
110 | The |
||||||
111 | template you call $template->param(PARAMETER_NAME => "VALUE"). When | ||||||
112 | the template is output the |
||||||
113 | you specified. If you don't set a parameter it just gets skipped in | ||||||
114 | the output. | ||||||
115 | |||||||
116 | You can assign a default value to a variable with the DEFAULT attribute, | ||||||
117 | should the value of a template variable not have been set. For example, | ||||||
118 | this will output "the devil gave me a taco" if the "who" variable is | ||||||
119 | not set. | ||||||
120 | |||||||
121 | The |
||||||
122 | |||||||
123 | You can use the "ESCAPE=xxx" option in the tag to indicate that you | ||||||
124 | want the value to be escaped before being returned from output. | ||||||
125 | Example: | ||||||
126 | |||||||
127 | "> | ||||||
128 | |||||||
129 | If the value within PARAM contained sam"my, you will get into trouble | ||||||
130 | with HTML's idea of double-quoting. To overcome this you can use the | ||||||
131 | form: | ||||||
132 | |||||||
133 | "> | ||||||
134 | |||||||
135 | which tells HTML::Template that you would like it to transform any | ||||||
136 | characters that HTML renderers would consider bad-form, into their | ||||||
137 | corresponding HTML equivalent-character entities. | ||||||
138 | |||||||
139 | =over 4 | ||||||
140 | |||||||
141 | =item eg: | ||||||
142 | |||||||
143 | & becomes & | ||||||
144 | " becomes " | ||||||
145 | ' becomes ' | ||||||
146 | < becomes < | ||||||
147 | > becomes > | ||||||
148 | |||||||
149 | =back | ||||||
150 | |||||||
151 | Other variations of escaping are available, see L |
||||||
152 | for more information. | ||||||
153 | |||||||
154 | =head2 TMPL_LOOP | ||||||
155 | |||||||
156 | |
||||||
157 | |||||||
158 | The |
||||||
159 | |
||||||
160 | name. Inside this named loop you place |
||||||
161 | C a list (an array ref) of parameter assignments (hash refs) for | ||||||
162 | this loop. The loop iterates over the list and produces output from | ||||||
163 | the text block for each pass. Unset parameters cause HTML::Template to | ||||||
164 | die (or are skipped). Here's an example: | ||||||
165 | |||||||
166 | In the template: | ||||||
167 | |||||||
168 | |
||||||
169 | Name: |
||||||
170 | Job:
|
||||||
171 | |||||||
172 | |||||||
173 | |||||||
174 | In the script: | ||||||
175 | |||||||
176 | $template->param(EMPLOYEE_INFO => [ | ||||||
177 | { name => 'Sam', job => 'programmer' }, | ||||||
178 | { name => 'Steve', job => 'soda jerk' }, | ||||||
179 | ] | ||||||
180 | ); | ||||||
181 | print $template->output(); | ||||||
182 | |||||||
183 | |||||||
184 | The output in a browser: | ||||||
185 | |||||||
186 | Name: Sam | ||||||
187 | Job: programmer | ||||||
188 | |||||||
189 | Name: Steve | ||||||
190 | Job: soda jerk | ||||||
191 | |||||||
192 | As you can see above the |
||||||
193 | assignments and then iterates over the loop body producing output. | ||||||
194 | |||||||
195 | Often you'll want to generate a |
||||||
196 | programmatically. Here's an example of how this can be done (many | ||||||
197 | other ways are possible!): | ||||||
198 | |||||||
199 | # a couple of arrays of data to put in a loop: | ||||||
200 | my @words = qw(I Am Cool); | ||||||
201 | my @numbers = qw(1 2 3); | ||||||
202 | |||||||
203 | my @loop_data = (); # initialize an array to hold your loop | ||||||
204 | |||||||
205 | while (@words and @numbers) { | ||||||
206 | my %row_data; # get a fresh hash for the row data | ||||||
207 | |||||||
208 | # fill in this row | ||||||
209 | $row_data{WORD} = shift @words; | ||||||
210 | $row_data{NUMBER} = shift @numbers; | ||||||
211 | |||||||
212 | # the crucial step - push a reference to this row into the loop! | ||||||
213 | push(@loop_data, \%row_data); | ||||||
214 | } | ||||||
215 | |||||||
216 | # finally, assign the loop data to the loop param, again with a | ||||||
217 | # reference: | ||||||
218 | $template->param(THIS_LOOP => \@loop_data); | ||||||
219 | |||||||
220 | The above example would work with a template like: | ||||||
221 | |||||||
222 | |
||||||
223 | Word: |
||||||
224 | Number:
|
||||||
225 | |||||||
226 | |||||||
227 | It would produce output like: | ||||||
228 | |||||||
229 | Word: I | ||||||
230 | Number: 1 | ||||||
231 | |||||||
232 | Word: Am | ||||||
233 | Number: 2 | ||||||
234 | |||||||
235 | Word: Cool | ||||||
236 | Number: 3 | ||||||
237 | |||||||
238 | |
||||||
239 | expect. If the syntax for the C call has you stumped, here's an | ||||||
240 | example of a param call with one nested loop: | ||||||
241 | |||||||
242 | $template->param(LOOP => [ | ||||||
243 | { name => 'Bobby', | ||||||
244 | nicknames => [ | ||||||
245 | { name => 'the big bad wolf' }, | ||||||
246 | { name => 'He-Man' }, | ||||||
247 | ], | ||||||
248 | }, | ||||||
249 | ], | ||||||
250 | ); | ||||||
251 | |||||||
252 | Basically, each |
||||||
253 | are any number of hash references. These hashes contain the | ||||||
254 | name=>value pairs for a single pass over the loop template. | ||||||
255 | |||||||
256 | Inside a |
||||||
257 | from the |
||||||
258 | visible within a template loop. For the computer-science geeks among | ||||||
259 | you, a |
||||||
260 | call. If you want your variables to be global you can use | ||||||
261 | 'global_vars' option to new() described below. | ||||||
262 | |||||||
263 | =head2 TMPL_INCLUDE | ||||||
264 | |||||||
265 | |
||||||
266 | |||||||
267 | This tag includes a template directly into the current template at the | ||||||
268 | point where the tag is found. The included template contents are used | ||||||
269 | exactly as if its contents were physically included in the master | ||||||
270 | template. | ||||||
271 | |||||||
272 | The file specified can be an absolute path (beginning with a '/' under | ||||||
273 | Unix, for example). If it isn't absolute, the path to the enclosing | ||||||
274 | file is tried first. After that the path in the environment variable | ||||||
275 | HTML_TEMPLATE_ROOT is tried, if it exists. Next, the "path" option is | ||||||
276 | consulted, first as-is and then with HTML_TEMPLATE_ROOT prepended if | ||||||
277 | available. As a final attempt, the filename is passed to open() | ||||||
278 | directly. See below for more information on HTML_TEMPLATE_ROOT and | ||||||
279 | the "path" option to new(). | ||||||
280 | |||||||
281 | As a protection against infinitly recursive includes, an arbitary | ||||||
282 | limit of 10 levels deep is imposed. You can alter this limit with the | ||||||
283 | "max_includes" option. See the entry for the "max_includes" option | ||||||
284 | below for more details. | ||||||
285 | |||||||
286 | =head2 TMPL_REQUIRE | ||||||
287 | |||||||
288 | |
||||||
289 | |||||||
290 | Like |
||||||
291 | scope. It differs in that it only does this once. | ||||||
292 | |||||||
293 | =head2 TMPL_IF | ||||||
294 | |||||||
295 | |
||||||
296 | |||||||
297 | The |
||||||
298 | template based on the value of a given parameter name. If the | ||||||
299 | parameter is given a value that is true for Perl - like '1' - then the | ||||||
300 | block is included in the output. If it is not defined, or given a | ||||||
301 | false value - like '0' - then it is skipped. The parameters are | ||||||
302 | specified the same way as with TMPL_VAR. | ||||||
303 | |||||||
304 | Example Template: | ||||||
305 | |||||||
306 | |
||||||
307 | Some text that only gets displayed if BOOL is true! | ||||||
308 | |||||||
309 | |||||||
310 | Now if you call $template->param(BOOL => 1) then the above block will | ||||||
311 | be included by output. | ||||||
312 | |||||||
313 | |
||||||
314 | construct - VARs and LOOPs and other IF/ELSE blocks. Note, however, | ||||||
315 | that intersecting a |
||||||
316 | |||||||
317 | Not going to work: | ||||||
318 | |
||||||
319 | |
||||||
320 | |||||||
321 | |||||||
322 | |||||||
323 | If the name of a TMPL_LOOP is used in a TMPL_IF, the IF block will | ||||||
324 | output if the loop has at least one row. Example: | ||||||
325 | |||||||
326 | |
||||||
327 | This will output if the loop is not empty. | ||||||
328 | |||||||
329 | |||||||
330 | |
||||||
331 | .... | ||||||
332 | |||||||
333 | |||||||
334 | WARNING: Much of the benefit of HTML::Template is in decoupling your | ||||||
335 | Perl and HTML. If you introduce numerous cases where you have | ||||||
336 | TMPL_IFs and matching Perl if()s, you will create a maintenance | ||||||
337 | problem in keeping the two synchronized. I suggest you adopt the | ||||||
338 | practice of only using TMPL_IF if you can do so without requiring a | ||||||
339 | matching if() in your Perl code. | ||||||
340 | |||||||
341 | =head2 TMPL_ELSE | ||||||
342 | |||||||
343 | |
||||||
344 | |||||||
345 | You can include an alternate block in your TMPL_IF block by using | ||||||
346 | TMPL_ELSE. NOTE: You still end the block with , not | ||||||
347 | ! | ||||||
348 | |||||||
349 | Example: | ||||||
350 | |||||||
351 | |
||||||
352 | Some text that is included only if BOOL is true | ||||||
353 | |
||||||
354 | Some text that is included only if BOOL is false | ||||||
355 | |||||||
356 | |||||||
357 | =head2 TMPL_ELSIF | ||||||
358 | |||||||
359 | |
||||||
360 | ... | ||||||
361 | |
||||||
362 | ... | ||||||
363 | |
||||||
364 | ... | ||||||
365 | |||||||
366 | |||||||
367 | Allows inclusion of alternative test cases, within your IF block. | ||||||
368 | |||||||
369 | Example: | ||||||
370 | |||||||
371 | |
||||||
372 | Some text that is included only if BOOL is true | ||||||
373 | |
||||||
374 | Some text that is included if BOOL is FALSE | ||||||
375 | and SOME_VAR is true | ||||||
376 | |
||||||
377 | Some other text if SOME_OTHER_VAR is true | ||||||
378 | |
||||||
379 | Some text that is included if only all the | ||||||
380 | previous values were false | ||||||
381 | |||||||
382 | |||||||
383 | Note: note this has the same performance impact as nesting multiple | ||||||
384 | |
||||||
385 | |||||||
386 | =head2 TMPL_UNLESS | ||||||
387 | |||||||
388 | |
||||||
389 | |||||||
390 | This tag is the opposite of |
||||||
391 | CONTROL_PARAMETER is set false or not defined. You can use | ||||||
392 | |
||||||
393 | |||||||
394 | Example: | ||||||
395 | |||||||
396 | |
||||||
397 | Some text that is output only if BOOL is FALSE. | ||||||
398 | |
||||||
399 | Some text that is output only if BOOL is TRUE. | ||||||
400 | |||||||
401 | |||||||
402 | If the name of a TMPL_LOOP is used in a TMPL_UNLESS, the UNLESS block | ||||||
403 | output if the loop has zero rows. | ||||||
404 | |||||||
405 | |
||||||
406 | This will output if the loop is empty. | ||||||
407 | |||||||
408 | |||||||
409 | |
||||||
410 | .... | ||||||
411 | |||||||
412 | |||||||
413 | =cut | ||||||
414 | |||||||
415 | =head2 NOTES | ||||||
416 | |||||||
417 | HTML::Template's tags are meant to mimic normal HTML tags. However, | ||||||
418 | they are allowed to "break the rules". Something like: | ||||||
419 | |||||||
420 | |||||||
421 | |||||||
422 | is not really valid HTML, but it is a perfectly valid use and will | ||||||
423 | work as planned. | ||||||
424 | |||||||
425 | The "NAME=" in the tag is optional, although for extensibility's sake I | ||||||
426 | recommend using it. Example - " |
||||||
427 | |||||||
428 | If you're a fanatic about valid HTML and would like your templates | ||||||
429 | to conform to valid HTML syntax, you may optionally type template tags | ||||||
430 | in the form of HTML comments. This may be of use to HTML authors who | ||||||
431 | would like to validate their templates' HTML syntax prior to | ||||||
432 | HTML::Template processing, or who use DTD-savvy editing tools. | ||||||
433 | |||||||
434 | |||||||
435 | |||||||
436 | In order to realize a dramatic savings in bandwidth, the standard | ||||||
437 | (non-comment) tags will be used throughout this documentation. | ||||||
438 | |||||||
439 | =cut | ||||||
440 | |||||||
441 | =head1 CUSTOM TAGS | ||||||
442 | |||||||
443 | HTML::Template can be sub-classed so that you can create custom tags. | ||||||
444 | There are various reasons for wanting the ability to do this. | ||||||
445 | |||||||
446 | For example, your application may need to be displayed in multiple | ||||||
447 | languages. Normal HTML would require you to localise each template. | ||||||
448 | By sub-classing HTML::Template you can create a TMPL_CATGETS tag and thus | ||||||
449 | dynamically lookup the localised version of the remaining part of the tag, | ||||||
450 | as in: | ||||||
451 | |||||||
452 | |
||||||
453 | 'Number one', while in the Italian locale it could translate to | ||||||
454 | 'Numero uno'. | ||||||
455 | |||||||
456 | Another example, implementing a 'switch' statement; you would sub-class | ||||||
457 | HTML::Template (or HTML::Template::Expr for that matter), and implement | ||||||
458 | the tags in a manner something like: | ||||||
459 | |||||||
460 | |
||||||
461 | |
||||||
462 | |
||||||
463 | |
||||||
464 | |||||||
465 | |||||||
466 | See L |
||||||
467 | |||||||
468 | =cut | ||||||
469 | |||||||
470 | =head1 METHODS | ||||||
471 | |||||||
472 | =head2 new() | ||||||
473 | |||||||
474 | Call new() to create a new Template object: | ||||||
475 | |||||||
476 | my $template = HTML::Template->new( filename => 'file.tmpl', | ||||||
477 | option => 'value' | ||||||
478 | ); | ||||||
479 | |||||||
480 | You must call new() with at least one name => value pair specifying how | ||||||
481 | to access the template text. You can use C<< filename => 'file.tmpl' >> | ||||||
482 | to specify a filename to be opened as the template. Alternately you can | ||||||
483 | use: | ||||||
484 | |||||||
485 | my $t = HTML::Template->new( scalarref => $ref_to_template_text, | ||||||
486 | option => 'value' | ||||||
487 | ); | ||||||
488 | |||||||
489 | and | ||||||
490 | |||||||
491 | my $t = HTML::Template->new( arrayref => $ref_to_array_of_lines , | ||||||
492 | option => 'value' | ||||||
493 | ); | ||||||
494 | |||||||
495 | |||||||
496 | These initialize the template from in-memory resources. In almost | ||||||
497 | every case you'll want to use the filename parameter. If you're | ||||||
498 | worried about all the disk access from reading a template file just | ||||||
499 | use mod_perl and the cache option detailed below. | ||||||
500 | |||||||
501 | You can also read the template from an already opened filehandle, | ||||||
502 | either traditionally as a glob or as a FileHandle: | ||||||
503 | |||||||
504 | my $t = HTML::Template->new( filehandle => *FH, option => 'value'); | ||||||
505 | |||||||
506 | The four new() calling methods can also be accessed as below, if you | ||||||
507 | prefer. | ||||||
508 | |||||||
509 | my $t = HTML::Template->new_file('file.tmpl', option => 'value'); | ||||||
510 | |||||||
511 | my $t = HTML::Template->new_scalar_ref($ref_to_template_text, | ||||||
512 | option => 'value'); | ||||||
513 | |||||||
514 | my $t = HTML::Template->new_array_ref($ref_to_array_of_lines, | ||||||
515 | option => 'value'); | ||||||
516 | |||||||
517 | my $t = HTML::Template->new_filehandle($fh, | ||||||
518 | option => 'value'); | ||||||
519 | |||||||
520 | And as a final option, for those that might prefer it, you can call new as: | ||||||
521 | |||||||
522 | my $t = HTML::Template->new(type => 'filename', | ||||||
523 | source => 'file.tmpl'); | ||||||
524 | |||||||
525 | Which works for all three of the source types. | ||||||
526 | |||||||
527 | If the environment variable HTML_TEMPLATE_ROOT is set and your | ||||||
528 | filename doesn't begin with /, then the path will be relative to the | ||||||
529 | value of $HTML_TEMPLATE_ROOT. Example - if the environment variable | ||||||
530 | HTML_TEMPLATE_ROOT is set to "/home/sam" and I call | ||||||
531 | HTML::Template->new() with filename set to "sam.tmpl", the | ||||||
532 | HTML::Template will try to open "/home/sam/sam.tmpl" to access the | ||||||
533 | template file. You can also affect the search path for files with the | ||||||
534 | "path" option to new() - see below for more information. | ||||||
535 | |||||||
536 | You can modify the Template object's behavior with new(). The options | ||||||
537 | are available: | ||||||
538 | |||||||
539 | =over 4 | ||||||
540 | |||||||
541 | =item Error Detection Options | ||||||
542 | |||||||
543 | =over 4 | ||||||
544 | |||||||
545 | =item * | ||||||
546 | |||||||
547 | die_on_bad_params - if set to 0 the module will let you call | ||||||
548 | $template->param(param_name => 'value') even if 'param_name' doesn't | ||||||
549 | exist in the template body. Defaults to 1. | ||||||
550 | |||||||
551 | =item * | ||||||
552 | |||||||
553 | die_on_unset_params - if set to 1 the module will allow you to not set | ||||||
554 | a value for 'param_name' when the template contains something like | ||||||
555 | |
||||||
556 | behaviour is that HTML::Template wont die when output() is called for | ||||||
557 | cases where you haven't called C |
||||||
558 | |||||||
559 | If you set C |
||||||
560 | die until it has completed generating the output, then die with a list | ||||||
561 | of unset params. | ||||||
562 | |||||||
563 | =item * | ||||||
564 | |||||||
565 | force_untaint - if set to 1 the module will not allow you to set | ||||||
566 | unescaped parameters with tainted values. If set to 2 you will have | ||||||
567 | to untaint all parameters, including ones with the escape attribute. | ||||||
568 | This option makes sure you untaint everything so you don't accidentally | ||||||
569 | introduce e.g. cross-site-scripting (CSS) vulnerabilities. Requires | ||||||
570 | taint mode. Defaults to 0. | ||||||
571 | |||||||
572 | =item * | ||||||
573 | |||||||
574 | strict - if set to 0 the module will allow things that look like they | ||||||
575 | might be TMPL_* tags to get by without dieing. Example: | ||||||
576 | |||||||
577 | |
||||||
578 | |||||||
579 | Would normally cause an error, but if you call new with strict => 0, | ||||||
580 | HTML::Template will ignore it. Defaults to 1. | ||||||
581 | |||||||
582 | =item * | ||||||
583 | |||||||
584 | vanguard_compatibility_mode - removed (use a filter to enable this | ||||||
585 | option). | ||||||
586 | |||||||
587 | |||||||
588 | =back | ||||||
589 | |||||||
590 | =item Caching Options | ||||||
591 | |||||||
592 | =over 4 | ||||||
593 | |||||||
594 | =item * | ||||||
595 | |||||||
596 | cache - if set to 1 the module will cache in memory the parsed | ||||||
597 | templates based on the filename parameter and modification date of the | ||||||
598 | file. This only applies to templates opened with the filename | ||||||
599 | parameter specified, not scalarref or arrayref templates. Caching | ||||||
600 | also looks at the modification times of any files included using | ||||||
601 | |
||||||
602 | filename parameter. | ||||||
603 | |||||||
604 | This is mainly of use in a persistent environment like | ||||||
605 | Apache/mod_perl. It has absolutely no benefit in a normal CGI | ||||||
606 | environment since the script is unloaded from memory after every | ||||||
607 | request. For a cache that does work for normal CGIs see the | ||||||
608 | 'shared_cache' option below. | ||||||
609 | |||||||
610 | Note that different new() parameter settings do not cause a cache | ||||||
611 | refresh, only a change in the modification time of the template will | ||||||
612 | trigger a cache refresh. For most usages this is fine. My simplistic | ||||||
613 | testing shows that using cache yields a 90% performance increase under | ||||||
614 | mod_perl. Cache defaults to 0. | ||||||
615 | |||||||
616 | =item * | ||||||
617 | |||||||
618 | shared_cache - if set to 1 the module will store its cache in shared | ||||||
619 | memory using the IPC::SharedCache module (available from CPAN). The | ||||||
620 | effect of this will be to maintain a single shared copy of each parsed | ||||||
621 | template for all instances of HTML::Template to use. This can be a | ||||||
622 | significant reduction in memory usage in a multiple server | ||||||
623 | environment. As an example, on one of our systems we use 4MB of | ||||||
624 | template cache and maintain 25 httpd processes - shared_cache results | ||||||
625 | in saving almost 100MB! Of course, some reduction in speed versus | ||||||
626 | normal caching is to be expected. Another difference between normal | ||||||
627 | caching and shared_cache is that shared_cache will work in a CGI | ||||||
628 | environment - normal caching is only useful in a persistent | ||||||
629 | environment like Apache/mod_perl. | ||||||
630 | |||||||
631 | By default HTML::Template uses the IPC key 'TMPL' as a shared root | ||||||
632 | segment (0x4c504d54 in hex), but this can be changed by setting the | ||||||
633 | 'ipc_key' new() parameter to another 4-character or integer key. | ||||||
634 | Other options can be used to affect the shared memory cache correspond | ||||||
635 | to IPC::SharedCache options - ipc_mode, ipc_segment_size and | ||||||
636 | ipc_max_size. See L |
||||||
637 | work - in most cases you shouldn't need to change them from the | ||||||
638 | defaults. | ||||||
639 | |||||||
640 | For more information about the shared memory cache system used by | ||||||
641 | HTML::Template see L |
||||||
642 | |||||||
643 | =item * | ||||||
644 | |||||||
645 | double_cache - if set to 1 the module will use a combination of | ||||||
646 | shared_cache and normal cache mode for the best possible caching. Of | ||||||
647 | course, it also uses the most memory of all the cache modes. All the | ||||||
648 | same ipc_* options that work with shared_cache apply to double_cache | ||||||
649 | as well. By default double_cache is off. | ||||||
650 | |||||||
651 | =item * | ||||||
652 | |||||||
653 | blind_cache - if set to 1 the module behaves exactly as with normal | ||||||
654 | caching but does not check to see if the file has changed on each | ||||||
655 | request. This option should be used with caution, but could be of use | ||||||
656 | on high-load servers. My tests show blind_cache performing only 1 to | ||||||
657 | 2 percent faster than cache under mod_perl. | ||||||
658 | |||||||
659 | NOTE: Combining this option with shared_cache can result in stale | ||||||
660 | templates stuck permanently in shared memory! | ||||||
661 | |||||||
662 | =item * | ||||||
663 | |||||||
664 | file_cache - if set to 1 the module will store its cache in a file | ||||||
665 | using the Storable module. It uses no additional memory, and my | ||||||
666 | simplistic testing shows that it yields a 50% performance advantage. | ||||||
667 | Like shared_cache, it will work in a CGI environment. Default is 0. | ||||||
668 | |||||||
669 | If you set this option you must set the "file_cache_dir" option. See | ||||||
670 | below for details. | ||||||
671 | |||||||
672 | NOTE: Storable using flock() to ensure safe access to cache files. | ||||||
673 | Using file_cache on a system or filesystem (NFS) without flock() | ||||||
674 | support is dangerous. | ||||||
675 | |||||||
676 | |||||||
677 | =item * | ||||||
678 | |||||||
679 | file_cache_dir - sets the directory where the module will store the | ||||||
680 | cache files if file_cache is enabled. Your script will need write | ||||||
681 | permissions to this directory. You'll also need to make sure the | ||||||
682 | sufficient space is available to store the cache files. | ||||||
683 | |||||||
684 | =item * | ||||||
685 | |||||||
686 | file_cache_dir_mode - sets the file mode for newly created file_cache | ||||||
687 | directories and subdirectories. Defaults to 0700 for security but | ||||||
688 | this may be inconvenient if you do not have access to the account | ||||||
689 | running the webserver. | ||||||
690 | |||||||
691 | =item * | ||||||
692 | |||||||
693 | double_file_cache - if set to 1 the module will use a combination of | ||||||
694 | file_cache and normal cache mode for the best possible caching. The | ||||||
695 | file_cache_* options that work with file_cache apply to double_file_cache | ||||||
696 | as well. By default double_file_cache is 0. | ||||||
697 | |||||||
698 | =back | ||||||
699 | |||||||
700 | =item Filesystem Options | ||||||
701 | |||||||
702 | =over 4 | ||||||
703 | |||||||
704 | =item * | ||||||
705 | |||||||
706 | path - you can set this variable with a list of paths to search for | ||||||
707 | files specified with the "filename" option to new() and for files | ||||||
708 | included with the |
||||||
709 | when the filename is relative. The HTML_TEMPLATE_ROOT environment | ||||||
710 | variable is always tried first if it exists. Also, if | ||||||
711 | HTML_TEMPLATE_ROOT is set then an attempt will be made to prepend | ||||||
712 | HTML_TEMPLATE_ROOT onto paths in the path array. In the case of a | ||||||
713 | |
||||||
714 | before path is consulted. | ||||||
715 | |||||||
716 | Example: | ||||||
717 | |||||||
718 | my $template = HTML::Template->new( filename => 'file.tmpl', | ||||||
719 | path => [ '/path/to/templates', | ||||||
720 | '/alternate/path' | ||||||
721 | ] | ||||||
722 | ); | ||||||
723 | |||||||
724 | NOTE: the paths in the path list must be expressed as UNIX paths, | ||||||
725 | separated by the forward-slash character ('/'). | ||||||
726 | |||||||
727 | =item * | ||||||
728 | |||||||
729 | search_path_on_include - if set to a true value the module will search | ||||||
730 | from the top of the array of paths specified by the path option on | ||||||
731 | every |
||||||
732 | normal behavior is to look only in the current directory for a | ||||||
733 | template to include. Defaults to 0. | ||||||
734 | |||||||
735 | =back | ||||||
736 | |||||||
737 | =item Debugging Options | ||||||
738 | |||||||
739 | =over 4 | ||||||
740 | |||||||
741 | =item * | ||||||
742 | |||||||
743 | debug - if set to 1 the module will write random debugging information | ||||||
744 | to STDERR. Defaults to 0. | ||||||
745 | |||||||
746 | =item * | ||||||
747 | |||||||
748 | stack_debug - if set to 1 the module will use Data::Dumper to print | ||||||
749 | out the contents of the parse_stack to STDERR. Defaults to 0. | ||||||
750 | |||||||
751 | =item * | ||||||
752 | |||||||
753 | cache_debug - if set to 1 the module will send information on cache | ||||||
754 | loads, hits and misses to STDERR. Defaults to 0. | ||||||
755 | |||||||
756 | =item * | ||||||
757 | |||||||
758 | shared_cache_debug - if set to 1 the module will turn on the debug | ||||||
759 | option in IPC::SharedCache - see L |
||||||
760 | details. Defaults to 0. | ||||||
761 | |||||||
762 | =item * | ||||||
763 | |||||||
764 | memory_debug - if set to 1 the module will send information on cache | ||||||
765 | memory usage to STDERR. Requires the GTop module. Defaults to 0. | ||||||
766 | |||||||
767 | =item * | ||||||
768 | |||||||
769 | includes_debug - if set to 1 the module will print TMPL_INCLUDEed | ||||||
770 | file-stack information, to STDERR. Defaults to 0. | ||||||
771 | |||||||
772 | =item * | ||||||
773 | |||||||
774 | param_debug - if set to 1 the module will list the params and values | ||||||
775 | as various stages of processing. Default to 0. | ||||||
776 | |||||||
777 | =back | ||||||
778 | |||||||
779 | =item Profiling Options | ||||||
780 | |||||||
781 | =over 4 | ||||||
782 | |||||||
783 | =item * | ||||||
784 | |||||||
785 | profile - if set to 1 the module will write timing information | ||||||
786 | to STDERR. Defaults to 0. | ||||||
787 | |||||||
788 | =back | ||||||
789 | |||||||
790 | =item Miscellaneous Options | ||||||
791 | |||||||
792 | =over 4 | ||||||
793 | |||||||
794 | =item * | ||||||
795 | |||||||
796 | associate - this option allows you to inherit the parameter values | ||||||
797 | from other objects. The only requirement for the other object is that | ||||||
798 | it have a C method that works like HTML::Template's C. A | ||||||
799 | good candidate would be a CGI.pm query object. Example: | ||||||
800 | |||||||
801 | my $query = new CGI; | ||||||
802 | my $template = HTML::Template->new(filename => 'template.tmpl', | ||||||
803 | associate => $query); | ||||||
804 | |||||||
805 | Now, C<< $template->output() >> will act as though | ||||||
806 | |||||||
807 | $template->param('FormField', $cgi->param('FormField')); | ||||||
808 | |||||||
809 | had been specified for each key/value pair that would be provided by | ||||||
810 | the C<< $cgi->param() >> method. Parameters you set directly take | ||||||
811 | precedence over associated parameters. | ||||||
812 | |||||||
813 | You can specify multiple objects to associate by passing an anonymous | ||||||
814 | array to the associate option. They are searched for parameters in | ||||||
815 | the order they appear: | ||||||
816 | |||||||
817 | my $template = HTML::Template->new(filename => 'template.tmpl', | ||||||
818 | associate => [$query, $other_obj]); | ||||||
819 | |||||||
820 | The old associateCGI() call is still supported, but should be | ||||||
821 | considered obsolete. | ||||||
822 | |||||||
823 | NOTE: The parameter names are matched in a case-insensitve manner. If | ||||||
824 | you have two parameters in a CGI object like 'NAME' and 'Name' one | ||||||
825 | will be chosen randomly by associate. This behavior can be changed by | ||||||
826 | the following option. | ||||||
827 | |||||||
828 | =item * | ||||||
829 | |||||||
830 | case_sensitive - setting this option to true causes HTML::Template to | ||||||
831 | treat template variable names case-sensitively. The following example | ||||||
832 | would only set one parameter without the "case_sensitive" option: | ||||||
833 | |||||||
834 | my $template = HTML::Template->new(filename => 'template.tmpl', | ||||||
835 | case_sensitive => 1); | ||||||
836 | $template->param( | ||||||
837 | FieldA => 'foo', | ||||||
838 | fIELDa => 'bar', | ||||||
839 | ); | ||||||
840 | |||||||
841 | This option defaults to off. | ||||||
842 | |||||||
843 | NOTE: with case_sensitive and loop_context_vars the special loop | ||||||
844 | variables are available in lower-case only. | ||||||
845 | |||||||
846 | =item * | ||||||
847 | |||||||
848 | loop_context_vars - when this parameter is set to true (it is false by | ||||||
849 | default) four loop context variables are made available inside a loop: | ||||||
850 | __first__, __last__, __outer__,__inner__, __odd__, __even__. They can | ||||||
851 | be used with |
||||||
852 | control how a loop is output. | ||||||
853 | |||||||
854 | In addition to the above, a __counter__ var is also made available | ||||||
855 | when loop context variables are turned on. | ||||||
856 | |||||||
857 | Example: | ||||||
858 | |||||||
859 | |
||||||
860 | |
||||||
861 | This only outputs on the first pass. | ||||||
862 | |||||||
863 | |||||||
864 | |
||||||
865 | This outputs every other pass, on the odd passes. | ||||||
866 | |||||||
867 | |||||||
868 | |
||||||
869 | This outputs every other pass, on the even passes. | ||||||
870 | |||||||
871 | |||||||
872 | |
||||||
873 | This outputs every other pass, on the even passes. | ||||||
874 | |||||||
875 | |||||||
876 | |
||||||
877 | This outputs every other pass, on the odd passes. | ||||||
878 | |||||||
879 | |||||||
880 | |
||||||
881 | This outputs on passes that are both first or last. | ||||||
882 | |||||||
883 | |||||||
884 | |
||||||
885 | This outputs on passes that are neither first nor last. | ||||||
886 | |||||||
887 | |||||||
888 | This is pass number |
||||||
889 | |||||||
890 | |
||||||
891 | This only outputs on the last pass. | ||||||
892 | |||||||
893 | |||||||
894 | |||||||
895 | One use of this feature is to provide a "separator" similar in effect | ||||||
896 | to the perl function join(). Example: | ||||||
897 | |||||||
898 | |
||||||
899 | |
||||||
900 | |
||||||
901 | |||||||
902 | |||||||
903 | Would output (in a browser) something like: | ||||||
904 | |||||||
905 | Apples, Oranges, Brains, Toes, and Kiwi. | ||||||
906 | |||||||
907 | Given an appropriate C call, of course. NOTE: A loop with only | ||||||
908 | a single pass will get __outer__, __first__ and __last__ set to true, but | ||||||
909 | not __inner__. | ||||||
910 | |||||||
911 | =item * | ||||||
912 | |||||||
913 | scalar_loops - when enabled, simply Perl arrays can be used in TMPL_LOOP's | ||||||
914 | such that the attibute name is '__value__'. | ||||||
915 | |||||||
916 | =item * | ||||||
917 | |||||||
918 | intrinsic_vars - Enable this to automatically generate template intrinsic | ||||||
919 | variables; current variables: | ||||||
920 | |||||||
921 | __type__ will be one of 'file','scalarref','arrayref','filehandle' | ||||||
922 | __filename__ the filename you specified, if any | ||||||
923 | __filepath__ as above but using a fully qualified path | ||||||
924 | |||||||
925 | =item * | ||||||
926 | |||||||
927 | no_includes - set this option to 1 to disallow the |
||||||
928 | in the template file. This can be used to make opening untrusted | ||||||
929 | templates B |
||||||
930 | |||||||
931 | =item * | ||||||
932 | |||||||
933 | max_includes - set this variable to determine the maximum depth that | ||||||
934 | includes can reach. Set to 10 by default. Including files to a depth | ||||||
935 | greater than this value causes an error message to be displayed. Set | ||||||
936 | to 0 to disable this protection. | ||||||
937 | |||||||
938 | =item * | ||||||
939 | |||||||
940 | global_vars - normally variables declared outside a loop are not | ||||||
941 | available inside a loop. This option makes |
||||||
942 | variables in Perl - they have unlimited scope. This option also | ||||||
943 | affects |
||||||
944 | |||||||
945 | Example: | ||||||
946 | |||||||
947 | This is a normal variable:
|
||||||
948 | |||||||
949 | |
||||||
950 | Here it is inside the loop:
|
||||||
951 | |||||||
952 | |||||||
953 | Normally this wouldn't work as expected, since |
||||||
954 | value outside the loop is not available inside the loop. | ||||||
955 | |||||||
956 | The global_vars option also allows you to access the values of an | ||||||
957 | enclosing loop within an inner loop. For example, in this loop the | ||||||
958 | inner loop will have access to the value of OUTER_VAR in the correct | ||||||
959 | iteration: | ||||||
960 | |||||||
961 | |
||||||
962 | OUTER: |
||||||
963 | |
||||||
964 | INNER: |
||||||
965 | INSIDE OUT: |
||||||
966 | |||||||
967 | |||||||
968 | |||||||
969 | One side-effect of global-vars is that variables you set with param() | ||||||
970 | that might otherwise be ignored when die_on_bad_params is off will | ||||||
971 | stick around. This is necessary to allow inner loops to access values | ||||||
972 | set for outer loops that don't directly use the value. | ||||||
973 | |||||||
974 | B |
||||||
975 | That means that loops you declare at one scope are not available | ||||||
976 | inside other loops even when C |
||||||
977 | |||||||
978 | =item * | ||||||
979 | |||||||
980 | filter - this option allows you to specify a filter for your template | ||||||
981 | files. A filter is a subroutine that will be called after | ||||||
982 | HTML::Template reads your template file but before it starts parsing | ||||||
983 | template tags. | ||||||
984 | |||||||
985 | In the most simple usage, you simply assign a code reference to the | ||||||
986 | filter parameter. This subroutine will recieve as the first argument, | ||||||
987 | a reference to a string containing the template file text. The second | ||||||
988 | argument is a reference to the HTML::Template instance, which you can | ||||||
989 | use to query its current state. | ||||||
990 | |||||||
991 | Here is an example that accepts templates with tags that look like | ||||||
992 | "!!!ZAP_VAR FOO!!!" and transforms them into HTML::Template tags: | ||||||
993 | |||||||
994 | my $filter = sub { | ||||||
995 | my $text_ref = shift; | ||||||
996 | $$text_ref =~ s/!!!ZAP_(.*?)!!!/ |
||||||
997 | }; | ||||||
998 | |||||||
999 | # open zap.tmpl using the above filter | ||||||
1000 | my $template = HTML::Template->new(filename => 'zap.tmpl', | ||||||
1001 | filter => $filter); | ||||||
1002 | |||||||
1003 | More complicated usages are possible. You can request that your | ||||||
1004 | filter receieve the template text as an array of lines rather than as | ||||||
1005 | a single scalar. To do that you need to specify your filter using a | ||||||
1006 | hash-ref. In this form you specify the filter using the C key and | ||||||
1007 | the desired argument format using the C |
||||||
1008 | formats are C |
||||||
1009 | a performance penalty but may be more convenient in some situations. | ||||||
1010 | |||||||
1011 | my $template = HTML::Template->new(filename => 'zap.tmpl', | ||||||
1012 | filter => { sub => $filter, | ||||||
1013 | format => 'array' }); | ||||||
1014 | |||||||
1015 | You may also have multiple filters. This allows simple filters to be | ||||||
1016 | combined for more elaborate functionality. To do this you specify an | ||||||
1017 | array of filters. The filters are applied in the order they are | ||||||
1018 | specified. | ||||||
1019 | |||||||
1020 | my $template = HTML::Template->new(filename => 'zap.tmpl', | ||||||
1021 | filter => [ | ||||||
1022 | { sub => \&decompress, | ||||||
1023 | format => 'scalar' }, | ||||||
1024 | { sub => \&remove_spaces, | ||||||
1025 | format => 'array' } | ||||||
1026 | ]); | ||||||
1027 | |||||||
1028 | The specified filters will be called for any TMPL_INCLUDEed files just | ||||||
1029 | as they are for the main template file. | ||||||
1030 | |||||||
1031 | A set of pre-made filters are available from the L |
||||||
1032 | module. | ||||||
1033 | |||||||
1034 | =item * | ||||||
1035 | |||||||
1036 | default_escape - Set this parameter with the name of one of the | ||||||
1037 | L |
||||||
1038 | the specified escaping to all variables unless they declare a | ||||||
1039 | different escape in the template. | ||||||
1040 | |||||||
1041 | =item * | ||||||
1042 | |||||||
1043 | structure_vars - Set this variable to make HTML::Template support a | ||||||
1044 | variable syntax similar to C-style structures. We use dot notation as | ||||||
1045 | the delimiter between template variables. This is easiest explained | ||||||
1046 | by example, say setting the properties of a 'user' object. | ||||||
1047 | |||||||
1048 | Say we have a user's first name, last name, their address and the address | ||||||
1049 | of the company they work for - the template variable that you would define | ||||||
1050 | would be: | ||||||
1051 | |||||||
1052 | user.name.first => 'Fred', | ||||||
1053 | user.name.last => 'Flinstone', | ||||||
1054 | user.address => 'Bedrock', | ||||||
1055 | user.company.name => 'Slate Construction', | ||||||
1056 | |||||||
1057 | Ordinarily, HTML::Template would treat these as simple (unique) variable | ||||||
1058 | names. With 'structure_vars' set, HTML::Template automatically sets: | ||||||
1059 | |||||||
1060 | user => 1 | ||||||
1061 | user.name => 1 | ||||||
1062 | user.company => 1 | ||||||
1063 | |||||||
1064 | unless the programmer has already set those variables; at any time they | ||||||
1065 | can be overridden with specific values. | ||||||
1066 | |||||||
1067 | The reason for this functionality is to simplify template handling of | ||||||
1068 | object-like data. For example, in the template you could now write: | ||||||
1069 | |||||||
1070 | |
||||||
1071 | |
||||||
1072 | |
||||||
1073 | |
||||||
1074 | |
||||||
1075 | |||||||
1076 | |||||||
1077 | |||||||
1078 | Note that the auto-vivified template variables, cannot be use in TMPL_LOOP | ||||||
1079 | context, ie. they can be use in TMPL_IF/TMPL_VAR context. | ||||||
1080 | |||||||
1081 | =item * | ||||||
1082 | |||||||
1083 | extended_syntax - Set this variable is to make HTML::Template defer handling | ||||||
1084 | of unknown tags, to the sub-class. Note that this option is only useful | ||||||
1085 | when used as part of a sub-class, since if HTML::Template is not sub-classed, | ||||||
1086 | the option has no effect. | ||||||
1087 | |||||||
1088 | See L |
||||||
1089 | |||||||
1090 | =item * | ||||||
1091 | |||||||
1092 | recursive_templates - set this variable to a non-zero value to allow | ||||||
1093 | template syntax to be embedded within other template syntax. Set it | ||||||
1094 | to a value > 0 to try recursing up to 'at most' that value. A value of | ||||||
1095 | -1 results in maximum depth recursion (which is limited to, at most, 10 | ||||||
1096 | recursions). This feature can be abused in so many ways... | ||||||
1097 | |||||||
1098 | This feature comes at a performance penalty, since memory caching is not | ||||||
1099 | applied due the variabliliy in the number of template instantiations. | ||||||
1100 | However, file_cache is still supported. | ||||||
1101 | |||||||
1102 | Thus this option allows the syntax: | ||||||
1103 | |||||||
1104 | |
||||||
1105 | or | ||||||
1106 | |
||||||
1107 | etc. | ||||||
1108 | |||||||
1109 | Note that use of the 'print_to' output-option, cannot currently be used | ||||||
1110 | in conjunction with this option. | ||||||
1111 | |||||||
1112 | =back | ||||||
1113 | |||||||
1114 | =back 4 | ||||||
1115 | |||||||
1116 | =cut | ||||||
1117 | |||||||
1118 | |||||||
1119 | 46 | 46 | 779217 | use integer; # no floating point math so far! | |||
46 | 517 | ||||||
46 | 396 | ||||||
1120 | 46 | 46 | 1456 | use strict; # and no funny business, either. | |||
46 | 139 | ||||||
46 | 2179 | ||||||
1121 | 46 | 46 | 259 | use warnings FATAL => 'all'; | |||
46 | 97 | ||||||
46 | 2182 | ||||||
1122 | 46 | 46 | 54028 | use utf8; | |||
46 | 362 | ||||||
46 | 376 | ||||||
1123 | |||||||
1124 | 46 | 46 | 1526 | use Carp; # generate better errors with more context | |||
46 | 86 | ||||||
46 | 4855 | ||||||
1125 | 46 | 46 | 269 | use File::Spec; # generate paths that work on all platforms | |||
46 | 105 | ||||||
46 | 2158 | ||||||
1126 | 46 | 46 | 259 | use Digest::MD5 qw(md5_hex); # generate cache keys | |||
46 | 127 | ||||||
46 | 2827 | ||||||
1127 | 46 | 46 | 265 | use Scalar::Util qw(tainted); | |||
46 | 90 | ||||||
46 | 6028 | ||||||
1128 | 46 | 46 | 48492 | use Time::HiRes qw(gettimeofday tv_interval); # generates sub-second timing info | |||
46 | 106335 | ||||||
46 | 238 | ||||||
1129 | |||||||
1130 | # define accessor constants used to improve readability of array | ||||||
1131 | # accesses into "objects". I used to use 'use constant' but that | ||||||
1132 | # seems to cause occasional irritating warnings in older Perls. | ||||||
1133 | package HTML::Template::LOOP; | ||||||
1134 | sub TEMPLATE_HASH () { 0 }; | ||||||
1135 | sub PARAM_SET () { 1 }; | ||||||
1136 | |||||||
1137 | package HTML::Template::COND; | ||||||
1138 | sub VARIABLE () { 0 }; | ||||||
1139 | sub VARIABLE_TYPE () { 1 }; | ||||||
1140 | sub VARIABLE_TYPE_VAR () { 0 }; | ||||||
1141 | sub VARIABLE_TYPE_LOOP () { 1 }; | ||||||
1142 | sub JUMP_IF_TRUE () { 2 }; | ||||||
1143 | sub JUMP_ADDRESS () { 3 }; | ||||||
1144 | sub WHICH () { 4 }; | ||||||
1145 | sub UNCONDITIONAL_JUMP () { 5 }; | ||||||
1146 | sub IS_ELSE () { 6 }; | ||||||
1147 | sub WHICH_IF () { 0 }; | ||||||
1148 | sub WHICH_UNLESS () { 1 }; | ||||||
1149 | |||||||
1150 | # back to the main package scope. | ||||||
1151 | package HTML::Template; | ||||||
1152 | |||||||
1153 | # Want to use Scalar::Util::reftype as a replacement for ref(), but the interface differs... WTF? | ||||||
1154 | # So reproduced here.... | ||||||
1155 | sub reftype ($) { | ||||||
1156 | 2113 | 2113 | 0 | 11750 | local($@, $SIG{__DIE__}, $SIG{__WARN__}); | ||
1157 | 2113 | 3364 | my $r = shift; | ||||
1158 | 2113 | 3794 | my $t = ref($r); | ||||
1159 | |||||||
1160 | 2113 | 100 | 9413 | length($t = ref($r)) or return ''; | |||
1161 | |||||||
1162 | # This eval will fail if the reference is not blessed | ||||||
1163 | 1071 | 10387 | $t = eval { $r->a_sub_not_likely_to_be_here; 1 } | ||||
0 | 0 | ||||||
1164 | 1071 | 50 | 1868 | ? do { | |||
1165 | $t = eval { | ||||||
1166 | # we have a GLOB or an IO. Stringify a GLOB gives it's name | ||||||
1167 | 0 | 0 | my $q = *$r; | ||||
1168 | 0 | 0 | 0 | $q =~ /^\*/ ? "GLOB" : "IO"; | |||
1169 | } | ||||||
1170 | 0 | 0 | 0 | or do { | |||
1171 | # OK, if we don't have a GLOB what parts of | ||||||
1172 | # a glob will it populate. | ||||||
1173 | # NOTE: A glob always has a SCALAR | ||||||
1174 | 0 | 0 | local *glob = $r; | ||||
1175 | 0 | 0 | defined *glob{ARRAY} && "ARRAY" | ||||
1176 | or defined *glob{HASH} && "HASH" | ||||||
1177 | or defined *glob{CODE} && "CODE" | ||||||
1178 | 0 | 0 | 0 | 0 | or length(ref(${$r})) ? "REF" : "SCALAR"; | ||
0 | 0 | ||||||
0 | |||||||
0 | |||||||
0 | |||||||
1179 | } | ||||||
1180 | } | ||||||
1181 | : $t; | ||||||
1182 | 1071 | 50 | 3775 | $t = '' unless $t; | |||
1183 | 1071 | 7429 | $t; | ||||
1184 | } | ||||||
1185 | |||||||
1186 | # open a new template and return an object handle | ||||||
1187 | sub new { | ||||||
1188 | 240 | 240 | 1 | 1242371 | my $pkg = shift; | ||
1189 | 240 | 386 | my $self; { my %hash; $self = bless(\%hash, $pkg); } | ||||
240 | 7042 | ||||||
240 | 354 | ||||||
240 | 1208 | ||||||
1190 | |||||||
1191 | # the options hash | ||||||
1192 | 240 | 559 | my $options = {}; | ||||
1193 | 240 | 759 | $self->{options} = $options; | ||||
1194 | |||||||
1195 | # set default parameters in options hash | ||||||
1196 | 240 | 6991 | %$options = ( | ||||
1197 | debug => 0, | ||||||
1198 | stack_debug => 0, | ||||||
1199 | param_debug => 0, | ||||||
1200 | profile => 0, | ||||||
1201 | search_path_on_include => 0, | ||||||
1202 | cache => 0, | ||||||
1203 | blind_cache => 0, | ||||||
1204 | file_cache => 0, | ||||||
1205 | file_cache_dir => '', | ||||||
1206 | file_cache_dir_mode => 0700, | ||||||
1207 | force_untaint => 0, | ||||||
1208 | cache_debug => 0, | ||||||
1209 | shared_cache_debug => 0, | ||||||
1210 | memory_debug => 0, | ||||||
1211 | includes_debug => 0, | ||||||
1212 | die_on_bad_params => 1, | ||||||
1213 | die_on_unset_params => 0, | ||||||
1214 | associate => [], | ||||||
1215 | path => [], | ||||||
1216 | strict => 1, | ||||||
1217 | loop_context_vars => 0, | ||||||
1218 | scalar_loops => 0, | ||||||
1219 | intrinsic_vars => 0, | ||||||
1220 | max_includes => 10, | ||||||
1221 | shared_cache => 0, | ||||||
1222 | double_cache => 0, | ||||||
1223 | double_file_cache => 0, | ||||||
1224 | ipc_key => 'TMPL', | ||||||
1225 | ipc_mode => 0666, | ||||||
1226 | ipc_segment_size => 65536, | ||||||
1227 | ipc_max_size => 0, | ||||||
1228 | global_vars => 0, | ||||||
1229 | no_includes => 0, | ||||||
1230 | case_sensitive => 0, | ||||||
1231 | filter => [], | ||||||
1232 | structure_vars => 0, | ||||||
1233 | extended_syntax => 0, | ||||||
1234 | recursive_templates => 0, | ||||||
1235 | default_escape => undef, | ||||||
1236 | ); | ||||||
1237 | |||||||
1238 | # load in options supplied to new() | ||||||
1239 | 240 | 2036 | $options = _load_supplied_options( [@_], $options); | ||||
1240 | |||||||
1241 | # blind_cache = 1 implies cache = 1 | ||||||
1242 | 236 | 100 | 1835 | $options->{blind_cache} and $options->{cache} = 1; | |||
1243 | |||||||
1244 | # shared_cache = 1 implies cache = 1 | ||||||
1245 | 236 | 50 | 657 | $options->{shared_cache} and $options->{cache} = 1; | |||
1246 | |||||||
1247 | # file_cache = 1 implies cache = 1 | ||||||
1248 | 236 | 100 | 577 | $options->{file_cache} and $options->{cache} = 1; | |||
1249 | |||||||
1250 | # double_cache is a combination of shared_cache and cache. | ||||||
1251 | 236 | 100 | 782 | $options->{double_cache} and $options->{cache} = 1; | |||
1252 | 236 | 100 | 734 | $options->{double_cache} and $options->{shared_cache} = 1; | |||
1253 | |||||||
1254 | # double_file_cache is a combination of file_cache and cache. | ||||||
1255 | 236 | 100 | 576 | $options->{double_file_cache} and $options->{cache} = 1; | |||
1256 | 236 | 100 | 19621 | $options->{double_file_cache} and $options->{file_cache} = 1; | |||
1257 | |||||||
1258 | # handle the "type", "source" parameter format (does anyone use it?) | ||||||
1259 | 236 | 100 | 813 | if (exists($options->{type})) { | |||
1260 | 10 | 100 | 127 | exists($options->{source}) or croak("HTML::Template->new() called with 'type' parameter set, but no 'source'!"); | |||
1261 | 9 | 100 | 100 | 188 | ($options->{type} eq 'filename' or $options->{type} eq 'scalarref' or | ||
100 | |||||||
100 | |||||||
1262 | $options->{type} eq 'arrayref' or $options->{type} eq 'filehandle') or | ||||||
1263 | croak("HTML::Template->new() : type parameter must be set to 'filename', 'arrayref', 'scalarref' or 'filehandle'!"); | ||||||
1264 | |||||||
1265 | 8 | 21 | $options->{$options->{type}} = $options->{source}; | ||||
1266 | 8 | 15 | delete $options->{type}; | ||||
1267 | 8 | 14 | delete $options->{source}; | ||||
1268 | } | ||||||
1269 | |||||||
1270 | # make sure taint mode is on if force_untaint flag is set | ||||||
1271 | 234 | 100 | 100 | 832 | if ($options->{force_untaint} && ! ${^TAINT}) { | ||
1272 | 1 | 295 | croak("HTML::Template->new() : 'force_untaint' option set but perl does not run in taint mode!"); | ||||
1273 | } | ||||||
1274 | |||||||
1275 | # associate should be an array of one element if it's not | ||||||
1276 | # already an array. | ||||||
1277 | 233 | 100 | 2044 | if (reftype($options->{associate}) ne 'ARRAY') { | |||
1278 | 3 | 10 | $options->{associate} = [ $options->{associate} ]; | ||||
1279 | } | ||||||
1280 | |||||||
1281 | # path should be an array if it's not already | ||||||
1282 | 233 | 100 | 692 | if (reftype($options->{path}) ne 'ARRAY') { | |||
1283 | 39 | 140 | $options->{path} = [ $options->{path} ]; | ||||
1284 | } | ||||||
1285 | |||||||
1286 | # filter should be an array if it's not already | ||||||
1287 | 233 | 100 | 637 | if (reftype($options->{filter}) ne 'ARRAY') { | |||
1288 | 6 | 19 | $options->{filter} = [ $options->{filter} ]; | ||||
1289 | } | ||||||
1290 | |||||||
1291 | # make sure objects in associate area support param() | ||||||
1292 | 233 | 470 | foreach my $object (@{$options->{associate}}) { | ||||
233 | 950 | ||||||
1293 | 4 | 100 | 179 | defined($object->can('param')) or | |||
1294 | croak("HTML::Template->new called with associate option, containing object of type " . ref($object) . " which lacks a param() method!"); | ||||||
1295 | } | ||||||
1296 | |||||||
1297 | # make sure we limit the number of recursions to an upper limit | ||||||
1298 | 232 | 50 | 1261 | if ($options->{recursive_templates} < 0) { | |||
50 | |||||||
1299 | 0 | 0 | $options->{recursive_templates} = 10; | ||||
1300 | } elsif ($options->{recursive_templates} > 100) { | ||||||
1301 | 0 | 0 | $options->{recursive_templates} = 100; | ||||
1302 | } | ||||||
1303 | 232 | 100 | 993 | if ($options->{recursive_templates}) { | |||
1304 | 1 | 4 | $options->{strict} = 0; | ||||
1305 | 1 | 2 | $self->{recursive_template_params} = {}; | ||||
1306 | } | ||||||
1307 | |||||||
1308 | # structure-vars requires the use of a temporary param cache | ||||||
1309 | 232 | 100 | 593 | if ($options->{structure_vars}){ | |||
1310 | 1 | 3 | $self->{structure_vars} = {}; | ||||
1311 | } | ||||||
1312 | |||||||
1313 | # check for syntax errors: | ||||||
1314 | 232 | 337 | my $source_count = 0; | ||||
1315 | 232 | 100 | 826 | exists($options->{filename}) and $source_count++; | |||
1316 | 232 | 100 | 610 | exists($options->{filehandle}) and $source_count++; | |||
1317 | 232 | 100 | 901 | exists($options->{arrayref}) and $source_count++; | |||
1318 | 232 | 100 | 625 | exists($options->{scalarref}) and $source_count++; | |||
1319 | 232 | 100 | 1229 | if ($source_count != 1) { | |||
1320 | 1 | 189 | croak("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"); | ||||
1321 | } | ||||||
1322 | |||||||
1323 | # check that cache options are not used with non-cacheable templates | ||||||
1324 | 693 | 2947 | croak "Cannot have caching when template source is not file" | ||||
1325 | 864 | 11022 | if grep { exists($options->{$_}) } qw( filehandle arrayref scalarref) | ||||
1326 | and | ||||||
1327 | 231 | 100 | 100 | 430 | grep {$options->{$_}} qw( cache blind_cache file_cache shared_cache | ||
1328 | double_cache double_file_cache ); | ||||||
1329 | |||||||
1330 | # check that filenames aren't empty | ||||||
1331 | 228 | 100 | 699 | if (exists($options->{filename})) { | |||
1332 | 87 | 100 | 66 | 1032 | croak("HTML::Template->new called with empty filename parameter!") | ||
1333 | unless defined $options->{filename} and length $options->{filename}; | ||||||
1334 | } | ||||||
1335 | |||||||
1336 | # do some memory debugging - this is best started as early as possible | ||||||
1337 | 227 | 50 | 726 | if ($options->{memory_debug}) { | |||
1338 | # memory_debug needs GTop | ||||||
1339 | 0 | 0 | eval { require GTop; }; | ||||
0 | 0 | ||||||
1340 | 0 | 0 | 0 | croak("Could not load GTop. You must have GTop installed to use HTML::Template in memory_debug mode. The error was: $@") | |||
1341 | if ($@); | ||||||
1342 | 0 | 0 | $self->{gtop} = GTop->new(); | ||||
1343 | 0 | 0 | $self->{proc_mem} = $self->{gtop}->proc_mem($$); | ||||
1344 | 0 | 0 | print STDERR "\n### HTML::Template Memory Debug ### START ", $self->{proc_mem}->size(), "\n"; | ||||
1345 | } | ||||||
1346 | |||||||
1347 | 227 | 100 | 643 | if ($options->{file_cache}) { | |||
1348 | # make sure we have a file_cache_dir option | ||||||
1349 | 11 | 100 | 66 | 394 | croak("You must specify the file_cache_dir option if you want to use file_cache.") | ||
1350 | unless defined $options->{file_cache_dir} and length $options->{file_cache_dir}; | ||||||
1351 | |||||||
1352 | |||||||
1353 | # file_cache needs some extra modules loaded | ||||||
1354 | 10 | 19 | eval { require Storable; }; | ||||
10 | 5484 | ||||||
1355 | 10 | 50 | 24385 | croak("Could not load Storable. You must have Storable installed to use HTML::Template in file_cache mode. The error was: $@") | |||
1356 | if ($@); | ||||||
1357 | } | ||||||
1358 | |||||||
1359 | 226 | 50 | 785 | if ($options->{shared_cache}) { | |||
1360 | # shared_cache needs some extra modules loaded | ||||||
1361 | 0 | 0 | eval { require IPC::SharedCache; }; | ||||
0 | 0 | ||||||
1362 | 0 | 0 | 0 | croak("Could not load IPC::SharedCache. You must have IPC::SharedCache installed to use HTML::Template in shared_cache mode. The error was: $@") | |||
1363 | if ($@); | ||||||
1364 | |||||||
1365 | # initialize the shared cache | ||||||
1366 | 0 | 0 | my %cache; | ||||
1367 | 0 | 0 | tie %cache, 'IPC::SharedCache', | ||||
1368 | ipc_key => $options->{ipc_key}, | ||||||
1369 | load_callback => [\&_load_shared_cache, $self], | ||||||
1370 | validate_callback => [\&_validate_shared_cache, $self], | ||||||
1371 | debug => $options->{shared_cache_debug}, | ||||||
1372 | ipc_mode => $options->{ipc_mode}, | ||||||
1373 | max_size => $options->{ipc_max_size}, | ||||||
1374 | ipc_segment_size => $options->{ipc_segment_size}; | ||||||
1375 | 0 | 0 | $self->{cache} = \%cache; | ||||
1376 | } | ||||||
1377 | |||||||
1378 | 226 | 100 | 678 | if ($options->{default_escape}) { | |||
1379 | 102 | 246 | $options->{default_escape} = uc $options->{default_escape}; | ||||
1380 | 102 | 139 | eval { $self->_load_escape_type($options->{default_escape}); }; | ||||
102 | 331 | ||||||
1381 | 102 | 100 | 566 | croak("HTML::Template->new(): Invalid setting for default_escape - '$options->{default_escape}'.\n$@") if $@; | |||
1382 | } | ||||||
1383 | |||||||
1384 | 225 | 50 | 582 | print STDERR "### HTML::Template Memory Debug ### POST CACHE INIT ", $self->{proc_mem}->size(), "\n" | |||
1385 | if $options->{memory_debug}; | ||||||
1386 | |||||||
1387 | # initialize data structures | ||||||
1388 | 225 | 841 | $self->_init; | ||||
1389 | |||||||
1390 | 217 | 50 | 757 | print STDERR "### HTML::Template Memory Debug ### POST _INIT CALL ", $self->{proc_mem}->size(), "\n" | |||
1391 | if $options->{memory_debug}; | ||||||
1392 | |||||||
1393 | # drop the shared cache - leaving out this step results in the | ||||||
1394 | # template object evading garbage collection since the callbacks in | ||||||
1395 | # the shared cache tie hold references to $self! This was not easy | ||||||
1396 | # to find, by the way. | ||||||
1397 | 217 | 50 | 620 | delete $self->{cache} if $options->{shared_cache}; | |||
1398 | |||||||
1399 | 217 | 518 | $self->{included_templates} = {}; | ||||
1400 | 217 | 778 | return $self; | ||||
1401 | } | ||||||
1402 | |||||||
1403 | sub _load_supplied_options { | ||||||
1404 | 279 | 279 | 499 | my $argsref = shift; | |||
1405 | 279 | 383 | my $options = shift; | ||||
1406 | 279 | 509 | for (my $x = 0; $x < @{$argsref}; $x += 2) { | ||||
1404 | 3910 | ||||||
1407 | 4 | 620 | defined(${$argsref}[($x + 1)]) or croak( | ||||
1129 | 2840 | ||||||
1408 | 1129 | 100 | 1259 | "HTML::Template->new() called with odd number of option parameters - should be of the form option => value, you supplied option = ".lc(${$argsref}[$x])); | |||
1409 | 1125 | 1200 | $options->{lc(${$argsref}[$x])} = ${$argsref}[($x + 1)]; | ||||
1125 | 3258 | ||||||
1125 | 1570 | ||||||
1410 | } | ||||||
1411 | 275 | 788 | return $options; | ||||
1412 | } | ||||||
1413 | |||||||
1414 | # an internally used new that receives its parse_stack and param_map as input | ||||||
1415 | sub _new_from_loop { | ||||||
1416 | 39 | 39 | 59 | my $pkg = shift; | |||
1417 | 39 | 53 | my $self; { my %hash; $self = bless(\%hash, $pkg); } | ||||
39 | 46 | ||||||
39 | 43 | ||||||
39 | 121 | ||||||
1418 | |||||||
1419 | # the options hash | ||||||
1420 | 39 | 73 | my $options = {}; | ||||
1421 | 39 | 98 | $self->{options} = $options; | ||||
1422 | |||||||
1423 | # set default parameters in options hash - a subset of the options | ||||||
1424 | # valid in a normal new(). Since _new_from_loop never calls _init, | ||||||
1425 | # many options have no relevance. | ||||||
1426 | 39 | 328 | %$options = ( | ||||
1427 | debug => 0, | ||||||
1428 | stack_debug => 0, | ||||||
1429 | profile => 0, | ||||||
1430 | die_on_bad_params => 1, | ||||||
1431 | die_on_unset_params => 0, | ||||||
1432 | associate => [], | ||||||
1433 | case_sensitive => 0, | ||||||
1434 | loop_context_vars => 0, | ||||||
1435 | scalar_loops => 0, | ||||||
1436 | intrinsic_vars => 0, | ||||||
1437 | global_vars => 0, #FIXME: should this be parent_global_vars ? | ||||||
1438 | extended_syntax => 0, | ||||||
1439 | ); | ||||||
1440 | |||||||
1441 | # load in options supplied to new() | ||||||
1442 | 39 | 234 | $options = _load_supplied_options( [@_], $options); | ||||
1443 | |||||||
1444 | 39 | 170 | $self->{param_map} = $options->{param_map}; | ||||
1445 | 39 | 78 | $self->{parse_stack} = $options->{parse_stack}; | ||||
1446 | 39 | 88 | delete($options->{param_map}); | ||||
1447 | 39 | 67 | delete($options->{parse_stack}); | ||||
1448 | |||||||
1449 | 39 | 286 | return $self; | ||||
1450 | } | ||||||
1451 | |||||||
1452 | # a few shortcuts to new(), of possible use... | ||||||
1453 | sub new_file { | ||||||
1454 | 1 | 1 | 0 | 7 | my $pkg = shift; return $pkg->new('filename', @_); | ||
1 | 5 | ||||||
1455 | } | ||||||
1456 | sub new_filehandle { | ||||||
1457 | 2 | 2 | 0 | 9 | my $pkg = shift; return $pkg->new('filehandle', @_); | ||
2 | 7 | ||||||
1458 | } | ||||||
1459 | sub new_array_ref { | ||||||
1460 | 1 | 1 | 0 | 7 | my $pkg = shift; return $pkg->new('arrayref', @_); | ||
1 | 4 | ||||||
1461 | } | ||||||
1462 | sub new_scalar_ref { | ||||||
1463 | 5 | 5 | 0 | 1681 | my $pkg = shift; return $pkg->new('scalarref', @_); | ||
5 | 23 | ||||||
1464 | } | ||||||
1465 | |||||||
1466 | # initializes all the object data structures, either from cache or by | ||||||
1467 | # calling the appropriate routines. | ||||||
1468 | sub _init { | ||||||
1469 | 225 | 225 | 900 | my $self = shift; | |||
1470 | 225 | 9670 | my $options = $self->{options}; | ||||
1471 | |||||||
1472 | 225 | 50 | 1998 | if ($options->{double_cache}) { | |||
100 | |||||||
50 | |||||||
100 | |||||||
100 | |||||||
1473 | # try the normal cache, return if we have it. | ||||||
1474 | 0 | 0 | $self->_fetch_from_cache(); | ||||
1475 | 0 | 0 | 0 | 0 | return if (defined $self->{param_map} and defined $self->{parse_stack}); | ||
1476 | |||||||
1477 | # try the shared cache | ||||||
1478 | 0 | 0 | $self->_fetch_from_shared_cache(); | ||||
1479 | |||||||
1480 | # put it in the local cache if we got it. | ||||||
1481 | 0 | 0 | 0 | 0 | $self->_commit_to_cache() | ||
1482 | if (defined $self->{param_map} and defined $self->{parse_stack}); | ||||||
1483 | } elsif ($options->{double_file_cache}) { | ||||||
1484 | # try the normal cache, return if we have it. | ||||||
1485 | 3 | 13 | $self->_fetch_from_cache(); | ||||
1486 | 3 | 100 | 66 | 18 | return if (defined $self->{param_map} and defined $self->{parse_stack}); | ||
1487 | |||||||
1488 | # try the file cache | ||||||
1489 | 1 | 6 | $self->_fetch_from_file_cache(); | ||||
1490 | |||||||
1491 | # put it in the local cache if we got it. | ||||||
1492 | 1 | 50 | 33 | 8 | $self->_commit_to_cache() | ||
1493 | if (defined $self->{param_map} and defined $self->{parse_stack}); | ||||||
1494 | } elsif ($options->{shared_cache}) { | ||||||
1495 | # try the shared cache | ||||||
1496 | 0 | 0 | $self->_fetch_from_shared_cache(); | ||||
1497 | } elsif ($options->{file_cache}) { | ||||||
1498 | # try the file cache | ||||||
1499 | 7 | 27 | $self->_fetch_from_file_cache(); | ||||
1500 | } elsif ($options->{cache}) { | ||||||
1501 | # try the normal cache | ||||||
1502 | 11 | 38 | $self->_fetch_from_cache(); | ||||
1503 | } | ||||||
1504 | |||||||
1505 | # if we got a cache hit, return | ||||||
1506 | 223 | 100 | 66 | 1110 | return if (defined $self->{param_map} and defined $self->{parse_stack}); | ||
1507 | |||||||
1508 | # if we're here, then we didn't get a cached copy, so do a full | ||||||
1509 | # init. | ||||||
1510 | 211 | 843 | $self->_init_template(); | ||||
1511 | 209 | 839 | $self->_parse(); | ||||
1512 | |||||||
1513 | # now that we have a full init, cache the structures if cacheing is | ||||||
1514 | # on. shared cache is already cool. | ||||||
1515 | 203 | 100 | 566 | if($options->{file_cache}){ | |||
1516 | 1 | 5 | $self->_commit_to_file_cache(); | ||||
1517 | } | ||||||
1518 | 203 | 100 | 66 | 2407 | $self->_commit_to_cache() if ( | ||
100 | |||||||
66 | |||||||
100 | |||||||
1519 | ($options->{cache} | ||||||
1520 | and not $options->{shared_cache} | ||||||
1521 | and not $options->{file_cache} | ||||||
1522 | ) | ||||||
1523 | or ($options->{double_cache}) | ||||||
1524 | or ($options->{double_file_cache}) | ||||||
1525 | ); | ||||||
1526 | } | ||||||
1527 | |||||||
1528 | # Caching subroutines - they handle getting and validating cache | ||||||
1529 | # records from either the in-memory or shared caches. | ||||||
1530 | |||||||
1531 | # handles the normal in memory cache | ||||||
1532 | 46 | 46 | 154457 | use vars qw( %CACHE ); | |||
46 | 126 | ||||||
46 | 253754 | ||||||
1533 | sub _fetch_from_cache { | ||||||
1534 | 14 | 14 | 24 | my $self = shift; | |||
1535 | 14 | 23 | my $options = $self->{options}; | ||||
1536 | 14 | 50 | 42 | return unless exists($options->{filename}); | |||
1537 | |||||||
1538 | # return if there's no file here | ||||||
1539 | 14 | 51 | my $filepath = $self->_find_file($options->{filename}); | ||||
1540 | 14 | 50 | 544 | return unless (defined($filepath)); | |||
1541 | 14 | 34 | $options->{filepath} = $filepath; | ||||
1542 | |||||||
1543 | # return if there's no cache entry for this key | ||||||
1544 | 14 | 61 | my $key = $self->_cache_key(); | ||||
1545 | 14 | 100 | 413 | return unless exists($CACHE{$key}); | |||
1546 | |||||||
1547 | # validate the cache | ||||||
1548 | 7 | 27 | my $mtime = $self->_mtime($filepath); | ||||
1549 | 7 | 100 | 31 | if (defined $mtime) { | |||
1550 | # return if the mtime doesn't match the cache | ||||||
1551 | 6 | 50 | 33 | 49 | if (defined($CACHE{$key}{mtime}) and | ||
1552 | ($mtime != $CACHE{$key}{mtime})) { | ||||||
1553 | 0 | 0 | 0 | $options->{cache_debug} and | |||
1554 | print STDERR "CACHE MISS : $filepath : $mtime\n"; | ||||||
1555 | 0 | 0 | return; | ||||
1556 | } | ||||||
1557 | |||||||
1558 | # if the template has includes, check each included file's mtime | ||||||
1559 | # and return if different | ||||||
1560 | 6 | 100 | 31 | if (exists($CACHE{$key}{included_mtimes})) { | |||
1561 | 4 | 6 | foreach my $filename (keys %{$CACHE{$key}{included_mtimes}}) { | ||||
4 | 17 | ||||||
1562 | next unless | ||||||
1563 | 2 | 50 | 9 | defined($CACHE{$key}{included_mtimes}{$filename}); | |||
1564 | |||||||
1565 | 2 | 33 | my $included_mtime = (stat($filename))[9]; | ||||
1566 | 2 | 50 | 12 | if ($included_mtime != $CACHE{$key}{included_mtimes}{$filename}) { | |||
1567 | 0 | 0 | 0 | $options->{cache_debug} and | |||
1568 | print STDERR "### HTML::Template Cache Debug ### CACHE MISS : $filepath : INCLUDE $filename : $included_mtime\n"; | ||||||
1569 | |||||||
1570 | 0 | 0 | return; | ||||
1571 | } | ||||||
1572 | } | ||||||
1573 | } | ||||||
1574 | } | ||||||
1575 | |||||||
1576 | # got a cache hit! | ||||||
1577 | |||||||
1578 | 7 | 100 | 33 | $options->{cache_debug} and print STDERR "### HTML::Template Cache Debug ### CACHE HIT : $filepath => $key\n"; | |||
1579 | |||||||
1580 | 7 | 26 | $self->{param_map} = $CACHE{$key}{param_map}; | ||||
1581 | 7 | 24 | $self->{parse_stack} = $CACHE{$key}{parse_stack}; | ||||
1582 | 7 | 100 | 31 | exists($CACHE{$key}{included_mtimes}) and | |||
1583 | $self->{included_mtimes} = $CACHE{$key}{included_mtimes}; | ||||||
1584 | |||||||
1585 | # clear out values from param_map from last run | ||||||
1586 | 7 | 54 | $self->_normalize_options(); | ||||
1587 | 7 | 28 | $self->clear_params(); | ||||
1588 | } | ||||||
1589 | |||||||
1590 | sub _commit_to_cache { | ||||||
1591 | 7 | 7 | 17 | my $self = shift; | |||
1592 | 7 | 19 | my $options = $self->{options}; | ||||
1593 | 7 | 20 | my $key = $self->_cache_key(); | ||||
1594 | 7 | 18 | my $filepath = $options->{filepath}; | ||||
1595 | |||||||
1596 | 7 | 100 | 39 | $options->{cache_debug} and print STDERR "### HTML::Template Cache Debug ### CACHE LOAD : $filepath => $key\n"; | |||
1597 | |||||||
1598 | 7 | 100 | 47 | $options->{blind_cache} or | |||
1599 | $CACHE{$key}{mtime} = $self->_mtime($filepath); | ||||||
1600 | 7 | 27 | $CACHE{$key}{param_map} = $self->{param_map}; | ||||
1601 | 7 | 20 | $CACHE{$key}{parse_stack} = $self->{parse_stack}; | ||||
1602 | 7 | 100 | 39 | exists($self->{included_mtimes}) and | |||
1603 | $CACHE{$key}{included_mtimes} = $self->{included_mtimes}; | ||||||
1604 | } | ||||||
1605 | |||||||
1606 | # create a cache key from a template object. The cache key includes | ||||||
1607 | # the full path to the template and options which affect template | ||||||
1608 | # loading. Has the side-effect of loading $self->{options}{filepath} | ||||||
1609 | sub _cache_key { | ||||||
1610 | 30 | 30 | 52 | my $self = shift; | |||
1611 | 30 | 49 | my $options = $self->{options}; | ||||
1612 | |||||||
1613 | # assemble pieces of the key | ||||||
1614 | 30 | 195 | my @key = ($options->{filepath}); | ||||
1615 | 30 | 39 | push(@key, @{$options->{path}}); | ||||
30 | 69 | ||||||
1616 | 30 | 100 | 149 | push(@key, $options->{search_path_on_include} || 0); | |||
1617 | 30 | 50 | 137 | push(@key, $options->{loop_context_vars} || 0); | |||
1618 | 30 | 50 | 131 | push(@key, $options->{scalar_loops} || 0); | |||
1619 | 30 | 50 | 129 | push(@key, $options->{intrinsic_vars} || 0); | |||
1620 | 30 | 100 | 121 | push(@key, $options->{global_vars} || 0); | |||
1621 | |||||||
1622 | # compute the md5 and return it | ||||||
1623 | 30 | 273 | return md5_hex(@key); | ||||
1624 | } | ||||||
1625 | |||||||
1626 | # generates MD5 from filepath to determine filename for cache file | ||||||
1627 | sub _get_cache_filename { | ||||||
1628 | 9 | 9 | 20 | my ($self, $filepath) = @_; | |||
1629 | |||||||
1630 | # get a cache key | ||||||
1631 | 9 | 27 | $self->{options}{filepath} = $filepath; | ||||
1632 | 9 | 50 | my $hash = $self->_cache_key(); | ||||
1633 | |||||||
1634 | # ... and build a path out of it. Using the first two charcters | ||||||
1635 | # gives us 255 buckets. This means you can have 255,000 templates | ||||||
1636 | # in the cache before any one directory gets over a few thousand | ||||||
1637 | # files in it. That's probably pretty good for this planet. If not | ||||||
1638 | # then it should be configurable. | ||||||
1639 | 9 | 100 | 29 | if (wantarray) { | |||
1640 | 1 | 4 | return (substr($hash,0,2), substr($hash,2)) | ||||
1641 | } else { | ||||||
1642 | 8 | 159 | return File::Spec->join($self->{options}{file_cache_dir}, | ||||
1643 | substr($hash,0,2), substr($hash,2)); | ||||||
1644 | } | ||||||
1645 | } | ||||||
1646 | |||||||
1647 | # handles the file cache | ||||||
1648 | sub _fetch_from_file_cache { | ||||||
1649 | 8 | 8 | 16 | my $self = shift; | |||
1650 | 8 | 17 | my $options = $self->{options}; | ||||
1651 | 8 | 50 | 37 | return unless exists($options->{filename}); | |||
1652 | |||||||
1653 | # return if there's no cache entry for this filename | ||||||
1654 | 8 | 42 | my $filepath = $self->_find_file($options->{filename}); | ||||
1655 | 8 | 50 | 27 | return unless defined $filepath; | |||
1656 | 8 | 32 | my $cache_filename = $self->_get_cache_filename($filepath); | ||||
1657 | 8 | 50 | 248 | return unless -e $cache_filename; | |||
1658 | |||||||
1659 | 8 | 17 | eval { | ||||
1660 | 8 | 31 | $self->{record} = Storable::lock_retrieve($cache_filename); | ||||
1661 | }; | ||||||
1662 | 8 | 50 | 17410 | croak("HTML::Template::new() - Problem reading cache file $cache_filename (file_cache => 1) : $@") | |||
1663 | if $@; | ||||||
1664 | 8 | 50 | 29 | croak("HTML::Template::new() - Problem reading cache file $cache_filename (file_cache => 1) : $!") | |||
1665 | unless defined $self->{record}; | ||||||
1666 | |||||||
1667 | 8 | 48 | ($self->{mtime}, | ||||
1668 | $self->{included_mtimes}, | ||||||
1669 | $self->{param_map}, | ||||||
1670 | 8 | 15 | $self->{parse_stack}) = @{$self->{record}}; | ||||
1671 | |||||||
1672 | 8 | 23 | $options->{filepath} = $filepath; | ||||
1673 | |||||||
1674 | # validate the cache | ||||||
1675 | 8 | 33 | my $mtime = $self->_mtime($filepath); | ||||
1676 | 8 | 50 | 32 | if (defined $mtime) { | |||
1677 | # return if the mtime doesn't match the cache | ||||||
1678 | 8 | 100 | 66 | 66 | if (defined($self->{mtime}) and | ||
1679 | ($mtime != $self->{mtime})) { | ||||||
1680 | 1 | 50 | 6 | $options->{cache_debug} and | |||
1681 | print STDERR "### HTML::Template Cache Debug ### FILE CACHE MISS : $filepath : $mtime\n"; | ||||||
1682 | 1 | 4 | ($self->{mtime}, | ||||
1683 | $self->{included_mtimes}, | ||||||
1684 | $self->{param_map}, | ||||||
1685 | $self->{parse_stack}) = (undef, undef, undef, undef); | ||||||
1686 | 1 | 723 | return; | ||||
1687 | } | ||||||
1688 | |||||||
1689 | # if the template has includes, check each included file's mtime | ||||||
1690 | # and return if different | ||||||
1691 | 7 | 50 | 24 | if (exists($self->{included_mtimes})) { | |||
1692 | 7 | 10 | foreach my $filename (keys %{$self->{included_mtimes}}) { | ||||
7 | 35 | ||||||
1693 | next unless | ||||||
1694 | 2 | 50 | 8 | defined($self->{included_mtimes}{$filename}); | |||
1695 | |||||||
1696 | 2 | 32 | my $included_mtime = (stat($filename))[9]; | ||||
1697 | 2 | 50 | 12 | if ($included_mtime != $self->{included_mtimes}{$filename}) { | |||
1698 | 0 | 0 | 0 | $options->{cache_debug} and | |||
1699 | print STDERR "### HTML::Template Cache Debug ### FILE CACHE MISS : $filepath : INCLUDE $filename : $included_mtime\n"; | ||||||
1700 | 0 | 0 | ($self->{mtime}, | ||||
1701 | $self->{included_mtimes}, | ||||||
1702 | $self->{param_map}, | ||||||
1703 | $self->{parse_stack}) = (undef, undef, undef, undef); | ||||||
1704 | 0 | 0 | return; | ||||
1705 | } | ||||||
1706 | } | ||||||
1707 | } | ||||||
1708 | } | ||||||
1709 | |||||||
1710 | # got a cache hit! | ||||||
1711 | 7 | 100 | 43 | $options->{cache_debug} and print STDERR "### HTML::Template Cache Debug ### FILE CACHE HIT : $filepath\n"; | |||
1712 | |||||||
1713 | # clear out values from param_map from last run | ||||||
1714 | 7 | 34 | $self->_normalize_options(); | ||||
1715 | 7 | 24 | $self->clear_params(); | ||||
1716 | } | ||||||
1717 | |||||||
1718 | sub _commit_to_file_cache { | ||||||
1719 | 1 | 1 | 2 | my $self = shift; | |||
1720 | 1 | 3 | my $options = $self->{options}; | ||||
1721 | |||||||
1722 | 1 | 2 | my $filepath = $options->{filepath}; | ||||
1723 | 1 | 50 | 4 | if (not defined $filepath) { | |||
1724 | 0 | 0 | $filepath = $self->_find_file($options->{filename}); | ||||
1725 | 0 | 0 | 0 | confess("HTML::Template->new() : Cannot open included file $options->{filename} : file not found.") | |||
1726 | unless defined($filepath); | ||||||
1727 | 0 | 0 | $options->{filepath} = $filepath; | ||||
1728 | } | ||||||
1729 | |||||||
1730 | 1 | 4 | my ($cache_dir, $cache_file) = $self->_get_cache_filename($filepath); | ||||
1731 | 1 | 22 | $cache_dir = File::Spec->join($options->{file_cache_dir}, $cache_dir); | ||||
1732 | 1 | 50 | 23 | if (not -d $cache_dir) { | |||
1733 | 0 | 0 | 0 | if (not -d $options->{file_cache_dir}) { | |||
1734 | 0 | 0 | 0 | mkdir($options->{file_cache_dir},$options->{file_cache_dir_mode}) | |||
1735 | or croak("HTML::Template->new() : can't mkdir $options->{file_cache_dir} (file_cache => 1): $!"); | ||||||
1736 | } | ||||||
1737 | 0 | 0 | 0 | mkdir($cache_dir,$options->{file_cache_dir_mode}) | |||
1738 | or croak("HTML::Template->new() : can't mkdir $cache_dir (file_cache => 1): $!"); | ||||||
1739 | } | ||||||
1740 | |||||||
1741 | 1 | 50 | 6 | $options->{cache_debug} and print STDERR "### HTML::Template Cache Debug ### FILE CACHE LOAD : $options->{filepath}\n"; | |||
1742 | |||||||
1743 | 1 | 1 | my $result; | ||||
1744 | 1 | 2 | eval { | ||||
1745 | 1 | 17 | $result = Storable::lock_store([ $self->{mtime}, | ||||
1746 | $self->{included_mtimes}, | ||||||
1747 | $self->{param_map}, | ||||||
1748 | $self->{parse_stack} ], | ||||||
1749 | scalar File::Spec->join($cache_dir, $cache_file) | ||||||
1750 | ); | ||||||
1751 | }; | ||||||
1752 | 1 | 50 | 552 | croak("HTML::Template::new() - Problem writing cache file $cache_dir/$cache_file (file_cache => 1) : $@") | |||
1753 | if $@; | ||||||
1754 | 1 | 50 | 6 | croak("HTML::Template::new() - Problem writing cache file $cache_dir/$cache_file (file_cache => 1) : $!") | |||
1755 | unless defined $result; | ||||||
1756 | } | ||||||
1757 | |||||||
1758 | # Shared cache routines. | ||||||
1759 | sub _fetch_from_shared_cache { | ||||||
1760 | 0 | 0 | 0 | my $self = shift; | |||
1761 | 0 | 0 | my $options = $self->{options}; | ||||
1762 | 0 | 0 | 0 | return unless exists($options->{filename}); | |||
1763 | |||||||
1764 | 0 | 0 | my $filepath = $self->_find_file($options->{filename}); | ||||
1765 | 0 | 0 | 0 | return unless defined $filepath; | |||
1766 | |||||||
1767 | # fetch from the shared cache. | ||||||
1768 | 0 | 0 | $self->{record} = $self->{cache}{$filepath}; | ||||
1769 | |||||||
1770 | 0 | 0 | ($self->{mtime}, | ||||
1771 | $self->{included_mtimes}, | ||||||
1772 | $self->{param_map}, | ||||||
1773 | 0 | 0 | 0 | $self->{parse_stack}) = @{$self->{record}} | |||
1774 | if defined($self->{record}); | ||||||
1775 | |||||||
1776 | 0 | 0 | 0 | 0 | $options->{cache_debug} and defined($self->{record}) and print STDERR "### HTML::Template Cache Debug ### CACHE HIT : $filepath\n"; | ||
1777 | # clear out values from param_map from last run | ||||||
1778 | 0 | 0 | 0 | $self->_normalize_options(), $self->clear_params() | |||
1779 | if (defined($self->{record})); | ||||||
1780 | 0 | 0 | delete($self->{record}); | ||||
1781 | |||||||
1782 | 0 | 0 | return $self; | ||||
1783 | } | ||||||
1784 | |||||||
1785 | sub _validate_shared_cache { | ||||||
1786 | 0 | 0 | 0 | my ($self, $filename, $record) = @_; | |||
1787 | 0 | 0 | my $options = $self->{options}; | ||||
1788 | |||||||
1789 | 0 | 0 | 0 | $options->{shared_cache_debug} and print STDERR "### HTML::Template Cache Debug ### SHARED CACHE VALIDATE : $filename\n"; | |||
1790 | |||||||
1791 | 0 | 0 | 0 | return 1 if $options->{blind_cache}; | |||
1792 | |||||||
1793 | 0 | 0 | my ($c_mtime, $included_mtimes, $param_map, $parse_stack) = @$record; | ||||
1794 | |||||||
1795 | # if the modification time has changed return false | ||||||
1796 | 0 | 0 | my $mtime = $self->_mtime($filename); | ||||
1797 | 0 | 0 | 0 | 0 | if (defined $mtime and defined $c_mtime | ||
0 | |||||||
1798 | and $mtime != $c_mtime) { | ||||||
1799 | 0 | 0 | 0 | $options->{cache_debug} and | |||
1800 | print STDERR "### HTML::Template Cache Debug ### SHARED CACHE MISS : $filename : $mtime\n"; | ||||||
1801 | 0 | 0 | return 0; | ||||
1802 | } | ||||||
1803 | |||||||
1804 | # if the template has includes, check each included file's mtime | ||||||
1805 | # and return false if different | ||||||
1806 | 0 | 0 | 0 | 0 | if (defined $mtime and defined $included_mtimes) { | ||
1807 | 0 | 0 | foreach my $fname (keys %$included_mtimes) { | ||||
1808 | 0 | 0 | 0 | next unless defined($included_mtimes->{$fname}); | |||
1809 | 0 | 0 | 0 | if ($included_mtimes->{$fname} != (stat($fname))[9]) { | |||
1810 | 0 | 0 | 0 | $options->{cache_debug} and | |||
1811 | print STDERR "### HTML::Template Cache Debug ### SHARED CACHE MISS : $filename : INCLUDE $fname\n"; | ||||||
1812 | 0 | 0 | return 0; | ||||
1813 | } | ||||||
1814 | } | ||||||
1815 | } | ||||||
1816 | |||||||
1817 | # all done - return true | ||||||
1818 | 0 | 0 | return 1; | ||||
1819 | } | ||||||
1820 | |||||||
1821 | sub _load_shared_cache { | ||||||
1822 | 0 | 0 | 0 | my ($self, $filename) = @_; | |||
1823 | 0 | 0 | my $options = $self->{options}; | ||||
1824 | 0 | 0 | my $cache = $self->{cache}; | ||||
1825 | |||||||
1826 | 0 | 0 | $self->_init_template(); | ||||
1827 | 0 | 0 | $self->_parse(); | ||||
1828 | |||||||
1829 | 0 | 0 | 0 | $options->{cache_debug} and print STDERR "### HTML::Template Cache Debug ### SHARED CACHE LOAD : $options->{filepath}\n"; | |||
1830 | |||||||
1831 | 0 | 0 | 0 | print STDERR "### HTML::Template Memory Debug ### END CACHE LOAD ", $self->{proc_mem}->size(), "\n" | |||
1832 | if $options->{memory_debug}; | ||||||
1833 | |||||||
1834 | 0 | 0 | return [ $self->{mtime}, | ||||
1835 | $self->{included_mtimes}, | ||||||
1836 | $self->{param_map}, | ||||||
1837 | $self->{parse_stack} ]; | ||||||
1838 | } | ||||||
1839 | |||||||
1840 | # utility function - given a filename performs documented search and | ||||||
1841 | # returns a full path or undef if the file cannot be found. | ||||||
1842 | sub _find_file { | ||||||
1843 | 123 | 123 | 442 | my ($self, $filename, $extra_path) = @_; | |||
1844 | 123 | 261 | my $options = $self->{options}; | ||||
1845 | 123 | 138 | my $filepath; | ||||
1846 | |||||||
1847 | # first check for a full path | ||||||
1848 | 123 | 50 | 33 | 1181 | return File::Spec->canonpath($filename) | ||
1849 | if (File::Spec->file_name_is_absolute($filename) and (-e $filename)); | ||||||
1850 | |||||||
1851 | # try the extra_path if one was specified | ||||||
1852 | 123 | 100 | 396 | if (defined($extra_path)) { | |||
1853 | 34 | 55 | $extra_path->[$#{$extra_path}] = $filename; | ||||
34 | 88 | ||||||
1854 | 34 | 473 | $filepath = File::Spec->canonpath(File::Spec->catfile(@$extra_path)); | ||||
1855 | 34 | 100 | 906 | return File::Spec->canonpath($filepath) if -e $filepath; | |||
1856 | } | ||||||
1857 | |||||||
1858 | # try pre-prending HTML_Template_Root | ||||||
1859 | 96 | 100 | 510 | if (defined($ENV{HTML_TEMPLATE_ROOT})) { | |||
1860 | 4 | 54 | $filepath = File::Spec->catfile($ENV{HTML_TEMPLATE_ROOT}, $filename); | ||||
1861 | 4 | 100 | 87 | return File::Spec->canonpath($filepath) if -e $filepath; | |||
1862 | } | ||||||
1863 | |||||||
1864 | # try "path" option list.. | ||||||
1865 | 95 | 148 | foreach my $path (@{$options->{path}}) { | ||||
95 | 260 | ||||||
1866 | 81 | 1156 | $filepath = File::Spec->catfile($path, $filename); | ||||
1867 | 81 | 100 | 2764 | return File::Spec->canonpath($filepath) if -e $filepath; | |||
1868 | } | ||||||
1869 | |||||||
1870 | # try even a relative path from the current directory... | ||||||
1871 | 20 | 100 | 555 | return File::Spec->canonpath($filename) if -e $filename; | |||
1872 | |||||||
1873 | # try "path" option list with HTML_TEMPLATE_ROOT prepended... | ||||||
1874 | 3 | 50 | 12 | if (defined($ENV{HTML_TEMPLATE_ROOT})) { | |||
1875 | 3 | 5 | foreach my $path (@{$options->{path}}) { | ||||
3 | 8 | ||||||
1876 | 2 | 25 | $filepath = File::Spec->catfile($ENV{HTML_TEMPLATE_ROOT}, $path, $filename); | ||||
1877 | 2 | 100 | 41 | return File::Spec->canonpath($filepath) if -e $filepath; | |||
1878 | } | ||||||
1879 | } | ||||||
1880 | |||||||
1881 | 2 | 6 | return undef; | ||||
1882 | } | ||||||
1883 | |||||||
1884 | # utility function - computes the mtime for $filename | ||||||
1885 | sub _mtime { | ||||||
1886 | 89 | 89 | 153 | my ($self, $filepath) = @_; | |||
1887 | 89 | 163 | my $options = $self->{options}; | ||||
1888 | |||||||
1889 | 89 | 100 | 254 | return(undef) if ($options->{blind_cache}); | |||
1890 | |||||||
1891 | # make sure it still exists in the filesystem | ||||||
1892 | 87 | 50 | 1507 | (-r $filepath) or Carp::confess("HTML::Template : template file $filepath does not exist or is unreadable."); | |||
1893 | |||||||
1894 | # get the modification time | ||||||
1895 | 87 | 478 | return (stat(_))[9]; | ||||
1896 | } | ||||||
1897 | |||||||
1898 | # utility function - enforces new() options across LOOPs that have | ||||||
1899 | # come from a cache. Otherwise they would have stale options hashes. | ||||||
1900 | sub _normalize_options { | ||||||
1901 | 14 | 14 | 99 | my $self = shift; | |||
1902 | 14 | 38 | my $options = $self->{options}; | ||||
1903 | |||||||
1904 | 14 | 40 | my @pstacks = ($self->{parse_stack}); | ||||
1905 | 14 | 52 | while(@pstacks) { | ||||
1906 | 15 | 28 | my $pstack = pop(@pstacks); | ||||
1907 | 15 | 35 | foreach my $item (@$pstack) { | ||||
1908 | 39 | 100 | 183 | next unless (ref($item) eq 'HTML::Template::LOOP'); | |||
1909 | 1 | 2 | foreach my $template (values %{$item->[HTML::Template::LOOP::TEMPLATE_HASH]}) { | ||||
1 | 5 | ||||||
1910 | # must be the same list as the call to _new_from_loop... | ||||||
1911 | 1 | 3 | $template->{options}{debug} = $options->{debug}; | ||||
1912 | 1 | 4 | $template->{options}{stack_debug} = $options->{stack_debug}; | ||||
1913 | 1 | 3 | $template->{options}{profile} = $options->{profile}; | ||||
1914 | 1 | 3 | $template->{options}{die_on_bad_params} = $options->{die_on_bad_params}; | ||||
1915 | 1 | 4 | $template->{options}{die_on_unset_params} = $options->{die_on_unset_params}; | ||||
1916 | 1 | 6 | $template->{options}{case_sensitive} = $options->{case_sensitive}; | ||||
1917 | 1 | 3 | $template->{options}{loop_context_vars} = $options->{loop_context_vars}; | ||||
1918 | 1 | 2 | $template->{options}{scalar_loops} = $options->{scalar_loops}; | ||||
1919 | 1 | 4 | $template->{options}{force_untaint} = $options->{force_untaint}; | ||||
1920 | 1 | 50 | 9 | $template->{options}{parent_global_vars} = $options->{parent_global_vars} || 0; #FIXME: should this include a check for global_vars ? | |||
1921 | 1 | 4 | $template->{options}{extended_syntax} = $options->{extended_syntax}; | ||||
1922 | 1 | 50 | 5 | $template->{options}{expr} = $options->{expr} if (exists $options->{expr}); | |||
1923 | 1 | 50 | 6 | $template->{options}{expr_func} = $options->{expr_func} if (exists $options->{expr_func}); | |||
1924 | 1 | 4 | push(@pstacks, $template->{parse_stack}); | ||||
1925 | } | ||||||
1926 | } | ||||||
1927 | } | ||||||
1928 | } | ||||||
1929 | |||||||
1930 | # initialize the template buffer | ||||||
1931 | sub _init_template { | ||||||
1932 | 211 | 211 | 336 | my $self = shift; | |||
1933 | 211 | 467 | my $options = $self->{options}; | ||||
1934 | |||||||
1935 | 211 | 50 | 819 | print STDERR "### HTML::Template Memory Debug ### START INIT_TEMPLATE ", $self->{proc_mem}->size(), "\n" | |||
1936 | if $options->{memory_debug}; | ||||||
1937 | |||||||
1938 | 211 | 100 | 1446 | if (exists($options->{filename})) { | |||
100 | |||||||
100 | |||||||
50 | |||||||
1939 | 70 | 161 | $self->{type} = "filename"; | ||||
1940 | 70 | 142 | my $filepath = $options->{filepath}; | ||||
1941 | 70 | 100 | 189 | if (not defined $filepath) { | |||
1942 | 63 | 519 | $filepath = $self->_find_file($options->{filename}); | ||||
1943 | 63 | 100 | 564 | confess("HTML::Template->new() : Cannot open included file $options->{filename} : file not found.") | |||
1944 | unless defined($filepath); | ||||||
1945 | # we'll need this for future reference - to call stat() for example. | ||||||
1946 | 61 | 157 | $options->{filepath} = $filepath; | ||||
1947 | } | ||||||
1948 | |||||||
1949 | 68 | 50 | 2839 | confess("HTML::Template->new() : Cannot open included file $options->{filename} : $!") | |||
1950 | unless defined(open(TEMPLATE, $filepath)); | ||||||
1951 | 68 | 283 | $self->{mtime} = $self->_mtime($filepath); | ||||
1952 | |||||||
1953 | # read into scalar, note the mtime for the record | ||||||
1954 | 68 | 210 | $self->{template} = ""; | ||||
1955 | 68 | 2721 | while (read(TEMPLATE, $self->{template}, 10240, length($self->{template}))) {} | ||||
1956 | 68 | 10553 | close(TEMPLATE); | ||||
1957 | |||||||
1958 | } elsif (exists($options->{scalarref})) { | ||||||
1959 | 135 | 324 | $self->{type} = "scalarref"; | ||||
1960 | # copy in the template text | ||||||
1961 | 135 | 176 | $self->{template} = ${$options->{scalarref}}; | ||||
135 | 492 | ||||||
1962 | 135 | 306 | delete($options->{scalarref}); | ||||
1963 | |||||||
1964 | } elsif (exists($options->{arrayref})) { | ||||||
1965 | 2 | 5 | $self->{type} = "arrayref"; | ||||
1966 | # if we have an array ref, join and store the template text | ||||||
1967 | 2 | 6 | $self->{template} = join("", @{$options->{arrayref}}); | ||||
2 | 9 | ||||||
1968 | 2 | 5 | delete($options->{arrayref}); | ||||
1969 | |||||||
1970 | } elsif (exists($options->{filehandle})) { | ||||||
1971 | 4 | 11 | $self->{type} = "filehandle"; | ||||
1972 | # just read everything in in one go | ||||||
1973 | 4 | 18 | local $/ = undef; | ||||
1974 | 4 | 147 | $self->{template} = readline($options->{filehandle}); | ||||
1975 | 4 | 20 | delete($options->{filehandle}); | ||||
1976 | |||||||
1977 | } else { | ||||||
1978 | 0 | 0 | confess("HTML::Template : Need to call new with filename, filehandle, scalarref or arrayref parameter specified."); | ||||
1979 | } | ||||||
1980 | |||||||
1981 | 209 | 50 | 1790 | print STDERR "### HTML::Template Memory Debug ### END INIT_TEMPLATE ", $self->{proc_mem}->size(), "\n" | |||
1982 | if $options->{memory_debug}; | ||||||
1983 | |||||||
1984 | # handle filters if necessary | ||||||
1985 | 209 | 100 | 327 | $self->_call_filters(\$self->{template}) if @{$options->{filter}}; | |||
209 | 764 | ||||||
1986 | |||||||
1987 | 209 | 444 | return $self; | ||||
1988 | } | ||||||
1989 | |||||||
1990 | # handle calling user defined filters | ||||||
1991 | sub _call_filters { | ||||||
1992 | 12 | 12 | 21 | my $self = shift; | |||
1993 | 12 | 18 | my $template_ref = shift; | ||||
1994 | 12 | 20 | my $options = $self->{options}; | ||||
1995 | |||||||
1996 | 12 | 14 | my ($format, $sub); | ||||
1997 | 12 | 15 | foreach my $filter (@{$options->{filter}}) { | ||||
12 | 30 | ||||||
1998 | 14 | 50 | 31 | croak("HTML::Template->new() : bad value set for filter parameter - must be a code ref or a hash ref.") | |||
1999 | unless reftype($filter); | ||||||
2000 | |||||||
2001 | # translate into CODE->HASH | ||||||
2002 | 14 | 100 | 31 | $filter = { 'format' => 'scalar', 'sub' => $filter } | |||
2003 | if (reftype($filter) eq 'CODE'); | ||||||
2004 | |||||||
2005 | 14 | 50 | 36 | if (reftype($filter) eq 'HASH') { | |||
2006 | 14 | 24 | $format = $filter->{'format'}; | ||||
2007 | 14 | 23 | $sub = $filter->{'sub'}; | ||||
2008 | |||||||
2009 | # check types and values | ||||||
2010 | 14 | 50 | 33 | 68 | croak("HTML::Template->new() : bad value set for filter parameter - hash must contain \"format\" key and \"sub\" key.") | ||
2011 | unless defined $format and defined $sub; | ||||||
2012 | 14 | 50 | 66 | 66 | croak("HTML::Template->new() : bad value set for filter parameter - \"format\" must be either 'array' or 'scalar'") | ||
2013 | unless $format eq 'array' or $format eq 'scalar'; | ||||||
2014 | 14 | 50 | 33 | 48 | croak("HTML::Template->new() : bad value set for filter parameter - \"sub\" must be a code ref") | ||
2015 | unless ref $sub and reftype($sub) eq 'CODE'; | ||||||
2016 | |||||||
2017 | # catch errors | ||||||
2018 | 14 | 22 | eval { | ||||
2019 | 14 | 100 | 31 | if ($format eq 'scalar') { | |||
2020 | # call | ||||||
2021 | 12 | 37 | $sub->($template_ref,$self); | ||||
2022 | } else { | ||||||
2023 | # modulate | ||||||
2024 | 2 | 8 | my @array = map { $_."\n" } split("\n", $$template_ref); | ||||
3 | 11 | ||||||
2025 | # call | ||||||
2026 | 2 | 9 | $sub->(\@array,$self); | ||||
2027 | # demodulate | ||||||
2028 | 2 | 26 | $$template_ref = join("", @array); | ||||
2029 | } | ||||||
2030 | }; | ||||||
2031 | 14 | 50 | 107 | croak("HTML::Template->new() : fatal error occured during filter call: $@") if $@; | |||
2032 | } else { | ||||||
2033 | 0 | 0 | croak("HTML::Template->new() : bad value set for filter parameter - must be code ref or hash ref"); | ||||
2034 | } | ||||||
2035 | } | ||||||
2036 | # all done | ||||||
2037 | 12 | 30 | return $template_ref; | ||||
2038 | } | ||||||
2039 | |||||||
2040 | # _parse sifts through a template building up the param_map and | ||||||
2041 | # parse_stack structures. | ||||||
2042 | # | ||||||
2043 | # The end result is a Template object that is fully ready for | ||||||
2044 | # output(). | ||||||
2045 | sub _parse { | ||||||
2046 | 209 | 209 | 280 | my $self = shift; | |||
2047 | 209 | 392 | my $options = $self->{options}; | ||||
2048 | |||||||
2049 | 209 | 50 | 1051 | $options->{debug} and print STDERR "### HTML::Template Debug ### In _parse:\n"; | |||
2050 | |||||||
2051 | # display profiling information | ||||||
2052 | 209 | 50 | 519 | if ($options->{profile}) { | |||
2053 | 46 | 46 | 505 | use vars qw($profile_time_start); | |||
46 | 97 | ||||||
46 | 13200 | ||||||
2054 | 0 | 0 | $profile_time_start = [gettimeofday]; | ||||
2055 | 0 | 0 | printf STDERR "### HTML::Template Profile ## begin _parse : %.6f\n", join('.',@$profile_time_start); | ||||
2056 | } | ||||||
2057 | |||||||
2058 | # setup the stacks and maps - they're accessed by typeglobs that | ||||||
2059 | # reference the top of the stack. They are masked so that a loop | ||||||
2060 | # can transparently have its own versions. | ||||||
2061 | 46 | 46 | 269 | use vars qw(@pstack %pmap @ifstack @elsifstack @ucstack %top_pmap); | |||
46 | 254 | ||||||
46 | 18161 | ||||||
2062 | 209 | 1366 | local (*pstack, *ifstack, *elsifstack, *pmap, *ucstack, *top_pmap); | ||||
2063 | |||||||
2064 | # the pstack is the array of scalar refs (plain text from the | ||||||
2065 | # template file), VARs, LOOPs, IFs and ELSEs that output() works on | ||||||
2066 | # to produce output. Looking at output() should make it clear what | ||||||
2067 | # _parse is trying to accomplish. | ||||||
2068 | 209 | 562 | my @pstacks = ([]); | ||||
2069 | 209 | 388 | *pstack = $pstacks[0]; | ||||
2070 | 209 | 580 | $self->{parse_stack} = $pstacks[0]; | ||||
2071 | |||||||
2072 | # the pmap binds names to VARs, LOOPs and IFs. It allows param() to | ||||||
2073 | # access the right variable. NOTE: output() does not look at the | ||||||
2074 | # pmap at all! | ||||||
2075 | 209 | 689 | my @pmaps = ({}); | ||||
2076 | 209 | 341 | *pmap = $pmaps[0]; | ||||
2077 | 209 | 298 | *top_pmap = $pmaps[0]; | ||||
2078 | 209 | 402 | $self->{param_map} = $pmaps[0]; | ||||
2079 | |||||||
2080 | # enable the intrinsic vars | ||||||
2081 | 209 | 100 | 655 | if ($options->{intrinsic_vars}) { | |||
2082 | 3 | 14 | $pmap{__type__} = HTML::Template::VAR->new(); | ||||
2083 | 3 | 10 | $pmap{__filename__} = HTML::Template::VAR->new(); | ||||
2084 | 3 | 8 | $pmap{__filepath__} = HTML::Template::VAR->new(); | ||||
2085 | 3 | 6 | ${$pmap{__type__}} = $self->{type}; | ||||
3 | 11 | ||||||
2086 | 3 | 100 | 12 | ${$pmap{__filename__}} = $options->{filename} || ''; | |||
3 | 6 | ||||||
2087 | 3 | 50 | 10 | ${$pmap{__filepath__}} = defined $options->{filepath} ? $options->{filepath} : | |||
3 | 100 | 5 | |||||
2088 | $options->{filename} ? $self->_find_file($options->{filename}) : | ||||||
2089 | ''; | ||||||
2090 | } | ||||||
2091 | |||||||
2092 | # the ifstack is a temporary stack containing pending ifs and elses | ||||||
2093 | # waiting for a /if. | ||||||
2094 | 209 | 519 | my @ifstacks = ([]); | ||||
2095 | 209 | 480 | *ifstack = $ifstacks[0]; | ||||
2096 | |||||||
2097 | # the elsifstack is a temporary stack for containing the elsif, | ||||||
2098 | # which in reality expands/unrolls to become IF-ELSE-/IF. | ||||||
2099 | 209 | 408 | my @elsifstacks = ([]); | ||||
2100 | 209 | 313 | *elsifstack = $elsifstacks[0]; | ||||
2101 | |||||||
2102 | # the ucstack is a temporary stack containing conditions that need | ||||||
2103 | # to be bound to param_map entries when their block is finished. | ||||||
2104 | # This happens when a conditional is encountered before any other | ||||||
2105 | # reference to its NAME. Since a conditional can reference VARs and | ||||||
2106 | # LOOPs it isn't possible to make the link right away. | ||||||
2107 | 209 | 382 | my @ucstacks = ([]); | ||||
2108 | 209 | 291 | *ucstack = $ucstacks[0]; | ||||
2109 | |||||||
2110 | # the loopstack is another temp stack for closing loops. unlike | ||||||
2111 | # those above it doesn't get scoped inside loops, therefore it | ||||||
2112 | # doesn't need the typeglob magic. | ||||||
2113 | 209 | 326 | my @loopstack = (); | ||||
2114 | |||||||
2115 | # the fstack is a stack of filenames and counters that keeps track | ||||||
2116 | # of which file we're in and where we are in it. This allows | ||||||
2117 | # accurate error messages even inside included files! | ||||||
2118 | # fcounter, fmax and fname are aliases for the current file's info | ||||||
2119 | 46 | 46 | 295 | use vars qw($fcounter $fname $fmax); | |||
46 | 134 | ||||||
46 | 331625 | ||||||
2120 | 209 | 877 | local (*fcounter, *fname, *fmax); | ||||
2121 | |||||||
2122 | 209 | 2844 | my @fstack = ([$options->{filepath} || "/fake/path/for/non/file/template", | ||||
2123 | 1, | ||||||
2124 | 209 | 100 | 3164 | scalar @{[$self->{template} =~ m/(\n)/g]} + 1 | |||
2125 | ]); | ||||||
2126 | 209 | 1220 | (*fname, *fcounter, *fmax) = \ ( @{$fstack[0]} ); | ||||
209 | 693 | ||||||
2127 | |||||||
2128 | 209 | 902 | my $NOOP = HTML::Template::NOOP->new(); | ||||
2129 | |||||||
2130 | # all the tags that need NAMEs: | ||||||
2131 | 209 | 413 | my %need_names = map { $_ => 1 } | ||||
1463 | 3877 | ||||||
2132 | qw(TMPL_VAR TMPL_LOOP TMPL_IF TMPL_ELSIF TMPL_UNLESS TMPL_INCLUDE TMPL_REQUIRE); | ||||||
2133 | |||||||
2134 | # variables used below that don't need to be my'd in the loop | ||||||
2135 | 209 | 466 | my ($name, $which, $escape, $default); | ||||
2136 | |||||||
2137 | # now split up template on ' | ||||||
2138 | 209 | 2814 | my @chunks = split(m!(?=<(?:\!--\s*)?/?[Tt][Mm][Pp][Ll]_)!, $self->{template}); | ||||
2139 | |||||||
2140 | # all done with template | ||||||
2141 | 209 | 466 | delete $self->{template}; | ||||
2142 | |||||||
2143 | # loop through chunks, filling up pstack | ||||||
2144 | 209 | 378 | my $last_chunk = $#chunks; | ||||
2145 | 209 | 919 | CHUNK: for (my $chunk_number = 0; | ||||
2146 | $chunk_number <= $last_chunk; | ||||||
2147 | $chunk_number++) { | ||||||
2148 | 614 | 50 | 4781 | next unless defined $chunks[$chunk_number]; | |||
2149 | 614 | 2729 | my $chunk = $chunks[$chunk_number]; | ||||
2150 | |||||||
2151 | # a general regex to match any and all TMPL_* tags | ||||||
2152 | 614 | 100 | 33 | 10136 | if ($chunk =~ /^< | ||
50 | |||||||
2153 | (?:!--\s*)? | ||||||
2154 | ( | ||||||
2155 | \/?[Tt][Mm][Pp][Ll]_ | ||||||
2156 | (?: | ||||||
2157 | (?:[Vv][Aa][Rr]) | ||||||
2158 | | | ||||||
2159 | (?:[Ll][Oo][Oo][Pp]) | ||||||
2160 | | | ||||||
2161 | (?:[Ii][Ff]) | ||||||
2162 | | | ||||||
2163 | (?:[Ee][Ll][Ss][Ee]) | ||||||
2164 | | | ||||||
2165 | (?:[Ee][Ll][Ss][Ii][Ff]) | ||||||
2166 | | | ||||||
2167 | (?:[Uu][Nn][Ll][Ee][Ss][Ss]) | ||||||
2168 | | | ||||||
2169 | (?:[Ii][Nn][Cc][Ll][Uu][Dd][Ee]) | ||||||
2170 | | | ||||||
2171 | (?:[Rr][Ee][Qq][Uu][Ii][Rr][Ee]) | ||||||
2172 | ) | ||||||
2173 | ) # $1 => $which - start of the tag | ||||||
2174 | |||||||
2175 | \s* | ||||||
2176 | |||||||
2177 | # DEFAULT attribute | ||||||
2178 | (?: | ||||||
2179 | [Dd][Ee][Ff][Aa][Uu][Ll][Tt] | ||||||
2180 | \s*=\s* | ||||||
2181 | (?: | ||||||
2182 | "([^">]*)" # $2 => double-quoted DEFAULT value " | ||||||
2183 | | | ||||||
2184 | '([^'>]*)' # $3 => single-quoted DEFAULT value | ||||||
2185 | | | ||||||
2186 | ([^\s=>]*) # $4 => unquoted DEFAULT value | ||||||
2187 | ) | ||||||
2188 | )? | ||||||
2189 | |||||||
2190 | \s* | ||||||
2191 | |||||||
2192 | # ESCAPE attribute | ||||||
2193 | (?: | ||||||
2194 | [Ee][Ss][Cc][Aa][Pp][Ee] | ||||||
2195 | \s*=\s* | ||||||
2196 | ( | ||||||
2197 | (?:"[^"]*") | ||||||
2198 | | | ||||||
2199 | (?:'[^']*') | ||||||
2200 | | | ||||||
2201 | (?:[^\s=>]*) # $5 => ESCAPE | ||||||
2202 | ) | ||||||
2203 | )* # allow multiple ESCAPEs | ||||||
2204 | |||||||
2205 | \s* | ||||||
2206 | |||||||
2207 | # DEFAULT attribute | ||||||
2208 | (?: | ||||||
2209 | [Dd][Ee][Ff][Aa][Uu][Ll][Tt] | ||||||
2210 | \s*=\s* | ||||||
2211 | (?: | ||||||
2212 | "([^">]*)" # $6 => double-quoted DEFAULT value " | ||||||
2213 | | | ||||||
2214 | '([^'>]*)' # $7 => single-quoted DEFAULT value | ||||||
2215 | | | ||||||
2216 | ([^\s=>]*) # $8 => unquoted DEFAULT value | ||||||
2217 | ) | ||||||
2218 | )? | ||||||
2219 | |||||||
2220 | \s* | ||||||
2221 | |||||||
2222 | # NAME attribute | ||||||
2223 | (?: | ||||||
2224 | (?: | ||||||
2225 | [Nn][Aa][Mm][Ee] | ||||||
2226 | \s*=\s* | ||||||
2227 | )? | ||||||
2228 | (?: | ||||||
2229 | "([^">]*)" # $9 => double-quoted NAME value " | ||||||
2230 | | | ||||||
2231 | '([^'>]*)' # $10 => single-quoted NAME value | ||||||
2232 | | | ||||||
2233 | ([^\s=>]*) # $11 => unquoted NAME value | ||||||
2234 | ) | ||||||
2235 | )? | ||||||
2236 | |||||||
2237 | \s* | ||||||
2238 | |||||||
2239 | # DEFAULT attribute | ||||||
2240 | (?: | ||||||
2241 | [Dd][Ee][Ff][Aa][Uu][Ll][Tt] | ||||||
2242 | \s*=\s* | ||||||
2243 | (?: | ||||||
2244 | "([^">]*)" # $12 => double-quoted DEFAULT value " | ||||||
2245 | | | ||||||
2246 | '([^'>]*)' # $13 => single-quoted DEFAULT value | ||||||
2247 | | | ||||||
2248 | ([^\s=>]*) # $14 => unquoted DEFAULT value | ||||||
2249 | ) | ||||||
2250 | )? | ||||||
2251 | |||||||
2252 | \s* | ||||||
2253 | |||||||
2254 | # ESCAPE attribute | ||||||
2255 | (?: | ||||||
2256 | [Ee][Ss][Cc][Aa][Pp][Ee] | ||||||
2257 | \s*=\s* | ||||||
2258 | ( | ||||||
2259 | (?:"[^"]*") | ||||||
2260 | | | ||||||
2261 | (?:'[^']*') | ||||||
2262 | | | ||||||
2263 | (?:[^\s=>]*) # $15 => ESCAPE | ||||||
2264 | ) | ||||||
2265 | )* # allow multiple ESCAPEs | ||||||
2266 | |||||||
2267 | \s* | ||||||
2268 | |||||||
2269 | # DEFAULT attribute | ||||||
2270 | (?: | ||||||
2271 | [Dd][Ee][Ff][Aa][Uu][Ll][Tt] | ||||||
2272 | \s*=\s* | ||||||
2273 | (?: | ||||||
2274 | "([^">]*)" # $16 => double-quoted DEFAULT value " | ||||||
2275 | | | ||||||
2276 | '([^'>]*)' # $17 => single-quoted DEFAULT value | ||||||
2277 | | | ||||||
2278 | ([^\s=>]*) # $18 => unquoted DEFAULT value | ||||||
2279 | ) | ||||||
2280 | )? | ||||||
2281 | |||||||
2282 | \s* | ||||||
2283 | |||||||
2284 | (?: | ||||||
2285 | (?:--) | ||||||
2286 | | | ||||||
2287 | (?:\/) | ||||||
2288 | )?> | ||||||
2289 | (.*) # $19 => $post - text that comes after the tag | ||||||
2290 | $/sx) { | ||||||
2291 | |||||||
2292 | 490 | 1423 | $which = uc($1); # which tag is it | ||||
2293 | |||||||
2294 | 490 | 100 | 100 | 3550 | $escape = defined $5 ? $5 : defined $15 ? $15 | ||
100 | |||||||
100 | |||||||
2295 | : (defined $options->{default_escape} && $which eq 'TMPL_VAR') ? $options->{default_escape} : 0; # escape set? | ||||||
2296 | |||||||
2297 | # what name for the tag? undef for a /tag at most, one of the | ||||||
2298 | # following three will be defined | ||||||
2299 | 490 | 50 | 2310 | $name = defined $9 ? $9 : defined $10 ? $10 : defined $11 ? $11 : undef; | |||
100 | |||||||
100 | |||||||
2300 | |||||||
2301 | # is there a default? | ||||||
2302 | 490 | 100 | 7001 | $default = defined $2 ? $2 : defined $3 ? $3 : defined $4 ? $4 : | |||
50 | |||||||
50 | |||||||
100 | |||||||
100 | |||||||
50 | |||||||
50 | |||||||
50 | |||||||
50 | |||||||
100 | |||||||
50 | |||||||
50 | |||||||
2303 | defined $6 ? $6 : defined $7 ? $7 : defined $8 ? $8 : | ||||||
2304 | defined $12 ? $12 : defined $13 ? $13 : defined $14 ? $14 : | ||||||
2305 | defined $16 ? $16 : defined $17 ? $17 : defined $18 ? $18 : | ||||||
2306 | undef; | ||||||
2307 | |||||||
2308 | 490 | 1271 | my $post = $19; # what comes after on the line | ||||
2309 | |||||||
2310 | # allow mixed case in filenames, otherwise flatten | ||||||
2311 | 490 | 100 | 66 | 5527 | $name = lc($name) unless (not defined $name or $which eq 'TMPL_INCLUDE' or $which eq 'TMPL_REQUIRE' or $options->{case_sensitive}); | ||
100 | |||||||
100 | |||||||
2312 | |||||||
2313 | # die if we need a name and didn't get one | ||||||
2314 | 490 | 100 | 66 | 3297 | die "HTML::Template->new() : No NAME given to a $which tag at $fname : line $fcounter." | ||
100 | |||||||
2315 | if ($need_names{$which} and (not defined $name or not length $name)); | ||||||
2316 | |||||||
2317 | # die if we got an escape but can't use one | ||||||
2318 | 489 | 100 | 100 | 1635 | die "HTML::Template->new() : ESCAPE option invalid in a $which tag at $fname : line $fcounter." if ( $escape and ($which ne 'TMPL_VAR')); | ||
2319 | |||||||
2320 | # die if we got a default but can't use one | ||||||
2321 | 488 | 100 | 100 | 1276 | die "HTML::Template->new() : DEFAULT option invalid in a $which tag at $fname : line $fcounter." if ( defined $default and ($which ne 'TMPL_VAR')); | ||
2322 | |||||||
2323 | # take actions depending on which tag found | ||||||
2324 | 487 | 100 | 100 | 2570 | if ($which eq 'TMPL_VAR') { | ||
100 | 100 | ||||||
100 | 66 | ||||||
100 | |||||||
100 | |||||||
100 | |||||||
100 | |||||||
50 | |||||||
2325 | 285 | 50 | 685 | $options->{debug} and print STDERR "### HTML::Template Debug ### $fname : line $fcounter : parsed VAR $name\n"; | |||
2326 | |||||||
2327 | # if we already have this var, then simply link to the existing | ||||||
2328 | # HTML::Template::VAR, else create a new one. | ||||||
2329 | 285 | 298 | my $var; | ||||
2330 | 285 | 100 | 918 | if (exists $pmap{$name}) { | |||
2331 | 28 | 47 | $var = $pmap{$name}; | ||||
2332 | 28 | 50 | 86 | (ref($var) eq 'HTML::Template::VAR') or | |||
2333 | die "HTML::Template->new() : Already used param name $name as a TMPL_LOOP, found in a TMPL_VAR at $fname : line $fcounter."; | ||||||
2334 | } else { | ||||||
2335 | 257 | 912 | $var = HTML::Template::VAR->new(); | ||||
2336 | 257 | 703 | $pmap{$name} = $var; | ||||
2337 | 257 | 100 | 100 | 2093 | $top_pmap{$name} = HTML::Template::VAR->new() | ||
2338 | if $options->{global_vars} and not exists $top_pmap{$name}; #FIXME: should this also check for parent_global_vars | ||||||
2339 | } | ||||||
2340 | |||||||
2341 | # if a DEFAULT was provided, push a DEFAULT object on the | ||||||
2342 | # stack before the variable. | ||||||
2343 | 285 | 100 | 658 | if (defined $default) { | |||
2344 | 25 | 78 | push(@pstack, HTML::Template::DEFAULT->new($default)); | ||||
2345 | } | ||||||
2346 | |||||||
2347 | # if ESCAPE was set, push an ESCAPE op on the stack before | ||||||
2348 | # the variable. output will handle the actual work. | ||||||
2349 | # unless of course, they have set escape=0 or escape=none | ||||||
2350 | 285 | 100 | 864 | if ($escape) { | |||
2351 | 132 | 15275 | $escape = $self->_load_escape_type($escape); | ||||
2352 | 132 | 100 | 9961 | push(@pstack, $escape) if $escape; | |||
2353 | } | ||||||
2354 | |||||||
2355 | 285 | 593 | push(@pstack, $var); | ||||
2356 | |||||||
2357 | } elsif ($which eq 'TMPL_LOOP') { | ||||||
2358 | # we've got a loop start | ||||||
2359 | 39 | 50 | 113 | $options->{debug} and print STDERR "### HTML::Template Debug ### $fname : line $fcounter : LOOP $name start\n"; | |||
2360 | |||||||
2361 | # if we already have this loop, then simply link to the existing | ||||||
2362 | # HTML::Template::LOOP, else create a new one. | ||||||
2363 | 39 | 46 | my $loop; | ||||
2364 | 39 | 100 | 180 | if (exists $pmap{$name}) { | |||
2365 | 4 | 10 | $loop = $pmap{$name}; | ||||
2366 | 4 | 50 | 15 | (ref($loop) eq 'HTML::Template::LOOP') or | |||
2367 | 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!"; | ||||||
2368 | |||||||
2369 | } else { | ||||||
2370 | # store the results in a LOOP object - actually just a | ||||||
2371 | # thin wrapper around another HTML::Template object. | ||||||
2372 | 35 | 157 | $loop = HTML::Template::LOOP->new(); | ||||
2373 | 35 | 283 | $pmap{$name} = $loop; | ||||
2374 | } | ||||||
2375 | |||||||
2376 | # get it on the loopstack, pstack of the enclosing block | ||||||
2377 | 39 | 66 | push(@pstack, $loop); | ||||
2378 | 39 | 174 | push(@loopstack, [$loop, $#pstack]); | ||||
2379 | |||||||
2380 | # magic time - push on a fresh pmap and pstack, adjust the typeglobs. | ||||||
2381 | # this gives the loop a separate namespace (i.e. pmap and pstack). | ||||||
2382 | 39 | 69 | push(@pstacks, []); | ||||
2383 | 39 | 79 | *pstack = $pstacks[$#pstacks]; | ||||
2384 | 39 | 65 | push(@pmaps, {}); | ||||
2385 | 39 | 65 | *pmap = $pmaps[$#pmaps]; | ||||
2386 | 39 | 56 | push(@ifstacks, []); | ||||
2387 | 39 | 97 | *ifstack = $ifstacks[$#ifstacks]; | ||||
2388 | 39 | 65 | push(@elsifstacks, []); | ||||
2389 | 39 | 70 | *elsifstack = $elsifstacks[$#elsifstacks]; | ||||
2390 | 39 | 65 | push(@ucstacks, []); | ||||
2391 | 39 | 73 | *ucstack = $ucstacks[$#ucstacks]; | ||||
2392 | |||||||
2393 | # auto-vivify __FIRST__, __LAST__, __OUTER__ and __INNER__ if | ||||||
2394 | # loop_context_vars is set. Otherwise, with | ||||||
2395 | # die_on_bad_params set output() will might cause errors | ||||||
2396 | # when it tries to set them. | ||||||
2397 | 39 | 100 | 122 | if ($options->{loop_context_vars}) { | |||
2398 | 6 | 22 | $pmap{__first__} = HTML::Template::VAR->new(); | ||||
2399 | 6 | 19 | $pmap{__inner__} = HTML::Template::VAR->new(); | ||||
2400 | 6 | 18 | $pmap{__outer__} = HTML::Template::VAR->new(); | ||||
2401 | 6 | 18 | $pmap{__last__} = HTML::Template::VAR->new(); | ||||
2402 | 6 | 16 | $pmap{__odd__} = HTML::Template::VAR->new(); | ||||
2403 | 6 | 72 | $pmap{__even__} = HTML::Template::VAR->new(); | ||||
2404 | 6 | 14 | $pmap{__counter__} = HTML::Template::VAR->new(); | ||||
2405 | } | ||||||
2406 | |||||||
2407 | } elsif ($which eq '/TMPL_LOOP') { | ||||||
2408 | 39 | 50 | 105 | $options->{debug} and print STDERR "### HTML::Template Debug ### $fname : line $fcounter : LOOP end\n"; | |||
2409 | |||||||
2410 | 39 | 67 | my $loopdata = pop(@loopstack); | ||||
2411 | 39 | 50 | 138 | die "HTML::Template->new() : found with no matching |
|||
2412 | |||||||
2413 | 39 | 83 | my ($loop, $starts_at) = @$loopdata; | ||||
2414 | |||||||
2415 | # resolve pending conditionals | ||||||
2416 | 39 | 98 | foreach my $uc (@ucstack) { | ||||
2417 | 3 | 9 | my $var = $uc->[HTML::Template::COND::VARIABLE]; | ||||
2418 | 3 | 100 | 9 | if (exists($pmap{$var})) { | |||
2419 | 2 | 5 | $uc->[HTML::Template::COND::VARIABLE] = $pmap{$var}; | ||||
2420 | } else { | ||||||
2421 | 1 | 6 | $pmap{$var} = HTML::Template::VAR->new(); | ||||
2422 | 1 | 50 | 33 | 15 | $top_pmap{$var} = HTML::Template::VAR->new() | ||
2423 | if $options->{global_vars} and not exists $top_pmap{$var}; #FIXME: should this also check for parent_global_vars ? | ||||||
2424 | 1 | 4 | $uc->[HTML::Template::COND::VARIABLE] = $pmap{$var}; | ||||
2425 | } | ||||||
2426 | 3 | 50 | 13 | if (ref($pmap{$var}) eq 'HTML::Template::VAR') { | |||
2427 | 3 | 10 | $uc->[HTML::Template::COND::VARIABLE_TYPE] = HTML::Template::COND::VARIABLE_TYPE_VAR; | ||||
2428 | } else { | ||||||
2429 | 0 | 0 | $uc->[HTML::Template::COND::VARIABLE_TYPE] = HTML::Template::COND::VARIABLE_TYPE_LOOP; | ||||
2430 | } | ||||||
2431 | } | ||||||
2432 | |||||||
2433 | # get pmap and pstack for the loop, adjust the typeglobs to | ||||||
2434 | # the enclosing block. | ||||||
2435 | 39 | 86 | my $param_map = pop(@pmaps); | ||||
2436 | 39 | 80 | *pmap = $pmaps[$#pmaps]; | ||||
2437 | 39 | 63 | my $parse_stack = pop(@pstacks); | ||||
2438 | 39 | 58 | *pstack = $pstacks[$#pstacks]; | ||||
2439 | |||||||
2440 | 39 | 50 | 102 | scalar(@ifstack) and die "HTML::Template->new() : Dangling |
|||
2441 | 39 | 49 | pop(@ifstacks); | ||||
2442 | 39 | 71 | *ifstack = $ifstacks[$#ifstacks]; | ||||
2443 | 39 | 45 | pop(@elsifstacks); | ||||
2444 | 39 | 60 | *elsifstack = $elsifstacks[$#elsifstacks]; | ||||
2445 | 39 | 49 | pop(@ucstacks); | ||||
2446 | 39 | 63 | *ucstack = $ucstacks[$#ucstacks]; | ||||
2447 | |||||||
2448 | # instantiate the sub-Template, feeding it parse_stack and | ||||||
2449 | # param_map. This means that only the enclosing template | ||||||
2450 | # does _parse() - sub-templates get their parse_stack and | ||||||
2451 | # param_map fed to them already filled in. | ||||||
2452 | 39 | 100 | 627 | my %opts = ( | |||
2453 | debug => $options->{debug}, | ||||||
2454 | stack_debug => $options->{stack_debug}, | ||||||
2455 | profile => $options->{profile}, | ||||||
2456 | die_on_bad_params => $options->{die_on_bad_params}, | ||||||
2457 | die_on_unset_params => $options->{die_on_unset_params}, | ||||||
2458 | case_sensitive => $options->{case_sensitive}, | ||||||
2459 | loop_context_vars => $options->{loop_context_vars}, | ||||||
2460 | scalar_loops => $options->{scalar_loops}, | ||||||
2461 | intrinsic_vars => $options->{intrinsic_vars}, | ||||||
2462 | parent_global_vars => ($options->{global_vars} || $options->{parent_global_vars} || 0), | ||||||
2463 | extended_syntax => $options->{extended_syntax}, | ||||||
2464 | force_untaint => $options->{force_untaint}, | ||||||
2465 | parse_stack => $parse_stack, | ||||||
2466 | param_map => $param_map, | ||||||
2467 | ); | ||||||
2468 | 39 | 50 | 100 | exists $options->{expr} and $opts{expr} = $options->{expr}; | |||
2469 | 39 | 50 | 106 | exists $options->{expr_func} and $opts{expr_func} = $options->{expr_func}; | |||
2470 | 39 | 332 | $loop->[HTML::Template::LOOP::TEMPLATE_HASH]{$starts_at} = ref($self)->_new_from_loop(%opts); | ||||
2471 | |||||||
2472 | } elsif ($which eq 'TMPL_IF' or $which eq 'TMPL_UNLESS') { | ||||||
2473 | 32 | 50 | 92 | $options->{debug} and print STDERR "### HTML::Template Debug ### $fname : line $fcounter : $which $name start\n"; | |||
2474 | |||||||
2475 | # if we already have this var, then simply link to the existing | ||||||
2476 | # HTML::Template::VAR/LOOP, else defer the mapping | ||||||
2477 | 32 | 34 | my $var; | ||||
2478 | 32 | 100 | 91 | if (exists $pmap{$name}) { | |||
2479 | 7 | 15 | $var = $pmap{$name}; | ||||
2480 | } else { | ||||||
2481 | 25 | 57 | $var = $name; | ||||
2482 | } | ||||||
2483 | |||||||
2484 | # connect the var to a conditional | ||||||
2485 | 32 | 156 | my $cond = HTML::Template::COND->new($var); | ||||
2486 | 32 | 100 | 77 | if ($which eq 'TMPL_IF') { | |||
2487 | 25 | 84 | $cond->[HTML::Template::COND::WHICH] = HTML::Template::COND::WHICH_IF; | ||||
2488 | 25 | 47 | $cond->[HTML::Template::COND::JUMP_IF_TRUE] = 0; | ||||
2489 | } else { | ||||||
2490 | 7 | 15 | $cond->[HTML::Template::COND::WHICH] = HTML::Template::COND::WHICH_UNLESS; | ||||
2491 | 7 | 13 | $cond->[HTML::Template::COND::JUMP_IF_TRUE] = 1; | ||||
2492 | } | ||||||
2493 | |||||||
2494 | # push unconnected conditionals onto the ucstack for | ||||||
2495 | # resolution later. Otherwise, save type information now. | ||||||
2496 | 32 | 100 | 78 | if ($var eq $name) { | |||
2497 | 25 | 55 | push(@ucstack, $cond); | ||||
2498 | } else { | ||||||
2499 | 7 | 50 | 22 | if (ref($var) eq 'HTML::Template::VAR') { | |||
2500 | 7 | 16 | $cond->[HTML::Template::COND::VARIABLE_TYPE] = HTML::Template::COND::VARIABLE_TYPE_VAR; | ||||
2501 | } else { | ||||||
2502 | 0 | 0 | $cond->[HTML::Template::COND::VARIABLE_TYPE] = HTML::Template::COND::VARIABLE_TYPE_LOOP; | ||||
2503 | } | ||||||
2504 | } | ||||||
2505 | |||||||
2506 | # push what we've got onto the stacks | ||||||
2507 | 32 | 61 | push(@pstack, $cond); | ||||
2508 | 32 | 48 | push(@ifstack, $cond); | ||||
2509 | 32 | 62 | push(@elsifstack, 0); | ||||
2510 | |||||||
2511 | } elsif ($which eq 'TMPL_ELSIF') { | ||||||
2512 | 3 | 50 | 8 | $options->{debug} and print STDERR "### HTML::Template Debug ### $fname : line $fcounter : ELSIF\n"; | |||
2513 | |||||||
2514 | 3 | 7 | my $cond = pop(@ifstack); | ||||
2515 | 3 | 50 | 8 | die "HTML::Template->new() : found |
|||
2516 | unless defined $cond; | ||||||
2517 | 3 | 50 | 8 | die "HTML::Template->new() : found |
|||
2518 | unless ($cond->[HTML::Template::COND::WHICH] == HTML::Template::COND::WHICH_IF); | ||||||
2519 | # die "HTML::Template->new() : found |
||||||
2520 | |||||||
2521 | # $else is masquerading as an TMPL_IF | ||||||
2522 | 3 | 9 | my $else = HTML::Template::COND->new($cond->[HTML::Template::COND::VARIABLE]); | ||||
2523 | 3 | 7 | $else->[HTML::Template::COND::WHICH] = $cond->[HTML::Template::COND::WHICH]; | ||||
2524 | 3 | 11 | $else->[HTML::Template::COND::JUMP_IF_TRUE] = 0; | ||||
2525 | |||||||
2526 | # need end-block resolution? | ||||||
2527 | 3 | 50 | 7 | if (defined($cond->[HTML::Template::COND::VARIABLE_TYPE])) { | |||
2528 | 0 | 0 | $else->[HTML::Template::COND::VARIABLE_TYPE] = $cond->[HTML::Template::COND::VARIABLE_TYPE]; | ||||
2529 | } else { | ||||||
2530 | 3 | 5 | push(@ucstack, $else); | ||||
2531 | } | ||||||
2532 | |||||||
2533 | 3 | 4 | push(@pstack, $else); | ||||
2534 | 3 | 5 | push(@ifstack, $else); | ||||
2535 | |||||||
2536 | # connect the matching to this "address" - thus the IF, | ||||||
2537 | # failing jumps to the ELSE address. The else then gets | ||||||
2538 | # elaborated, and of course succeeds. On the other hand, if | ||||||
2539 | # the IF fails and falls though, output will reach the else | ||||||
2540 | # and jump to the /IF address. | ||||||
2541 | 3 | 6 | $cond->[HTML::Template::COND::JUMP_ADDRESS] = $#pstack; | ||||
2542 | |||||||
2543 | # if we already have this var, then simply link to the existing | ||||||
2544 | # HTML::Template::VAR/LOOP, else defer the mapping | ||||||
2545 | 3 | 5 | my $var; | ||||
2546 | 3 | 50 | 7 | if (exists $pmap{$name}) { | |||
2547 | 0 | 0 | $var = $pmap{$name}; | ||||
2548 | } else { | ||||||
2549 | 3 | 4 | $var = $name; | ||||
2550 | } | ||||||
2551 | |||||||
2552 | # treat elsif as an if, for the jump condition | ||||||
2553 | 3 | 13 | my $cond_if = HTML::Template::COND->new($var); | ||||
2554 | 3 | 5 | $cond_if->[HTML::Template::COND::WHICH] = HTML::Template::COND::WHICH_IF; | ||||
2555 | 3 | 6 | $cond_if->[HTML::Template::COND::JUMP_IF_TRUE] = 0; | ||||
2556 | |||||||
2557 | # push unconnected conditionals onto the ucstack for | ||||||
2558 | # resolution later. Otherwise, save type information now. | ||||||
2559 | 3 | 50 | 7 | if ($var eq $name) { | |||
2560 | 3 | 4 | push(@ucstack, $cond_if); | ||||
2561 | } else { | ||||||
2562 | 0 | 0 | 0 | if (ref($var) eq 'HTML::Template::VAR') { | |||
2563 | 0 | 0 | $cond_if->[HTML::Template::COND::VARIABLE_TYPE] = HTML::Template::COND::VARIABLE_TYPE_VAR; | ||||
2564 | } else { | ||||||
2565 | 0 | 0 | $cond_if->[HTML::Template::COND::VARIABLE_TYPE] = HTML::Template::COND::VARIABLE_TYPE_LOOP; | ||||
2566 | } | ||||||
2567 | } | ||||||
2568 | |||||||
2569 | # push what we've got onto the stacks | ||||||
2570 | 3 | 5 | push(@pstack, $cond_if); | ||||
2571 | 3 | 5 | push(@ifstack, $cond_if); | ||||
2572 | 3 | 6 | $elsifstack[$#elsifstack]++; | ||||
2573 | |||||||
2574 | } elsif ($which eq 'TMPL_ELSE') { | ||||||
2575 | 19 | 50 | 56 | $options->{debug} and print STDERR "### HTML::Template Debug ### $fname : line $fcounter : ELSE\n"; | |||
2576 | |||||||
2577 | 19 | 37 | my $cond = pop(@ifstack); | ||||
2578 | 19 | 50 | 52 | die "HTML::Template->new() : found |
|||
2579 | 19 | 100 | 164 | die "HTML::Template->new() : found second |
|||
2580 | |||||||
2581 | 18 | 58 | my $else = HTML::Template::COND->new($cond->[HTML::Template::COND::VARIABLE]); | ||||
2582 | 18 | 40 | $else->[HTML::Template::COND::WHICH] = $cond->[HTML::Template::COND::WHICH]; | ||||
2583 | 18 | 33 | $else->[HTML::Template::COND::UNCONDITIONAL_JUMP] = 1; | ||||
2584 | 18 | 43 | $else->[HTML::Template::COND::IS_ELSE] = 1; | ||||
2585 | |||||||
2586 | # need end-block resolution? | ||||||
2587 | 18 | 100 | 52 | if (defined($cond->[HTML::Template::COND::VARIABLE_TYPE])) { | |||
2588 | 2 | 6 | $else->[HTML::Template::COND::VARIABLE_TYPE] = $cond->[HTML::Template::COND::VARIABLE_TYPE]; | ||||
2589 | } else { | ||||||
2590 | 16 | 29 | push(@ucstack, $else); | ||||
2591 | } | ||||||
2592 | |||||||
2593 | 18 | 30 | push(@pstack, $else); | ||||
2594 | 18 | 27 | push(@ifstack, $else); | ||||
2595 | |||||||
2596 | # connect the matching to this "address" - thus the IF, | ||||||
2597 | # failing jumps to the ELSE address. The else then gets | ||||||
2598 | # elaborated, and of course succeeds. On the other hand, if | ||||||
2599 | # the IF fails and falls though, output will reach the else | ||||||
2600 | # and jump to the /IF address. | ||||||
2601 | 18 | 35 | $cond->[HTML::Template::COND::JUMP_ADDRESS] = $#pstack; | ||||
2602 | |||||||
2603 | } elsif ($which eq '/TMPL_IF' or $which eq '/TMPL_UNLESS') { | ||||||
2604 | 31 | 50 | 82 | $options->{debug} and print STDERR "### HTML::Template Debug ### $fname : line $fcounter : $which end\n"; | |||
2605 | |||||||
2606 | 31 | 51 | my $elsif_count = pop @elsifstack; | ||||
2607 | 34 | 54 | UNROLL: { | ||||
2608 | 34 | 37 | my $cond = pop(@ifstack); | ||||
2609 | 34 | 100 | 84 | if ($which eq '/TMPL_IF') { | |||
2610 | 27 | 50 | 61 | die "HTML::Template->new() : found with no matching |
|||
2611 | 27 | 50 | 74 | die "HTML::Template->new() : found incorrectly terminating a |
|||
2612 | if ($cond->[HTML::Template::COND::WHICH] == HTML::Template::COND::WHICH_UNLESS); | ||||||
2613 | } else { | ||||||
2614 | 7 | 50 | 17 | die "HTML::Template->new() : found with no matching |
|||
2615 | 7 | 50 | 20 | die "HTML::Template->new() : found incorrectly terminating a |
|||
2616 | if ($cond->[HTML::Template::COND::WHICH] == HTML::Template::COND::WHICH_IF); | ||||||
2617 | } | ||||||
2618 | |||||||
2619 | # connect the matching to this "address" - place a NOOP to | ||||||
2620 | # hold the spot. This allows output() to treat an IF in the | ||||||
2621 | # assembler-esque "Conditional Jump" mode. | ||||||
2622 | 34 | 58 | push(@pstack, $NOOP); | ||||
2623 | 34 | 61 | $cond->[HTML::Template::COND::JUMP_ADDRESS] = $#pstack; | ||||
2624 | } | ||||||
2625 | |||||||
2626 | # unroll the ELSIF stack | ||||||
2627 | 34 | 100 | 293 | $elsif_count--, goto UNROLL if $elsif_count; | |||
2628 | |||||||
2629 | } elsif ($which eq 'TMPL_INCLUDE' or $which eq 'TMPL_REQUIRE') { | ||||||
2630 | # handle TMPL_INCLUDEs and TMPL_REQUIRES | ||||||
2631 | 39 | 98 | my $w = "".$which; | ||||
2632 | 39 | 163 | $w =~ s/^TMPL_//; | ||||
2633 | 39 | 50 | 124 | $options->{debug} and print STDERR "### HTML::Template Debug ### $fname : line $fcounter : $w $name \n"; | |||
2634 | |||||||
2635 | # no includes here, bub | ||||||
2636 | 39 | 100 | 344 | $options->{no_includes} and croak("HTML::Template : Illegal attempt to use TMPL_$w in template file : (no_includes => 1)"); | |||
2637 | |||||||
2638 | # display profiling information | ||||||
2639 | 38 | 50 | 97 | $options->{profile} and printf STDERR "### HTML::Template Profile ## template include: %.6f\n", Time::HiRes::time; | |||
2640 | |||||||
2641 | 38 | 65 | my $filename = $name; | ||||
2642 | |||||||
2643 | # look for the included file... | ||||||
2644 | 38 | 51 | my $filepath; | ||||
2645 | 38 | 100 | 105 | if ($options->{search_path_on_include}) { | |||
2646 | 4 | 15 | $filepath = $self->_find_file($filename); | ||||
2647 | } else { | ||||||
2648 | 34 | 372 | $filepath = $self->_find_file($filename, | ||||
2649 | [File::Spec->splitdir($fstack[-1][0])] | ||||||
2650 | ); | ||||||
2651 | } | ||||||
2652 | |||||||
2653 | 38 | 50 | 153 | die "HTML::Template->new() : Cannot open included file $filename : file not found." | |||
2654 | unless defined($filepath); | ||||||
2655 | |||||||
2656 | # if we haven't seen it before or we TMPL_INCLUDE, then load it up. | ||||||
2657 | 38 | 100 | 100 | 135 | if ($which eq 'TMPL_INCLUDE' or !exists $self->{included_templates}{$filepath}){ | ||
2658 | 37 | 136 | $self->{included_templates}->{$filepath} ++; | ||||
2659 | |||||||
2660 | 37 | 50 | 1401 | die "HTML::Template->new() : Cannot open included file $filename : $!" | |||
2661 | unless defined(open(TEMPLATE, $filepath)); | ||||||
2662 | |||||||
2663 | # read into the array | ||||||
2664 | 37 | 80 | my $included_template = ""; | ||||
2665 | 37 | 1160 | while(read(TEMPLATE, $included_template, 10240, length($included_template))) {} | ||||
2666 | 37 | 391 | close(TEMPLATE); | ||||
2667 | |||||||
2668 | # call filters if necessary | ||||||
2669 | 37 | 100 | 57 | $self->_call_filters(\$included_template) if @{$options->{filter}}; | |||
37 | 236 | ||||||
2670 | |||||||
2671 | 37 | 50 | 91 | if ($included_template) { # not empty | |||
2672 | |||||||
2673 | # collect mtimes for included files | ||||||
2674 | 37 | 100 | 66 | 129 | if ($options->{cache} and !$options->{blind_cache}) { | ||
2675 | 4 | 245 | $self->{included_mtimes}{$filepath} = (stat($filepath))[9]; | ||||
2676 | } | ||||||
2677 | |||||||
2678 | # adjust the fstack to point to the included file info | ||||||
2679 | 37 | 336 | push(@fstack, [$filepath, 1, | ||||
2680 | 37 | 56 | scalar @{[$included_template =~ m/(\n)/g]} + 1]); | ||||
2681 | 37 | 95 | (*fname, *fcounter, *fmax) = \ ( @{$fstack[$#fstack]} ); | ||||
37 | 134 | ||||||
2682 | |||||||
2683 | # make sure we aren't infinitely recursing | ||||||
2684 | 37 | 50 | 112 | if ($options->{includes_debug}) { | |||
2685 | 0 | 0 | require Data::Dumper; | ||||
2686 | 0 | 0 | print STDERR "TMPL_INCLUDE/TMPL_REQUIRE stack: ", Data::Dumper::Dumper(\@fstack); | ||||
2687 | } | ||||||
2688 | 37 | 100 | 66 | 238 | die "HTML::Template->new() : likely recursive includes - parsed $options->{max_includes} files deep and giving up (set max_includes higher to allow deeper recursion)." if ($options->{max_includes} and (scalar(@fstack) > $options->{max_includes})); | ||
2689 | |||||||
2690 | # stick the remains of this chunk onto the bottom of the | ||||||
2691 | # included text. | ||||||
2692 | 36 | 91 | $included_template .= $post; | ||||
2693 | 36 | 53 | $post = undef; | ||||
2694 | |||||||
2695 | # move the new chunks into place, splitting at ' | ||||||
2696 | 36 | 275 | splice(@chunks, $chunk_number, 1, | ||||
2697 | split(m/(?=<(?:\!--\s*)?\/?[Tt][Mm][Pp][Ll]_)/, $included_template)); | ||||||
2698 | |||||||
2699 | # recalculate stopping point | ||||||
2700 | 36 | 70 | $last_chunk = $#chunks; | ||||
2701 | |||||||
2702 | # start in on the first line of the included text - nothing | ||||||
2703 | # else to do on this line. | ||||||
2704 | 36 | 55 | $chunk = $chunks[$chunk_number]; | ||||
2705 | |||||||
2706 | 36 | 104 | redo CHUNK; | ||||
2707 | } | ||||||
2708 | } | ||||||
2709 | } else { | ||||||
2710 | # zuh!? | ||||||
2711 | 0 | 0 | die "HTML::Template->new() : Unknown or unmatched TMPL construct at $fname : line $fcounter."; | ||||
2712 | } | ||||||
2713 | # push the rest after the tag | ||||||
2714 | 448 | 50 | 1012 | if (defined($post)) { | |||
2715 | 448 | 100 | 1447 | if (ref($pstack[$#pstack]) eq 'SCALAR') { | |||
2716 | 1 | 3 | ${$pstack[$#pstack]} .= $post; | ||||
1 | 3 | ||||||
2717 | } else { | ||||||
2718 | 447 | 905 | push(@pstack, \$post); | ||||
2719 | } | ||||||
2720 | } | ||||||
2721 | |||||||
2722 | # custom markup construct | ||||||
2723 | } elsif ($options->{extended_syntax} and | ||||||
2724 | $chunk =~ /^<(?:!--\s*)? | ||||||
2725 | (\/?) # $1 => $slash - start or end of tag marker | ||||||
2726 | |||||||
2727 | [Tt][Mm][Pp][Ll]_([a-zA-Z0-9_]+) # $2 => $which - custom tag definition | ||||||
2728 | |||||||
2729 | \s* | ||||||
2730 | |||||||
2731 | ([^>]*) # $3 => $part - remaining part of custom tag | ||||||
2732 | |||||||
2733 | > | ||||||
2734 | (.*) # $4 => $post - text that comes after the tag | ||||||
2735 | $/sx) { | ||||||
2736 | 0 | 0 | my $objs; | ||||
2737 | 0 | 0 | my $slash = $1; | ||||
2738 | 0 | 0 | my $which = uc($2); | ||||
2739 | 0 | 0 | 0 | my $part = $3 if length $3; | |||
2740 | 0 | 0 | 0 | my $post = $4 if length $4; | |||
2741 | 0 | 0 | 0 | $slash = "" unless (defined $slash); | |||
2742 | 0 | 0 | 0 | die "Huh? What is the custom tag definition" unless $which; | |||
2743 | 0 | 0 | 0 | if (defined $part) { | |||
2744 | 0 | 0 | $part =~ s/\s*(?:(?:--)|(?:\/))$//; | ||||
2745 | } else { | ||||||
2746 | 0 | 0 | $part = ""; | ||||
2747 | } | ||||||
2748 | 0 | 0 | 0 | $post = "" unless (defined $post); | |||
2749 | |||||||
2750 | # The sub-class is responsible for handling custom constructs | ||||||
2751 | 0 | 0 | 0 | 0 | ($objs,$post) = $self->handle_tmpl_construct($slash,$which,$part,$post,\%pmap,($options->{parent_global_vars} || $options->{global_vars}) ? \%top_pmap : undef); | ||
2752 | # If subclass returned any objects, then we want to keep them on the pstack. | ||||||
2753 | 0 | 0 | 0 | if (defined $objs) { | |||
2754 | 0 | 0 | 0 | if (reftype($objs) eq 'ARRAY') { | |||
2755 | 0 | 0 | push @pstack, @$objs; | ||||
2756 | } else { | ||||||
2757 | 0 | 0 | push @pstack, $objs; | ||||
2758 | } | ||||||
2759 | } | ||||||
2760 | |||||||
2761 | # if there is anything after the tag, that is not gobbled up by the sub-class, | ||||||
2762 | # display it in the output. | ||||||
2763 | 0 | 0 | 0 | 0 | if (defined($post) and length($post)) { | ||
2764 | 0 | 0 | 0 | if (ref($pstack[$#pstack]) eq 'SCALAR') { | |||
2765 | 0 | 0 | ${$pstack[$#pstack]} .= $post; | ||||
0 | 0 | ||||||
2766 | } else { | ||||||
2767 | 0 | 0 | push(@pstack, \$post); | ||||
2768 | } | ||||||
2769 | } | ||||||
2770 | |||||||
2771 | } else { # just your ordinary markup | ||||||
2772 | # make sure we didn't reject something TMPL_* but badly formed | ||||||
2773 | 124 | 100 | 410 | if ($options->{strict}) { | |||
2774 | 120 | 50 | 352 | die "HTML::Template->new() : Syntax error in |
|||
2775 | } | ||||||
2776 | |||||||
2777 | # push the rest and get next chunk | ||||||
2778 | 124 | 50 | 315 | if (defined($chunk)) { | |||
2779 | 124 | 100 | 467 | if (ref($pstack[$#pstack]) eq 'SCALAR') { | |||
2780 | 36 | 55 | ${$pstack[$#pstack]} .= $chunk; | ||||
36 | 98 | ||||||
2781 | } else { | ||||||
2782 | 88 | 225 | push(@pstack, \$chunk); | ||||
2783 | } | ||||||
2784 | } | ||||||
2785 | } | ||||||
2786 | # count newlines in chunk and advance line count | ||||||
2787 | 572 | 787 | $fcounter += scalar(@{[$chunk =~ m/(\n)/g]}); | ||||
572 | 3847 | ||||||
2788 | # if we just crossed the end of an included file | ||||||
2789 | # pop off the record and re-alias to the enclosing file's info | ||||||
2790 | 572 | 2924 | while ($fcounter > $fmax) { | ||||
2791 | 26 | 47 | my $counter_offset = $fcounter - $fmax; | ||||
2792 | 26 | 191 | pop(@fstack), (*fname, *fcounter, *fmax) = \ ( @{$fstack[$#fstack]} ); | ||||
26 | 77 | ||||||
2793 | 26 | 122 | $fcounter += $counter_offset; | ||||
2794 | } | ||||||
2795 | |||||||
2796 | } # next CHUNK | ||||||
2797 | |||||||
2798 | # make sure we don't have dangling IF or LOOP blocks | ||||||
2799 | 203 | 50 | 529 | scalar(@ifstack) and die "HTML::Template->new() : At least one |
|||
2800 | 203 | 50 | 6211 | scalar(@loopstack) and die "HTML::Template->new() : At least one |
|||
2801 | |||||||
2802 | # resolve pending conditionals | ||||||
2803 | 203 | 488 | foreach my $uc (@ucstack) { | ||||
2804 | 42 | 70 | my $var = $uc->[HTML::Template::COND::VARIABLE]; | ||||
2805 | 42 | 100 | 92 | if (exists($pmap{$var})) { | |||
2806 | 23 | 46 | $uc->[HTML::Template::COND::VARIABLE] = $pmap{$var}; | ||||
2807 | } else { | ||||||
2808 | 19 | 72 | $pmap{$var} = HTML::Template::VAR->new(); | ||||
2809 | 19 | 50 | 33 | 79 | $top_pmap{$var} = HTML::Template::VAR->new() | ||
2810 | if $options->{global_vars} and not exists $top_pmap{$var}; #FIXME: should this also check for parent_global_vars ? | ||||||
2811 | 19 | 41 | $uc->[HTML::Template::COND::VARIABLE] = $pmap{$var}; | ||||
2812 | } | ||||||
2813 | 42 | 100 | 131 | if (ref($pmap{$var}) eq 'HTML::Template::VAR') { | |||
2814 | 38 | 83 | $uc->[HTML::Template::COND::VARIABLE_TYPE] = HTML::Template::COND::VARIABLE_TYPE_VAR; | ||||
2815 | } else { | ||||||
2816 | 4 | 10 | $uc->[HTML::Template::COND::VARIABLE_TYPE] = HTML::Template::COND::VARIABLE_TYPE_LOOP; | ||||
2817 | } | ||||||
2818 | } | ||||||
2819 | |||||||
2820 | # want a stack dump? | ||||||
2821 | 203 | 50 | 681 | if ($options->{stack_debug}) { | |||
2822 | 0 | 0 | require Data::Dumper; | ||||
2823 | 0 | 0 | print STDERR "### HTML::Template _param Stack Dump ###\n\n", Data::Dumper::Dumper($self->{parse_stack}), "\n"; | ||||
2824 | } | ||||||
2825 | |||||||
2826 | # get rid of filters - they cause runtime errors if Storable tries | ||||||
2827 | # to store them. This can happen under global_vars. | ||||||
2828 | 203 | 470 | delete $options->{filter}; | ||||
2829 | |||||||
2830 | # display profiling information | ||||||
2831 | 203 | 50 | 561 | if ($options->{profile}) { | |||
2832 | 46 | 46 | 605 | use vars qw($profile_time_start $profile_time_end $profile_time_difference); | |||
46 | 131 | ||||||
46 | 47302 | ||||||
2833 | 0 | 0 | $profile_time_end = [gettimeofday]; | ||||
2834 | 0 | 0 | printf STDERR "### HTML::Template Profile ## end _parse : %.6f\n", join('.',@$profile_time_end); | ||||
2835 | 0 | 0 | printf STDERR "### HTML::Template Profile ## _parse timing : %.6f\n", tv_interval($profile_time_start,$profile_time_end); | ||||
2836 | 0 | 0 | $profile_time_start = $profile_time_end = [gettimeofday]; | ||||
2837 | 0 | 0 | require Math::BigFloat; | ||||
2838 | 0 | 0 | $profile_time_difference = Math::BigFloat->bzero; | ||||
2839 | } | ||||||
2840 | |||||||
2841 | # dump params in template | ||||||
2842 | 203 | 50 | 3127 | if ($options->{param_debug}) { | |||
2843 | 0 | 0 | print STDERR "### HTML::Template Param Dump ###\n\n"; | ||||
2844 | 0 | 0 | my @p = $self->param(); | ||||
2845 | 0 | 0 | foreach (@p) { | ||||
2846 | 0 | 0 | print STDERR " '$_' => undef $/"; | ||||
2847 | } | ||||||
2848 | } | ||||||
2849 | } | ||||||
2850 | |||||||
2851 | # we support arbitrary escape types | ||||||
2852 | sub _load_escape_type { | ||||||
2853 | 234 | 234 | 367 | my $self = shift; | |||
2854 | 234 | 325 | my $escape = shift; | ||||
2855 | 234 | 100 | 969 | if ($escape =~ /^(?: | |||
2856 | "([^"]*)" | ||||||
2857 | | | ||||||
2858 | '([^']*)' | ||||||
2859 | )$/sx) { | ||||||
2860 | 68 | 0 | 251 | $escape = (defined $1) ? $1 : (defined $2) ? $2 : (defined $escape) ? $escape : ''; | |||
50 | |||||||
100 | |||||||
2861 | } | ||||||
2862 | 234 | 365 | $escape = uc($escape); | ||||
2863 | 234 | 100 | 66 | 1877 | return undef if ($escape eq '' || $escape eq '0' || $escape eq 'NONE'); | ||
100 | |||||||
2864 | 196 | 100 | 100 | 973 | $escape = "ESCAPE" if ($escape eq '1' || $escape eq 'HTML'); | ||
2865 | 46 | 46 | 320 | use vars qw(%ESCAPE_MAP); | |||
46 | 109 | ||||||
46 | 14332 | ||||||
2866 | 196 | 100 | 803 | return $ESCAPE_MAP{$escape} if $ESCAPE_MAP{$escape}; | |||
2867 | 10 | 24 | my $module = "HTML::Template::ESCAPE"; | ||||
2868 | 10 | 100 | 40 | $module .= "::". $escape unless ($escape eq 'ESCAPE'); | |||
2869 | 10 | 1033 | eval 'require '.$module; | ||||
2870 | 10 | 100 | 66 | die "Failed to locate escape module: $escape (tried loading: $module)" if $@; | |||
2871 | 9 | 21 | my $esc_obj; | ||||
2872 | 9 | 942 | eval '$esc_obj = '.$module.'->new()'; | ||||
2873 | 9 | 50 | 44 | die "Failed to create escape module: $escape (tried creating: $module)" if $@; | |||
2874 | 9 | 50 | 72 | die "Loaded escape module: $escape, but it is not a sub-class of HTML::Template::ESCAPE" | |||
2875 | unless (UNIVERSAL::isa($esc_obj,'HTML::Template::ESCAPE')); | ||||||
2876 | 9 | 28 | $ESCAPE_MAP{$escape} = $esc_obj; | ||||
2877 | 9 | 26 | return $esc_obj; | ||||
2878 | } | ||||||
2879 | |||||||
2880 | # allow subclass a chance at handling customised TMPL_ syntax | ||||||
2881 | # -> default implementation simply dies | ||||||
2882 | sub handle_tmpl_construct { | ||||||
2883 | 0 | 0 | 0 | 0 | my $self = shift; | ||
2884 | 0 | 0 | my $slash = shift; | ||||
2885 | 0 | 0 | my $which = shift; | ||||
2886 | 0 | 0 | my $part = shift; | ||||
2887 | 0 | 0 | my $post = shift; | ||||
2888 | 0 | 0 | my $pmap = shift; | ||||
2889 | 0 | 0 | my $top_pmap = shift; | ||||
2890 | 0 | 0 | my $options = $self->{options}; | ||||
2891 | |||||||
2892 | # die unless user wants non-strict mode | ||||||
2893 | 0 | 0 | 0 | if ($options->{strict}) { | |||
2894 | 46 | 46 | 473 | use vars qw($fcounter $fname $fmax); | |||
46 | 103 | ||||||
46 | 133850 | ||||||
2895 | 0 | 0 | die "HTML::Template->output() : Unknown or unmatched TMPL construct at $fname : line $fcounter."; | ||||
2896 | } | ||||||
2897 | |||||||
2898 | 0 | 0 | 0 | $options->{debug} and print STDERR "### HTML::Template Debug ### In handle_tmpl_construct:\nCustom TMPL_ construct '${slash}TMPL_${which}' with content:\n\n", $part, "\n\n"; | |||
2899 | |||||||
2900 | 0 | 0 | return undef,$post; | ||||
2901 | } | ||||||
2902 | |||||||
2903 | # a recursive sub that associates each loop with the loops above | ||||||
2904 | # (treating the top-level as a loop) | ||||||
2905 | sub _globalize_vars { | ||||||
2906 | 17 | 17 | 114 | my $self = shift; | |||
2907 | |||||||
2908 | # associate with the loop (and top-level templates) above in the tree. | ||||||
2909 | 17 | 25 | push(@{$self->{options}{associate}}, @_); | ||||
17 | 84 | ||||||
2910 | |||||||
2911 | # recurse down into the template tree, adding ourself to the end of | ||||||
2912 | # list. | ||||||
2913 | 17 | 33 | push(@_, $self); | ||||
2914 | 11 | 62 | map { $_->_globalize_vars(@_) } | ||||
11 | 41 | ||||||
2915 | 11 | 14 | map {values %{$_->[HTML::Template::LOOP::TEMPLATE_HASH]}} | ||||
70 | 169 | ||||||
2916 | 17 | 24 | grep { ref($_) eq 'HTML::Template::LOOP'} @{$self->{parse_stack}}; | ||||
17 | 32 | ||||||
2917 | } | ||||||
2918 | |||||||
2919 | # method used to recursively un-hook associate | ||||||
2920 | sub _unglobalize_vars { | ||||||
2921 | 17 | 17 | 26 | my $self = shift; | |||
2922 | |||||||
2923 | # disassociate | ||||||
2924 | 17 | 32 | $self->{options}{associate} = undef; | ||||
2925 | |||||||
2926 | # recurse down into the template tree disassociating | ||||||
2927 | 11 | 32 | map { $_->_unglobalize_vars() } | ||||
11 | 36 | ||||||
2928 | 11 | 14 | map {values %{$_->[HTML::Template::LOOP::TEMPLATE_HASH]}} | ||||
70 | 153 | ||||||
2929 | 17 | 28 | grep { ref($_) eq 'HTML::Template::LOOP'} @{$self->{parse_stack}}; | ||||
17 | 38 | ||||||
2930 | } | ||||||
2931 | |||||||
2932 | =head2 param() | ||||||
2933 | |||||||
2934 | C can be called in a number of ways | ||||||
2935 | |||||||
2936 | 1) To return a list of parameters in the template : | ||||||
2937 | |||||||
2938 | my @parameter_names = $self->param(); | ||||||
2939 | |||||||
2940 | |||||||
2941 | 2) To return the value set to a param : | ||||||
2942 | |||||||
2943 | my $value = $self->param('PARAM'); | ||||||
2944 | |||||||
2945 | 3) To set the value of a parameter : | ||||||
2946 | |||||||
2947 | # For simple TMPL_VARs: | ||||||
2948 | $self->param(PARAM => 'value'); | ||||||
2949 | |||||||
2950 | # with a subroutine reference that gets called to get the value | ||||||
2951 | # of the scalar. The sub will recieve the template object as a | ||||||
2952 | # parameter. | ||||||
2953 | $self->param(PARAM => sub { return 'value' }); | ||||||
2954 | |||||||
2955 | # And TMPL_LOOPs: | ||||||
2956 | $self->param(LOOP_PARAM => | ||||||
2957 | [ | ||||||
2958 | { PARAM => VALUE_FOR_FIRST_PASS, ... }, | ||||||
2959 | { PARAM => VALUE_FOR_SECOND_PASS, ... } | ||||||
2960 | ... | ||||||
2961 | ] | ||||||
2962 | ); | ||||||
2963 | |||||||
2964 | 4) To set the value of a a number of parameters : | ||||||
2965 | |||||||
2966 | # For simple TMPL_VARs: | ||||||
2967 | $self->param(PARAM => 'value', | ||||||
2968 | PARAM2 => 'value' | ||||||
2969 | ); | ||||||
2970 | |||||||
2971 | # And with some TMPL_LOOPs: | ||||||
2972 | $self->param(PARAM => 'value', | ||||||
2973 | PARAM2 => 'value', | ||||||
2974 | LOOP_PARAM => | ||||||
2975 | [ | ||||||
2976 | { PARAM => VALUE_FOR_FIRST_PASS, ... }, | ||||||
2977 | { PARAM => VALUE_FOR_SECOND_PASS, ... } | ||||||
2978 | ... | ||||||
2979 | ], | ||||||
2980 | ANOTHER_LOOP_PARAM => | ||||||
2981 | [ | ||||||
2982 | { PARAM => VALUE_FOR_FIRST_PASS, ... }, | ||||||
2983 | { PARAM => VALUE_FOR_SECOND_PASS, ... } | ||||||
2984 | ... | ||||||
2985 | ] | ||||||
2986 | ); | ||||||
2987 | |||||||
2988 | 5) To set the value of a a number of parameters using a hash-ref : | ||||||
2989 | |||||||
2990 | $self->param( | ||||||
2991 | { | ||||||
2992 | PARAM => 'value', | ||||||
2993 | PARAM2 => 'value', | ||||||
2994 | LOOP_PARAM => | ||||||
2995 | [ | ||||||
2996 | { PARAM => VALUE_FOR_FIRST_PASS, ... }, | ||||||
2997 | { PARAM => VALUE_FOR_SECOND_PASS, ... } | ||||||
2998 | ... | ||||||
2999 | ], | ||||||
3000 | ANOTHER_LOOP_PARAM => | ||||||
3001 | [ | ||||||
3002 | { PARAM => VALUE_FOR_FIRST_PASS, ... }, | ||||||
3003 | { PARAM => VALUE_FOR_SECOND_PASS, ... } | ||||||
3004 | ... | ||||||
3005 | ] | ||||||
3006 | } | ||||||
3007 | ); | ||||||
3008 | |||||||
3009 | An error occurs if you try to set a value that is tainted if the "force_untaint" | ||||||
3010 | option is set. | ||||||
3011 | |||||||
3012 | =cut | ||||||
3013 | |||||||
3014 | |||||||
3015 | sub param { | ||||||
3016 | 366 | 366 | 1 | 17462 | my $self = shift; | ||
3017 | 366 | 702 | my $options = $self->{options}; | ||||
3018 | 366 | 508 | my $param_map = $self->{param_map}; | ||||
3019 | |||||||
3020 | # the no-parameter case - return list of parameters in the template. | ||||||
3021 | 366 | 50 | 949 | return keys(%$param_map) unless scalar(@_); | |||
3022 | |||||||
3023 | 366 | 519 | my $first = shift; | ||||
3024 | 366 | 1021 | my $type = reftype($first); | ||||
3025 | |||||||
3026 | # the one-parameter case - could be a parameter value request or a | ||||||
3027 | # hash-ref. | ||||||
3028 | 366 | 100 | 66 | 1266 | if (!scalar(@_) and !length($type)) { | ||
3029 | 78 | 100 | 222 | my $param = $options->{case_sensitive} ? $first : lc $first; | |||
3030 | |||||||
3031 | # check for parameter existence | ||||||
3032 | 78 | 100 | 100 | 445 | $options->{die_on_bad_params} and !exists($param_map->{$param}) and | ||
3033 | croak("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)"); | ||||||
3034 | |||||||
3035 | 77 | 100 | 66 | 516 | return undef unless (exists($param_map->{$param}) and | ||
3036 | defined($param_map->{$param})); | ||||||
3037 | |||||||
3038 | 67 | 100 | 182 | return ${$param_map->{$param}} if | |||
60 | 253 | ||||||
3039 | (ref($param_map->{$param}) eq 'HTML::Template::VAR'); | ||||||
3040 | 7 | 35 | return $param_map->{$param}[HTML::Template::LOOP::PARAM_SET]; | ||||
3041 | } | ||||||
3042 | |||||||
3043 | 288 | 100 | 678 | if (!scalar(@_)) { | |||
3044 | 59 | 100 | 100 | 305 | croak("HTML::Template->param() : Single reference arg to param() must be a hash-ref! You gave me a $type.") | ||
3045 | unless $type eq 'HASH' or UNIVERSAL::isa($first, 'HASH'); | ||||||
3046 | 58 | 265 | push(@_, %$first); | ||||
3047 | } else { | ||||||
3048 | 229 | 525 | unshift(@_, $first); | ||||
3049 | } | ||||||
3050 | |||||||
3051 | 287 | 100 | 1148 | croak("HTML::Template->param() : You gave me an odd number of parameters to param()!") | |||
3052 | unless ((@_ % 2) == 0); | ||||||
3053 | |||||||
3054 | # strangely, changing this to a "while(@_) { shift, shift }" type | ||||||
3055 | # loop causes perl 5.004_04 to die with some nonsense about a | ||||||
3056 | # read-only value. | ||||||
3057 | 286 | 981 | for (my $x = 0; $x <= $#_; $x += 2) { | ||||
3058 | 443 | 100 | 1725 | my $param = $options->{case_sensitive} ? $_[$x] : lc $_[$x]; | |||
3059 | 443 | 716 | my $value = $_[($x + 1)]; | ||||
3060 | |||||||
3061 | # check that this param exists in the template | ||||||
3062 | 443 | 50 | 100 | 3234 | $options->{die_on_bad_params} and not $options->{recursive_templates} and !exists($param_map->{$param}) and not reftype($value) eq 'HASH' and | ||
66 | |||||||
33 | |||||||
3063 | croak("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)"); | ||||||
3064 | |||||||
3065 | # When using recurisve templates, we keep the unmatched params around | ||||||
3066 | # for subsequent instances. | ||||||
3067 | 443 | 100 | 100 | 1134 | $options->{recursive_templates} and !exists($param_map->{$param}) and not reftype($value) eq 'HASH' and $self->{recursive_template_params}->{$param} = $value; | ||
66 | |||||||
3068 | |||||||
3069 | # if we want structure-esque variables, we had better check here... | ||||||
3070 | 443 | 100 | 100 | 1233 | if ($options->{structure_vars} and $param =~ /\./) { | ||
3071 | 1 | 4 | $self->{structure_vars}->{$param} = $value; | ||||
3072 | |||||||
3073 | # Break down full-length variable into structure-esque parts. Note | ||||||
3074 | # that we handle the full-length variable in the normal code-path. | ||||||
3075 | 1 | 5 | my @structure_vars = split(/\./,$param); | ||||
3076 | 1 | 3 | pop @structure_vars; | ||||
3077 | |||||||
3078 | # Build up structure param name and check if not already defined. | ||||||
3079 | 1 | 2 | my $structure_param = ""; | ||||
3080 | 1 | 2 | foreach my $structure_var (@structure_vars) { | ||||
3081 | 1 | 4 | $structure_param .= $structure_var; | ||||
3082 | |||||||
3083 | # Auto-vivify structure-esque variable, but only if: | ||||||
3084 | # - defined in param map, | ||||||
3085 | # - not already set, | ||||||
3086 | # - if used in TMPL_VAR/TMPL_IF context | ||||||
3087 | # Otherwise we simply Skip setting unused structure-esque | ||||||
3088 | # value. | ||||||
3089 | 1 | 50 | 33 | 9 | if (exists($param_map->{$structure_param}) and !exists($self->{structure_vars}->{$structure_param})) { | ||
3090 | 1 | 3 | $self->{structure_vars}->{$structure_param} = 1; | ||||
3091 | 1 | 3 | my $structure_param_type = ref($param_map->{$structure_param}); | ||||
3092 | 1 | 50 | 4 | if ($structure_param_type eq 'HTML::Template::VAR') { | |||
0 | |||||||
3093 | 1 | 50 | 2 | unless (defined ${$param_map->{$structure_param}}) { | |||
1 | 5 | ||||||
3094 | 1 | 1 | ${$param_map->{$structure_param}} = 1; | ||||
1 | 2 | ||||||
3095 | 1 | 50 | 5 | $options->{debug} and print STDERR "Auto-vivify TMPL_VAR structure-param: $structure_param\n"; | |||
3096 | } | ||||||
3097 | } elsif ($structure_param_type eq 'HTML::Template::LOOP') { | ||||||
3098 | 0 | 0 | 0 | unless (defined $param_map->{$structure_param}[HTML::Template::LOOP::PARAM_SET]) { | |||
3099 | 0 | 0 | $param_map->{$structure_param}[HTML::Template::LOOP::PARAM_SET] = []; | ||||
3100 | 0 | 0 | 0 | $options->{debug} and print STDERR "Auto-vivify TMPL_LOOP structure-param: $structure_param\n"; | |||
3101 | } | ||||||
3102 | } else { | ||||||
3103 | 0 | 0 | croak("HTML::Template->param() : attempt to set parameter structure param '$structure_param' but template param is '$structure_param_type'"); | ||||
3104 | } | ||||||
3105 | } | ||||||
3106 | |||||||
3107 | 1 | 3 | $structure_param .= '.'; | ||||
3108 | } | ||||||
3109 | } | ||||||
3110 | |||||||
3111 | # if we're not going to die from bad param names, we need to ignore | ||||||
3112 | # them... | ||||||
3113 | 443 | 100 | 1088 | unless (exists($param_map->{$param})) { | |||
3114 | 7 | 100 | 66 | 65 | next if (not ($options->{parent_global_vars} or $options->{global_vars})); | ||
3115 | |||||||
3116 | # ... unless global_vars is on - in which case we can't be | ||||||
3117 | # sure we won't need it in a lower loop. | ||||||
3118 | 2 | 100 | 4 | if (reftype($value) eq 'ARRAY') { | |||
50 | |||||||
3119 | 1 | 4 | $param_map->{$param} = HTML::Template::LOOP->new(); | ||||
3120 | |||||||
3121 | } elsif (reftype($value) eq 'HASH') { | ||||||
3122 | 0 | 0 | 0 | my $sep = $options->{structure_vars} ? "." : "_"; | |||
3123 | 0 | 0 | foreach my $key (keys %{$value}) { | ||||
0 | 0 | ||||||
3124 | 0 | 0 | $self->param($param.$sep.$key => $value->{$key}); | ||||
3125 | } | ||||||
3126 | |||||||
3127 | } else { | ||||||
3128 | 1 | 3 | $param_map->{$param} = HTML::Template::VAR->new(); | ||||
3129 | } | ||||||
3130 | } | ||||||
3131 | |||||||
3132 | # figure out what we've got, taking special care to allow for | ||||||
3133 | # objects that are compatible underneath. | ||||||
3134 | 438 | 1108 | my $value_type = reftype($value); | ||||
3135 | |||||||
3136 | # handle array/TMPL_LOOP | ||||||
3137 | 438 | 100 | 66 | 4410 | if (defined($value_type) and length($value_type) and ($value_type eq 'ARRAY' or ((reftype($value) !~ /^(CODE)|(HASH)|(SCALAR)$/) and UNIVERSAL::isa($value,'ARRAY')))) { | ||
100 | 66 | ||||||
66 | |||||||
66 | |||||||
100 | |||||||
66 | |||||||
3138 | 27 | 50 | 94 | (ref($param_map->{$param}) eq 'HTML::Template::LOOP') or | |||
3139 | croak("HTML::Template::param() : attempt to set parameter '$param' with an array ref - parameter is not a TMPL_LOOP!"); | ||||||
3140 | 27 | 100 | 66 | 111 | if (scalar(@$value) > 0 and reftype($value->[0]) ne 'HASH') { | ||
3141 | 1 | 50 | 4 | $options->{scalar_loops} or | |||
3142 | croak("HTML::Template::param() : attempt to set parameter '$param' with an arrayref - \$$param\->[0] is not a hashmap"); | ||||||
3143 | 1 | 2 | my $v = []; | ||||
3144 | 1 | 3 | foreach (@$value) { | ||||
3145 | 2 | 7 | push @$v, { __value__ => $_ }; | ||||
3146 | } | ||||||
3147 | 1 | 3 | $value = $v; | ||||
3148 | } | ||||||
3149 | 27 | 52 | $param_map->{$param}[HTML::Template::LOOP::PARAM_SET] = [@{$value}]; | ||||
27 | 205 | ||||||
3150 | |||||||
3151 | # handle expansion hash into sub-TMPL_VAR's and sub-TMPL_LOOP's | ||||||
3152 | } elsif (defined($value_type) and length($value_type) and ($value_type eq 'HASH') and UNIVERSAL::isa($value,'HASH')) { | ||||||
3153 | 2 | 100 | 7 | my $sep = $options->{structure_vars} ? "." : "_"; | |||
3154 | 2 | 3 | foreach my $key (keys %{$value}) { | ||||
2 | 8 | ||||||
3155 | 2 | 32 | $self->param($param.$sep.$key => $value->{$key}); | ||||
3156 | } | ||||||
3157 | |||||||
3158 | # handle scalar/TMPL_VAR | ||||||
3159 | } else { | ||||||
3160 | 409 | 50 | 1485 | (ref($param_map->{$param}) eq 'HTML::Template::VAR') or | |||
3161 | croak("HTML::Template::param() : attempt to set parameter '$param' with a scalar - parameter is not a TMPL_VAR!"); | ||||||
3162 | 409 | 478 | ${$param_map->{$param}} = $value; | ||||
409 | 2663 | ||||||
3163 | } | ||||||
3164 | } | ||||||
3165 | } | ||||||
3166 | |||||||
3167 | =pod | ||||||
3168 | |||||||
3169 | =head2 clear_params() | ||||||
3170 | |||||||
3171 | Sets all the parameters to undef. Useful internally, if nowhere else! | ||||||
3172 | |||||||
3173 | =cut | ||||||
3174 | |||||||
3175 | sub clear_params { | ||||||
3176 | 70 | 70 | 1 | 154 | my $self = shift; | ||
3177 | 70 | 153 | my $type; | ||||
3178 | 70 | 86 | foreach my $name (keys %{$self->{param_map}}) { | ||||
70 | 437 | ||||||
3179 | 238 | 414 | $type = ref($self->{param_map}{$name}); | ||||
3180 | 238 | 100 | 607 | undef(${$self->{param_map}{$name}}) | |||
228 | 540 | ||||||
3181 | if ($type eq 'HTML::Template::VAR'); | ||||||
3182 | 238 | 100 | 663 | undef($self->{param_map}{$name}[HTML::Template::LOOP::PARAM_SET]) | |||
3183 | if ($type eq 'HTML::Template::LOOP'); | ||||||
3184 | } | ||||||
3185 | } | ||||||
3186 | |||||||
3187 | |||||||
3188 | # obsolete implementation of associate | ||||||
3189 | sub associateCGI { | ||||||
3190 | 2 | 2 | 0 | 6897 | my $self = shift; | ||
3191 | 2 | 4 | my $cgi = shift; | ||||
3192 | 2 | 100 | 160 | (ref($cgi) eq 'CGI') or | |||
3193 | croak("Warning! non-CGI object was passed to HTML::Template::associateCGI()!\n"); | ||||||
3194 | 1 | 3 | push(@{$self->{options}{associate}}, $cgi); | ||||
1 | 4 | ||||||
3195 | 1 | 4 | return 1; | ||||
3196 | } | ||||||
3197 | |||||||
3198 | |||||||
3199 | =head2 output() | ||||||
3200 | |||||||
3201 | output() returns the final result of the template. In most situations | ||||||
3202 | you'll want to print this, like: | ||||||
3203 | |||||||
3204 | print $template->output(); | ||||||
3205 | |||||||
3206 | When output is called each occurrence of |
||||||
3207 | replaced with the value assigned to "name" via C. If a named | ||||||
3208 | parameter is unset, HTML::Template will die indicating that the template | ||||||
3209 | variable hasn't been set. This behaviour can be altered so that it wont | ||||||
3210 | die, by setting C |
||||||
3211 | replaced with ''. |
||||||
3212 | accumlating output on each pass. | ||||||
3213 | |||||||
3214 | Calling output() is guaranteed not to change the state of the | ||||||
3215 | Template object, in case you were wondering. This property is mostly | ||||||
3216 | important for the internal implementation of loops. | ||||||
3217 | |||||||
3218 | You may optionally supply a filehandle to print to automatically as | ||||||
3219 | the template is generated. This may improve performance and lower | ||||||
3220 | memory consumption. Example: | ||||||
3221 | |||||||
3222 | $template->output(print_to => *STDOUT); | ||||||
3223 | |||||||
3224 | The return value is undefined when using the C |
||||||
3225 | |||||||
3226 | Alternatively, you may optionally return the generated output 'by | ||||||
3227 | reference'. This may improve performance by avoiding the copying of | ||||||
3228 | data from the HTML::Template variable into your application variable. | ||||||
3229 | Example: | ||||||
3230 | |||||||
3231 | my $output = $template->output(by_reference => 1); | ||||||
3232 | print $$output; | ||||||
3233 | |||||||
3234 | =cut | ||||||
3235 | |||||||
3236 | sub output { | ||||||
3237 | 460 | 460 | 1 | 127028 | my $self = shift; | ||
3238 | 460 | 20277 | my $options = $self->{options}; | ||||
3239 | 460 | 653 | local $_; | ||||
3240 | |||||||
3241 | 460 | 50 | 1272 | croak("HTML::Template->output() : You gave me an odd number of parameters to output()!") | |||
3242 | unless ((@_ % 2) == 0); | ||||||
3243 | 460 | 843 | my %args = @_; | ||||
3244 | |||||||
3245 | # dump params in template | ||||||
3246 | 460 | 50 | 1180 | if ($options->{param_debug}) { | |||
3247 | 0 | 0 | print STDERR "### HTML::Template Param Dump ###\n\n"; | ||||
3248 | 0 | 0 | my @p = $self->param(); | ||||
3249 | 0 | 0 | foreach (@p) { | ||||
3250 | 0 | 0 | my $v = $self->param($_); | ||||
3251 | 0 | 0 | 0 | $v = defined $v ? "'$v'" : "undef"; | |||
3252 | 0 | 0 | print STDERR " '$_' => $v $/"; | ||||
3253 | } | ||||||
3254 | } | ||||||
3255 | |||||||
3256 | 460 | 50 | 1006 | print STDERR "### HTML::Template Memory Debug ### START OUTPUT ", $self->{proc_mem}->size(), "\n" | |||
3257 | if $options->{memory_debug}; | ||||||
3258 | |||||||
3259 | 460 | 50 | 1179 | $options->{debug} and print STDERR "### HTML::Template Debug ### In output\n"; | |||
3260 | |||||||
3261 | # want a stack dump? | ||||||
3262 | 460 | 50 | 1545 | if ($options->{stack_debug}) { | |||
3263 | 0 | 0 | require Data::Dumper; | ||||
3264 | 0 | 0 | print STDERR "### HTML::Template output Stack Dump ###\n\n", Data::Dumper::Dumper($self->{parse_stack}), "\n"; | ||||
3265 | } | ||||||
3266 | |||||||
3267 | # display profiling information | ||||||
3268 | 460 | 50 | 1030 | if ($options->{profile}) { | |||
3269 | 46 | 46 | 474 | use vars qw($profile_time_start $profile_time_end $profile_time_difference); | |||
46 | 119 | ||||||
46 | 26795 | ||||||
3270 | 0 | 0 | $profile_time_start = [gettimeofday]; | ||||
3271 | 0 | 0 | $profile_time_difference += tv_interval($profile_time_end,$profile_time_start); | ||||
3272 | 0 | 0 | $profile_time_end = [gettimeofday]; | ||||
3273 | 0 | 0 | printf STDERR "### HTML::Template Profile ## begin output : %.6f (%.6f)\n", join('.',@$profile_time_start), $profile_time_difference; | ||||
3274 | } | ||||||
3275 | |||||||
3276 | # globalize vars - this happens here to localize the circular | ||||||
3277 | # references created by global_vars. | ||||||
3278 | 460 | 100 | 1131 | $self->_globalize_vars() if $options->{global_vars}; #FIXME: should this also check for parent_global_vars ? | |||
3279 | |||||||
3280 | # support the associate magic, searching for undefined params and | ||||||
3281 | # attempting to fill them from the associated objects. | ||||||
3282 | 460 | 100 | 509 | if (scalar(@{$options->{associate}})) { | |||
460 | 1210 | ||||||
3283 | 20 | 34 | my @undef_params; | ||||
3284 | 20 | 53 | foreach my $param (keys %{$self->{param_map}}) { | ||||
20 | 64 | ||||||
3285 | 34 | 100 | 71 | next if (defined $self->param($param)); | |||
3286 | 16 | 36 | push @undef_params, $param; | ||||
3287 | } | ||||||
3288 | 20 | 100 | 59 | if (scalar(@undef_params)) { | |||
3289 | 11 | 11 | my $value; | ||||
3290 | # if case sensitive mode or no CGI objects, we can use the fast path | ||||||
3291 | 11 | 100 | 66 | 45 | if ($options->{case_sensitive} or (grep { !/^1/ } map { UNIVERSAL::isa($_,'HTML::Template') } @{$options->{associate}}) == 0) { | ||
19 | 105 | ||||||
19 | 86 | ||||||
11 | 35 | ||||||
3292 | 10 | 19 | foreach my $param (@undef_params) { | ||||
3293 | 15 | 20 | foreach my $associated_object (reverse @{$options->{associate}}) { | ||||
15 | 29 | ||||||
3294 | 23 | 45 | $value = $associated_object->param($param); | ||||
3295 | 23 | 100 | 59 | next unless (defined $value); | |||
3296 | 15 | 33 | $self->param($param, scalar $value); | ||||
3297 | 15 | 47 | last; | ||||
3298 | } | ||||||
3299 | } | ||||||
3300 | } else { | ||||||
3301 | 1 | 4 | my %case_map; | ||||
3302 | 1 | 3 | foreach my $associated_object (@{$options->{associate}}) { | ||||
1 | 4 | ||||||
3303 | 1 | 6 | map { $case_map{$associated_object}{lc($_)} = $_ } $associated_object->param(); | ||||
1 | 37 | ||||||
3304 | } | ||||||
3305 | 1 | 3 | my $associated_param; | ||||
3306 | 1 | 3 | foreach my $param (@undef_params) { | ||||
3307 | 1 | 2 | foreach my $associated_object (reverse @{$options->{associate}}) { | ||||
1 | 4 | ||||||
3308 | 1 | 4 | $associated_param = $case_map{$associated_object}{$param}; | ||||
3309 | 1 | 50 | 5 | next unless (defined $associated_param); | |||
3310 | 1 | 4 | $value = $associated_object->param($associated_param); | ||||
3311 | 1 | 50 | 28 | next unless (defined $value); | |||
3312 | 1 | 5 | $self->param($param, scalar $value); | ||||
3313 | 1 | 7 | last; | ||||
3314 | } | ||||||
3315 | } | ||||||
3316 | } | ||||||
3317 | } | ||||||
3318 | } | ||||||
3319 | |||||||
3320 | # # support the associate magic, searching for undefined params and | ||||||
3321 | # # attempting to fill them from the associated objects. | ||||||
3322 | # if (scalar(@{$options->{associate}})) { | ||||||
3323 | # # prepare case-mapping hashes to do case-insensitive matching | ||||||
3324 | # # against associated objects. This allows CGI.pm to be | ||||||
3325 | # # case-sensitive and still work with asssociate. | ||||||
3326 | # my (%case_map, $lparam); | ||||||
3327 | # foreach my $associated_object (@{$options->{associate}}) { | ||||||
3328 | # # what a hack! This should really be optimized out for case_sensitive. | ||||||
3329 | # if ($options->{case_sensitive}) { | ||||||
3330 | # map { | ||||||
3331 | # $case_map{$associated_object}{$_} = $_ | ||||||
3332 | # } $associated_object->param(); | ||||||
3333 | # } else { | ||||||
3334 | # map { | ||||||
3335 | # $case_map{$associated_object}{lc($_)} = $_ | ||||||
3336 | # } $associated_object->param(); | ||||||
3337 | # } | ||||||
3338 | # } | ||||||
3339 | # | ||||||
3340 | # foreach my $param (keys %{$self->{param_map}}) { | ||||||
3341 | # unless (defined($self->param($param))) { | ||||||
3342 | # OBJ: foreach my $associated_object (reverse @{$options->{associate}}) { | ||||||
3343 | # $self->param($param, scalar $associated_object->param($case_map{$associated_object}{$param})), last OBJ | ||||||
3344 | # if (exists($case_map{$associated_object}{$param})); | ||||||
3345 | # } | ||||||
3346 | # } | ||||||
3347 | # } | ||||||
3348 | # } | ||||||
3349 | |||||||
3350 | |||||||
3351 | 46 | 46 | 292 | use vars qw($line @parse_stack); local(*line, *parse_stack); | |||
46 | 97 | ||||||
46 | 115180 | ||||||
460 | 1661 | ||||||
3352 | |||||||
3353 | # walk the parse stack, accumulating output in $result | ||||||
3354 | # with unset params stored in @unset_params. | ||||||
3355 | 460 | 819 | *parse_stack = $self->{parse_stack}; | ||||
3356 | 460 | 646 | my $result = ''; | ||||
3357 | 460 | 491 | my @unset_params; | ||||
3358 | |||||||
3359 | 460 | 100 | 66 | 1305 | tie $result, 'HTML::Template::PRINTSCALAR', $args{print_to} | ||
3360 | if defined $args{print_to} and not tied $args{print_to}; | ||||||
3361 | |||||||
3362 | 460 | 50 | 66 | 1168 | die "HTML::Template::output() : Cannot use 'print_to' and 'recursive_templates' together." | ||
3363 | if ($options->{recursive_templates} && $args{print_to}); | ||||||
3364 | |||||||
3365 | 460 | 616 | my $type; | ||||
3366 | 460 | 813 | my $parse_stack_length = $#parse_stack; | ||||
3367 | 460 | 1712 | for (my $x = 0; $x <= $parse_stack_length; $x++) { | ||||
3368 | 1760 | 4352 | *line = \$parse_stack[$x]; | ||||
3369 | 1760 | 3404 | $type = ref($line); | ||||
3370 | |||||||
3371 | 1760 | 100 | 100 | 6942 | if ($type eq 'SCALAR') { #FIXME: do we need to test for the reftype? if so, we should more this case further down. | ||
100 | 33 | ||||||
100 | |||||||
100 | |||||||
100 | |||||||
100 | |||||||
100 | |||||||
50 | |||||||
3372 | 946 | 2685 | $result .= $$line; | ||||
3373 | } elsif ($type eq 'HTML::Template::VAR' and reftype($$line) eq 'CODE') { | ||||||
3374 | 9 | 50 | 38 | if ( defined($$line) ) { | |||
0 | |||||||
3375 | 9 | 100 | 28 | if ($options->{force_untaint}) { | |||
3376 | 1 | 5 | my $tmp = $$line->($self); | ||||
3377 | 1 | 50 | 123 | croak("HTML::Template->output() : 'force_untaint' option but coderef returns tainted value") | |||
3378 | if tainted($tmp); | ||||||
3379 | 0 | 0 | $result .= $tmp; | ||||
3380 | } else { | ||||||
3381 | 8 | 34 | $result .= $$line->($self); | ||||
3382 | } | ||||||
3383 | } elsif ($options->{die_on_unset_params}) { | ||||||
3384 | 0 | 0 | croak("HTML::Template : Unset TMPL_VAR CODE block : (die_on_unset_params => $options->{die_on_unset_params})"); | ||||
3385 | } | ||||||
3386 | } elsif ($type eq 'HTML::Template::VAR') { | ||||||
3387 | 189 | 100 | 458 | if (defined $$line) { | |||
50 | |||||||
3388 | 179 | 100 | 66 | 604 | if ($options->{force_untaint} && tainted($$line)) { | ||
3389 | 1 | 163 | croak("HTML::Template->output() : tainted value with 'force_untaint' option"); | ||||
3390 | } | ||||||
3391 | 178 | 50 | 33 | 7821 | $result .= $$line unless (ref($line) eq 'HTML::Template::UNDEF' or ref($$line) eq 'HTML::Template::UNDEF'); | ||
3392 | } elsif ($options->{die_on_unset_params}) { | ||||||
3393 | 0 | 0 | keys %{$self->{param_map}}; | ||||
0 | 0 | ||||||
3394 | 0 | 0 | while (my ($key,$value) = each %{$self->{param_map}}) { | ||||
0 | 0 | ||||||
3395 | 0 | 0 | 0 | next if ("$line" ne "$value"); | |||
3396 | 0 | 0 | 0 | croak("HTML::Template : Unset TMPL_VAR param '$key' - this param doesn't match any set by HTML::Template->param($key => ...) : (die_on_unset_params => 1, case_sensitive => $options->{case_sensitive})") | |||
3397 | if ($options->{die_on_unset_params} == 1); | ||||||
3398 | 0 | 0 | push @unset_params, [$key,"TMPL_VAR"]; | ||||
3399 | } | ||||||
3400 | } | ||||||
3401 | } elsif ($type eq 'HTML::Template::LOOP') { | ||||||
3402 | 33 | 100 | 113 | if (defined($line->[HTML::Template::LOOP::PARAM_SET])) { | |||
50 | |||||||
3403 | 27 | 37 | eval { $result .= $line->output($x, $options->{loop_context_vars}); }; | ||||
27 | 121 | ||||||
3404 | 27 | 50 | 110 | croak("HTML::Template->output() : fatal error in loop output : $@") | |||
3405 | if $@; | ||||||
3406 | } elsif ($options->{die_on_unset_params}) { | ||||||
3407 | 0 | 0 | keys %{$self->{param_map}}; | ||||
0 | 0 | ||||||
3408 | 0 | 0 | while (my ($key,$value) = each %{$self->{param_map}}) { | ||||
0 | 0 | ||||||
3409 | 0 | 0 | 0 | next if ("$line" ne "$value"); | |||
3410 | 0 | 0 | 0 | croak("HTML::Template : Unset TMPL_LOOP param '$key' - this param doesn't match any set by HTML::Template->param($key => ...) : (die_on_unset_params => 1, case_sensitive => $options->{case_sensitive})") | |||
3411 | if ($options->{die_on_unset_params} == 1); | ||||||
3412 | 0 | 0 | push @unset_params, [$key,"TMPL_LOOP"]; | ||||
3413 | } | ||||||
3414 | } | ||||||
3415 | } elsif ($type eq 'HTML::Template::COND') { | ||||||
3416 | 370 | 100 | 757 | if ($line->[HTML::Template::COND::UNCONDITIONAL_JUMP]) { | |||
3417 | 124 | 564 | $x = $line->[HTML::Template::COND::JUMP_ADDRESS] | ||||
3418 | } else { | ||||||
3419 | 246 | 100 | 458 | if ($line->[HTML::Template::COND::JUMP_IF_TRUE]) { # UNLESS path | |||
3420 | 11 | 50 | 29 | if ($line->[HTML::Template::COND::VARIABLE_TYPE] == HTML::Template::COND::VARIABLE_TYPE_VAR) { | |||
3421 | 11 | 100 | 12 | if (defined ${$line->[HTML::Template::COND::VARIABLE]}) { | |||
11 | 50 | 42 | |||||
3422 | 10 | 100 | 14 | if (reftype(${$line->[HTML::Template::COND::VARIABLE]}) eq 'CODE') { | |||
10 | 50 | 23 | |||||
9 | 31 | ||||||
3423 | 1 | 50 | 2 | $x = $line->[HTML::Template::COND::JUMP_ADDRESS] if ${$line->[HTML::Template::COND::VARIABLE]}->($self); | |||
1 | 4 | ||||||
3424 | } elsif (ref(${$line->[HTML::Template::COND::VARIABLE]}) eq 'HTML::Template::UNDEF') { | ||||||
3425 | #$x = $line->[HTML::Template::COND::JUMP_ADDRESS]; | ||||||
3426 | } else { | ||||||
3427 | 9 | 100 | 67 | $x = $line->[HTML::Template::COND::JUMP_ADDRESS] if ${$line->[HTML::Template::COND::VARIABLE]}; | |||
9 | 49 | ||||||
3428 | } | ||||||
3429 | } elsif ($options->{die_on_unset_params}) { | ||||||
3430 | 0 | 0 | keys %{$self->{param_map}}; | ||||
0 | 0 | ||||||
3431 | 0 | 0 | while (my ($key,$value) = each %{$self->{param_map}}) { | ||||
0 | 0 | ||||||
3432 | 0 | 0 | 0 | next if ("".$line->[HTML::Template::COND::VARIABLE] ne "$value"); | |||
3433 | 0 | 0 | 0 | croak("HTML::Template : Unset TMPL_UNLESS param '$key' - this param doesn't match any set by HTML::Template->param($key => ...) : (die_on_unset_params => 1, case_sensitive => $options->{case_sensitive})") | |||
3434 | if ($options->{die_on_unset_params} == 1); | ||||||
3435 | 0 | 0 | push @unset_params, [$key,"TMPL_UNLESS"]; | ||||
3436 | } | ||||||
3437 | } | ||||||
3438 | } else { | ||||||
3439 | 0 | 0 | $x = $line->[HTML::Template::COND::JUMP_ADDRESS] if | ||||
3440 | (defined $line->[HTML::Template::COND::VARIABLE][HTML::Template::LOOP::PARAM_SET] and | ||||||
3441 | 0 | 0 | 0 | 0 | scalar @{$line->[HTML::Template::COND::VARIABLE][HTML::Template::LOOP::PARAM_SET]}); | ||
3442 | } | ||||||
3443 | } else { # IF path | ||||||
3444 | 235 | 100 | 434 | if ($line->[HTML::Template::COND::VARIABLE_TYPE] == HTML::Template::COND::VARIABLE_TYPE_VAR) { | |||
3445 | 233 | 100 | 240 | if (defined ${$line->[HTML::Template::COND::VARIABLE]}) { | |||
233 | 50 | 582 | |||||
3446 | 226 | 100 | 270 | if (reftype(${$line->[HTML::Template::COND::VARIABLE]}) eq 'CODE') { | |||
226 | 50 | 527 | |||||
25 | 81 | ||||||
3447 | 201 | 100 | 245 | $x = $line->[HTML::Template::COND::JUMP_ADDRESS] unless ${$line->[HTML::Template::COND::VARIABLE]}->($self); | |||
201 | 615 | ||||||
3448 | } elsif (ref(${$line->[HTML::Template::COND::VARIABLE]}) eq 'HTML::Template::UNDEF') { | ||||||
3449 | 0 | 0 | $x = $line->[HTML::Template::COND::JUMP_ADDRESS]; | ||||
3450 | } else { | ||||||
3451 | 25 | 100 | 29 | $x = $line->[HTML::Template::COND::JUMP_ADDRESS] unless ${$line->[HTML::Template::COND::VARIABLE]}; | |||
25 | 244 | ||||||
3452 | } | ||||||
3453 | } elsif ($options->{die_on_unset_params}) { | ||||||
3454 | 0 | 0 | keys %{$self->{param_map}}; | ||||
0 | 0 | ||||||
3455 | 0 | 0 | while (my ($key,$value) = each %{$self->{param_map}}) { | ||||
0 | 0 | ||||||
3456 | 0 | 0 | 0 | next if ("".$line->[HTML::Template::COND::VARIABLE] ne "$value"); | |||
3457 | 0 | 0 | 0 | croak("HTML::Template : Unset TMPL_IF param '$key' - this param doesn't match any set by HTML::Template->param($key => ...) : (die_on_unset_params => 1, case_sensitive => $options->{case_sensitive})") | |||
3458 | if ($options->{die_on_unset_params} == 1); | ||||||
3459 | 0 | 0 | push @unset_params, [$key,"TMPL_IF"]; | ||||
3460 | } | ||||||
3461 | } else { | ||||||
3462 | 7 | 25 | $x = $line->[HTML::Template::COND::JUMP_ADDRESS]; | ||||
3463 | } | ||||||
3464 | } else { | ||||||
3465 | 1 | 6 | $x = $line->[HTML::Template::COND::JUMP_ADDRESS] if | ||||
3466 | (not defined $line->[HTML::Template::COND::VARIABLE][HTML::Template::LOOP::PARAM_SET] or | ||||||
3467 | 2 | 100 | 66 | 14 | not scalar @{$line->[HTML::Template::COND::VARIABLE][HTML::Template::LOOP::PARAM_SET]}); | ||
3468 | } | ||||||
3469 | } | ||||||
3470 | } | ||||||
3471 | } elsif ($type eq 'HTML::Template::NOOP') { | ||||||
3472 | 113 | 255 | next; | ||||
3473 | } elsif ($type eq 'HTML::Template::DEFAULT') { | ||||||
3474 | 25 | 41 | $_ = $x; # remember default place in stack | ||||
3475 | |||||||
3476 | # find next VAR, there might be an ESCAPE in the way | ||||||
3477 | 25 | 42 | *line = \$parse_stack[++$x]; | ||||
3478 | 25 | 100 | 66 | 180 | *line = \$parse_stack[++$x] if (ref $line and UNIVERSAL::isa($line,'HTML::Template::ESCAPE')); | ||
3479 | |||||||
3480 | # either output the default or go back | ||||||
3481 | 25 | 100 | 55 | if (defined $$line) { | |||
3482 | 4 | 8 | $x = $_; | ||||
3483 | } else { | ||||||
3484 | 21 | 24 | $result .= ${$parse_stack[$_]}; | ||||
21 | 45 | ||||||
3485 | } | ||||||
3486 | 25 | 240 | next; | ||||
3487 | } elsif ($type and UNIVERSAL::isa($line,'HTML::Template::ESCAPE')) { | ||||||
3488 | 75 | 111 | my $obj = $line; | ||||
3489 | 75 | 155 | *line = \$parse_stack[++$x]; | ||||
3490 | 75 | 227 | my $line_type = ref($line); | ||||
3491 | 75 | 50 | 66 | 1177 | if ($line_type eq 'SCALAR') { | ||
100 | 0 | ||||||
50 | |||||||
0 | |||||||
3492 | 0 | 0 | $_ = $$line; | ||||
3493 | } elsif ($line_type eq 'HTML::Template::VAR' and reftype($$line) eq 'CODE') { | ||||||
3494 | 4 | 50 | 7 | if ($options->{force_untaint}) { | |||
3495 | 0 | 0 | my $tmp = $$line->($self); | ||||
3496 | 0 | 0 | 0 | croak("HTML::Template->output() : 'force_untaint' option but coderef returns tainted value") | |||
3497 | if tainted($tmp); | ||||||
3498 | 0 | 0 | $_ = $tmp; | ||||
3499 | } else { | ||||||
3500 | 4 | 10 | $_ = $$line->($self); | ||||
3501 | } | ||||||
3502 | } elsif ($line_type eq 'HTML::Template::VAR') { | ||||||
3503 | 71 | 50 | 182 | if (defined($$line)) { | |||
3504 | 71 | 50 | 33 | 233 | if ($options->{force_untaint} > 1 && tainted($$line)) { | ||
3505 | 0 | 0 | croak("HTML::Template->output() : tainted value with 'force_untaint' option"); | ||||
3506 | } | ||||||
3507 | 71 | 120 | $_ = $$line; | ||||
3508 | } | ||||||
3509 | } elsif ($line_type and $line->can('output')) { | ||||||
3510 | 0 | 0 | my $tmp = $line->output(); | ||||
3511 | 0 | 0 | 0 | 0 | if ($options->{force_untaint} > 1 && tainted($tmp)) { | ||
3512 | 0 | 0 | croak("HTML::Template->output() : tainted value with 'force_untaint' option"); | ||||
3513 | } | ||||||
3514 | 0 | 0 | $_ = $tmp; | ||||
3515 | } else { | ||||||
3516 | 0 | 0 | die "HTML::Template::output() : unknown construct in param stack: type: $line_type"; | ||||
3517 | } | ||||||
3518 | 75 | 412 | my $tmp = $obj->output($_); | ||||
3519 | 75 | 50 | 33 | 256 | if ($options->{force_untaint} > 1 && tainted($tmp)) { | ||
3520 | 0 | 0 | croak("HTML::Template->output() : tainted value with 'force_untaint' option"); | ||||
3521 | } | ||||||
3522 | 75 | 142 | $result .= $tmp; | ||||
3523 | 75 | 237 | next; | ||||
3524 | } else { | ||||||
3525 | 0 | 0 | 0 | my ($output,$jump_address) = $self->handle_parse_stack_construct($x,$type,$line,$options->{force_untaint} || 0); | |||
3526 | 0 | 0 | 0 | 0 | $result .= $output if (defined $output and length $output); | ||
3527 | 0 | 0 | 0 | $x = $jump_address if (defined $jump_address); | |||
3528 | } | ||||||
3529 | } | ||||||
3530 | |||||||
3531 | # undo the globalization circular refs | ||||||
3532 | 458 | 100 | 1138 | $self->_unglobalize_vars() if $options->{global_vars}; #FIXME: should this also check for parent_global_vars ? | |||
3533 | |||||||
3534 | # If there are any unset params, then we need to die | ||||||
3535 | 458 | 50 | 1131 | if (@unset_params > 0) { | |||
3536 | 0 | 0 | my $list = join($/,map { $_->[0] ." => ". $_->[1] } @unset_params); | ||||
0 | 0 | ||||||
3537 | 0 | 0 | croak("HTML::Template : The following TMPL_xxx params are unset - they do not match any set by HTML::Template->param(name => ...) : (die_on_unset_params => 2, case_sensitive => $options->{case_sensitive}):$/$list$/") | ||||
3538 | } | ||||||
3539 | |||||||
3540 | # display profiling information | ||||||
3541 | 458 | 50 | 1133 | if ($options->{profile}) { | |||
3542 | 46 | 46 | 382 | use vars qw($profile_time_start $profile_time_end $profile_time_difference); | |||
46 | 117 | ||||||
46 | 76998 | ||||||
3543 | 0 | 0 | $profile_time_end = [gettimeofday]; | ||||
3544 | 0 | 0 | $profile_time_difference += tv_interval($profile_time_start,$profile_time_end); | ||||
3545 | 0 | 0 | $profile_time_start = [gettimeofday]; | ||||
3546 | 0 | 0 | printf STDERR "### HTML::Template Profile ## end output : %.6f (%.6f)\n", join('.',@$profile_time_end), $profile_time_difference; | ||||
3547 | } | ||||||
3548 | |||||||
3549 | 458 | 50 | 993 | print STDERR "### HTML::Template Memory Debug ### END OUTPUT ", $self->{proc_mem}->size(), "\n" | |||
3550 | if $options->{memory_debug}; | ||||||
3551 | |||||||
3552 | # we dont (yet) support recursive templates when printing to a specific file handle | ||||||
3553 | # so we exit immediately | ||||||
3554 | 458 | 100 | 1058 | return undef if defined $args{print_to}; | |||
3555 | |||||||
3556 | # From here on in, $output is a reference to the result | ||||||
3557 | 457 | 662 | my $output = \$result; | ||||
3558 | |||||||
3559 | # recurse into template, if user wanted recursion | ||||||
3560 | 457 | 100 | 66 | 1456 | if ($options->{recursive_templates} and $$output =~ /<(?:\!--\s*)?[Tt][Mm][Pp][Ll]_/) { | ||
3561 | 1 | 50 | 3 | $options->{profile} and printf STDERR "### HTML::Template Profile ## recursive template %.6f\n", Time::HiRes::time; | |||
3562 | |||||||
3563 | 1 | 2 | my $opts = {}; | ||||
3564 | 1 | 3 | my %skip = map { $_ => 1 } qw( filename recursive_templates cache shared_cache blind_cache ); | ||||
5 | 12 | ||||||
3565 | 1 | 17 | foreach (keys %$options) { | ||||
3566 | 38 | 100 | 69 | next if $skip{$_}; | |||
3567 | 34 | 100 | 61 | next unless defined $options->{$_}; | |||
3568 | 33 | 51 | $opts->{$_} = $options->{$_}; | ||||
3569 | } | ||||||
3570 | 1 | 4 | push @{$opts->{associate}}, $self; | ||||
1 | 3 | ||||||
3571 | |||||||
3572 | # recurse into the resultant template output, but only if | ||||||
3573 | # - we haven't hit an upper limit | ||||||
3574 | # - there exists some form of ' | ||||||
3575 | 1 | 3 | my $recursions = $options->{recursive_templates}; | ||||
3576 | 1 | 66 | 11 | for (; $recursions && $$output =~ /<(?:\!--\s*)?[Tt][Mm][Pp][Ll]_/; $recursions--) { | |||
3577 | 1 | 2 | $opts->{scalarref} = $output; | ||||
3578 | 1 | 2 | eval { | ||||
3579 | 1 | 20 | my $ht = ref($self)->new(%$opts); | ||||
3580 | 1 | 4 | $ht->param(%{$self->{recursive_template_params}}); | ||||
1 | 4 | ||||||
3581 | 1 | 24 | $output = $ht->output(by_reference => 1); | ||||
3582 | }; | ||||||
3583 | 1 | 50 | 10 | croak("HTML::Template->output : failure to parse recursive template instance. The error was: $@") | |||
3584 | if ($@); | ||||||
3585 | } | ||||||
3586 | } | ||||||
3587 | |||||||
3588 | # does user want to pass data back by reference, or by value? | ||||||
3589 | 457 | 100 | 946 | if ($args{by_reference}) { | |||
3590 | 1 | 18 | return $output; | ||||
3591 | } else { | ||||||
3592 | 456 | 2293 | return $$output; | ||||
3593 | } | ||||||
3594 | } | ||||||
3595 | |||||||
3596 | sub handle_parse_stack_construct { | ||||||
3597 | 0 | 0 | 0 | 0 | my $self = shift; | ||
3598 | 0 | 0 | my $index = shift; | ||||
3599 | 0 | 0 | my $type = shift; | ||||
3600 | 0 | 0 | my $tmpl_obj = shift; | ||||
3601 | 0 | 0 | my $force_untaint = shift; | ||||
3602 | 0 | 0 | confess("HTML::Template::output() : Unknown item in parse_stack : " . $type); | ||||
3603 | } | ||||||
3604 | |||||||
3605 | =pod | ||||||
3606 | |||||||
3607 | =head2 query() | ||||||
3608 | |||||||
3609 | This method allows you to get information about the template structure. | ||||||
3610 | It can be called in a number of ways. The simplest usage of query is | ||||||
3611 | simply to check whether a parameter name exists in the template, using | ||||||
3612 | the C |
||||||
3613 | |||||||
3614 | if ($template->query(name => 'foo')) { | ||||||
3615 | # do something if a varaible of any type | ||||||
3616 | # named FOO is in the template | ||||||
3617 | } | ||||||
3618 | |||||||
3619 | This same usage returns the type of the parameter. The type is the | ||||||
3620 | same as the tag minus the leading 'TMPL_'. So, for example, a | ||||||
3621 | TMPL_VAR parameter returns 'VAR' from C |
||||||
3622 | |||||||
3623 | if ($template->query(name => 'foo') eq 'VAR') { | ||||||
3624 | # do something if FOO exists and is a TMPL_VAR | ||||||
3625 | } | ||||||
3626 | |||||||
3627 | Note that the variables associated with TMPL_IFs and TMPL_UNLESSs will | ||||||
3628 | be identified as 'VAR' unless they are also used in a TMPL_LOOP, in | ||||||
3629 | which case they will return 'LOOP'. | ||||||
3630 | |||||||
3631 | C |
||||||
3632 | (and inside loops inside loops). Example loop: | ||||||
3633 | |||||||
3634 | |
||||||
3635 | |
||||||
3636 | |
||||||
3637 | |
||||||
3638 | |
||||||
3639 | |
||||||
3640 | |||||||
3641 | |||||||
3642 | |||||||
3643 | And some query calls: | ||||||
3644 | |||||||
3645 | # returns 'LOOP' | ||||||
3646 | $type = $template->query(name => 'EXAMPLE_LOOP'); | ||||||
3647 | |||||||
3648 | # returns ('bop', 'bee', 'example_inner_loop') | ||||||
3649 | @param_names = $template->query(loop => 'EXAMPLE_LOOP'); | ||||||
3650 | |||||||
3651 | # both return 'VAR' | ||||||
3652 | $type = $template->query(name => ['EXAMPLE_LOOP', 'BEE']); | ||||||
3653 | $type = $template->query(name => ['EXAMPLE_LOOP', 'BOP']); | ||||||
3654 | |||||||
3655 | # and this one returns 'LOOP' | ||||||
3656 | $type = $template->query(name => ['EXAMPLE_LOOP', | ||||||
3657 | 'EXAMPLE_INNER_LOOP']); | ||||||
3658 | |||||||
3659 | # and finally, this returns ('inner_bee', 'inner_bop') | ||||||
3660 | @inner_param_names = $template->query(loop => ['EXAMPLE_LOOP', | ||||||
3661 | 'EXAMPLE_INNER_LOOP']); | ||||||
3662 | |||||||
3663 | # for non existent parameter names you get undef | ||||||
3664 | # this returns undef. | ||||||
3665 | $type = $template->query(name => 'DWEAZLE_ZAPPA'); | ||||||
3666 | |||||||
3667 | # calling loop on a non-loop parameter name will cause an error. | ||||||
3668 | # this dies: | ||||||
3669 | $type = $template->query(loop => 'DWEAZLE_ZAPPA'); | ||||||
3670 | |||||||
3671 | As you can see above the C |
||||||
3672 | names and both C |
||||||
3673 | to parameters inside loops. It is an error to use C |
||||||
3674 | parameter that is not a loop. | ||||||
3675 | |||||||
3676 | Note that all the names are returned in lowercase and the types are | ||||||
3677 | uppercase. | ||||||
3678 | |||||||
3679 | Just like C, C |
||||||
3680 | parameter names in the template at the top level. | ||||||
3681 | |||||||
3682 | =cut | ||||||
3683 | |||||||
3684 | sub query { | ||||||
3685 | 6 | 6 | 1 | 221 | my $self = shift; | ||
3686 | 6 | 50 | 24 | $self->{options}{debug} and print STDERR "### HTML::Template Debug ### query(", join(', ', @_), ")\n"; | |||
3687 | |||||||
3688 | # the no-parameter case - return $self->param() | ||||||
3689 | 6 | 50 | 16 | return $self->param() unless scalar(@_); | |||
3690 | |||||||
3691 | 6 | 50 | 16 | croak("HTML::Template::query() : Odd number of parameters passed to query!") | |||
3692 | if (scalar(@_) % 2); | ||||||
3693 | 6 | 50 | 17 | croak("HTML::Template::query() : Wrong number of parameters passed to query - should be 2.") | |||
3694 | if (scalar(@_) != 2); | ||||||
3695 | |||||||
3696 | 6 | 16 | my ($opt, $path) = (lc shift, shift); | ||||
3697 | 6 | 50 | 66 | 26 | croak("HTML::Template::query() : invalid parameter ($opt)") | ||
3698 | unless ($opt eq 'name' or $opt eq 'loop'); | ||||||
3699 | |||||||
3700 | # make path an array unless it already is | ||||||
3701 | 6 | 100 | 20 | $path = [$path] unless (ref $path); | |||
3702 | |||||||
3703 | # find the param in question. | ||||||
3704 | 6 | 20 | my @objs = $self->_find_param(@$path); | ||||
3705 | 6 | 50 | 23 | return undef unless scalar(@objs); | |||
3706 | 6 | 11 | my ($obj, $type); | ||||
3707 | |||||||
3708 | # do what the user asked with the object | ||||||
3709 | 6 | 100 | 30 | if ($opt eq 'name') { | |||
50 | |||||||
3710 | # we only look at the first one. new() should make sure they're | ||||||
3711 | # all the same. | ||||||
3712 | 3 | 7 | ($obj, $type) = (shift(@objs), shift(@objs)); | ||||
3713 | 3 | 50 | 11 | return undef unless defined $obj; | |||
3714 | 3 | 100 | 12 | return 'VAR' if $type eq 'HTML::Template::VAR'; | |||
3715 | 2 | 50 | 16 | return 'LOOP' if $type eq 'HTML::Template::LOOP'; | |||
3716 | 0 | 0 | croak("HTML::Template::query() : unknown object ($type) in param_map!"); | ||||
3717 | |||||||
3718 | } elsif ($opt eq 'loop') { | ||||||
3719 | 3 | 6 | my %results; | ||||
3720 | 3 | 11 | while(@objs) { | ||||
3721 | 4 | 9 | ($obj, $type) = (shift(@objs), shift(@objs)); | ||||
3722 | 4 | 100 | 66 | 342 | croak("HTML::Template::query() : Search path [", join(', ', @$path), "] 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.") | ||
3723 | unless ((defined $obj) and ($type eq 'HTML::Template::LOOP')); | ||||||
3724 | |||||||
3725 | # SHAZAM! This bit extracts all the parameter names from all the | ||||||
3726 | # loop objects for this name. | ||||||
3727 | 8 | 21 | map {$results{$_} = 1} map { keys(%{$_->{'param_map'}}) } | ||||
5 | 6 | ||||||
5 | 20 | ||||||
3 | 8 | ||||||
3728 | 3 | 5 | values(%{$obj->[HTML::Template::LOOP::TEMPLATE_HASH]}); | ||||
3729 | } | ||||||
3730 | # this is our loop list, return it. | ||||||
3731 | 2 | 12 | return keys(%results); | ||||
3732 | } | ||||||
3733 | } | ||||||
3734 | |||||||
3735 | # a function that returns the object(s) corresponding to a given path and | ||||||
3736 | # its (their) ref()(s). Used by query() in the obvious way. | ||||||
3737 | sub _find_param { | ||||||
3738 | 14 | 14 | 19 | my $self = shift; | |||
3739 | 14 | 50 | 45 | my $spot = $self->{options}{case_sensitive} ? shift : lc shift; | |||
3740 | |||||||
3741 | # get the obj and type for this spot | ||||||
3742 | 14 | 26 | my $obj = $self->{'param_map'}{$spot}; | ||||
3743 | 14 | 100 | 36 | return unless defined $obj; | |||
3744 | 11 | 16 | my $type = ref $obj; | ||||
3745 | |||||||
3746 | # return if we're here or if we're not but this isn't a loop | ||||||
3747 | 11 | 100 | 44 | return ($obj, $type) unless @_; | |||
3748 | 3 | 50 | 11 | return unless ($type eq 'HTML::Template::LOOP'); | |||
3749 | |||||||
3750 | # recurse. this is a depth first seach on the template tree, for | ||||||
3751 | # the algorithm geeks in the audience. | ||||||
3752 | 8 | 23 | return map { $_->_find_param(@_) } | ||||
3 | 9 | ||||||
3753 | 3 | 5 | values(%{$obj->[HTML::Template::LOOP::TEMPLATE_HASH]}); | ||||
3754 | } | ||||||
3755 | |||||||
3756 | # HTML::Template::VAR, LOOP, etc are *light* objects - their internal | ||||||
3757 | # spec is used above. No encapsulation or information hiding is to be | ||||||
3758 | # assumed. | ||||||
3759 | |||||||
3760 | package HTML::Template::VAR; | ||||||
3761 | 46 | 46 | 392 | use strict; | |||
46 | 450 | ||||||
46 | 2621 | ||||||
3762 | 46 | 46 | 269 | use warnings FATAL => 'all'; | |||
46 | 98 | ||||||
46 | 2730 | ||||||
3763 | 46 | 46 | 255 | use utf8; | |||
46 | 108 | ||||||
46 | 501 | ||||||
3764 | |||||||
3765 | sub new { | ||||||
3766 | 334 | 334 | 468 | my $value; | |||
3767 | 334 | 1717 | return bless(\$value, $_[0]); | ||||
3768 | } | ||||||
3769 | |||||||
3770 | package HTML::Template::DEFAULT; | ||||||
3771 | 46 | 46 | 3725 | use strict; | |||
46 | 89 | ||||||
46 | 1599 | ||||||
3772 | 46 | 46 | 226 | use warnings FATAL => 'all'; | |||
46 | 106 | ||||||
46 | 1795 | ||||||
3773 | 46 | 46 | 254 | use utf8; | |||
46 | 105 | ||||||
46 | 228 | ||||||
3774 | |||||||
3775 | sub new { | ||||||
3776 | 25 | 25 | 43 | my $value = $_[1]; | |||
3777 | 25 | 84 | return bless(\$value, $_[0]); | ||||
3778 | } | ||||||
3779 | |||||||
3780 | package HTML::Template::LOOP; | ||||||
3781 | 46 | 46 | 3860 | use strict; | |||
46 | 91 | ||||||
46 | 1496 | ||||||
3782 | 46 | 46 | 388 | use warnings FATAL => 'all'; | |||
46 | 95 | ||||||
46 | 1668 | ||||||
3783 | 46 | 46 | 234 | use utf8; | |||
46 | 85 | ||||||
46 | 234 | ||||||
3784 | |||||||
3785 | sub new { | ||||||
3786 | 36 | 36 | 137 | return bless([], $_[0]); | |||
3787 | } | ||||||
3788 | |||||||
3789 | sub output { | ||||||
3790 | 27 | 27 | 42 | my $self = shift; | |||
3791 | 27 | 44 | my $index = shift; | ||||
3792 | 27 | 33 | my $loop_context_vars = shift; | ||||
3793 | 27 | 60 | my $template = $self->[TEMPLATE_HASH]{$index}; | ||||
3794 | 27 | 40 | my $value_sets_array = $self->[PARAM_SET]; | ||||
3795 | 27 | 48 | my $result = ''; | ||||
3796 | 27 | 50 | 57 | return $result unless defined($value_sets_array); | |||
3797 | |||||||
3798 | 27 | 100 | 66 | if ($loop_context_vars) { | |||
3799 | 7 | 10 | my $count = 0; | ||||
3800 | 7 | 9 | my $odd = 0; | ||||
3801 | 7 | 16 | foreach my $value_set (@$value_sets_array) { | ||||
3802 | 23 | 100 | 53 | if ($count == 0) { | |||
16 | 100 | 39 | |||||
3803 | 7 | 11 | @{$value_set}{qw(__first__ __outer__ __inner__ __last__)} = (1,1,0,$#{$value_sets_array} == 0); | ||||
7 | 32 | ||||||
7 | 15 | ||||||
3804 | } elsif ($count == $#{$value_sets_array}) { | ||||||
3805 | 6 | 11 | @{$value_set}{qw(__first__ __outer__ __inner__ __last__)} = (0,1,0,1); | ||||
6 | 19 | ||||||
3806 | } else { | ||||||
3807 | 10 | 18 | @{$value_set}{qw(__first__ __outer__ __inner__ __last__)} = (0,0,1,0); | ||||
10 | 34 | ||||||
3808 | } | ||||||
3809 | 23 | 139 | $odd = $value_set->{__odd__} = not $odd; | ||||
3810 | 23 | 43 | $value_set->{__even__} = $odd; | ||||
3811 | 23 | 58 | $value_set->{__counter__} = $count + 1; | ||||
3812 | 23 | 56 | $template->param($value_set); | ||||
3813 | 23 | 67 | $result .= $template->output(); | ||||
3814 | 23 | 58 | $template->clear_params; | ||||
3815 | 23 | 56 | @{$value_set}{qw(__first__ __last__ __outer__ __inner__ __odd__ __even__ __counter__)} = (0,0,0,0,0,0); | ||||
23 | 71 | ||||||
3816 | 23 | 50 | $count++; | ||||
3817 | } | ||||||
3818 | } else { | ||||||
3819 | 20 | 49 | foreach my $value_set (@$value_sets_array) { | ||||
3820 | 33 | 73 | $template->param($value_set); | ||||
3821 | 33 | 234 | $result .= $template->output(); | ||||
3822 | 33 | 114 | $template->clear_params; | ||||
3823 | } | ||||||
3824 | } | ||||||
3825 | |||||||
3826 | 27 | 95 | return $result; | ||||
3827 | } | ||||||
3828 | |||||||
3829 | package HTML::Template::COND; | ||||||
3830 | 46 | 46 | 20379 | use strict; | |||
46 | 88 | ||||||
46 | 1974 | ||||||
3831 | 46 | 46 | 242 | use warnings FATAL => 'all'; | |||
46 | 107 | ||||||
46 | 1591 | ||||||
3832 | 46 | 46 | 243 | use utf8; | |||
46 | 536 | ||||||
46 | 250 | ||||||
3833 | |||||||
3834 | sub new { | ||||||
3835 | 56 | 56 | 84 | my $pkg = shift; | |||
3836 | 56 | 74 | my $var = shift; | ||||
3837 | 56 | 97 | my $self = []; | ||||
3838 | 56 | 125 | $self->[VARIABLE] = $var; | ||||
3839 | |||||||
3840 | 56 | 138 | bless($self, $pkg); | ||||
3841 | 56 | 125 | return $self; | ||||
3842 | } | ||||||
3843 | |||||||
3844 | package HTML::Template::NOOP; | ||||||
3845 | 46 | 46 | 4408 | use strict; | |||
46 | 78 | ||||||
46 | 1665 | ||||||
3846 | 46 | 46 | 236 | use warnings FATAL => 'all'; | |||
46 | 129 | ||||||
46 | 1620 | ||||||
3847 | 46 | 46 | 233 | use utf8; | |||
46 | 99 | ||||||
46 | 172 | ||||||
3848 | |||||||
3849 | sub new { | ||||||
3850 | 209 | 209 | 319 | my $unused; | |||
3851 | 209 | 306 | my $self = \$unused; | ||||
3852 | 209 | 671 | bless($self, $_[0]); | ||||
3853 | 209 | 425 | return $self; | ||||
3854 | } | ||||||
3855 | |||||||
3856 | # scalar-tying package for output(print_to => *HANDLE) implementation | ||||||
3857 | package HTML::Template::PRINTSCALAR; | ||||||
3858 | 46 | 46 | 3773 | use strict; | |||
46 | 85 | ||||||
46 | 1625 | ||||||
3859 | 46 | 46 | 243 | use warnings FATAL => 'all'; | |||
46 | 96 | ||||||
46 | 1713 | ||||||
3860 | 46 | 46 | 208 | use utf8; | |||
46 | 88 | ||||||
46 | 203 | ||||||
3861 | |||||||
3862 | 1 | 1 | 6 | sub TIESCALAR { bless \$_[1], $_[0]; } | |||
3863 | 1 | 1 | 7 | sub FETCH { } | |||
3864 | sub STORE { | ||||||
3865 | 1 | 1 | 2 | my $self = shift; | |||
3866 | 1 | 12 | local *FH = $$self; | ||||
3867 | 1 | 10 | print FH @_; | ||||
3868 | } | ||||||
3869 | 1; | ||||||
3870 | __END__ |