line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Template::Qtpl; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
########################################################################### |
4
|
|
|
|
|
|
|
# Copyright (c) 2000 barnabÓs debreceni [cranx@scene.hu] |
5
|
|
|
|
|
|
|
# Original PHP version. |
6
|
|
|
|
|
|
|
# |
7
|
|
|
|
|
|
|
# Copyright(c) 2000-2001 Alexey Presnyakov [alexey_pres@sourceforge.net] |
8
|
|
|
|
|
|
|
# Perl port and extension. |
9
|
|
|
|
|
|
|
# |
10
|
|
|
|
|
|
|
# This library is free software; you can redistribute it and/or |
11
|
|
|
|
|
|
|
# modify it under the same terms as Perl itself. |
12
|
|
|
|
|
|
|
# |
13
|
|
|
|
|
|
|
# $Author: alexey_pres $, $Date: 2001/10/18 09:39:24 $ |
14
|
|
|
|
|
|
|
# $Revision: 1.2 $ |
15
|
|
|
|
|
|
|
########################################################################### |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
|
18
|
1
|
|
|
1
|
|
2801
|
use strict; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
51
|
|
19
|
1
|
|
|
1
|
|
7
|
use Carp; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
124
|
|
20
|
1
|
|
|
1
|
|
8
|
use File::Basename; |
|
1
|
|
|
|
|
6
|
|
|
1
|
|
|
|
|
2112
|
|
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
$Template::Qtpl::VERSION = '0.5'; |
23
|
|
|
|
|
|
|
$Template::Qtpl::file_delim = "\{FILE\s*\"(.+?)\"\s*\}"; |
24
|
|
|
|
|
|
|
$Template::Qtpl::block_start_delim = ''; |
26
|
|
|
|
|
|
|
$Template::Qtpl::block_start_word = 'BEGIN:'; |
27
|
|
|
|
|
|
|
$Template::Qtpl::block_end_word = 'END:'; |
28
|
|
|
|
|
|
|
$Template::Qtpl::var_begin = '{'; |
29
|
|
|
|
|
|
|
$Template::Qtpl::var_end = '}'; |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
############################ variable set functions ################ |
33
|
|
|
|
|
|
|
sub block_start_delim { |
34
|
0
|
|
|
0
|
1
|
0
|
my ($v) = shift; |
35
|
0
|
|
|
|
|
0
|
my $ret; |
36
|
0
|
0
|
|
|
|
0
|
$v = shift if ((ref $v) eq 'Template::Qtpl'); |
37
|
0
|
|
|
|
|
0
|
$ret = $Template::Qtpl::block_start_delim; |
38
|
0
|
0
|
|
|
|
0
|
$Template::Qtpl::block_start_delim = $v if (length $v); |
39
|
0
|
|
|
|
|
0
|
return $ret; |
40
|
|
|
|
|
|
|
} |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
sub block_end_delim { |
43
|
0
|
|
|
0
|
1
|
0
|
my ($v) = shift; |
44
|
0
|
|
|
|
|
0
|
my $ret; |
45
|
0
|
0
|
|
|
|
0
|
$v = shift if ((ref $v) eq 'Template::Qtpl'); |
46
|
0
|
|
|
|
|
0
|
$ret = $Template::Qtpl::block_end_delim; |
47
|
0
|
0
|
|
|
|
0
|
$Template::Qtpl::block_end_delim = $v if (length $v); |
48
|
0
|
|
|
|
|
0
|
return $ret; |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
sub block_start_word { |
52
|
0
|
|
|
0
|
1
|
0
|
my ($v) = shift; |
53
|
0
|
|
|
|
|
0
|
my $ret; |
54
|
0
|
0
|
|
|
|
0
|
$v = shift if ((ref $v) eq 'Template::Qtpl'); |
55
|
0
|
|
|
|
|
0
|
$ret = $Template::Qtpl::block_start_word; |
56
|
0
|
0
|
|
|
|
0
|
$Template::Qtpl::block_start_word = $v if (length $v); |
57
|
0
|
|
|
|
|
0
|
return $ret; |
58
|
|
|
|
|
|
|
} |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
sub block_end_word { |
61
|
0
|
|
|
0
|
1
|
0
|
my ($v) = shift; |
62
|
0
|
|
|
|
|
0
|
my $ret; |
63
|
0
|
0
|
|
|
|
0
|
$v = shift if ((ref $v) eq 'Template::Qtpl'); |
64
|
0
|
|
|
|
|
0
|
$ret = $Template::Qtpl::block_end_word; |
65
|
0
|
0
|
|
|
|
0
|
$Template::Qtpl::block_end_word = $v if (length $v); |
66
|
0
|
|
|
|
|
0
|
return $ret; |
67
|
|
|
|
|
|
|
} |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
sub var_begin { |
70
|
0
|
|
|
0
|
1
|
0
|
my ($v) = shift; |
71
|
0
|
|
|
|
|
0
|
my $ret; |
72
|
0
|
0
|
|
|
|
0
|
$v = shift if ((ref $v) eq 'Template::Qtpl'); |
73
|
0
|
|
|
|
|
0
|
$ret = $Template::Qtpl::var_begin; |
74
|
0
|
0
|
|
|
|
0
|
$Template::Qtpl::block_start_word = $v if (length $v); |
75
|
0
|
|
|
|
|
0
|
return $ret; |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
sub var_end { |
79
|
0
|
|
|
0
|
1
|
0
|
my ($v) = shift; |
80
|
0
|
|
|
|
|
0
|
my $ret; |
81
|
0
|
0
|
|
|
|
0
|
$v = shift if ((ref $v) eq 'Template::Qtpl'); |
82
|
0
|
|
|
|
|
0
|
$ret = $Template::Qtpl::var_end; |
83
|
0
|
0
|
|
|
|
0
|
$Template::Qtpl::block_end_word = $v if (length $v); |
84
|
0
|
|
|
|
|
0
|
return $ret; |
85
|
|
|
|
|
|
|
} |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
sub file_delim { |
88
|
0
|
|
|
0
|
1
|
0
|
my ($v) = shift; |
89
|
0
|
|
|
|
|
0
|
my $ret; |
90
|
0
|
0
|
|
|
|
0
|
$v = shift if ((ref $v) eq 'Template::Qtpl'); |
91
|
0
|
|
|
|
|
0
|
$ret = $Template::Qtpl::file_delim; |
92
|
0
|
0
|
|
|
|
0
|
$Template::Qtpl::file_delim = $v if (length $v); |
93
|
0
|
|
|
|
|
0
|
return $ret; |
94
|
|
|
|
|
|
|
} |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
############################ new ################################### |
97
|
|
|
|
|
|
|
sub new { |
98
|
1
|
|
|
1
|
1
|
11
|
my $class = shift; |
99
|
1
|
|
|
|
|
3
|
my $self = {}; |
100
|
1
|
|
|
|
|
2
|
bless $self, $class; |
101
|
1
|
|
|
|
|
6
|
$self->init(@_); |
102
|
1
|
|
|
|
|
3
|
return $self; |
103
|
|
|
|
|
|
|
} |
104
|
|
|
|
|
|
|
############################## init ################################ |
105
|
|
|
|
|
|
|
sub init { |
106
|
1
|
|
|
1
|
0
|
3
|
my $self = shift; |
107
|
1
|
|
|
|
|
3
|
my ($filename, $mainblock) = @_; |
108
|
|
|
|
|
|
|
##### set vars |
109
|
1
|
|
|
|
|
7
|
$self->{filecontents} = ''; |
110
|
1
|
|
|
|
|
4
|
$self->{blocks} = {}; |
111
|
1
|
|
|
|
|
3
|
$self->{parsed_blocks} = {}; |
112
|
1
|
|
|
|
|
4
|
$self->{block_parse_order} = []; |
113
|
1
|
|
|
|
|
3
|
$self->{sub_blocks} = {}; |
114
|
1
|
|
|
|
|
2
|
$self->{VARS} = {}; |
115
|
|
|
|
|
|
|
#this makes the delimiters look like: if you use my syntax. |
116
|
1
|
|
|
|
|
4
|
$self->{NULL_STRING} = {''=>''}; |
117
|
1
|
|
|
|
|
5
|
$self->{NULL_BLOCK} = {''=>''}; |
118
|
1
|
|
|
|
|
3
|
$self->{mainblock} = ''; |
119
|
1
|
|
|
|
|
3
|
$self->{ERROR} = ''; |
120
|
1
|
|
|
|
|
3
|
$self->{AUTORESET} = 1; |
121
|
|
|
|
|
|
|
####### init variables |
122
|
1
|
|
|
|
|
1
|
$self->{mainblock} = $mainblock; |
123
|
1
|
|
|
|
|
3
|
$self->{FILENAME} = $filename; |
124
|
1
|
|
|
|
|
6
|
$self->{filecontents} = $self->r_getfile($filename); |
125
|
1
|
|
|
|
|
6
|
$self->{blocks} = $self->maketree($self->{filecontents}, $mainblock); |
126
|
1
|
|
|
|
|
6
|
$self->scan_globals(); |
127
|
1
|
|
|
|
|
2
|
return $self; |
128
|
|
|
|
|
|
|
} |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
sub assign { |
131
|
3
|
|
|
3
|
1
|
421
|
my $self = shift; |
132
|
3
|
|
|
|
|
5
|
my ($k, $v); |
133
|
3
|
|
|
|
|
8
|
while (scalar(@_)){ |
134
|
3
|
|
|
|
|
4
|
$k = shift; |
135
|
3
|
|
|
|
|
4
|
$v = shift; |
136
|
3
|
|
|
|
|
14
|
$self->{VARS}{$k} = $v; |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
} |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
sub get_var{ |
141
|
6
|
|
|
6
|
0
|
6
|
my $self = shift; |
142
|
6
|
|
|
|
|
7
|
my $v = shift; #variable name for subst |
143
|
6
|
|
|
|
|
4
|
my $need_encode = 0; |
144
|
6
|
50
|
|
|
|
10
|
if ($v =~ /^\~(.+)$/){ |
145
|
0
|
|
|
|
|
0
|
$v = $1; |
146
|
0
|
|
|
|
|
0
|
$need_encode = 1; |
147
|
|
|
|
|
|
|
} |
148
|
6
|
|
|
|
|
14
|
my @sub = split(/\./,$v); |
149
|
6
|
|
|
|
|
6
|
my $var; |
150
|
6
|
100
|
|
|
|
17
|
if ($sub[0] =~ /^main::(.+)$/){ |
151
|
1
|
|
|
1
|
|
9
|
no strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
4351
|
|
152
|
2
|
|
|
|
|
9
|
my $varname = $sub[0]; |
153
|
2
|
50
|
|
|
|
4
|
if (scalar(@sub)>1) { |
154
|
2
|
|
|
|
|
6
|
$var = \%$varname; |
155
|
2
|
|
|
|
|
2
|
shift @sub; |
156
|
2
|
|
|
|
|
7
|
goto FROM_GLOBALS; |
157
|
|
|
|
|
|
|
} else { |
158
|
0
|
|
|
|
|
0
|
$var = $$varname; |
159
|
|
|
|
|
|
|
} |
160
|
|
|
|
|
|
|
} else { |
161
|
4
|
|
|
|
|
6
|
$var=$self->{VARS}; |
162
|
6
|
|
|
|
|
4
|
FROM_GLOBALS: |
163
|
|
|
|
|
|
|
my $sv; |
164
|
6
|
|
|
|
|
7
|
foreach $sv (@sub){ |
165
|
9
|
|
|
|
|
18
|
$var = $var->{$sv}; |
166
|
|
|
|
|
|
|
} |
167
|
|
|
|
|
|
|
} |
168
|
6
|
50
|
|
|
|
12
|
if ($need_encode) { |
169
|
0
|
|
|
|
|
0
|
$var =~ s/\"/\"/g; |
170
|
|
|
|
|
|
|
} |
171
|
6
|
|
|
|
|
22
|
return $var; |
172
|
|
|
|
|
|
|
} |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
sub _if_subst { |
175
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
176
|
0
|
|
|
|
|
0
|
my ($if, $body) = @_; |
177
|
0
|
|
|
|
|
0
|
my $if_val = $self->get_var($if); |
178
|
0
|
|
|
|
|
0
|
my @parts = split(/$Template::Qtpl::var_begin[E]LSE$Template::Qtpl::var_end/, $body); |
179
|
0
|
0
|
|
|
|
0
|
if (length $if_val) { |
180
|
0
|
|
|
|
|
0
|
return $parts[0]; |
181
|
|
|
|
|
|
|
} else { |
182
|
0
|
|
|
|
|
0
|
return $parts[1]; |
183
|
|
|
|
|
|
|
} |
184
|
|
|
|
|
|
|
} |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
sub parse { |
187
|
4
|
|
|
4
|
1
|
13
|
my $self = shift; |
188
|
4
|
|
|
|
|
5
|
my ($bname) = @_; |
189
|
4
|
|
|
|
|
8
|
my $copy = $self->{blocks}->{$bname}; |
190
|
|
|
|
|
|
|
|
191
|
4
|
50
|
|
|
|
10
|
$self->set_error("parse: blockname [$bname] does not exist") |
192
|
|
|
|
|
|
|
unless (defined($self->{blocks}->{$bname})); |
193
|
|
|
|
|
|
|
|
194
|
4
|
|
|
|
|
77
|
while ($self->{blocks}->{$bname} =~ |
195
|
|
|
|
|
|
|
/$Template::Qtpl::var_begin([\~\w\.\:]+)$Template::Qtpl::var_end/g) { |
196
|
9
|
|
|
|
|
15
|
my $v = $1; |
197
|
9
|
50
|
|
|
|
14
|
next if ($v =~ /^IF\s+/); |
198
|
9
|
50
|
|
|
|
12
|
next if ($v =~ /^(ELSE|ENDIF)$/); |
199
|
9
|
100
|
|
|
|
20
|
if ($v =~ /^_BLOCK_\.(.+)$/) { |
200
|
3
|
|
|
|
|
5
|
my $bname2=$1; |
201
|
3
|
|
|
|
|
4
|
my $var=$self->{parsed_blocks}->{$bname2}; |
202
|
3
|
50
|
|
|
|
9
|
my $nul=(!exists($self->{NULL_BLOCK}->{$bname2})) ? |
203
|
|
|
|
|
|
|
$self->{NULL_BLOCK}{''} : |
204
|
|
|
|
|
|
|
$self->{NULL_BLOCK}->{$bname2}; |
205
|
3
|
50
|
|
|
|
7
|
$var=(!defined($var))?$nul:$var; |
206
|
3
|
|
|
|
|
32
|
$copy =~ s/$Template::Qtpl::var_begin$v$Template::Qtpl::var_end/$var/eg; |
|
3
|
|
|
|
|
26
|
|
207
|
|
|
|
|
|
|
} else { |
208
|
6
|
|
|
|
|
13
|
my $var = $self->get_var($v); |
209
|
6
|
50
|
|
|
|
15
|
my $nul=(!exists($self->{NULL_STRING}{$v})) ? |
210
|
|
|
|
|
|
|
$self->{NULL_STRING}{''} : |
211
|
|
|
|
|
|
|
$self->{NULL_STRING}{$v}; |
212
|
6
|
100
|
|
|
|
10
|
$var=(!length($var))?$nul:$var; |
213
|
6
|
50
|
|
|
|
73
|
$copy =~ s/$Template::Qtpl::var_begin$v$Template::Qtpl::var_end/$var/eg |
|
6
|
|
|
|
|
51
|
|
214
|
|
|
|
|
|
|
unless ($v =~ /^\d/); |
215
|
|
|
|
|
|
|
} |
216
|
|
|
|
|
|
|
} |
217
|
|
|
|
|
|
|
# parse if tags |
218
|
4
|
|
|
|
|
24
|
$copy =~ s/$Template::Qtpl::var_begin[I]F\s+(.+?)\s*$Template::Qtpl::var_end(.*?)$Template::Qtpl::var_begin[E]NDIF$Template::Qtpl::var_end/$self->_if_subst($1, $2)/egs; |
|
0
|
|
|
|
|
0
|
|
219
|
|
|
|
|
|
|
|
220
|
4
|
|
|
|
|
7
|
my ($bname_new) = split(/\:/, $bname); |
221
|
|
|
|
|
|
|
#save as to parsed |
222
|
4
|
|
|
|
|
10
|
$self->{parsed_blocks}->{$bname_new}.=$copy; |
223
|
|
|
|
|
|
|
#reset sub-blocks |
224
|
4
|
|
|
|
|
3
|
my ($bname3); |
225
|
4
|
50
|
|
|
|
10
|
if ($self->{AUTORESET}) { |
226
|
4
|
50
|
|
|
|
9
|
if (exists($self->{sub_blocks}->{$bname_new})) { |
227
|
4
|
|
|
|
|
3
|
foreach $bname3 (@{$self->{sub_blocks}->{$bname_new}}){ |
|
4
|
|
|
|
|
8
|
|
228
|
7
|
50
|
|
|
|
11
|
next unless length ($bname_new); |
229
|
7
|
|
|
|
|
13
|
$self->reset($bname3); |
230
|
|
|
|
|
|
|
} |
231
|
|
|
|
|
|
|
} |
232
|
|
|
|
|
|
|
} |
233
|
|
|
|
|
|
|
} |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
#***[ rparse ]**************************************************************/ |
236
|
|
|
|
|
|
|
#* returns the parsed text for a block, including all sub-blocks. |
237
|
|
|
|
|
|
|
sub rparse { |
238
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
239
|
0
|
|
|
|
|
0
|
my $bname = shift; |
240
|
0
|
0
|
|
|
|
0
|
if (exists($self->{sub_blocks}->{$bname})) { |
241
|
0
|
|
|
|
|
0
|
my ($bname3); |
242
|
0
|
|
|
|
|
0
|
foreach $bname3 (@{$self->{sub_blocks}->{$bname}}){ |
|
0
|
|
|
|
|
0
|
|
243
|
0
|
0
|
|
|
|
0
|
next if (!length $bname3); |
244
|
0
|
|
|
|
|
0
|
$self->rparse($bname3); |
245
|
|
|
|
|
|
|
} |
246
|
|
|
|
|
|
|
} |
247
|
0
|
|
|
|
|
0
|
$self->parse($bname); |
248
|
|
|
|
|
|
|
} |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
#***[ text ]****************************************************************/ |
251
|
|
|
|
|
|
|
#* returns the parsed text for a block |
252
|
|
|
|
|
|
|
sub text { |
253
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
254
|
0
|
|
|
|
|
0
|
my ($bname) = @_; |
255
|
0
|
0
|
|
|
|
0
|
if (!length($bname)) { |
256
|
0
|
|
|
|
|
0
|
$bname=$self->{mainblock}; |
257
|
|
|
|
|
|
|
} |
258
|
0
|
|
|
|
|
0
|
return $self->{parsed_blocks}->{$bname}; |
259
|
|
|
|
|
|
|
} |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
#/***[ out ]*****************************************************************/ |
262
|
|
|
|
|
|
|
#/* prints the parsed text |
263
|
|
|
|
|
|
|
sub out { |
264
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
265
|
0
|
|
|
|
|
0
|
my ($bname) = @_; |
266
|
0
|
|
|
|
|
0
|
print $self->text($bname); |
267
|
|
|
|
|
|
|
} |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
#/***[ reset ]***************************************************************/ |
270
|
|
|
|
|
|
|
#/* resets the parsed text |
271
|
|
|
|
|
|
|
sub reset { |
272
|
7
|
|
|
7
|
0
|
7
|
my $self = shift; |
273
|
7
|
|
|
|
|
8
|
my ($bname) = @_; |
274
|
7
|
|
|
|
|
20
|
$self->{parsed_blocks}->{$bname}=''; |
275
|
|
|
|
|
|
|
} |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
#***[ parsed ]**************************************************************/ |
278
|
|
|
|
|
|
|
#* returns true if block was parsed, false if not |
279
|
|
|
|
|
|
|
sub parsed { |
280
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
281
|
0
|
|
|
|
|
0
|
my ($bname) = @_; |
282
|
0
|
|
|
|
|
0
|
return (defined($self->{parsed_blocks}->{$bname})); |
283
|
|
|
|
|
|
|
} |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
#***[ SetNullString ]*******************************************************/ |
286
|
|
|
|
|
|
|
#* sets the string to replace in case the var was not assigned |
287
|
|
|
|
|
|
|
sub SetNullString { |
288
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
289
|
0
|
|
|
|
|
0
|
my ($str, $varname) = @_; |
290
|
0
|
|
|
|
|
0
|
$self->{NULL_STRING}{$varname}=$str; |
291
|
|
|
|
|
|
|
} |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
#***[ SetNullBlock ]********************************************************/ |
294
|
|
|
|
|
|
|
#* sets the string to replace in case the block was not parsed |
295
|
|
|
|
|
|
|
sub SetNullBlock { |
296
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
297
|
0
|
|
|
|
|
0
|
my ($str, $bname) = @_; |
298
|
0
|
|
|
|
|
0
|
$self->{NULL_BLOCK}{$bname}=$str; |
299
|
|
|
|
|
|
|
} |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
#***[ set_autoreset ]*******************************************************/ |
302
|
|
|
|
|
|
|
#* sets AUTORESET to 1. (default is 1) |
303
|
|
|
|
|
|
|
# if set to 1, parse() automatically resets the parsed blocks' sub blocks |
304
|
|
|
|
|
|
|
# (for multiple level blocks) |
305
|
|
|
|
|
|
|
sub set_autoreset { |
306
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
307
|
0
|
|
|
|
|
0
|
$self->{AUTORESET}=1; |
308
|
|
|
|
|
|
|
} |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
#/***[ clear_autoreset ]*****************************************************/ |
311
|
|
|
|
|
|
|
#/* |
312
|
|
|
|
|
|
|
# sets AUTORESET to 0. (default is 1) |
313
|
|
|
|
|
|
|
# if set to 1, parse() automatically resets the parsed blocks' sub blocks |
314
|
|
|
|
|
|
|
# (for multiple level blocks) |
315
|
|
|
|
|
|
|
sub clear_autoreset { |
316
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
317
|
0
|
|
|
|
|
0
|
$self->{AUTORESET}=0; |
318
|
|
|
|
|
|
|
} |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
#/***[ scan_globals ]********************************************************/ |
321
|
|
|
|
|
|
|
#/* |
322
|
|
|
|
|
|
|
# scans global variables |
323
|
|
|
|
|
|
|
#*/ |
324
|
|
|
|
|
|
|
sub scan_globals { |
325
|
1
|
|
|
1
|
0
|
2
|
my $self = shift; |
326
|
1
|
|
|
|
|
5
|
$self->assign("PHP",\%ENV); |
327
|
|
|
|
|
|
|
#* access global variables as {ENV.HTTP_HOST} in your template! */ |
328
|
|
|
|
|
|
|
} |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
#/****** |
331
|
|
|
|
|
|
|
# |
332
|
|
|
|
|
|
|
# WARNING |
333
|
|
|
|
|
|
|
# PUBLIC FUNCTIONS BELOW THIS LINE DIDN'T GET TESTED |
334
|
|
|
|
|
|
|
# |
335
|
|
|
|
|
|
|
#******/ |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
#/***************************************************************************/ |
339
|
|
|
|
|
|
|
#/***[ private stuff ]*******************************************************/ |
340
|
|
|
|
|
|
|
#/***************************************************************************/ |
341
|
|
|
|
|
|
|
#/***[ maketree ]************************************************************/ |
342
|
|
|
|
|
|
|
#/* |
343
|
|
|
|
|
|
|
# generates the array containing to-be-parsed stuff: |
344
|
|
|
|
|
|
|
# $blocks["main"],$blocks["main.table"],$blocks["main.table.row"], etc. |
345
|
|
|
|
|
|
|
# also builds the reverse parse order. |
346
|
|
|
|
|
|
|
#*/ |
347
|
|
|
|
|
|
|
sub maketree { |
348
|
1
|
|
|
1
|
0
|
3
|
my $self = shift; |
349
|
1
|
|
|
|
|
2
|
my ($con, $block) = @_; |
350
|
1
|
|
|
|
|
25
|
my @con2=split($Template::Qtpl::block_start_delim,$con); |
351
|
1
|
|
|
|
|
4
|
my $level=0; |
352
|
1
|
|
|
|
|
3
|
my @block_names = (''); |
353
|
1
|
|
|
|
|
3
|
my %blocks=(); |
354
|
1
|
|
|
|
|
1
|
my $parent_name; |
355
|
1
|
|
|
|
|
2
|
my ($k,$v, @res); |
356
|
1
|
|
|
|
|
2
|
my %added_to_parent = (); |
357
|
1
|
|
|
|
|
4
|
foreach $v (@con2){ |
358
|
9
|
|
|
|
|
26
|
my $patt="($Template::Qtpl::block_start_word|$Template::Qtpl::block_end_word)\\s*([\\w\\.\\:]+)\\s*$Template::Qtpl::block_end_delim(.*)"; |
359
|
9
|
100
|
|
|
|
163
|
if ($v =~ /$patt/is) { |
360
|
|
|
|
|
|
|
# $res[1] = BEGIN or END |
361
|
|
|
|
|
|
|
# $res[2] = block name |
362
|
|
|
|
|
|
|
# $res[3] = kinda content |
363
|
8
|
|
|
|
|
122
|
$res[1] = $1; |
364
|
8
|
|
|
|
|
13
|
$res[2] = $2; |
365
|
8
|
|
|
|
|
18
|
$res[3] = $3; |
366
|
8
|
100
|
|
|
|
39
|
if ($res[1] eq $Template::Qtpl::block_start_word) { |
|
|
50
|
|
|
|
|
|
367
|
4
|
50
|
|
|
|
12
|
$parent_name=@block_names ? join(".", @block_names) : ''; |
368
|
4
|
|
|
|
|
12
|
$parent_name =~ s/^\.//; #hack |
369
|
4
|
|
|
|
|
10
|
$block_names[++$level ] = $res[2]; |
370
|
|
|
|
|
|
|
#/* add one level - array("main","table","row")*/ |
371
|
4
|
|
|
|
|
11
|
my @block_nm = @block_names; |
372
|
4
|
|
|
|
|
5
|
shift @block_nm; |
373
|
4
|
|
|
|
|
10
|
my $cur_block_name=join(".",@block_nm); |
374
|
|
|
|
|
|
|
#/* make block name (main.table.row) */ |
375
|
4
|
|
|
|
|
5
|
push @{$self->{block_parse_order}}, $cur_block_name; |
|
4
|
|
|
|
|
8
|
|
376
|
|
|
|
|
|
|
#/* build block parsing order (reverse) */ |
377
|
4
|
|
|
|
|
14
|
$blocks{$cur_block_name}.=$res[3]; |
378
|
|
|
|
|
|
|
|
379
|
4
|
|
|
|
|
9
|
my ($cur_block_name_new) = split(/\:/, $cur_block_name); |
380
|
|
|
|
|
|
|
#/* add contents */ |
381
|
|
|
|
|
|
|
#/* add {_BLOCK_.blockname} string to parent block */ |
382
|
4
|
50
|
|
|
|
14
|
if (!$added_to_parent{$cur_block_name_new}) { |
383
|
4
|
|
|
|
|
23
|
$blocks{$parent_name}.=$Template::Qtpl::var_begin."_BLOCK_.$cur_block_name_new".$Template::Qtpl::var_end; |
384
|
|
|
|
|
|
|
#/* store sub block names for autoresetting |
385
|
|
|
|
|
|
|
# and recursive parsing */ |
386
|
4
|
|
|
|
|
5
|
push @{$self->{sub_blocks}->{$parent_name}}, |
|
4
|
|
|
|
|
19
|
|
387
|
|
|
|
|
|
|
$cur_block_name_new; |
388
|
|
|
|
|
|
|
#/* store sub block names for autoresetting */ |
389
|
4
|
|
|
|
|
5
|
push @{$self->{sub_blocks}->{$cur_block_name_new}},''; |
|
4
|
|
|
|
|
15
|
|
390
|
|
|
|
|
|
|
} |
391
|
4
|
|
|
|
|
15
|
$added_to_parent{$cur_block_name_new}++; |
392
|
|
|
|
|
|
|
} elsif ($res[1] eq $Template::Qtpl::block_end_word) { |
393
|
4
|
|
|
|
|
8
|
splice(@block_names, $level--, 1); |
394
|
4
|
|
|
|
|
10
|
$parent_name=join(".",@block_names); |
395
|
4
|
|
|
|
|
58
|
$parent_name =~ s/^\.//; #hack |
396
|
4
|
|
|
|
|
24
|
$blocks{$parent_name}.=$res[3]; |
397
|
|
|
|
|
|
|
#/* add rest of block to parent block */ |
398
|
|
|
|
|
|
|
} else { #if there is not block |
399
|
0
|
|
|
|
|
0
|
$parent_name=join(".",@block_names); |
400
|
0
|
|
|
|
|
0
|
$parent_name =~ s/^\.//; #hack |
401
|
0
|
|
|
|
|
0
|
$blocks{$parent_name}.=$Template::Qtpl::block_start_delim . $v; |
402
|
|
|
|
|
|
|
} } |
403
|
|
|
|
|
|
|
} |
404
|
1
|
|
|
|
|
7
|
return \%blocks; |
405
|
|
|
|
|
|
|
} |
406
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
#/***[ error stuff ]*********************************************************/ |
410
|
|
|
|
|
|
|
#/* |
411
|
|
|
|
|
|
|
# sets and gets error |
412
|
|
|
|
|
|
|
#*/ |
413
|
|
|
|
|
|
|
sub get_error { |
414
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
415
|
0
|
0
|
|
|
|
0
|
return ($self->{ERROR} eq '') ? 0 : $self->{ERROR}; |
416
|
|
|
|
|
|
|
} |
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
sub set_error { |
420
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
421
|
0
|
|
|
|
|
0
|
my $str = shift; |
422
|
0
|
|
|
|
|
0
|
$self->{ERROR}=$str; |
423
|
0
|
|
|
|
|
0
|
die "$self->{ERROR}\n"; |
424
|
|
|
|
|
|
|
} |
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
#/***[ getfile ]*************************************************************/ |
427
|
|
|
|
|
|
|
#/* returns the contents of a file |
428
|
|
|
|
|
|
|
sub getfile { |
429
|
1
|
|
|
1
|
0
|
2
|
my $self = shift; |
430
|
1
|
|
|
|
|
2
|
my $file = shift; |
431
|
1
|
50
|
|
|
|
4
|
if (!length($file)) { |
432
|
0
|
|
|
|
|
0
|
$self->set_error("Empty file name!"); |
433
|
0
|
|
|
|
|
0
|
return ''; |
434
|
|
|
|
|
|
|
} |
435
|
|
|
|
|
|
|
#find path of original template |
436
|
1
|
50
|
33
|
|
|
6
|
if (($self->{FILENAME} ne $file) && dirname($self->{FILENAME})){ |
437
|
0
|
|
|
|
|
0
|
$file = dirname($self->{FILENAME}) . '/' .$file; |
438
|
|
|
|
|
|
|
} |
439
|
1
|
50
|
|
|
|
48
|
unless (open(XTPLFILE, $file)){ |
440
|
0
|
|
|
|
|
0
|
$self->set_error("Cannot open file: $file or file not exists"); |
441
|
0
|
|
|
|
|
0
|
return ''; |
442
|
|
|
|
|
|
|
} |
443
|
1
|
|
|
|
|
49
|
my @file_text = ; |
444
|
1
|
|
|
|
|
13
|
close(XTPLFILE); |
445
|
1
|
|
|
|
|
12
|
return join('',@file_text); |
446
|
|
|
|
|
|
|
} |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
#/***[ r_getfile ]***********************************************************/ |
449
|
|
|
|
|
|
|
#/* |
450
|
|
|
|
|
|
|
# recursively gets the content of a file with {FILE "filename.tpl"} directives |
451
|
|
|
|
|
|
|
#*/ |
452
|
|
|
|
|
|
|
sub r_getfile($file) { |
453
|
1
|
|
|
1
|
0
|
1
|
my $self = shift; |
454
|
1
|
|
|
|
|
2
|
my $file = shift; |
455
|
1
|
|
|
|
|
5
|
my $text=$self->getfile($file); |
456
|
1
|
|
|
|
|
7
|
while ($text =~ /(\{FILE\s*")(.+?)(\"\s*\})/g){ |
457
|
0
|
|
|
|
|
0
|
my $full = $1.$2.$3; |
458
|
0
|
|
|
|
|
0
|
my $text2=$self->getfile($2); |
459
|
0
|
|
|
|
|
0
|
$text =~ s/$full/$text2/gi; |
460
|
|
|
|
|
|
|
} |
461
|
1
|
|
|
|
|
3
|
return $text; |
462
|
|
|
|
|
|
|
} |
463
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
1; |
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
__END__ |