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
Test Template
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
and . It even allows you to sub-class
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 tag is very simple. For each tag in the
111
template you call $template->param(PARAMETER_NAME => "VALUE"). When
112
the template is output the is replaced with the VALUE text
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 gave me a taco.
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 tag is a bit more complicated than . The
159
tag allows you to delimit a section of text and give it a
160
name. Inside this named loop you place s. Now you pass to
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 takes a list of variable
193
assignments and then iterates over the loop body producing output.
194
195
Often you'll want to generate a 's contents
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
s within s are fine and work as you would
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 gets an array reference. Inside the array
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 , the only variables that are usable are the ones
257
from the . The variables in the outer blocks are not
258
visible within a template loop. For the computer-science geeks among
259
you, a introduces a new scope much like a perl subroutine
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 , this tag imports another template into the current
291
scope. It differs in that it only does this once.
292
293
=head2 TMPL_IF
294
295
...
296
297
The tag allows you to include or not include a block of 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
blocks can include any valid HTML::Template
314
construct - VARs and LOOPs and other IF/ELSE blocks. Note, however,
315
that intersecting a and a is invalid.
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
blocks.
385
386
=head2 TMPL_UNLESS
387
388
...
389
390
This tag is the opposite of . The block is output if the
391
CONTROL_PARAMETER is set false or not defined. You can use
392
with just as you can with .
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 - "" is acceptable.
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
in the English locale would translate to
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 for more information.
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
. The default (C)
556
behaviour is that HTML::Template wont die when output() is called for
557
cases where you haven't called Cparam(param_name => 'value')>.
558
559
If you set C, HTML::Template will defer the
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
tags, but again, only if the template is opened with
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 for a description of how these
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 tag. This list is only consulted
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
file, the path to the including file is also tried
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 and use the first matching template found. The
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 for
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 , , and to
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
and
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 tag
928
in the template file. This can be used to make opening untrusted
929
templates B less dangerous. Defaults to 0.
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 s like global
942
variables in Perl - they have unlimited scope. This option also
943
affects and .
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 's
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: C is not C (which does not exist).
975
That means that loops you declare at one scope are not available
976
inside other loops even when C is on.
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_(.*?)!!!//g;
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 key. The available
1008
formats are C and C. Using the C format will incur
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 modules. HTML::Template will apply
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 for more information.
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 at $fname : line $fcounter!" unless defined $loopdata;
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 or in loop ending at $fname : line $fcounter.";
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 with no matching at $fname : line $fcounter."
2516
unless defined $cond;
2517
3
50
8
die "HTML::Template->new() : found incorrectly terminating or at $fname : line $fcounter."
2518
unless ($cond->[HTML::Template::COND::WHICH] == HTML::Template::COND::WHICH_IF);
2519
# die "HTML::Template->new() : found tag for at $fname : line $fcounter." if $cond->[HTML::Template::COND::IS_ELSE];
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 with no matching or at $fname : line $fcounter." unless defined $cond;
2579
19
100
164
die "HTML::Template->new() : found second tag for or at $fname : line $fcounter." if $cond->[HTML::Template::COND::IS_ELSE];
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 at $fname : line $fcounter." unless defined $cond;
2611
27
50
74
die "HTML::Template->new() : found incorrectly terminating a (use ) at $fname : line $fcounter.\n"
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 at $fname : line $fcounter." unless defined $cond;
2615
7
50
20
die "HTML::Template->new() : found incorrectly terminating a (use ) at $fname : line $fcounter.\n"
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 tag at $fname : $fcounter." if ($chunk =~ /<(?:!--\s*)?\/?[Tt][Mm][Pp][Ll]_/);
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 or not terminated at end of file!";
2800
203
50
6211
scalar(@loopstack) and die "HTML::Template->new() : At least one not terminated at end of file!";
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 is
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, in which case it is simply
3211
replaced with ''. are evaluated once per parameter set,
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 option.
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 option:
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 also allows you to get a list of parameters inside a loop
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 option returns a list of parameter
3672
names and both C and C take array refs in order to refer
3673
to parameters inside loops. It is an error to use C with a
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 with no arguments returns all the
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__