File Coverage

blib/lib/HTML/KTemplate.pm

Criterion	Covered	Total	%
statement	279	293	95.2
branch	184	226	81.4
condition	42	69	60.8
subroutine	20	22	90.9
pod	10	10	100.0
total	535	620	86.2

line	stmt	bran	cond	sub	pod	time	code
1
2							#=======================================================================
3							#
4							# Copyright (c) 2002-2003 Kasper Dziurdz. All rights reserved.
5							#
6							# This module is free software; you can redistribute it and/or
7							# modify it under the same terms as Perl itself.
8							#
9							# This program is distributed in the hope that it will be useful,
10							# but WITHOUT ANY WARRANTY; without even the implied warranty of
11							# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12							# Artistic License for more details.
13							#
14							# Please email me any comments, questions, suggestions or bug
15							# reports to:
16							#
17							#=======================================================================
18
19							package HTML::KTemplate;
20	1			1		13570	use strict;
	1					3
	1					39
21	1			1		5	use Carp;
	1					4
	1					67
22	1			1		5	use File::Spec;
	1					6
	1					35
23
24	1					5844	use vars qw(
25							$VAR_START_TAG $VAR_END_TAG
26							$BLOCK_START_TAG $BLOCK_END_TAG
27							$INCLUDE_START_TAG $INCLUDE_END_TAG
28							$ROOT $CHOMP $VERSION $CACHE
29							$FIRST $INNER $LAST
30	1			1		4	);
	1					1
