line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Template::Nest; |
2
|
|
|
|
|
|
|
|
3
|
7
|
|
|
7
|
|
521845
|
use strict; |
|
7
|
|
|
|
|
74
|
|
|
7
|
|
|
|
|
220
|
|
4
|
7
|
|
|
7
|
|
39
|
use warnings; |
|
7
|
|
|
|
|
13
|
|
|
7
|
|
|
|
|
185
|
|
5
|
7
|
|
|
7
|
|
37
|
use File::Spec; |
|
7
|
|
|
|
|
11
|
|
|
7
|
|
|
|
|
137
|
|
6
|
7
|
|
|
7
|
|
33
|
use Carp; |
|
7
|
|
|
|
|
13
|
|
|
7
|
|
|
|
|
380
|
|
7
|
7
|
|
|
7
|
|
4817
|
use Data::Dumper; |
|
7
|
|
|
|
|
50946
|
|
|
7
|
|
|
|
|
19361
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
our $VERSION = '0.11'; |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
sub new{ |
12
|
8
|
|
|
8
|
1
|
863
|
my ($class,%opts) = @_; |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
# defaults: |
16
|
8
|
|
|
|
|
106
|
my $self = { |
17
|
|
|
|
|
|
|
comment_delims => [ '' ], |
18
|
|
|
|
|
|
|
token_delims => [ '<%','%>' ], |
19
|
|
|
|
|
|
|
name_label => 'NAME', |
20
|
|
|
|
|
|
|
template_dir => '', |
21
|
|
|
|
|
|
|
template_ext => '.html', |
22
|
|
|
|
|
|
|
show_labels => 0, |
23
|
|
|
|
|
|
|
defaults => {}, |
24
|
|
|
|
|
|
|
defaults_namespace_char => '.', |
25
|
|
|
|
|
|
|
fixed_indent => 0, |
26
|
|
|
|
|
|
|
die_on_bad_params => 1, |
27
|
|
|
|
|
|
|
escape_char => "\\" |
28
|
|
|
|
|
|
|
}; |
29
|
|
|
|
|
|
|
|
30
|
8
|
|
|
|
|
20
|
bless $self,$class; |
31
|
|
|
|
|
|
|
|
32
|
8
|
100
|
|
|
|
33
|
if ( %opts ){ |
33
|
7
|
|
|
|
|
31
|
for my $k (keys %opts){ |
34
|
39
|
50
|
|
|
|
156
|
confess "$k is not a valid option" unless defined $self->can($k); |
35
|
39
|
|
|
|
|
136
|
$self->$k( $opts{$k} ); |
36
|
|
|
|
|
|
|
} |
37
|
|
|
|
|
|
|
} |
38
|
|
|
|
|
|
|
|
39
|
8
|
|
|
|
|
38
|
return $self; |
40
|
|
|
|
|
|
|
} |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
sub template_dir{ |
44
|
87
|
|
|
87
|
1
|
2359
|
my($self,$dir) = @_; |
45
|
87
|
50
|
66
|
|
|
247
|
confess "Expected a scalar directory name but got a ".ref($dir) if $dir && ref($dir); |
46
|
87
|
100
|
|
|
|
232
|
$self->{template_dir} = $dir if $dir; |
47
|
87
|
|
|
|
|
205
|
return $self->{template_dir}; |
48
|
|
|
|
|
|
|
} |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
sub template_hash{ |
52
|
4
|
|
|
4
|
0
|
906
|
my ($self,$template_hash) = @_; |
53
|
|
|
|
|
|
|
|
54
|
4
|
100
|
|
|
|
16
|
$self->{template_hash} = $template_hash if $template_hash; |
55
|
4
|
|
|
|
|
15
|
return $self->{template_hash}; |
56
|
|
|
|
|
|
|
} |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
sub defaults{ |
60
|
7
|
|
|
7
|
1
|
3501
|
my ($self,$defaults) = @_; |
61
|
|
|
|
|
|
|
|
62
|
7
|
100
|
|
|
|
24
|
if ( $defaults ){ |
63
|
|
|
|
|
|
|
|
64
|
5
|
50
|
|
|
|
27
|
confess "defaults should be a hashref" unless ref $defaults eq ref {}; |
65
|
5
|
|
|
|
|
18
|
$self->{defaults} = $defaults; |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
} |
68
|
|
|
|
|
|
|
|
69
|
7
|
|
|
|
|
23
|
return $self->{defaults}; |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
sub defaults_namespace_char{ |
74
|
30
|
|
|
30
|
1
|
1301
|
my ($self,$char) = @_; |
75
|
|
|
|
|
|
|
|
76
|
30
|
100
|
|
|
|
75
|
if ( defined $char ){ |
77
|
10
|
100
|
|
|
|
51
|
if ( $char eq '' ){ |
78
|
7
|
|
|
|
|
24
|
$self->{defaults_namespace_char} = ''; |
79
|
|
|
|
|
|
|
} else { |
80
|
3
|
50
|
|
|
|
21
|
confess "defaults_namespace_char should be a single character or ''" unless $char =~ /./; |
81
|
3
|
|
|
|
|
7
|
$self->{defaults_namespace_char} = $char; |
82
|
|
|
|
|
|
|
} |
83
|
|
|
|
|
|
|
} |
84
|
|
|
|
|
|
|
|
85
|
30
|
|
|
|
|
70
|
return $self->{defaults_namespace_char}; |
86
|
|
|
|
|
|
|
} |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
sub comment_delims{ |
90
|
3
|
|
|
3
|
1
|
5352
|
my ($self,$delim1,$delim2) = @_; |
91
|
3
|
100
|
|
|
|
13
|
if (defined $delim1 ){ |
92
|
2
|
|
50
|
|
|
7
|
$delim2 = $delim2 || ''; |
93
|
2
|
|
|
|
|
7
|
$self->{'comment_delims'} = [ $delim1, $delim2 ]; |
94
|
|
|
|
|
|
|
} |
95
|
3
|
|
|
|
|
12
|
return $self->{'comment_delims'}; |
96
|
|
|
|
|
|
|
} |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
sub token_delims{ |
100
|
45
|
|
|
45
|
1
|
5978
|
my ($self,$delim1,$delim2) = @_; |
101
|
|
|
|
|
|
|
|
102
|
45
|
100
|
|
|
|
121
|
if (defined $delim1 ){ |
103
|
|
|
|
|
|
|
|
104
|
8
|
100
|
|
|
|
52
|
if ( ref $delim1 eq ref [] ){ |
105
|
7
|
|
|
|
|
28
|
($delim1,$delim2) = @$delim1; |
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
|
108
|
8
|
|
50
|
|
|
39
|
$delim2 ||= ''; |
109
|
8
|
|
|
|
|
32
|
$self->{'token_delims'} = [ $delim1, $delim2 ]; |
110
|
|
|
|
|
|
|
} |
111
|
45
|
|
|
|
|
89
|
return $self->{'token_delims'}; |
112
|
|
|
|
|
|
|
} |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
sub show_labels{ |
117
|
78
|
|
|
78
|
1
|
533
|
my ($self,$show) = @_; |
118
|
78
|
100
|
66
|
|
|
308
|
confess "Expected a boolean but got $show" if $show && ! ( $show == 0 || $show == 1 ); |
|
|
|
100
|
|
|
|
|
119
|
77
|
100
|
|
|
|
157
|
$self->{show_labels} = $show if defined $show; |
120
|
77
|
|
|
|
|
250
|
return $self->{show_labels}; |
121
|
|
|
|
|
|
|
} |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
sub template_ext{ |
125
|
87
|
|
|
87
|
1
|
2331
|
my ($self,$ext) = @_; |
126
|
87
|
50
|
66
|
|
|
253
|
confess "Expected a scalar extension name but got a ".ref($ext) if defined $ext && ref($ext); |
127
|
87
|
100
|
|
|
|
167
|
$self->{template_ext} = $ext if defined $ext; |
128
|
87
|
|
|
|
|
823
|
return $self->{template_ext}; |
129
|
|
|
|
|
|
|
} |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
sub name_label{ |
133
|
245
|
|
|
245
|
1
|
1819
|
my ($self,$label) = @_; |
134
|
245
|
50
|
66
|
|
|
487
|
confess "Expected a scalar name label but got a ".ref($label) if defined $label && ref($label); |
135
|
245
|
100
|
|
|
|
443
|
$self->{name_label} = $label if $label; |
136
|
245
|
|
|
|
|
567
|
return $self->{name_label}; |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
sub fixed_indent{ |
141
|
9
|
|
|
9
|
1
|
5010
|
my ($self,$indent) = @_; |
142
|
|
|
|
|
|
|
|
143
|
9
|
100
|
|
|
|
23
|
if ( defined $indent ){ |
144
|
7
|
100
|
100
|
|
|
245
|
confess "Expected 0 or 1 but got $indent" unless $indent == 0 or $indent == 1; |
145
|
6
|
|
|
|
|
12
|
$self->{fixed_indent} = $indent; |
146
|
|
|
|
|
|
|
} |
147
|
|
|
|
|
|
|
|
148
|
8
|
|
|
|
|
24
|
return $self->{fixed_indent}; |
149
|
|
|
|
|
|
|
} |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
sub die_on_bad_params{ |
153
|
8
|
|
|
8
|
1
|
1871
|
my ($self,$should_die) = @_; |
154
|
|
|
|
|
|
|
|
155
|
8
|
100
|
|
|
|
27
|
if ( defined $should_die ){ |
156
|
6
|
100
|
100
|
|
|
138
|
confess "Expected 0 or 1 but got $should_die" unless $should_die == 0 or $should_die == 1; |
157
|
5
|
|
|
|
|
14
|
$self->{die_on_bad_params} = $should_die; |
158
|
|
|
|
|
|
|
} |
159
|
|
|
|
|
|
|
|
160
|
7
|
|
|
|
|
21
|
return $self->{die_on_bad_params}; |
161
|
|
|
|
|
|
|
} |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
sub escape_char{ |
166
|
7
|
|
|
7
|
1
|
902
|
my ($self,$char) = @_; |
167
|
|
|
|
|
|
|
|
168
|
7
|
100
|
|
|
|
18
|
if (defined $char){ |
169
|
5
|
50
|
66
|
|
|
38
|
confess "escape_char should be a single character or ''" unless $char eq '' or $char =~ /./; |
170
|
5
|
|
|
|
|
12
|
$self->{escape_char} = $char; |
171
|
|
|
|
|
|
|
} |
172
|
|
|
|
|
|
|
|
173
|
7
|
|
|
|
|
20
|
return $self->{escape_char}; |
174
|
|
|
|
|
|
|
} |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
sub render{ |
179
|
134
|
|
|
134
|
1
|
5404
|
my ($self,$comp) = @_; |
180
|
|
|
|
|
|
|
|
181
|
134
|
|
|
|
|
193
|
my $html; |
182
|
134
|
100
|
|
|
|
467
|
if ( ref($comp) =~ /array/i ){ |
|
|
100
|
|
|
|
|
|
183
|
14
|
|
|
|
|
38
|
$html = $self->_render_array( $comp ); |
184
|
|
|
|
|
|
|
} elsif( ref( $comp ) =~ /hash/i ){ |
185
|
77
|
|
|
|
|
291
|
$html = $self->_render_hash( $comp ); |
186
|
|
|
|
|
|
|
} else { |
187
|
43
|
|
|
|
|
69
|
$html = $comp; |
188
|
|
|
|
|
|
|
} |
189
|
|
|
|
|
|
|
|
190
|
128
|
|
|
|
|
372
|
return $html; |
191
|
|
|
|
|
|
|
} |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
sub _render_hash{ |
196
|
77
|
|
|
77
|
|
133
|
my ($self,$h) = @_; |
197
|
|
|
|
|
|
|
|
198
|
77
|
50
|
|
|
|
214
|
confess "Expected a hashref. Instead got a ".ref($h) unless ref($h) =~ /hash/i; |
199
|
|
|
|
|
|
|
|
200
|
77
|
|
|
|
|
159
|
my $template_name = $h->{ $self->name_label }; |
201
|
|
|
|
|
|
|
|
202
|
77
|
50
|
|
|
|
161
|
confess 'Encountered hash with no name_label ("'.$self->name_label.'"): '.Dumper( $h ) unless $template_name; |
203
|
|
|
|
|
|
|
|
204
|
77
|
|
|
|
|
130
|
my $param = {}; |
205
|
|
|
|
|
|
|
|
206
|
77
|
|
|
|
|
220
|
foreach my $k ( keys %$h ){ |
207
|
159
|
100
|
|
|
|
271
|
next if $k eq $self->name_label; |
208
|
83
|
|
|
|
|
195
|
$param->{$k} = $self->render( $h->{$k} ); |
209
|
|
|
|
|
|
|
} |
210
|
|
|
|
|
|
|
|
211
|
75
|
|
|
|
|
169
|
my $template = $self->_get_template( $template_name ); |
212
|
75
|
|
|
|
|
226
|
my $html = $self->_fill_in( $template_name, $template, $param ); |
213
|
|
|
|
|
|
|
|
214
|
72
|
100
|
|
|
|
180
|
if ( $self->show_labels ){ |
215
|
|
|
|
|
|
|
|
216
|
8
|
|
|
|
|
15
|
my $ca = $self->{comment_delims}->[0]; |
217
|
8
|
|
|
|
|
13
|
my $cb = $self->{comment_delims}->[1]; |
218
|
|
|
|
|
|
|
|
219
|
8
|
|
|
|
|
29
|
$html = "$ca BEGIN $template_name $cb\n$html\n$ca END $template_name $cb\n"; |
220
|
|
|
|
|
|
|
} |
221
|
|
|
|
|
|
|
|
222
|
72
|
|
|
|
|
229
|
return $html; |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
} |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
sub _render_array{ |
230
|
|
|
|
|
|
|
|
231
|
14
|
|
|
14
|
|
34
|
my ($self, $arr, $delim) = @_; |
232
|
14
|
50
|
|
|
|
51
|
confess "Expected an array. Instead got a ".ref($arr) unless ref($arr) =~ /array/i; |
233
|
14
|
|
|
|
|
26
|
my $html = ''; |
234
|
14
|
|
|
|
|
32
|
foreach my $comp (@$arr){ |
235
|
27
|
50
|
33
|
|
|
66
|
$html.= $delim if ($delim && $html); |
236
|
27
|
|
|
|
|
77
|
$html.= $self->render( $comp ); |
237
|
|
|
|
|
|
|
} |
238
|
13
|
|
|
|
|
30
|
return $html; |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
} |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
sub _get_template{ |
245
|
81
|
|
|
81
|
|
134
|
my ($self,$template_name) = @_; |
246
|
|
|
|
|
|
|
|
247
|
81
|
|
|
|
|
137
|
my $template = ''; |
248
|
81
|
100
|
|
|
|
160
|
if ( $self->{template_hash} ){ |
249
|
3
|
|
|
|
|
4
|
$template = $self->{template_hash}{$template_name}; |
250
|
|
|
|
|
|
|
} else { |
251
|
|
|
|
|
|
|
|
252
|
78
|
|
|
|
|
171
|
my $filename = File::Spec->catdir( |
253
|
|
|
|
|
|
|
$self->template_dir, |
254
|
|
|
|
|
|
|
$template_name.$self->template_ext |
255
|
|
|
|
|
|
|
); |
256
|
|
|
|
|
|
|
|
257
|
78
|
|
|
|
|
173
|
my $fh; |
258
|
78
|
50
|
|
|
|
3177
|
open $fh,'<',$filename or confess "Could not open file $filename: $!"; |
259
|
|
|
|
|
|
|
|
260
|
78
|
|
|
|
|
264
|
my $text = ''; |
261
|
78
|
|
|
|
|
1268
|
while( my $line = <$fh> ){ |
262
|
335
|
|
|
|
|
2137
|
$template.=$line; |
263
|
|
|
|
|
|
|
} |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
} |
266
|
|
|
|
|
|
|
|
267
|
81
|
|
|
|
|
569
|
$template =~ s/\n$//; |
268
|
81
|
|
|
|
|
241
|
return $template; |
269
|
|
|
|
|
|
|
} |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
sub params{ |
275
|
6
|
|
|
6
|
0
|
2978
|
my ($self,$template_name) = @_; |
276
|
|
|
|
|
|
|
|
277
|
6
|
|
|
|
|
13
|
my $esc = $self->{escape_char}; |
278
|
6
|
|
|
|
|
23
|
my $template = $self->_get_template( $template_name ); |
279
|
6
|
|
|
|
|
37
|
my @frags = split( /\Q$esc$esc\E/, $template ); |
280
|
6
|
|
|
|
|
17
|
my $tda = $self->{token_delims}[0]; |
281
|
6
|
|
|
|
|
8
|
my $tdb = $self->{token_delims}[1]; |
282
|
|
|
|
|
|
|
|
283
|
6
|
|
|
|
|
12
|
my %rem; |
284
|
6
|
|
|
|
|
18
|
for my $i (0..$#frags){ |
285
|
6
|
|
|
|
|
72
|
my @f = $frags[$i] =~ m/(?
|
286
|
6
|
|
|
|
|
14
|
for my $f ( @f ){ |
287
|
14
|
|
|
|
|
37
|
$f =~ s/^\s*//; |
288
|
14
|
|
|
|
|
59
|
$f =~ s/\s*$//; |
289
|
14
|
|
|
|
|
39
|
$rem{$f} = 1; |
290
|
|
|
|
|
|
|
} |
291
|
|
|
|
|
|
|
} |
292
|
|
|
|
|
|
|
|
293
|
6
|
|
|
|
|
28
|
my @params = sort(keys %rem); |
294
|
6
|
|
|
|
|
27
|
return \@params; |
295
|
|
|
|
|
|
|
} |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
sub _token_regex{ |
300
|
177
|
|
|
177
|
|
324
|
my ($self,$param_name) = @_; |
301
|
|
|
|
|
|
|
|
302
|
177
|
|
|
|
|
262
|
my $esc = $self->{escape_char}; |
303
|
177
|
|
|
|
|
282
|
my $tda = $self->{token_delims}[0]; |
304
|
177
|
|
|
|
|
249
|
my $tdb = $self->{token_delims}[1]; |
305
|
|
|
|
|
|
|
|
306
|
177
|
100
|
|
|
|
350
|
$param_name = '.*?' unless defined $param_name; |
307
|
|
|
|
|
|
|
|
308
|
177
|
|
|
|
|
2298
|
my $token_regex = qr/\Q$tda\E\s+$param_name\s+\Q$tdb\E/; |
309
|
177
|
50
|
|
|
|
432
|
if ( $esc ){ |
310
|
177
|
|
|
|
|
2034
|
$token_regex = qr/(?
|
311
|
|
|
|
|
|
|
} |
312
|
177
|
|
|
|
|
507
|
return $token_regex; |
313
|
|
|
|
|
|
|
} |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
sub _fill_in{ |
317
|
75
|
|
|
75
|
|
186
|
my ($self,$template_name,$template,$params) = @_; |
318
|
|
|
|
|
|
|
|
319
|
75
|
|
|
|
|
151
|
my $esc = $self->{escape_char}; |
320
|
75
|
|
|
|
|
149
|
my @frags; |
321
|
|
|
|
|
|
|
|
322
|
75
|
50
|
|
|
|
162
|
if ( $esc ){ |
323
|
75
|
|
|
|
|
410
|
@frags = split( /\Q$esc$esc\E/, $template ); |
324
|
|
|
|
|
|
|
} else { |
325
|
0
|
|
|
|
|
0
|
@frags = ( $template ); |
326
|
|
|
|
|
|
|
} |
327
|
|
|
|
|
|
|
|
328
|
75
|
|
|
|
|
248
|
foreach my $param_name (keys %$params){ |
329
|
|
|
|
|
|
|
|
330
|
79
|
|
|
|
|
145
|
my $param_val = $params->{$param_name}; |
331
|
|
|
|
|
|
|
|
332
|
79
|
|
|
|
|
103
|
my $replaced = 0; |
333
|
|
|
|
|
|
|
|
334
|
79
|
100
|
|
|
|
159
|
if ( $self->{fixed_indent} ){ #if fixed_indent we need to add spaces during the replacement |
335
|
10
|
|
|
|
|
22
|
for my $i (0..$#frags){ |
336
|
10
|
|
|
|
|
21
|
my $rx = $self->_token_regex( $param_name ); |
337
|
10
|
|
|
|
|
335
|
my @spaces_repl = $frags[$i] =~ m/([^\S\r\n]*)$rx/g; |
338
|
|
|
|
|
|
|
|
339
|
10
|
|
|
|
|
36
|
while(@spaces_repl){ |
340
|
10
|
|
|
|
|
20
|
my $sp = shift @spaces_repl; |
341
|
10
|
|
|
|
|
14
|
my $repl = shift @spaces_repl; |
342
|
10
|
|
|
|
|
17
|
my $param_out = $param_val; |
343
|
10
|
|
|
|
|
42
|
$param_out =~ s/\n/\n$sp/g; |
344
|
|
|
|
|
|
|
|
345
|
10
|
50
|
|
|
|
21
|
if ( $esc ){ |
346
|
10
|
50
|
|
|
|
167
|
$replaced = 1 if $frags[$i] =~ s/(?
|
347
|
|
|
|
|
|
|
} else { |
348
|
0
|
0
|
|
|
|
0
|
$replaced = 1 if $frags[$i] =~ s/\Q$repl\E/$param_out/; |
349
|
|
|
|
|
|
|
} |
350
|
|
|
|
|
|
|
} |
351
|
|
|
|
|
|
|
} |
352
|
|
|
|
|
|
|
} else { |
353
|
69
|
|
|
|
|
181
|
for my $i (0..$#frags){ |
354
|
77
|
|
|
|
|
157
|
my $rx = $self->_token_regex( $param_name ); |
355
|
77
|
100
|
|
|
|
801
|
$replaced = 1 if $frags[$i] =~ s/$rx/$param_val/g; |
356
|
|
|
|
|
|
|
} |
357
|
|
|
|
|
|
|
} |
358
|
|
|
|
|
|
|
|
359
|
79
|
100
|
100
|
|
|
398
|
if ( $self->{die_on_bad_params} && $replaced == 0 ){ |
360
|
3
|
|
|
|
|
554
|
confess "Could not replace template param '$param_name': token does not exist in template '$template_name'"; |
361
|
|
|
|
|
|
|
} |
362
|
|
|
|
|
|
|
} |
363
|
|
|
|
|
|
|
|
364
|
72
|
|
|
|
|
195
|
for my $i (0..$#frags){ |
365
|
|
|
|
|
|
|
|
366
|
76
|
100
|
|
|
|
110
|
if ( %{$self->{defaults}} ){ |
|
76
|
|
|
|
|
185
|
|
367
|
18
|
|
|
|
|
44
|
my @rem = $self->_params_in( $frags[$i] ); |
368
|
18
|
|
|
|
|
47
|
my $char = $self->defaults_namespace_char; |
369
|
18
|
|
|
|
|
36
|
for my $name ( @rem ){ |
370
|
14
|
|
|
|
|
28
|
my @parts = ( $name ); |
371
|
14
|
100
|
|
|
|
58
|
@parts = split( /\Q$char\E/, $name ) if $char; |
372
|
|
|
|
|
|
|
|
373
|
14
|
|
|
|
|
41
|
my $val = $self->_get_default_val( $self->{defaults}, @parts ); |
374
|
14
|
|
|
|
|
30
|
my $rx = $self->_token_regex( $name ); |
375
|
14
|
|
|
|
|
133
|
$frags[$i] =~ s/$rx/$val/g; |
376
|
|
|
|
|
|
|
} |
377
|
|
|
|
|
|
|
} |
378
|
|
|
|
|
|
|
|
379
|
76
|
|
|
|
|
173
|
my $rx = $self->_token_regex; |
380
|
76
|
|
|
|
|
385
|
$frags[$i] =~ s/$rx//g; |
381
|
|
|
|
|
|
|
} |
382
|
|
|
|
|
|
|
|
383
|
72
|
50
|
|
|
|
230
|
if ( $esc ){ |
384
|
72
|
|
|
|
|
158
|
for my $i (0..$#frags){ |
385
|
76
|
|
|
|
|
268
|
$frags[$i] =~ s/\Q$esc\E//gs; |
386
|
|
|
|
|
|
|
} |
387
|
|
|
|
|
|
|
} |
388
|
|
|
|
|
|
|
|
389
|
72
|
50
|
|
|
|
255
|
my $text = $esc? join($esc,@frags): $frags[0]; |
390
|
72
|
|
|
|
|
181
|
return $text; |
391
|
|
|
|
|
|
|
} |
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
sub _params_in{ |
395
|
18
|
|
|
18
|
|
44
|
my ( $self, $text ) = @_; |
396
|
|
|
|
|
|
|
|
397
|
18
|
|
|
|
|
25
|
my $esc = $self->{escape_char}; |
398
|
18
|
|
|
|
|
47
|
my $tda = $self->token_delims->[0]; |
399
|
18
|
|
|
|
|
36
|
my $tdb = $self->token_delims->[1]; |
400
|
|
|
|
|
|
|
|
401
|
18
|
|
|
|
|
31
|
my @rem; |
402
|
18
|
50
|
|
|
|
36
|
if ( $esc ){ |
403
|
18
|
|
|
|
|
147
|
@rem = $text =~ m/(?
|
404
|
|
|
|
|
|
|
} else { |
405
|
0
|
|
|
|
|
0
|
@rem = $text =~ m/\Q$tda\E\s+(.*?)\s+\Q$tdb\E/g; |
406
|
|
|
|
|
|
|
} |
407
|
|
|
|
|
|
|
|
408
|
18
|
|
|
|
|
34
|
my %rem; |
409
|
18
|
|
|
|
|
34
|
for my $name (@rem){ |
410
|
14
|
|
|
|
|
31
|
$rem{$name} = 1 |
411
|
|
|
|
|
|
|
} |
412
|
|
|
|
|
|
|
|
413
|
18
|
|
|
|
|
61
|
return keys %rem; |
414
|
|
|
|
|
|
|
} |
415
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
sub _get_default_val{ |
419
|
25
|
|
|
25
|
|
53
|
my ($self,$ref,@parts) = @_; |
420
|
|
|
|
|
|
|
|
421
|
25
|
100
|
|
|
|
48
|
if ( @parts == 1 ){ |
422
|
12
|
|
100
|
|
|
39
|
my $val = $ref->{$parts[0]} || ''; |
423
|
12
|
|
|
|
|
34
|
return $val; |
424
|
|
|
|
|
|
|
} else { |
425
|
13
|
|
|
|
|
23
|
my $ref_name = shift @parts; |
426
|
13
|
|
|
|
|
20
|
my $new_ref = $ref->{ $ref_name }; |
427
|
13
|
100
|
|
|
|
32
|
return '' unless $new_ref; |
428
|
11
|
|
|
|
|
24
|
return $self->_get_default_val( $new_ref, @parts ); |
429
|
|
|
|
|
|
|
} |
430
|
|
|
|
|
|
|
} |
431
|
|
|
|
|
|
|
|
432
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
1; |
435
|
|
|
|
|
|
|
__END__ |