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