31
32							$VERSION = '1.33';
33
34							$VAR_START_TAG = '[%';
35							$VAR_END_TAG = '%]';
36
37							$BLOCK_START_TAG = '';
39
40							$INCLUDE_START_TAG = '';
42
43							$ROOT = undef;
44							$CHOMP = 1;
45							$CACHE = {};
46
47							$FIRST = { 'FIRST' => 1, 'first' => 1 };
48							$INNER = { 'INNER' => 1, 'inner' => 1 };
49							$LAST = { 'LAST' => 1, 'last' => 1 };
50
51
52							sub TEXT () { 0 }
53							sub VAR () { 1 }
54							sub BLOCK () { 2 }
55							sub FILE () { 3 }
56							sub IF () { 4 }
57							sub ELSE () { 5 }
58							sub UNLESS () { 6 }
59							sub LOOP () { 7 }
60
61							sub TYPE () { 0 }
62							sub IDENT () { 1 }
63							sub STACK () { 2 }
64
65							sub NAME () { 0 }
66							sub PATH () { 1 }
67
68
69							sub new {
70
71	36			36	1	2629	my $class = shift;
72	36					355	my $self = {
73							'vars' => [{}], # values for template vars
74							'loop' => [], # loop context variables
75							'block' => undef, # current block reference
76							'files' => [], # file paths for include
77							'output' => '', # template output
78							'config' => { # configuration
79							'cache' => 0,
80							'strict' => 0,
81							'no_includes' => 0,
82							'max_includes' => 15,
83							'loop_vars' => 0,
84							'blind_cache' => 0,
85							'include_vars' => 0,
86							'parse_vars' => 0,
87							},
88							};
89
90	36	100				100	$self->{'config'}->{'root'} = shift if @_ == 1;
91	36	50				76	croak('Odd number of option parameters') if @_ % 2 != 0;
92
93							# load in all option parameters
94	36					122	$self->{'config'}->{$_} = shift while $_ = lc shift;
95
96	36	100				116	$self->{'config'}->{'root'} = $ROOT
97							unless exists $self->{'config'}->{'root'};
98
99	36	50				71	$self->{'config'}->{'cache'} = 1
100							if $self->{'config'}->{'blind_cache'};
101
102	36					70	bless ($self, $class);
103	36					76	return $self;
104
105							}
106
107
108							sub assign {
109
110	59			59	1	372	my $self = shift;
111	59					55	my ($target, $block);
112
113							# odd number of arguments: block
114	59	100	100			139	if (@_ % 2 != 0 && @_ >= 3) {
115	1					3	$self->block(shift);
116	1					1	++$block;
117							}
118
119							# if a block reference is defined,
120							# assign the variables to the block
121	25					63	$target = defined $self->{'block'}
122	59	100				130	? $self->{'block'}->[ $#{ $self->{'block'} } ]
123							: $self->{'vars'}->[0];
124
125	59	100				103	if (ref $_[0] eq 'HASH') {
126							# copy data for faster variable lookup
127	3					5	@{ $target }{ keys %{$_[0]} } = values %{$_[0]};
	3					6
	3					7
	3					9
128							} else {
129	56					150	my %assign = @_;
130	56					108	@{ $target }{ keys %assign } = values %assign;
	56					153
131							}
132
133							# remove block reference
134	59	100				116	$self->block() if $block;
135
136	59					106	return 1;
137
138							}
139
140
141							sub block {
142							# - creates a new loop in the defined block
143							# - sets a reference so all future variable values will
144							# be assigned there (until this method is called again)
145
146	46			46	1	173	my $self = shift;
147	46					40	my (@ident, $root, $key, $last_key);
148
149							# no argument: undefine block reference
150	46	100	66			140	if (!defined $_[0] \|\| !length $_[0]) {
151	5					7	$self->{'block'} = undef;
152	5					10	return 1;
153							}
154
155	41					170	push @ident, split /\./, shift while @_;
156	41					50	$last_key = pop @ident;
157
158	41					59	$root = $self->{'vars'}->[0];
159
160	41					52	foreach $key (@ident) {
161
162							# hash reference: perfect!
163	40	100	66			132	if (ref $root->{$key} eq 'HASH') {
	22	100				70
164	9					15	$root = $root->{$key};
165							}
166
167							# array reference: block continues in hash
168							# reference at the end of the array
169							elsif (ref $root->{$key} eq 'ARRAY'
170							&& ref $root->{$key}->[ $#{ $root->{$key} } ] eq 'HASH' ) {
171	22					27	$root = $root->{$key}->[ $#{ $root->{$key} } ];
	22					52
172							}
173
174							else { # create new hash reference
175	9					25	$root = $root->{$key} = {};
176							}
177
178							}
179
180	41	100				82	if (ref $root->{$last_key} eq 'ARRAY') {
181							# block exists: add new loop
182	26					23	push @{ $root->{$last_key} }, {};
	26					52
183							} else {
184							# create new block
185	15					33	$root->{$last_key} = [{}];
186							}
187
188	41					95	$self->{'block'} = $root->{$last_key};
189
190	41					69	return 1;
191
192							}
193
194
195							sub process {
196
197	39			39	1	222	my $self = shift;
198
199	39					65	foreach (@_) {
200	41	50				69	next unless defined;
201	41					77	$self->_include($_);
202							}
203
204	36					80	return 1;
205
206							}
207
208
209							sub _include {
210
211	69			69		81	my $self = shift;
212	69					83	my $filename = shift;
213	69					66	my ($stack, $filepath);
214
215							# check whether includes are disabled
216	69	100	100			180	if ($self->{'config'}->{'no_includes'} && scalar @{ $self->{'files'} } != 0) {
	2					10
217	1	50				200	croak('Include blocks are disabled at ' . $self->{'files'}->[0]->[NAME])
218							if $self->{'config'}->{'strict'};
219	0					0	return; # no strict
220							}
221
222							# check for recursive includes
223	68					537	croak('Recursive includes: maximum recursion depth of ' . $self->{'config'}->{'max_includes'} . ' files exceeded')
224	68	100				66	if scalar @{ $self->{'files'} } > $self->{'config'}->{'max_includes'};
225
226	67					127	($stack, $filepath) = $self->_load($filename);
227
228							# add file path to use as include path
229	67	100				145	unshift @{ $self->{'files'} }, [ $filename, $filepath ]
	62					151
230							if defined $filepath;
231
232							# create output
233	67					166	$self->_output($stack);
234
235							# delete file info if it was added
236	49	100				115	shift @{ $self->{'files'} } if defined $filepath;
	44					251
237
238							}
239
240
241							sub _load {
242							# - loads the template file from cache or hard drive
243							# - returns the parsed stack and the full template path
244
245	67			67		69	my $self = shift;
246	67					67	my $filename = shift;
247	67					64	my ($filepath, $mtime, $filedata);
248
249							# slurp the file
250	67					176	local $/ = undef;
251
252							# when the passed argument is a reference to a scalar,
253							# array or file handle, load and use it as template
254
255	67	100				125	if (ref $filename eq 'SCALAR') {
256							# skip undef and do not change passed scalar
257	2	50				7	$filedata = defined $$filename ? $$filename : '';
258	2					6	return $self->_parse(\$filedata, '[scalar_ref]');
259							}
260
261	65	100				109	if (ref $filename eq 'ARRAY') {
262	1					3	$filedata = join("", @$filename);
263	1					6	return $self->_parse(\$filedata, '[array_ref]');
264							}
265
266	64	100				98	if (ref $filename eq 'GLOB') {
267	1					18	$filedata = readline($$filename);
268	1	50				3	$filedata = '' unless defined $filedata; # skip undef
269	1					4	return $self->_parse(\$filedata, '[file_handle]');
270							}
271
272							# file handle (no reference)
273	63	100				140	if (ref \$filename eq 'GLOB') {
274	1					14	$filedata = readline($filename);
275	1	50				4	$filedata = '' unless defined $filedata; # skip undef
276	1					3	return $self->_parse(\$filedata, '[file_handle]');
277							}
278
279	62					117	($filepath, $mtime) = $self->_find($filename);
280
281	62	50				145	croak("Can't open file $filename: file not found")
282							unless defined $filepath;
283
284	62	50				132	if ($self->{'config'}->{'cache'}) {
285							# load parsed template from cache
286	0					0	$filedata = $CACHE->{$filepath};
287
288	0	0	0			0	return ($filedata->[0], $filepath)
289							if $self->{'config'}->{'blind_cache'} && defined $filedata;
290	0	0	0			0	return ($filedata->[0], $filepath)
291							if defined $filedata && $filedata->[1] == $mtime;
292							}
293
294	62	50				1666	open (TEMPLATE, '<' . $filepath) \|\|
295							croak("Can't open file $filename: $!");
296	62					1243	$filedata =
297	62					517	close TEMPLATE;
298
299	62					144	$filedata = $self->_parse(\$filedata, $filename);
300
301							# commit to cache
302	62	50				151	$CACHE->{$filepath} = [ $filedata, $mtime ]
303							if $self->{'config'}->{'cache'};
304
305	62					223	return ($filedata, $filepath);
306
307							}
308
309
310							sub _find {
311							# - searches for the template file in the
312							# root path or from where it was included
313							# - returns a full path and the mtime or
314							# undef if the file cannot be found
315
316	62			62		61	my $self = shift;
317	62					55	my $filename = shift;
318	62					60	my ($inclpath, $filepath);
319
320	62	100				319	$filepath = defined $self->{'config'}->{'root'}
321							? File::Spec->catfile($self->{'config'}->{'root'}, $filename)
322							: File::Spec->canonpath($filename);
323
324	62	50	33			169	return $filepath if $self->{'config'}->{'blind_cache'}
325							&& defined $CACHE->{$filepath};
326	62	100				909	return ($filepath, (stat(_))[9]) if -e $filepath;
327
328							# check path from where the file was included
329	23	50				52	if (defined $self->{'files'}->[0]->[PATH]) {
330	23					29	$inclpath = $self->{'files'}->[0]->[PATH];
331	23					126	$inclpath = [ File::Spec->splitdir($inclpath) ];
332	23					43	$inclpath->[$#$inclpath] = $filename;
333	23					177	$filepath = File::Spec->catfile(@$inclpath);
334	23					72	$filepath = File::Spec->canonpath($filepath);
335
336	23	50	33			59	return $filepath if $self->{'config'}->{'blind_cache'}
337							&& defined $CACHE->{$filepath};
338	23	100				348	return ($filepath, (stat(_))[9]) if -e $filepath;
339
340							# check path from variable
341	2	50				8	if ($self->{'config'}->{'include_vars'}) {
342	2					5	$filepath = File::Spec->canonpath( $self->_get($filename) );
343	2	50	33			9	return $filepath if $self->{'config'}->{'blind_cache'}
344							&& defined $CACHE->{$filepath};
345	2	50				37	return ($filepath, (stat(_))[9]) if -e $filepath;
346							}
347
348							}
349
350	0					0	return undef;
351
352							}
353
354
355							sub _parse {
356							# - parses the template data passed as a reference
357							# - returns the finished stack
358
359	67			67		78	my $self = shift;
360	67					62	my $filedata = shift;
361	67					74	my $filename = shift;
362	67					54	my ($text, $tag, $type, $ident);
363	0					0	my ($regexp, $line, $block, $space);
364	0					0	my (@idents, @pstacks);
365
366	67					69	$line = 1; # current line
367	67					122	@pstacks = ([]);
368
369							# block and include tags are the same by default.
370							# if that wasn't changed, use a faster regexp.
371
372	67	100	66			1415	$regexp = $BLOCK_START_TAG eq $INCLUDE_START_TAG
373							&& $BLOCK_END_TAG eq $INCLUDE_END_TAG
374
375							? qr/^
376							(.*?)
377							(
378							\Q$VAR_START_TAG\E
379							\s*
380							([\w.-]+)
381							\s*
382							\Q$VAR_END_TAG\E
383							\|
384							\Q$BLOCK_START_TAG\E
385							\s*
386							(?:
387							(
388							[Bb][Ee][Gg][Ii][Nn]
389							\|
390							[Ee][Nn][Dd]
391							\|
392							[Ii][Ff]
393							\|
394							[Ll][Oo][Oo][Pp]
395							\|
396							[Ee][Ll][Ss][Ee]
397							\|
398							[Uu][Nn][Ll][Ee][Ss][Ss]
399							)
400							(?: \s+ ([\w.-]+) )?
401							\|
402							([Ii][Nn][Cc][Ll][Uu][Dd][Ee])\s+
403							(?: "([^"]?)" \| '([^']?)' \| (\S*?) )
404							)
405							\s*
406							\Q$BLOCK_END_TAG\E
407							)
408							/sx
409
410							: qr/^
411							(.*?)
412							(
413							\Q$VAR_START_TAG\E
414							\s*
415							([\w.-]+)
416							\s*
417							\Q$VAR_END_TAG\E
418							\|
419							\Q$BLOCK_START_TAG\E
420							\s*
421							(
422							[Bb][Ee][Gg][Ii][Nn]
423							\|
424							[Ee][Nn][Dd]
425							\|
426							[Ii][Ff]
427							\|
428							[Ll][Oo][Oo][Pp]
429							\|
430							[Ee][Ll][Ss][Ee]
431							\|
432							[Uu][Nn][Ll][Ee][Ss][Ss]
433							)
434							(?: \s+ ([\w.-]+) )?
435							\s*
436							\Q$BLOCK_END_TAG\E
437							\|
438							\Q$INCLUDE_START_TAG\E
439							\s*
440							([Ii][Nn][Cc][Ll][Uu][Dd][Ee])\s+
441							(?: "([^"]?)" \| '([^']?)' \| (\S*?) )
442							\s*
443							\Q$INCLUDE_END_TAG\E
444							)
445							/sx;
446
447	67					593	while ($$filedata =~ s/$regexp//sx) {
448
449	277					495	$text = $1; # preceding text
450	277					388	$tag = $2; # whole tag (needed for line count)
451	277		66			747	$type = $4 \|\| $6; # tag type (undef for var)
452	277	100				802	$ident = defined $3 ? $3 : defined $5 ? $5 : defined $7 ? $7 :
		100
		100
		100
		100
453							defined $8 ? $8 : defined $9 ? $9 : undef;
454
455							# get line position
456	277					320	$line += ($text =~ tr/\n//);
457
458	277	50				507	if ($CHOMP) {
459							# delete newline after last block tag
460	277	100				829	$space ? $text =~ s/^[ \t]\r?\n// : $text =~ s/^[ \t]\r?\n/ / if $block;
		100
461
462							# check this tag is not a var or include
463	277	100	100			1091	$block = $type && $type !~ /^[Ii]/ ? 1 : 0;
464	277					270	$space = 0; # no space was added (default)
465
466							# remove newline preceding this block tag
467	277	100	100			1238	$space = 1 if $block && $text =~ s/\r?\n[ \t]*\z/ /;
468							}
469
470							# the first element of the @pstacks array contains a reference
471							# to the current parse stack where the template data is added.
472
473	277	50				525	push @{$pstacks[0]}, [ TEXT, $text ] if defined $text;
	277					721
474
475	277	100				1139	if (!defined $type) {
		100
		100
		100
		100
		100
		100
		50
476
477	60					57	push @{$pstacks[0]}, [ VAR, $ident ];
	60					133
478
479							} elsif ($type =~ /^[Bb]/) {
480
481	47	50				122	croak("Parse error: invalid param in block tag at $filename line $line")
482							unless length $ident;
483
484							# create a new parse stack were all data
485							# will be added until the block ends.
486	47					77	unshift @pstacks, [];
487
488							# create a reference to this new parse stack in the old one
489							# so the block data doesn't get lost after the block ends.
490	47					520	push @{$pstacks[1]}, [ BLOCK, $ident, $pstacks[0] ];
	47					110
491
492							# add block type and ident for syntax checking
493	47					101	unshift @idents, [ 'BEGIN', $ident ];
494
495							} elsif ($type =~ /^[Ee][Nn]/) {
496
497	86	50				174	croak("Parse error: block closed but never opened at $filename line $line")
498							if scalar @idents == 0;
499
500	86	50	66			578	croak("Parse error: invalid param in block tag at $filename line $line")
			66
			66
501							if defined $ident && (uc $ident eq 'BEGIN' \|\| uc $ident ne $idents[0]->[TYPE])
502							&& $ident ne $idents[0]->[IDENT];
503
504	86					94	shift @pstacks;
505	86					102	shift @idents;
506
507							} elsif ($type =~ /^[Ii][Ff]/) {
508
509	14	50				24	croak("Parse error: invalid param in if tag at $filename line $line")
510							unless length $ident;
511
512	14					26	unshift @pstacks, [];
513	14					13	push @{$pstacks[1]}, [ IF , $ident, $pstacks[0] ];
	14					32
514	14					32	unshift @idents, [ 'IF', $ident ];
515
516							} elsif ($type =~ /^[Uu]/) {
517
518	14	50				28	croak("Parse error: invalid param in unless tag at $filename line $line")
519							unless length $ident;
520
521	14					20	unshift @pstacks, [];
522	14					16	push @{$pstacks[1]}, [ UNLESS , $ident, $pstacks[0] ];
	14					41
523	14					30	unshift @idents, [ 'UNLESS', $ident ];
524
525							} elsif ($type =~ /^[Ee]/) {
526
527	12	50				28	croak("Parse error: found else tag with no matching block at $filename line $line")
528							if scalar @idents == 0;
529
530	12	50	66			39	croak("Parse error: invalid param in else tag at $filename line $line")
531							if defined $ident && $ident ne $idents[0]->[IDENT];
532
533	12					10	shift @pstacks; # close current block
534	12					24	unshift @pstacks, []; # and create a new one.
535	12					12	push @{$pstacks[1]}, [ ELSE, undef, $pstacks[0] ];
	12					28
536
537							} elsif ($type =~ /^[Ii]/) {
538
539	33	50				62	croak("Parse error: file to include not defined at $filename line $line")
540							unless length $ident;
541
542	33					28	push @{$pstacks[0]}, [ FILE, $ident ];
	33					79
543
544							} elsif ($type =~ /^[Ll]/) {
545
546	11	50				29	croak("Parse error: invalid param in loop tag at $filename line $line")
547							unless length $ident;
548
549	11					19	unshift @pstacks, [];
550	11					13	push @{$pstacks[1]}, [ LOOP , $ident, $pstacks[0] ];
	11					34
551	11					27	unshift @idents, [ 'LOOP', $ident ];
552
553							}
554
555							# tag might contain newline
556	277					2079	$line += ($tag =~ tr/\n//);
557
558							}
559
560							# chomp and add remaining text not recognized by the regexp
561	67	100	66			244	$$filedata =~ s/^[ \t]*\n// if $CHOMP && $block;
562	67					67	push @{$pstacks[0]}, [ TEXT, $$filedata ];
	67					148
563
564	67	50				134	croak("Parse error: block not closed at $filename")
565							if @idents > 0;
566
567	67					224	return $pstacks[0];
568
569							}
570
571
572							sub _output {
573
574	186			186		198	my $self = shift;
575	186					185	my $stack = shift;
576	186					180	my ($line, $looped);
577
578	186					240	foreach $line (@$stack) { # create template output
579	802	50				2783	$line->[TYPE] == VAR ? $self->{'output'} .= $self->_value( $line->[IDENT] ) :
		100
		100
		100
		100
		100
		100
		100
580							$line->[TYPE] == TEXT ? $self->{'output'} .= $line->[IDENT] :
581							$line->[TYPE] == FILE ? $self->_include( $line->[IDENT] ) :
582							$line->[TYPE] == BLOCK ? $looped = $self->_loop( $line->[IDENT], $line->[STACK], BLOCK ) :
583							$line->[TYPE] == IF ? $looped = $self->_loop( $line->[IDENT], $line->[STACK], IF ) :
584							$line->[TYPE] == LOOP ? $looped = $self->_loop( $line->[IDENT], $line->[STACK], LOOP ) :
585							$line->[TYPE] == UNLESS ? $looped = $self->_loop( $line->[IDENT], $line->[STACK], UNLESS ) :
586							$line->[TYPE] == ELSE ? $looped = $self->_loop( $looped, $line->[STACK], ELSE ) : next;
587							}
588
589							}
590
591
592							sub _value {
593
594	95			95		88	my $self = shift;
595	95					98	my $ident = shift;
596	95					149	my $value = $self->_get($ident);
597
598	95	100				186	unless (defined $value) {
599	7	100				131	croak("No value found for variable $ident at " . $self->{'files'}->[0]->[NAME])
600							if $self->{'config'}->{'strict'};
601	6					13	return ''; # no strict
602							}
603
604							# if the value is a code reference the code
605							# is called and the output is returned
606
607	88	100				134	if (ref $value) {
608	1	50				6	$value = &{$value} if ref $value eq 'CODE';
	1					3
609	1	50	33			25	return '' if !defined $value \|\| ref $value;
610							}
611
612	88	100				180	if ($self->{'config'}->{'parse_vars'}) {
613	5					184	$value =~ s/ # replace template vars
614							\Q$VAR_START_TAG\E
615							\s([\w.-]+)\s
616							\Q$VAR_END_TAG\E
617	3					15	/ $self->_value($1) /xge;
618							}
619
620	88					178	return $value;
621
622							}
623
624
625							sub _loop {
626
627	203			203		211	my $self = shift;
628	203					204	my $ident = shift;
629	203					208	my $stack = shift;
630	203					207	my $mode = shift;
631	203					190	my ($data, $vars, $skip);
632	203					187	my $loop_vars = 0;
633	203					183	my $loop_count = 0;
634
635	203	100				370	if ($mode == BLOCK) {
		100
		100
		100
		50
636
637	135					213	$data = $self->_get($ident);
638	135	100				425	return 0 unless defined $data;
639
640							# no array reference: check the Boolean
641							# context to loop once or skip the block
642	58	100				112	unless (ref $data eq 'ARRAY') {
643	33	100				71	$data ? $data = [1] : return 0;
644							# if statement: no loop vars
645							} else {
646	25	100				43	return 0 unless @$data;
647	23					42	$loop_vars = $self->{'config'}->{'loop_vars'};
648							}
649
650							} elsif ($mode == LOOP) {
651
652	29					66	$data = $self->_get($ident);
653	29	100				74	return 0 unless defined $data;
654	13	100				41	return 0 unless ref $data eq 'ARRAY';
655	7	100				17	return 0 unless @$data;
656	6					12	$loop_vars = $self->{'config'}->{'loop_vars'};
657
658							} elsif ($mode == IF) {
659
660	13					22	$data = $self->_get($ident);
661	13	100				30	return 0 unless defined $data;
662	12	100				31	$data ? $data = [1] : return 0;
663
664							} elsif ($mode == UNLESS) {
665
666	14					26	$data = $self->_get($ident);
667	14	100				36	return 0 if $data;
668	5					10	$data = [1];
669
670							} elsif ($mode == ELSE) {
671
672	12	50				21	return 0 if $ident;
673	12					23	$data = [1];
674
675							}
676
677	81					107	foreach $vars (@$data) {
678
679	53					81	ref $vars eq 'HASH' # add current loop variables
680	119	100				301	? (unshift @{ $self->{'vars'} }, $vars)
681							: ($skip = 1);
682
683	119	100				172	if ($loop_vars) {
684	15					15	++$loop_count;
685
686							# add loop context variables
687	0					0	@$data == 1 ? unshift @{ $self->{'loop'} }, { %$FIRST, %$LAST } :
	6					8
688	6					7	$loop_count == 1 ? unshift @{ $self->{'loop'} }, $FIRST :
689	3					4	$loop_count == @$data ? unshift @{ $self->{'loop'} }, $LAST :
690	15	100				39	unshift @{ $self->{'loop'} }, $INNER;
		100
		50
691
692							# create output
693	15					30	$self->_output($stack);
694
695							# delete loop context variables
696	15					16	shift @{ $self->{'loop'} };
	15					21
697
698							} else {
699
700							# create output
701	104					210	$self->_output($stack);
702
703							}
704
705	53					92	!$skip # delete current loop variables
706	119	100				241	? (shift @{ $self->{'vars'} })
707							: ($skip = 0);
708							}
709
710	81					173	return 1;
711							}
712
713
714							sub _get {
715							# - returns the variable value from the variable
716							# hash (considering the temporary loop variables)
717
718	288			288		275	my $self = shift;
719	288					265	my (@ident, $root, $last_key, $skip);
720
721	288					638	@ident = split /\./, $_[0];
722	288					370	$last_key = pop @ident;
723
724							# check for loop context variables
725	288	100	66			929	return $self->{'loop'}->[0]->{$last_key} if $self->{'config'}->{'loop_vars'}
			100
726							&& @ident == 0 && exists $self->{'loop'}->[0]->{$last_key};
727
728							# loop values are prepended to the front of the
729							# var array so start with them first
730
731	273					268	foreach my $hash (@{ $self->{'vars'} }) {
	273					449
732
733							# speed up normal variable lookup
734	427	100	100			1726	return $hash->{$last_key} if @ident == 0
735							&& exists $hash->{$last_key};
736
737	267					276	$root = $hash; # do not change the hash
738
739	267					319	foreach my $key (@ident) {
740
741	30	100				68	if (ref $root eq 'HASH') {
742							# go down the hash structure
743	28					65	$root = $root->{$key};
744							}
745
746							else {
747							# nothing found
748	2					3	$skip = 1; last;
	2					4
749							}
750
751							}
752
753	267	100				358	unless ($skip) { # return if found something
754	265	100				552	return $root->{$last_key} if exists $root->{$last_key};
755							}
756
757							else { # try again
758	2					4	$skip = 0;
759							}
760
761							}
762
763	97					278	return undef;
764
765							}
766
767
768							sub print {
769
770	0			0	1	0	my $self = shift;
771	0					0	my $fh = shift;
772
773	0	0	0			0	ref $fh eq 'GLOB' \|\| ref \$fh eq 'GLOB'
774							? CORE::print $fh $self->{'output'}
775							: CORE::print $self->{'output'};
776
777	0					0	return 1;
778
779							}
780
781
782							sub fetch {
783	33			33	1	109	my $self = shift;
784	33					52	my $temp = $self->{'output'};
785	33					65	return \$temp;
786							}
787
788
789							sub clear {
790	1			1	1	6	my $self = shift;
791	1					3	$self->clear_vars();
792	1					2	$self->clear_out();
793	1					1	return 1;
794							}
795
796
797							sub clear_vars {
798	3			3	1	6	my $self = shift;
799	3					7	$self->{'vars'} = [{}];
800	3					10	$self->block();
801	3					5	return 1;
802							}
803
804
805							sub clear_out {
806	3			3	1	8	my $self = shift;
807	3					4	$self->{'output'} = '';
808	3					6	return 1;
809							}
810
811
812							sub clear_cache {
813	0			0	1		$CACHE = {};
814	0						return 1;
815							}
816
817
818							1;
819
820
821
822							=head1 NAME
823
824							HTML::KTemplate - Perl module to process HTML templates.
825
826
827							=head1 SYNOPSIS
828
829							B
830
831							#!/usr/bin/perl -w
832							use HTML::KTemplate;
833
834							$tpl = HTML::KTemplate->new('path/to/templates');
835
836							$tpl->assign( TITLE => 'Template Test Page' );
837							$tpl->assign( TEXT => 'Some welcome text ...' );
838
839							foreach (1 .. 3) {
840
841							$tpl->assign( LOOP,
842							TEXT => 'Just a test ...',
843							);
844
845							}
846
847							$tpl->process('template.tpl');
848
849							$tpl->print();
850
851							B
852
853
854							[% TITLE %]
855
856
857							Hello! [% TEXT %]
858
859
860
861							[% TEXT %]
862
863
864
865
866
867
868
869							B
870
871							Hello! Some welcome text ...
872
873							Just a test ...
874							Just a test ...
875							Just a test ...
876
877
878							=head1 MOTIVATION
879
880							Although there are many different template modules at CPAN, I couldn't find any that would meet my expectations. So I created this one with following features:
881
882							=over 4
883
884							=item *
885							Template syntax can consist only of variables and blocks.
886
887							=item *
888							Support for multidimensional data structures.
889
890							=item *
891							Everything is very simple and very fast.
892
893							=item *
894							Still there are many advanced options available.
895
896							=back
897
898							Please email me any comments, suggestions or bug reports to .
899
900
901							=head1 VARIABLES
902
903							By default, template variables are embedded within C<[% %]> and may contain any alphanumeric characters including the underscore and the hyphen. The values for the variables are assigned with C, passed as a hash or a hash reference.
904
905							%hash = (
906							VARIABLE => 'Value',
907							);
908
909							$tpl->assign( %hash );
910							$tpl->assign(\%hash );
911							$tpl->assign( VARIABLE => 'Value' );
912
913							To access a multidimensional hash data structure, the variable names are separated by a dot. In the following example, two values for the variables C<[% USER.NAME %]> and C<[% USER.EMAIL %]> are assigned:
914
915							$tpl->assign(
916
917							USER => {
918							NAME => 'Kasper Dziurdz', # [% USER.NAME %]
919							EMAIL => 'kasper@repsak.de', # [% USER.EMAIL %]
920							},
921
922							);
923
924							If the value of a variable is a reference to a subroutine, the subroutine is called and the returned string is included in the output. This is the only way to execute Perl code in a template.
925
926							$tpl->assign(
927
928							BENCHMARK => sub {
929							# get benchmark data
930							return 'created in 0.01 seconds';
931							}
932
933							);
934
935
936							=head1 BLOCKS
937
938							Blocks allow you to create loops and iterate over a part of a template or to write simple if-statements. A block begins with C<< >> and ends with C<< >>. This is an example of creating a block with the C method:
939
940							$tpl->assign( HEADER => 'Some numbers:' );
941
942							@block_values = ('One', 'Two', 'Three', 'Four');
943
944							foreach (@block_values) {
945
946							$tpl->block('LOOP_NUMBERS');
947							$tpl->assign( NUMBER => $_ );
948							$tpl->assign( SOMETHING => '' );
949
950							}
951
952							$tpl->block(); # leave block
953
954							$tpl->assign( FOOTER => '...in words.' );
955
956							Each time C is called it creates a new loop in the selected block. All variable values passed to C are assigned only to this loop until a new loop is created or C is called without any arguments to assign global variables again. This is a template for the script above:
957
958							[% HEADER %]
959
960
961
962							[% NUMBER %]
963
964
965
966							[% FOOTER %]
967
968							Global variables (or outer block variables) are also available inside a block. However, if there is a block variable with the same name, the block variable is preferred.
969
970							Because a block is a normal variable with an array reference, blocks can also be created without the C method:
971
972							$tpl->assign(
973							HEADER => 'Some numbers:',
974							LOOP_NUMBERS =>
975							[
976							{ NUMBER => 'One' },
977							{ NUMBER => 'Two' },
978							{ NUMBER => 'Three' },
979							{ NUMBER => 'Four' },
980							],
981							FOOTER => '...in words.',
982							);
983
984							Loops within loops work as you would expect. To create a nested loop with C, you have to pass all block names separate as a list or joined with a dot, for example as C. This way, a new loop for C is created in the last loop of C. The variable values are assigned with C.
985
986							foreach (@block_one) {
987
988							$tpl->block('BLOCK_1');
989							$tpl->assign(VAR => $_);
990
991							foreach (@block_two) {
992
993							$tpl->block('BLOCK_1', 'BLOCK_2');
994							$tpl->assign(VAR => $_);
995
996							}
997							}
998
999							$tpl->block(); # leave block
1000
1001							The template would look like this:
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011							B without any arguments to assign global variables again.>
1012
1013							It is also possible to create a loop with the C method by passing the block name as the first argument (or all block names joined with a dot to create nested loops). The variables can be assigned only once and not as a hash reference but there is no need to use the C method.
1014
1015							$tpl->assign( BLOCK, # assign to this block
1016							VARIABLE_1 => 'Block ...',
1017							VARIABLE_2 => 'Block ...',
1018							);
1019
1020							$tpl->assign( # assign global again
1021							VARIABLE_3 => 'Global ...'.
1022							);
1023
1024							Blocks can even be used to create if-statements. Simply assign a variable with a true or false value. Based on that, the block is skipped or included in the output.
1025
1026							$tpl->assign( SHOW_INFO => 1 ); # show block SHOW_INFO
1027							$tpl->assign( SHOW_LOGIN => 0 ); # skip block SHOW_LOGIN
1028
1029							For a better control of the loop output, three special loop variables can be made available inside a loop: C, C and C. This variables are disabled by default (see L section how to enable them).
1030
1031
1032
1033
1034
1035							First loop pass
1036
1037
1038
1039
1040							Neither first nor last
1041
1042
1043
1044
1045							Last loop pass
1046
1047
1048
1049
1050
1051
1052							=head1 INCLUDES
1053
1054							Includes are used to process and include the output of another template file directly into the current template in place of the include tag. All variables and blocks assigned to the current template are also available inside the included template.
1055
1056
1057
1058
1059
1060
1061
1062							If the template can't be found under the specified file path (considering the root path), the path to the enclosing file is tried. See L section how to disable includes or change the limit for recursive includes.
1063
1064							It is possible to include template files defined by a variable when the option for including variables is enabled (it is disabled by default).
1065
1066
1067
1068
1069							=head1 ADVANCED
1070
1071							Although it is possible to create loops and if statements with the block tag, sometimes the template syntax might get too confusing or not allow to write the wanted conditions in an easy way. For this reason if, unless, else and loop tags are available.
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094							The else tag can be used with all statements, even with loops. For an even cleaner template syntax, the else and the end tag can be written without the variable name.
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107							The following syntax is also allowed but will not work with the block tag:
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121							=head1 METHODS
1122
1123							=head2 new()
1124
1125							Creates a new template object.
1126
1127							$tpl = HTML::KTemplate->new();
1128
1129							$tpl = HTML::KTemplate->new('/path/to/templates');
1130
1131							$tpl = HTML::KTemplate->new(
1132							root => '/path/to/templates',
1133							cache => 0,
1134							strict => 0,
1135							no_includes => 0,
1136							max_includes => 15,
1137							loop_vars => 0,
1138							blind_cache => 0,
1139							include_vars => 0,
1140							parse_vars => 0,
1141							);
1142
1143
1144							=head2 assign()
1145
1146							Assigns values for the variables used in the template.
1147
1148							%hash = (
1149							VARIABLE => 'Value',
1150							);
1151
1152							$tpl->assign( %hash );
1153							$tpl->assign(\%hash );
1154							$tpl->assign( VARIABLE => 'Value' );
1155
1156							$tpl->assign( BLOCK,
1157							VARIABLE => 'Value',
1158							VARIABLE => 'Value',
1159							);
1160
1161							=head2 block()
1162
1163							See the description of L.
1164
1165							$tpl->block('BLOCK_1');
1166
1167							$tpl->block('BLOCK_1','BLOCK_2');
1168							$tpl->block('BLOCK_1.BLOCK_2');
1169
1170							$tpl->block(); # leave block
1171
1172							=head2 process()
1173
1174							The C method is called to process the template files passed as arguments. It loads each template file, parses it and adds it to the template output. It is also possible to pass a reference to a scalar, array or file handle to initialize the template from memory. The use of the template output is determined by the C or the C method.
1175
1176							$tpl->process('header.tpl', 'footer.tpl');
1177
1178							$tpl->process('header.tpl');
1179							$tpl->process('footer.tpl');
1180
1181							$tpl->process(\$scalar);
1182							$tpl->process(\@array);
1183							$tpl->process(\*FH);
1184
1185							=head2 print()
1186
1187							Prints the output data to C. If a file handle reference is passed, it is used instead of the standard output.
1188
1189							$tpl->print();
1190
1191							$tpl->print(\*FILE);
1192
1193							=head2 fetch()
1194
1195							Returns a scalar reference to the output data.
1196
1197							$output_ref = $tpl->fetch();
1198
1199							print FILE $$output_ref;
1200
1201							=head2 clear()
1202
1203							Clears all variable values and other data being held in memory (except cache data).
1204
1205							$tpl->clear();
1206
1207							Equivalent to:
1208
1209							$tpl->clear_vars();
1210							$tpl->clear_out();
1211
1212							=head2 clear_vars()
1213
1214							Clears all assigned variable values.
1215
1216							$tpl->clear_vars();
1217
1218							=head2 clear_out()
1219
1220							Clears all output data created by C.
1221
1222							$tpl->clear_out();
1223
1224							=head2 clear_cache()
1225
1226							Empties all cache data.
1227
1228							$tpl->clear_cache();
1229
1230
1231							=head1 OPTIONS
1232
1233							=head2 Variable Tag
1234
1235							$HTML::KTemplate::VAR_START_TAG = '[%';
1236							$HTML::KTemplate::VAR_END_TAG = '%]';
1237
1238							=head2 Block Tag
1239
1240							$HTML::KTemplate::BLOCK_START_TAG = '';
1242
1243							=head2 Include Tag
1244
1245							$HTML::KTemplate::INCLUDE_START_TAG = '';
1247
1248							=head2 Root
1249
1250							$HTML::KTemplate::ROOT = undef; # default
1251							$HTML::KTemplate::ROOT = '/path/to/templates';
1252
1253							$tpl = HTML::KTemplate->new( '/path/to/templates' );
1254							$tpl = HTML::KTemplate->new( root => '/path/to/templates' );
1255
1256							=head2 No Includes
1257
1258							Set this option to 1 to disable includes. The include tags will be skipped unless the strict option is set to 1.
1259
1260							$tpl = HTML::KTemplate->new( no_includes => 0 ); # default
1261							$tpl = HTML::KTemplate->new( no_includes => 1 );
1262
1263							=head2 Max Includes
1264
1265							Allows to set the maximum depth that includes can reach. An error is raised when this depth is exceeded.
1266
1267							$tpl = HTML::KTemplate->new( max_includes => 15 ); # default
1268
1269							=head2 Include Vars
1270
1271							Allows to include template files defined by a variable (see the description of L for more information).
1272
1273							$tpl = HTML::KTemplate->new( include_vars => 0 ); # default
1274							$tpl = HTML::KTemplate->new( include_vars => 1 );
1275
1276							=head2 Cache
1277
1278							Caching option for a persistent environment like mod_perl. Parsed templates will be cached in memory based on their file path and modification date. Use C to empty cache.
1279
1280							$tpl = HTML::KTemplate->new( cache => 0 ); # default
1281							$tpl = HTML::KTemplate->new( cache => 1 );
1282
1283							=head2 Blind Cache
1284
1285							Behaves as the normal caching option but does not check the modification date to see if the template has changed. This might result in some speed improvement over normal caching.
1286
1287							$tpl = HTML::KTemplate->new( blind_cache => 0 ); # default
1288							$tpl = HTML::KTemplate->new( blind_cache => 1 );
1289
1290							=head2 Loop Vars
1291
1292							Set this option to 1 to enable the loop variables C, C and C.
1293
1294							$tpl = HTML::KTemplate->new( loop_vars => 0 ); # default
1295							$tpl = HTML::KTemplate->new( loop_vars => 1 );
1296
1297							The default loop variables can be changed in the following way:
1298
1299							$HTML::KTemplate::FIRST = { 'FIRST' => 1, 'first' => 1 };
1300							$HTML::KTemplate::INNER = { 'INNER' => 1, 'inner' => 1 };
1301							$HTML::KTemplate::LAST = { 'LAST' => 1, 'last' => 1 };
1302
1303							=head2 Parse Vars
1304
1305							Set this option to 1 to parse variables. That way all template variables inside of a variable will be replaced with their assigned values.
1306
1307							$tpl = HTML::KTemplate->new( parse_vars => 0 ); # default
1308							$tpl = HTML::KTemplate->new( parse_vars => 1 );
1309
1310
1311							=head2 Strict
1312
1313							Set this option to 1 to raise errors on not defined variables and include tags when disabled.
1314
1315							$tpl = HTML::KTemplate->new( strict => 0 ); # default
1316							$tpl = HTML::KTemplate->new( strict => 1 );
1317
1318							=head2 Chomp
1319
1320							Removes the newline before and after a block tag.
1321
1322							$HTML::KTemplate::CHOMP = 1; # default
1323							$HTML::KTemplate::CHOMP = 0;
1324
1325
1326							=head1 MAILING LIST
1327
1328							If you want to get email when a new version of HTML::KTemplate is released, join the announcements mailing list:
1329
1330							http://lists.sourceforge.net/lists/listinfo/html-ktemplate-announce
1331
1332							A mailing list for discussing HTML::KTemplate is available at . To join, visit:
1333
1334							http://lists.sourceforge.net/lists/listinfo/html-ktemplate-users
1335
1336							You can also email me questions, comments, suggestions or bug reports directly to .
1337
1338
1339							=head1 WEBSITE
1340
1341							More information about HTML::KTemplate can be found at:
1342
1343							http://html-ktemplate.sourceforge.net/
1344
1345
1346							=head1 COPYRIGHT
1347
1348							Copyright (c) 2002-2003 Kasper Dziurdz. All rights reserved.
1349
1350							This module is free software; you can redistribute it and/or
1351							modify it under the same terms as Perl itself.
1352
1353							This program is distributed in the hope that it will be useful,
1354							but WITHOUT ANY WARRANTY; without even the implied warranty of
1355							MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1356							Artistic License for more details.
1357
1358							=head1 AUTHOR
1359
1360							Kasper Dziurdz
1361
1362							=cut
1363