Filename | /usr/lib/x86_64-linux-gnu/perl5/5.28/Template/Directive.pm |
Statements | Executed 12589963 statements in 33.1s |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
505407 | 2 | 2 | 7.59s | 9.12s | text | Template::Directive::
503416 | 1 | 1 | 4.20s | 13.3s | textblock | Template::Directive::
384174 | 1 | 1 | 3.60s | 4.45s | template | Template::Directive::
378297 | 2 | 2 | 2.46s | 2.46s | ident | Template::Directive::
439240 | 1 | 1 | 1.71s | 1.71s | block | Template::Directive::
383161 | 1 | 1 | 1.65s | 1.65s | _init | Template::Directive::
1010814 | 2 | 1 | 1.30s | 1.30s | CORE:subst (opcode) | Template::Directive::
242791 | 1 | 1 | 952ms | 952ms | args | Template::Directive::
384174 | 1 | 1 | 845ms | 845ms | CORE:match (opcode) | Template::Directive::
257349 | 2 | 1 | 820ms | 820ms | get | Template::Directive::
37103 | 1 | 1 | 336ms | 336ms | if | Template::Directive::
252123 | 1 | 1 | 235ms | 235ms | CORE:substcont (opcode) | Template::Directive::
5968 | 1 | 1 | 103ms | 123ms | foreach | Template::Directive::
8013 | 2 | 1 | 93.8ms | 151ms | set | Template::Directive::
8013 | 1 | 1 | 56.7ms | 56.7ms | assign | Template::Directive::
1013 | 1 | 1 | 33.9ms | 38.7ms | include | Template::Directive::
3982 | 1 | 1 | 14.3ms | 14.3ms | call | Template::Directive::
1991 | 1 | 1 | 9.39ms | 9.39ms | quoted | Template::Directive::
1013 | 1 | 1 | 4.83ms | 4.83ms | filenames | Template::Directive::
1 | 1 | 1 | 140µs | 140µs | BEGIN@33 | Template::Directive::
1 | 1 | 1 | 16µs | 18µs | BEGIN@29 | Template::Directive::
1 | 1 | 1 | 6µs | 22µs | BEGIN@32 | Template::Directive::
1 | 1 | 1 | 6µs | 21µs | BEGIN@30 | Template::Directive::
1 | 1 | 1 | 5µs | 48µs | BEGIN@31 | Template::Directive::
1 | 1 | 1 | 600ns | 600ns | __ANON__ (xsub) | Template::Directive::
0 | 0 | 0 | 0s | 0s | OLD_break | Template::Directive::
0 | 0 | 0 | 0s | 0s | anon_block | Template::Directive::
0 | 0 | 0 | 0s | 0s | capture | Template::Directive::
0 | 0 | 0 | 0s | 0s | clear | Template::Directive::
0 | 0 | 0 | 0s | 0s | debug | Template::Directive::
0 | 0 | 0 | 0s | 0s | default | Template::Directive::
0 | 0 | 0 | 0s | 0s | filter | Template::Directive::
0 | 0 | 0 | 0s | 0s | identref | Template::Directive::
0 | 0 | 0 | 0s | 0s | insert | Template::Directive::
0 | 0 | 0 | 0s | 0s | macro | Template::Directive::
0 | 0 | 0 | 0s | 0s | multi_wrapper | Template::Directive::
0 | 0 | 0 | 0s | 0s | next | Template::Directive::
0 | 0 | 0 | 0s | 0s | no_perl | Template::Directive::
0 | 0 | 0 | 0s | 0s | pad | Template::Directive::
0 | 0 | 0 | 0s | 0s | perl | Template::Directive::
0 | 0 | 0 | 0s | 0s | process | Template::Directive::
0 | 0 | 0 | 0s | 0s | rawperl | Template::Directive::
0 | 0 | 0 | 0s | 0s | return | Template::Directive::
0 | 0 | 0 | 0s | 0s | stop | Template::Directive::
0 | 0 | 0 | 0s | 0s | switch | Template::Directive::
0 | 0 | 0 | 0s | 0s | throw | Template::Directive::
0 | 0 | 0 | 0s | 0s | trace_vars | Template::Directive::
0 | 0 | 0 | 0s | 0s | try | Template::Directive::
0 | 0 | 0 | 0s | 0s | use | Template::Directive::
0 | 0 | 0 | 0s | 0s | view | Template::Directive::
0 | 0 | 0 | 0s | 0s | while | Template::Directive::
0 | 0 | 0 | 0s | 0s | wrapper | Template::Directive::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | #================================================================= -*-Perl-*- | ||||
2 | # | ||||
3 | # Template::Directive | ||||
4 | # | ||||
5 | # DESCRIPTION | ||||
6 | # Factory module for constructing templates from Perl code. | ||||
7 | # | ||||
8 | # AUTHOR | ||||
9 | # Andy Wardley <abw@wardley.org> | ||||
10 | # | ||||
11 | # WARNING | ||||
12 | # Much of this module is hairy, even furry in places. It needs | ||||
13 | # a lot of tidying up and may even be moved into a different place | ||||
14 | # altogether. The generator code is often inefficient, particularly in | ||||
15 | # being very anal about pretty-printing the Perl code all neatly, but | ||||
16 | # at the moment, that's still high priority for the sake of easier | ||||
17 | # debugging. | ||||
18 | # | ||||
19 | # COPYRIGHT | ||||
20 | # Copyright (C) 1996-2007 Andy Wardley. All Rights Reserved. | ||||
21 | # | ||||
22 | # This module is free software; you can redistribute it and/or | ||||
23 | # modify it under the same terms as Perl itself. | ||||
24 | # | ||||
25 | #============================================================================ | ||||
26 | |||||
27 | package Template::Directive; | ||||
28 | |||||
29 | 2 | 35µs | 2 | 21µs | # spent 18µs (16+3) within Template::Directive::BEGIN@29 which was called:
# once (16µs+3µs) by Template::Parser::BEGIN@40 at line 29 # spent 18µs making 1 call to Template::Directive::BEGIN@29
# spent 3µs making 1 call to strict::import |
30 | 2 | 22µs | 2 | 36µs | # spent 21µs (6+15) within Template::Directive::BEGIN@30 which was called:
# once (6µs+15µs) by Template::Parser::BEGIN@40 at line 30 # spent 21µs making 1 call to Template::Directive::BEGIN@30
# spent 15µs making 1 call to warnings::import |
31 | 2 | 22µs | 2 | 92µs | # spent 48µs (5+43) within Template::Directive::BEGIN@31 which was called:
# once (5µs+43µs) by Template::Parser::BEGIN@40 at line 31 # spent 48µs making 1 call to Template::Directive::BEGIN@31
# spent 43µs making 1 call to base::import |
32 | 2 | 19µs | 2 | 37µs | # spent 22µs (6+16) within Template::Directive::BEGIN@32 which was called:
# once (6µs+16µs) by Template::Parser::BEGIN@40 at line 32 # spent 22µs making 1 call to Template::Directive::BEGIN@32
# spent 16µs making 1 call to Exporter::import |
33 | 2 | 3.61ms | 2 | 141µs | # spent 140µs (140+600ns) within Template::Directive::BEGIN@33 which was called:
# once (140µs+600ns) by Template::Parser::BEGIN@40 at line 33 # spent 140µs making 1 call to Template::Directive::BEGIN@33
# spent 600ns making 1 call to Template::Directive::__ANON__ |
34 | |||||
35 | 1 | 300ns | our $VERSION = 2.20; | ||
36 | 1 | 300ns | our $DEBUG = 0 unless defined $DEBUG; | ||
37 | 1 | 100ns | our $WHILE_MAX = 1000 unless defined $WHILE_MAX; | ||
38 | 1 | 100ns | our $PRETTY = 0 unless defined $PRETTY; | ||
39 | 1 | 200ns | our $OUTPUT = '$output .= '; | ||
40 | |||||
41 | |||||
42 | # spent 1.65s within Template::Directive::_init which was called 383161 times, avg 4µs/call:
# 383161 times (1.65s+0s) by Template::Base::new at line 65 of Template/Base.pm, avg 4µs/call | ||||
43 | 383161 | 204ms | my ($self, $config) = @_; | ||
44 | 383161 | 561ms | $self->{ NAMESPACE } = $config->{ NAMESPACE }; | ||
45 | 383161 | 2.15s | return $self; | ||
46 | } | ||||
47 | |||||
48 | sub trace_vars { | ||||
49 | my $self = shift; | ||||
50 | return @_ | ||||
51 | ? ($self->{ TRACE_VARS } = shift) | ||||
52 | : $self->{ TRACE_VARS }; | ||||
53 | } | ||||
54 | |||||
55 | sub pad { | ||||
56 | my ($text, $pad) = @_; | ||||
57 | $pad = ' ' x ($pad * 4); | ||||
58 | $text =~ s/^(?!#line)/$pad/gm; | ||||
59 | $text; | ||||
60 | } | ||||
61 | |||||
62 | #======================================================================== | ||||
63 | # FACTORY METHODS | ||||
64 | # | ||||
65 | # These methods are called by the parser to construct directive instances. | ||||
66 | #======================================================================== | ||||
67 | |||||
68 | #------------------------------------------------------------------------ | ||||
69 | # template($block) | ||||
70 | #------------------------------------------------------------------------ | ||||
71 | |||||
72 | # spent 4.45s (3.60+845ms) within Template::Directive::template which was called 384174 times, avg 12µs/call:
# 384174 times (3.60s+845ms) by Template::Grammar::__ANON__[Parser.yp:64] at line 64 of /root/tor-browser-build/Parser.yp, avg 12µs/call | ||||
73 | 384174 | 205ms | my ($self, $block) = @_; | ||
74 | 384174 | 240ms | $block = pad($block, 2) if $PRETTY; | ||
75 | |||||
76 | 384174 | 2.67s | 384174 | 845ms | return "sub { return '' }" unless $block =~ /\S/; # spent 845ms making 384174 calls to Template::Directive::CORE:match, avg 2µs/call |
77 | |||||
78 | 384174 | 2.13s | return <<EOF; | ||
79 | sub { | ||||
80 | my \$context = shift || die "template sub called without context\\n"; | ||||
81 | my \$stash = \$context->stash; | ||||
82 | my \$output = ''; | ||||
83 | my \$_tt_error; | ||||
84 | |||||
85 | eval { BLOCK: { | ||||
86 | $block | ||||
87 | } }; | ||||
88 | if (\$@) { | ||||
89 | \$_tt_error = \$context->catch(\$@, \\\$output); | ||||
90 | die \$_tt_error unless \$_tt_error->type eq 'return'; | ||||
91 | } | ||||
92 | |||||
93 | return \$output; | ||||
94 | } | ||||
95 | EOF | ||||
96 | } | ||||
97 | |||||
98 | |||||
99 | #------------------------------------------------------------------------ | ||||
100 | # anon_block($block) [% BLOCK %] ... [% END %] | ||||
101 | #------------------------------------------------------------------------ | ||||
102 | |||||
103 | sub anon_block { | ||||
104 | my ($self, $block) = @_; | ||||
105 | $block = pad($block, 2) if $PRETTY; | ||||
106 | |||||
107 | return <<EOF; | ||||
108 | |||||
109 | # BLOCK | ||||
110 | $OUTPUT do { | ||||
111 | my \$output = ''; | ||||
112 | my \$_tt_error; | ||||
113 | |||||
114 | eval { BLOCK: { | ||||
115 | $block | ||||
116 | } }; | ||||
117 | if (\$@) { | ||||
118 | \$_tt_error = \$context->catch(\$@, \\\$output); | ||||
119 | die \$_tt_error unless \$_tt_error->type eq 'return'; | ||||
120 | } | ||||
121 | |||||
122 | \$output; | ||||
123 | }; | ||||
124 | EOF | ||||
125 | } | ||||
126 | |||||
127 | |||||
128 | #------------------------------------------------------------------------ | ||||
129 | # block($blocktext) | ||||
130 | #------------------------------------------------------------------------ | ||||
131 | |||||
132 | # spent 1.71s within Template::Directive::block which was called 439240 times, avg 4µs/call:
# 439240 times (1.71s+0s) by Template::Grammar::__ANON__[Parser.yp:67] at line 67 of /root/tor-browser-build/Parser.yp, avg 4µs/call | ||||
133 | 439240 | 205ms | my ($self, $block) = @_; | ||
134 | 439240 | 2.81s | return join("\n", @{ $block || [] }); | ||
135 | } | ||||
136 | |||||
137 | |||||
138 | #------------------------------------------------------------------------ | ||||
139 | # textblock($text) | ||||
140 | #------------------------------------------------------------------------ | ||||
141 | |||||
142 | # spent 13.3s (4.20+9.09) within Template::Directive::textblock which was called 503416 times, avg 26µs/call:
# 503416 times (4.20s+9.09s) by Template::Grammar::__ANON__[Parser.yp:76] at line 76 of /root/tor-browser-build/Parser.yp, avg 26µs/call | ||||
143 | 503416 | 265ms | my ($self, $text) = @_; | ||
144 | 503416 | 3.60s | 503416 | 9.09s | return "$OUTPUT " . &text($self, $text) . ';'; # spent 9.09s making 503416 calls to Template::Directive::text, avg 18µs/call |
145 | } | ||||
146 | |||||
147 | |||||
148 | #------------------------------------------------------------------------ | ||||
149 | # text($text) | ||||
150 | #------------------------------------------------------------------------ | ||||
151 | |||||
152 | # spent 9.12s (7.59+1.53) within Template::Directive::text which was called 505407 times, avg 18µs/call:
# 503416 times (7.57s+1.53s) by Template::Directive::textblock at line 144, avg 18µs/call
# 1991 times (22.7ms+7.86ms) by Template::Grammar::__ANON__[Parser.yp:440] at line 440 of /root/tor-browser-build/Parser.yp, avg 15µs/call | ||||
153 | 505407 | 215ms | my ($self, $text) = @_; | ||
154 | 505407 | 563ms | for ($text) { | ||
155 | 505407 | 4.64s | 757530 | 1.09s | s/(["\$\@\\])/\\$1/g; # spent 859ms making 505407 calls to Template::Directive::CORE:subst, avg 2µs/call
# spent 235ms making 252123 calls to Template::Directive::CORE:substcont, avg 934ns/call |
156 | 505407 | 2.58s | 505407 | 441ms | s/\n/\\n/g; # spent 441ms making 505407 calls to Template::Directive::CORE:subst, avg 872ns/call |
157 | } | ||||
158 | 505407 | 2.62s | return '"' . $text . '"'; | ||
159 | } | ||||
160 | |||||
161 | |||||
162 | #------------------------------------------------------------------------ | ||||
163 | # quoted(\@items) "foo$bar" | ||||
164 | #------------------------------------------------------------------------ | ||||
165 | |||||
166 | # spent 9.39ms within Template::Directive::quoted which was called 1991 times, avg 5µs/call:
# 1991 times (9.39ms+0s) by Template::Grammar::__ANON__[Parser.yp:307] at line 307 of /root/tor-browser-build/Parser.yp, avg 5µs/call | ||||
167 | 1991 | 1.07ms | my ($self, $items) = @_; | ||
168 | 1991 | 1.06ms | return '' unless @$items; | ||
169 | 1991 | 20.7ms | return ("('' . " . $items->[0] . ')') if scalar @$items == 1; | ||
170 | return '(' . join(' . ', @$items) . ')'; | ||||
171 | # my $r = '(' . join(' . ', @$items) . ' . "")'; | ||||
172 | # print STDERR "[$r]\n"; | ||||
173 | # return $r; | ||||
174 | } | ||||
175 | |||||
176 | |||||
177 | #------------------------------------------------------------------------ | ||||
178 | # ident(\@ident) foo.bar(baz) | ||||
179 | #------------------------------------------------------------------------ | ||||
180 | |||||
181 | # spent 2.46s within Template::Directive::ident which was called 378297 times, avg 6µs/call:
# 372329 times (2.44s+0s) by Template::Grammar::__ANON__[Parser.yp:305] at line 305 of /root/tor-browser-build/Parser.yp, avg 7µs/call
# 5968 times (19.4ms+0s) by Template::Directive::foreach at line 433, avg 3µs/call | ||||
182 | 378297 | 184ms | my ($self, $ident) = @_; | ||
183 | 378297 | 171ms | return "''" unless @$ident; | ||
184 | 378297 | 87.7ms | my $ns; | ||
185 | |||||
186 | # Careful! Template::Parser always creates a Template::Directive object | ||||
187 | # (as of v2.22_1) so $self is usually an object. However, we used to | ||||
188 | # allow Template::Directive methods to be called as class methods and | ||||
189 | # Template::Namespace::Constants module takes advantage of this fact | ||||
190 | # by calling Template::Directive->ident() when it needs to generate an | ||||
191 | # identifier. This hack guards against Mr Fuckup from coming to town | ||||
192 | # when that happens. | ||||
193 | |||||
194 | 378297 | 238ms | if (ref $self) { | ||
195 | # trace variable usage | ||||
196 | 378297 | 184ms | if ($self->{ TRACE_VARS }) { | ||
197 | my $root = $self->{ TRACE_VARS }; | ||||
198 | my $n = 0; | ||||
199 | my $v; | ||||
200 | while ($n < @$ident) { | ||||
201 | $v = $ident->[$n]; | ||||
202 | for ($v) { s/^'//; s/'$// }; | ||||
203 | $root = $root->{ $v } ||= { }; | ||||
204 | $n += 2; | ||||
205 | } | ||||
206 | } | ||||
207 | |||||
208 | # does the first element of the identifier have a NAMESPACE | ||||
209 | # handler defined? | ||||
210 | 378297 | 260ms | if (@$ident > 2 && ($ns = $self->{ NAMESPACE })) { | ||
211 | my $key = $ident->[0]; | ||||
212 | $key =~ s/^'(.+)'$/$1/s; | ||||
213 | if ($ns = $ns->{ $key }) { | ||||
214 | return $ns->ident($ident); | ||||
215 | } | ||||
216 | } | ||||
217 | } | ||||
218 | |||||
219 | 378297 | 453ms | if (scalar @$ident <= 2 && ! $ident->[1]) { | ||
220 | $ident = $ident->[0]; | ||||
221 | } | ||||
222 | else { | ||||
223 | 246776 | 194ms | $ident = '[' . join(', ', @$ident) . ']'; | ||
224 | } | ||||
225 | 378297 | 1.57s | return "\$stash->get($ident)"; | ||
226 | } | ||||
227 | |||||
228 | #------------------------------------------------------------------------ | ||||
229 | # identref(\@ident) \foo.bar(baz) | ||||
230 | #------------------------------------------------------------------------ | ||||
231 | |||||
232 | sub identref { | ||||
233 | my ($self, $ident) = @_; | ||||
234 | return "''" unless @$ident; | ||||
235 | if (scalar @$ident <= 2 && ! $ident->[1]) { | ||||
236 | $ident = $ident->[0]; | ||||
237 | } | ||||
238 | else { | ||||
239 | $ident = '[' . join(', ', @$ident) . ']'; | ||||
240 | } | ||||
241 | return "\$stash->getref($ident)"; | ||||
242 | } | ||||
243 | |||||
244 | |||||
245 | #------------------------------------------------------------------------ | ||||
246 | # assign(\@ident, $value, $default) foo = bar | ||||
247 | #------------------------------------------------------------------------ | ||||
248 | |||||
249 | # spent 56.7ms within Template::Directive::assign which was called 8013 times, avg 7µs/call:
# 8013 times (56.7ms+0s) by Template::Directive::set at line 323, avg 7µs/call | ||||
250 | 8013 | 11.1ms | my ($self, $var, $val, $default) = @_; | ||
251 | |||||
252 | 8013 | 17.0ms | if (ref $var) { | ||
253 | if (scalar @$var == 2 && ! $var->[1]) { | ||||
254 | $var = $var->[0]; | ||||
255 | } | ||||
256 | else { | ||||
257 | $var = '[' . join(', ', @$var) . ']'; | ||||
258 | } | ||||
259 | } | ||||
260 | 8013 | 3.65ms | $val .= ', 1' if $default; | ||
261 | 8013 | 30.1ms | return "\$stash->set($var, $val)"; | ||
262 | } | ||||
263 | |||||
264 | |||||
265 | #------------------------------------------------------------------------ | ||||
266 | # args(\@args) foo, bar, baz = qux | ||||
267 | #------------------------------------------------------------------------ | ||||
268 | |||||
269 | # spent 952ms within Template::Directive::args which was called 242791 times, avg 4µs/call:
# 242791 times (952ms+0s) by Template::Grammar::__ANON__[Parser.yp:342] at line 342 of /root/tor-browser-build/Parser.yp, avg 4µs/call | ||||
270 | 242791 | 82.7ms | my ($self, $args) = @_; | ||
271 | 242791 | 118ms | my $hash = shift @$args; | ||
272 | 242791 | 79.8ms | push(@$args, '{ ' . join(', ', @$hash) . ' }') | ||
273 | if @$hash; | ||||
274 | |||||
275 | 242791 | 107ms | return '0' unless @$args; | ||
276 | 242791 | 1.28s | return '[ ' . join(', ', @$args) . ' ]'; | ||
277 | } | ||||
278 | |||||
279 | #------------------------------------------------------------------------ | ||||
280 | # filenames(\@names) | ||||
281 | #------------------------------------------------------------------------ | ||||
282 | |||||
283 | # spent 4.83ms within Template::Directive::filenames which was called 1013 times, avg 5µs/call:
# 1013 times (4.83ms+0s) by Template::Directive::include at line 368, avg 5µs/call | ||||
284 | 1013 | 858µs | my ($self, $names) = @_; | ||
285 | 1013 | 917µs | if (@$names > 1) { | ||
286 | $names = '[ ' . join(', ', @$names) . ' ]'; | ||||
287 | } | ||||
288 | else { | ||||
289 | 1013 | 613µs | $names = shift @$names; | ||
290 | } | ||||
291 | 1013 | 21.2ms | return $names; | ||
292 | } | ||||
293 | |||||
294 | |||||
295 | #------------------------------------------------------------------------ | ||||
296 | # get($expr) [% foo %] | ||||
297 | #------------------------------------------------------------------------ | ||||
298 | |||||
299 | # spent 820ms within Template::Directive::get which was called 257349 times, avg 3µs/call:
# 250383 times (806ms+0s) by Template::Grammar::__ANON__[Parser.yp:90] at line 90 of /root/tor-browser-build/Parser.yp, avg 3µs/call
# 6966 times (14.1ms+0s) by Template::Grammar::__ANON__[Parser.yp:113] at line 113 of /root/tor-browser-build/Parser.yp, avg 2µs/call | ||||
300 | 257349 | 127ms | my ($self, $expr) = @_; | ||
301 | 257349 | 1.43s | return "$OUTPUT $expr;"; | ||
302 | } | ||||
303 | |||||
304 | |||||
305 | #------------------------------------------------------------------------ | ||||
306 | # call($expr) [% CALL bar %] | ||||
307 | #------------------------------------------------------------------------ | ||||
308 | |||||
309 | # spent 14.3ms within Template::Directive::call which was called 3982 times, avg 4µs/call:
# 3982 times (14.3ms+0s) by Template::Grammar::__ANON__[Parser.yp:114] at line 114 of /root/tor-browser-build/Parser.yp, avg 4µs/call | ||||
310 | 3982 | 4.85ms | my ($self, $expr) = @_; | ||
311 | 3982 | 2.37ms | $expr .= ';'; | ||
312 | 3982 | 12.7ms | return $expr; | ||
313 | } | ||||
314 | |||||
315 | |||||
316 | #------------------------------------------------------------------------ | ||||
317 | # set(\@setlist) [% foo = bar, baz = qux %] | ||||
318 | #------------------------------------------------------------------------ | ||||
319 | |||||
320 | # spent 151ms (93.8+56.7) within Template::Directive::set which was called 8013 times, avg 19µs/call:
# 4031 times (44.7ms+24.9ms) by Template::Grammar::__ANON__[Parser.yp:115] at line 115 of /root/tor-browser-build/Parser.yp, avg 17µs/call
# 3982 times (49.2ms+31.8ms) by Template::Grammar::__ANON__[Parser.yp:95] at line 95 of /root/tor-browser-build/Parser.yp, avg 20µs/call | ||||
321 | 8013 | 4.04ms | my ($self, $setlist) = @_; | ||
322 | 8013 | 2.25ms | my $output; | ||
323 | 8013 | 56.5ms | 8013 | 56.7ms | while (my ($var, $val) = splice(@$setlist, 0, 2)) { # spent 56.7ms making 8013 calls to Template::Directive::assign, avg 7µs/call |
324 | $output .= &assign($self, $var, $val) . ";\n"; | ||||
325 | } | ||||
326 | 8013 | 10.4ms | chomp $output; | ||
327 | 8013 | 37.4ms | return $output; | ||
328 | } | ||||
329 | |||||
330 | |||||
331 | #------------------------------------------------------------------------ | ||||
332 | # default(\@setlist) [% DEFAULT foo = bar, baz = qux %] | ||||
333 | #------------------------------------------------------------------------ | ||||
334 | |||||
335 | sub default { | ||||
336 | my ($self, $setlist) = @_; | ||||
337 | my $output; | ||||
338 | while (my ($var, $val) = splice(@$setlist, 0, 2)) { | ||||
339 | $output .= &assign($self, $var, $val, 1) . ";\n"; | ||||
340 | } | ||||
341 | chomp $output; | ||||
342 | return $output; | ||||
343 | } | ||||
344 | |||||
345 | |||||
346 | #------------------------------------------------------------------------ | ||||
347 | # insert(\@nameargs) [% INSERT file %] | ||||
348 | # # => [ [ $file, ... ], \@args ] | ||||
349 | #------------------------------------------------------------------------ | ||||
350 | |||||
351 | sub insert { | ||||
352 | my ($self, $nameargs) = @_; | ||||
353 | my ($file, $args) = @$nameargs; | ||||
354 | $file = $self->filenames($file); | ||||
355 | return "$OUTPUT \$context->insert($file);"; | ||||
356 | } | ||||
357 | |||||
358 | |||||
359 | #------------------------------------------------------------------------ | ||||
360 | # include(\@nameargs) [% INCLUDE template foo = bar %] | ||||
361 | # # => [ [ $file, ... ], \@args ] | ||||
362 | #------------------------------------------------------------------------ | ||||
363 | |||||
364 | # spent 38.7ms (33.9+4.83) within Template::Directive::include which was called 1013 times, avg 38µs/call:
# 1013 times (33.9ms+4.83ms) by Template::Grammar::__ANON__[Parser.yp:118] at line 118 of /root/tor-browser-build/Parser.yp, avg 38µs/call | ||||
365 | 1013 | 601µs | my ($self, $nameargs) = @_; | ||
366 | 1013 | 3.59ms | my ($file, $args) = @$nameargs; | ||
367 | 1013 | 894µs | my $hash = shift @$args; | ||
368 | 1013 | 4.52ms | 1013 | 4.83ms | $file = $self->filenames($file); # spent 4.83ms making 1013 calls to Template::Directive::filenames, avg 5µs/call |
369 | 1013 | 908µs | $file .= @$hash ? ', { ' . join(', ', @$hash) . ' }' : ''; | ||
370 | 1013 | 5.53ms | return "$OUTPUT \$context->include($file);"; | ||
371 | } | ||||
372 | |||||
373 | |||||
374 | #------------------------------------------------------------------------ | ||||
375 | # process(\@nameargs) [% PROCESS template foo = bar %] | ||||
376 | # # => [ [ $file, ... ], \@args ] | ||||
377 | #------------------------------------------------------------------------ | ||||
378 | |||||
379 | sub process { | ||||
380 | my ($self, $nameargs) = @_; | ||||
381 | my ($file, $args) = @$nameargs; | ||||
382 | my $hash = shift @$args; | ||||
383 | $file = $self->filenames($file); | ||||
384 | $file .= @$hash ? ', { ' . join(', ', @$hash) . ' }' : ''; | ||||
385 | return "$OUTPUT \$context->process($file);"; | ||||
386 | } | ||||
387 | |||||
388 | |||||
389 | #------------------------------------------------------------------------ | ||||
390 | # if($expr, $block, $else) [% IF foo < bar %] | ||||
391 | # ... | ||||
392 | # [% ELSE %] | ||||
393 | # ... | ||||
394 | # [% END %] | ||||
395 | #------------------------------------------------------------------------ | ||||
396 | |||||
397 | # spent 336ms within Template::Directive::if which was called 37103 times, avg 9µs/call:
# 37103 times (336ms+0s) by Template::Grammar::__ANON__[Parser.yp:141] at line 141 of /root/tor-browser-build/Parser.yp, avg 9µs/call | ||||
398 | 37103 | 30.2ms | my ($self, $expr, $block, $else) = @_; | ||
399 | 37103 | 35.4ms | my @else = $else ? @$else : (); | ||
400 | 37103 | 22.2ms | $else = pop @else; | ||
401 | 37103 | 17.1ms | $block = pad($block, 1) if $PRETTY; | ||
402 | |||||
403 | 37103 | 38.3ms | my $output = "if ($expr) {\n$block\n}\n"; | ||
404 | |||||
405 | 37103 | 34.1ms | foreach my $elsif (@else) { | ||
406 | 2988 | 1.44ms | ($expr, $block) = @$elsif; | ||
407 | 2988 | 474µs | $block = pad($block, 1) if $PRETTY; | ||
408 | 2988 | 3.41ms | $output .= "elsif ($expr) {\n$block\n}\n"; | ||
409 | } | ||||
410 | 37103 | 14.3ms | if (defined $else) { | ||
411 | 9007 | 2.99ms | $else = pad($else, 1) if $PRETTY; | ||
412 | 9007 | 9.84ms | $output .= "else {\n$else\n}\n"; | ||
413 | } | ||||
414 | |||||
415 | 37103 | 287ms | return $output; | ||
416 | } | ||||
417 | |||||
418 | |||||
419 | #------------------------------------------------------------------------ | ||||
420 | # foreach($target, $list, $args, $block) [% FOREACH x = [ foo bar ] %] | ||||
421 | # ... | ||||
422 | # [% END %] | ||||
423 | #------------------------------------------------------------------------ | ||||
424 | |||||
425 | # spent 123ms (103+19.4) within Template::Directive::foreach which was called 5968 times, avg 21µs/call:
# 5968 times (103ms+19.4ms) by Template::Grammar::__ANON__[Parser.yp:168] at line 168 of /root/tor-browser-build/Parser.yp, avg 21µs/call | ||||
426 | 5968 | 9.13ms | my ($self, $target, $list, $args, $block, $label) = @_; | ||
427 | 5968 | 5.52ms | $args = shift @$args; | ||
428 | 5968 | 9.80ms | $args = @$args ? ', { ' . join(', ', @$args) . ' }' : ''; | ||
429 | 5968 | 1.50ms | $label ||= 'LOOP'; | ||
430 | |||||
431 | 5968 | 3.27ms | my ($loop_save, $loop_set, $loop_restore, $setiter); | ||
432 | 5968 | 7.69ms | if ($target) { | ||
433 | 5968 | 15.6ms | 5968 | 19.4ms | $loop_save = 'eval { $_tt_oldloop = ' . &ident($self, ["'loop'"]) . ' }'; # spent 19.4ms making 5968 calls to Template::Directive::ident, avg 3µs/call |
434 | 5968 | 3.79ms | $loop_set = "\$stash->{'$target'} = \$_tt_value"; | ||
435 | 5968 | 4.83ms | $loop_restore = "\$stash->set('loop', \$_tt_oldloop)"; | ||
436 | } | ||||
437 | else { | ||||
438 | $loop_save = '$stash = $context->localise()'; | ||||
439 | # $loop_set = "\$stash->set('import', \$_tt_value) " | ||||
440 | # . "if ref \$value eq 'HASH'"; | ||||
441 | $loop_set = "\$stash->get(['import', [\$_tt_value]]) " | ||||
442 | . "if ref \$_tt_value eq 'HASH'"; | ||||
443 | $loop_restore = '$stash = $context->delocalise()'; | ||||
444 | } | ||||
445 | 5968 | 4.21ms | $block = pad($block, 3) if $PRETTY; | ||
446 | |||||
447 | 5968 | 40.5ms | return <<EOF; | ||
448 | |||||
449 | # FOREACH | ||||
450 | do { | ||||
451 | my (\$_tt_value, \$_tt_error, \$_tt_oldloop); | ||||
452 | my \$_tt_list = $list; | ||||
453 | |||||
454 | unless (UNIVERSAL::isa(\$_tt_list, 'Template::Iterator')) { | ||||
455 | \$_tt_list = Template::Config->iterator(\$_tt_list) | ||||
456 | || die \$Template::Config::ERROR, "\\n"; | ||||
457 | } | ||||
458 | |||||
459 | (\$_tt_value, \$_tt_error) = \$_tt_list->get_first(); | ||||
460 | $loop_save; | ||||
461 | \$stash->set('loop', \$_tt_list); | ||||
462 | eval { | ||||
463 | $label: while (! \$_tt_error) { | ||||
464 | $loop_set; | ||||
465 | $block; | ||||
466 | (\$_tt_value, \$_tt_error) = \$_tt_list->get_next(); | ||||
467 | } | ||||
468 | }; | ||||
469 | $loop_restore; | ||||
470 | die \$@ if \$@; | ||||
471 | \$_tt_error = 0 if \$_tt_error && \$_tt_error eq Template::Constants::STATUS_DONE; | ||||
472 | die \$_tt_error if \$_tt_error; | ||||
473 | }; | ||||
474 | EOF | ||||
475 | } | ||||
476 | |||||
477 | #------------------------------------------------------------------------ | ||||
478 | # next() [% NEXT %] | ||||
479 | # | ||||
480 | # Next iteration of a FOREACH loop (experimental) | ||||
481 | #------------------------------------------------------------------------ | ||||
482 | |||||
483 | sub next { | ||||
484 | my ($self, $label) = @_; | ||||
485 | $label ||= 'LOOP'; | ||||
486 | return <<EOF; | ||||
487 | (\$_tt_value, \$_tt_error) = \$_tt_list->get_next(); | ||||
488 | next $label; | ||||
489 | EOF | ||||
490 | } | ||||
491 | |||||
492 | |||||
493 | #------------------------------------------------------------------------ | ||||
494 | # wrapper(\@nameargs, $block) [% WRAPPER template foo = bar %] | ||||
495 | # # => [ [$file,...], \@args ] | ||||
496 | #------------------------------------------------------------------------ | ||||
497 | |||||
498 | sub wrapper { | ||||
499 | my ($self, $nameargs, $block) = @_; | ||||
500 | my ($file, $args) = @$nameargs; | ||||
501 | my $hash = shift @$args; | ||||
502 | |||||
503 | local $" = ', '; | ||||
504 | # print STDERR "wrapper([@$file], { @$hash })\n"; | ||||
505 | |||||
506 | return $self->multi_wrapper($file, $hash, $block) | ||||
507 | if @$file > 1; | ||||
508 | $file = shift @$file; | ||||
509 | |||||
510 | $block = pad($block, 1) if $PRETTY; | ||||
511 | push(@$hash, "'content'", '$output'); | ||||
512 | $file .= @$hash ? ', { ' . join(', ', @$hash) . ' }' : ''; | ||||
513 | |||||
514 | return <<EOF; | ||||
515 | |||||
516 | # WRAPPER | ||||
517 | $OUTPUT do { | ||||
518 | my \$output = ''; | ||||
519 | $block | ||||
520 | \$context->include($file); | ||||
521 | }; | ||||
522 | EOF | ||||
523 | } | ||||
524 | |||||
525 | |||||
526 | sub multi_wrapper { | ||||
527 | my ($self, $file, $hash, $block) = @_; | ||||
528 | $block = pad($block, 1) if $PRETTY; | ||||
529 | |||||
530 | push(@$hash, "'content'", '$output'); | ||||
531 | $hash = @$hash ? ', { ' . join(', ', @$hash) . ' }' : ''; | ||||
532 | |||||
533 | $file = join(', ', reverse @$file); | ||||
534 | # print STDERR "multi wrapper: $file\n"; | ||||
535 | |||||
536 | return <<EOF; | ||||
537 | |||||
538 | # WRAPPER | ||||
539 | $OUTPUT do { | ||||
540 | my \$output = ''; | ||||
541 | $block | ||||
542 | foreach ($file) { | ||||
543 | \$output = \$context->include(\$_$hash); | ||||
544 | } | ||||
545 | \$output; | ||||
546 | }; | ||||
547 | EOF | ||||
548 | } | ||||
549 | |||||
550 | |||||
551 | #------------------------------------------------------------------------ | ||||
552 | # while($expr, $block) [% WHILE x < 10 %] | ||||
553 | # ... | ||||
554 | # [% END %] | ||||
555 | #------------------------------------------------------------------------ | ||||
556 | |||||
557 | sub while { | ||||
558 | my ($self, $expr, $block, $label) = @_; | ||||
559 | $block = pad($block, 2) if $PRETTY; | ||||
560 | $label ||= 'LOOP'; | ||||
561 | |||||
562 | return <<EOF; | ||||
563 | |||||
564 | # WHILE | ||||
565 | do { | ||||
566 | my \$_tt_failsafe = $WHILE_MAX; | ||||
567 | $label: | ||||
568 | while (--\$_tt_failsafe && ($expr)) { | ||||
569 | $block | ||||
570 | } | ||||
571 | die "WHILE loop terminated (> $WHILE_MAX iterations)\\n" | ||||
572 | unless \$_tt_failsafe; | ||||
573 | }; | ||||
574 | EOF | ||||
575 | } | ||||
576 | |||||
577 | |||||
578 | #------------------------------------------------------------------------ | ||||
579 | # switch($expr, \@case) [% SWITCH %] | ||||
580 | # [% CASE foo %] | ||||
581 | # ... | ||||
582 | # [% END %] | ||||
583 | #------------------------------------------------------------------------ | ||||
584 | |||||
585 | sub switch { | ||||
586 | my ($self, $expr, $case) = @_; | ||||
587 | my @case = @$case; | ||||
588 | my ($match, $block, $default); | ||||
589 | my $caseblock = ''; | ||||
590 | |||||
591 | $default = pop @case; | ||||
592 | |||||
593 | foreach $case (@case) { | ||||
594 | $match = $case->[0]; | ||||
595 | $block = $case->[1]; | ||||
596 | $block = pad($block, 1) if $PRETTY; | ||||
597 | $caseblock .= <<EOF; | ||||
598 | \$_tt_match = $match; | ||||
599 | \$_tt_match = [ \$_tt_match ] unless ref \$_tt_match eq 'ARRAY'; | ||||
600 | if (grep(/^\\Q\$_tt_result\\E\$/, \@\$_tt_match)) { | ||||
601 | $block | ||||
602 | last SWITCH; | ||||
603 | } | ||||
604 | EOF | ||||
605 | } | ||||
606 | |||||
607 | $caseblock .= $default | ||||
608 | if defined $default; | ||||
609 | $caseblock = pad($caseblock, 2) if $PRETTY; | ||||
610 | |||||
611 | return <<EOF; | ||||
612 | |||||
613 | # SWITCH | ||||
614 | do { | ||||
615 | my \$_tt_result = $expr; | ||||
616 | my \$_tt_match; | ||||
617 | SWITCH: { | ||||
618 | $caseblock | ||||
619 | } | ||||
620 | }; | ||||
621 | EOF | ||||
622 | } | ||||
623 | |||||
624 | |||||
625 | #------------------------------------------------------------------------ | ||||
626 | # try($block, \@catch) [% TRY %] | ||||
627 | # ... | ||||
628 | # [% CATCH %] | ||||
629 | # ... | ||||
630 | # [% END %] | ||||
631 | #------------------------------------------------------------------------ | ||||
632 | |||||
633 | sub try { | ||||
634 | my ($self, $block, $catch) = @_; | ||||
635 | my @catch = @$catch; | ||||
636 | my ($match, $mblock, $default, $final, $n); | ||||
637 | my $catchblock = ''; | ||||
638 | my $handlers = []; | ||||
639 | |||||
640 | $block = pad($block, 2) if $PRETTY; | ||||
641 | $final = pop @catch; | ||||
642 | $final = "# FINAL\n" . ($final ? "$final\n" : '') | ||||
643 | . 'die $_tt_error if $_tt_error;' . "\n" . '$output;'; | ||||
644 | $final = pad($final, 1) if $PRETTY; | ||||
645 | |||||
646 | $n = 0; | ||||
647 | foreach $catch (@catch) { | ||||
648 | $match = $catch->[0] || do { | ||||
649 | $default ||= $catch->[1]; | ||||
650 | next; | ||||
651 | }; | ||||
652 | $mblock = $catch->[1]; | ||||
653 | $mblock = pad($mblock, 1) if $PRETTY; | ||||
654 | push(@$handlers, "'$match'"); | ||||
655 | $catchblock .= $n++ | ||||
656 | ? "elsif (\$_tt_handler eq '$match') {\n$mblock\n}\n" | ||||
657 | : "if (\$_tt_handler eq '$match') {\n$mblock\n}\n"; | ||||
658 | } | ||||
659 | $catchblock .= "\$_tt_error = 0;"; | ||||
660 | $catchblock = pad($catchblock, 3) if $PRETTY; | ||||
661 | if ($default) { | ||||
662 | $default = pad($default, 1) if $PRETTY; | ||||
663 | $default = "else {\n # DEFAULT\n$default\n \$_tt_error = '';\n}"; | ||||
664 | } | ||||
665 | else { | ||||
666 | $default = '# NO DEFAULT'; | ||||
667 | } | ||||
668 | $default = pad($default, 2) if $PRETTY; | ||||
669 | |||||
670 | $handlers = join(', ', @$handlers); | ||||
671 | return <<EOF; | ||||
672 | |||||
673 | # TRY | ||||
674 | $OUTPUT do { | ||||
675 | my \$output = ''; | ||||
676 | my (\$_tt_error, \$_tt_handler); | ||||
677 | eval { | ||||
678 | $block | ||||
679 | }; | ||||
680 | if (\$@) { | ||||
681 | \$_tt_error = \$context->catch(\$@, \\\$output); | ||||
682 | die \$_tt_error if \$_tt_error->type =~ /^return|stop\$/; | ||||
683 | \$stash->set('error', \$_tt_error); | ||||
684 | \$stash->set('e', \$_tt_error); | ||||
685 | if (defined (\$_tt_handler = \$_tt_error->select_handler($handlers))) { | ||||
686 | $catchblock | ||||
687 | } | ||||
688 | $default | ||||
689 | } | ||||
690 | $final | ||||
691 | }; | ||||
692 | EOF | ||||
693 | } | ||||
694 | |||||
695 | |||||
696 | #------------------------------------------------------------------------ | ||||
697 | # throw(\@nameargs) [% THROW foo "bar error" %] | ||||
698 | # # => [ [$type], \@args ] | ||||
699 | #------------------------------------------------------------------------ | ||||
700 | |||||
701 | sub throw { | ||||
702 | my ($self, $nameargs) = @_; | ||||
703 | my ($type, $args) = @$nameargs; | ||||
704 | my $hash = shift(@$args); | ||||
705 | my $info = shift(@$args); | ||||
706 | $type = shift @$type; # uses same parser production as INCLUDE | ||||
707 | # etc., which allow multiple names | ||||
708 | # e.g. INCLUDE foo+bar+baz | ||||
709 | |||||
710 | if (! $info) { | ||||
711 | $args = "$type, undef"; | ||||
712 | } | ||||
713 | elsif (@$hash || @$args) { | ||||
714 | local $" = ', '; | ||||
715 | my $i = 0; | ||||
716 | $args = "$type, { args => [ " | ||||
717 | . join(', ', $info, @$args) | ||||
718 | . ' ], ' | ||||
719 | . join(', ', | ||||
720 | (map { "'" . $i++ . "' => $_" } ($info, @$args)), | ||||
721 | @$hash) | ||||
722 | . ' }'; | ||||
723 | } | ||||
724 | else { | ||||
725 | $args = "$type, $info"; | ||||
726 | } | ||||
727 | |||||
728 | return "\$context->throw($args, \\\$output);"; | ||||
729 | } | ||||
730 | |||||
731 | |||||
732 | #------------------------------------------------------------------------ | ||||
733 | # clear() [% CLEAR %] | ||||
734 | # | ||||
735 | # NOTE: this is redundant, being hard-coded (for now) into Parser.yp | ||||
736 | #------------------------------------------------------------------------ | ||||
737 | |||||
738 | sub clear { | ||||
739 | return "\$output = '';"; | ||||
740 | } | ||||
741 | |||||
742 | #------------------------------------------------------------------------ | ||||
743 | # break() [% BREAK %] | ||||
744 | # | ||||
745 | # NOTE: this is redundant, being hard-coded (for now) into Parser.yp | ||||
746 | #------------------------------------------------------------------------ | ||||
747 | |||||
748 | sub OLD_break { | ||||
749 | return 'last LOOP;'; | ||||
750 | } | ||||
751 | |||||
752 | #------------------------------------------------------------------------ | ||||
753 | # return() [% RETURN %] | ||||
754 | #------------------------------------------------------------------------ | ||||
755 | |||||
756 | sub return { | ||||
757 | return "\$context->throw('return', '', \\\$output);"; | ||||
758 | } | ||||
759 | |||||
760 | #------------------------------------------------------------------------ | ||||
761 | # stop() [% STOP %] | ||||
762 | #------------------------------------------------------------------------ | ||||
763 | |||||
764 | sub stop { | ||||
765 | return "\$context->throw('stop', '', \\\$output);"; | ||||
766 | } | ||||
767 | |||||
768 | |||||
769 | #------------------------------------------------------------------------ | ||||
770 | # use(\@lnameargs) [% USE alias = plugin(args) %] | ||||
771 | # # => [ [$file, ...], \@args, $alias ] | ||||
772 | #------------------------------------------------------------------------ | ||||
773 | |||||
774 | sub use { | ||||
775 | my ($self, $lnameargs) = @_; | ||||
776 | my ($file, $args, $alias) = @$lnameargs; | ||||
777 | $file = shift @$file; # same production rule as INCLUDE | ||||
778 | $alias ||= $file; | ||||
779 | $args = &args($self, $args); | ||||
780 | $file .= ", $args" if $args; | ||||
781 | # my $set = &assign($self, $alias, '$plugin'); | ||||
782 | return "# USE\n" | ||||
783 | . "\$stash->set($alias,\n" | ||||
784 | . " \$context->plugin($file));"; | ||||
785 | } | ||||
786 | |||||
787 | #------------------------------------------------------------------------ | ||||
788 | # view(\@nameargs, $block) [% VIEW name args %] | ||||
789 | # # => [ [$file, ... ], \@args ] | ||||
790 | #------------------------------------------------------------------------ | ||||
791 | |||||
792 | sub view { | ||||
793 | my ($self, $nameargs, $block, $defblocks) = @_; | ||||
794 | my ($name, $args) = @$nameargs; | ||||
795 | my $hash = shift @$args; | ||||
796 | $name = shift @$name; # same production rule as INCLUDE | ||||
797 | $block = pad($block, 1) if $PRETTY; | ||||
798 | |||||
799 | if (%$defblocks) { | ||||
800 | $defblocks = join(",\n", map { "'$_' => $defblocks->{ $_ }" } | ||||
801 | keys %$defblocks); | ||||
802 | $defblocks = pad($defblocks, 1) if $PRETTY; | ||||
803 | $defblocks = "{\n$defblocks\n}"; | ||||
804 | push(@$hash, "'blocks'", $defblocks); | ||||
805 | } | ||||
806 | $hash = @$hash ? '{ ' . join(', ', @$hash) . ' }' : ''; | ||||
807 | |||||
808 | return <<EOF; | ||||
809 | # VIEW | ||||
810 | do { | ||||
811 | my \$output = ''; | ||||
812 | my \$_tt_oldv = \$stash->get('view'); | ||||
813 | my \$_tt_view = \$context->view($hash); | ||||
814 | \$stash->set($name, \$_tt_view); | ||||
815 | \$stash->set('view', \$_tt_view); | ||||
816 | |||||
817 | $block | ||||
818 | |||||
819 | \$stash->set('view', \$_tt_oldv); | ||||
820 | \$_tt_view->seal(); | ||||
821 | # \$output; # not used - commented out to avoid warning | ||||
822 | }; | ||||
823 | EOF | ||||
824 | } | ||||
825 | |||||
826 | |||||
827 | #------------------------------------------------------------------------ | ||||
828 | # perl($block) | ||||
829 | #------------------------------------------------------------------------ | ||||
830 | |||||
831 | sub perl { | ||||
832 | my ($self, $block) = @_; | ||||
833 | $block = pad($block, 1) if $PRETTY; | ||||
834 | |||||
835 | return <<EOF; | ||||
836 | |||||
837 | # PERL | ||||
838 | \$context->throw('perl', 'EVAL_PERL not set') | ||||
839 | unless \$context->eval_perl(); | ||||
840 | |||||
841 | $OUTPUT do { | ||||
842 | my \$output = "package Template::Perl;\\n"; | ||||
843 | |||||
844 | $block | ||||
845 | |||||
846 | local(\$Template::Perl::context) = \$context; | ||||
847 | local(\$Template::Perl::stash) = \$stash; | ||||
848 | |||||
849 | my \$_tt_result = ''; | ||||
850 | tie *Template::Perl::PERLOUT, 'Template::TieString', \\\$_tt_result; | ||||
851 | my \$_tt_save_stdout = select *Template::Perl::PERLOUT; | ||||
852 | |||||
853 | eval \$output; | ||||
854 | select \$_tt_save_stdout; | ||||
855 | \$context->throw(\$@) if \$@; | ||||
856 | \$_tt_result; | ||||
857 | }; | ||||
858 | EOF | ||||
859 | } | ||||
860 | |||||
861 | |||||
862 | #------------------------------------------------------------------------ | ||||
863 | # no_perl() | ||||
864 | #------------------------------------------------------------------------ | ||||
865 | |||||
866 | sub no_perl { | ||||
867 | my $self = shift; | ||||
868 | return "\$context->throw('perl', 'EVAL_PERL not set');"; | ||||
869 | } | ||||
870 | |||||
871 | |||||
872 | #------------------------------------------------------------------------ | ||||
873 | # rawperl($block) | ||||
874 | # | ||||
875 | # NOTE: perhaps test context EVAL_PERL switch at compile time rather than | ||||
876 | # runtime? | ||||
877 | #------------------------------------------------------------------------ | ||||
878 | |||||
879 | sub rawperl { | ||||
880 | my ($self, $block, $line) = @_; | ||||
881 | for ($block) { | ||||
882 | s/^\n+//; | ||||
883 | s/\n+$//; | ||||
884 | } | ||||
885 | $block = pad($block, 1) if $PRETTY; | ||||
886 | $line = $line ? " (starting line $line)" : ''; | ||||
887 | |||||
888 | return <<EOF; | ||||
889 | # RAWPERL | ||||
890 | #line 1 "RAWPERL block$line" | ||||
891 | $block | ||||
892 | EOF | ||||
893 | } | ||||
894 | |||||
- - | |||||
897 | #------------------------------------------------------------------------ | ||||
898 | # filter() | ||||
899 | #------------------------------------------------------------------------ | ||||
900 | |||||
901 | sub filter { | ||||
902 | my ($self, $lnameargs, $block) = @_; | ||||
903 | my ($name, $args, $alias) = @$lnameargs; | ||||
904 | $name = shift @$name; | ||||
905 | $args = &args($self, $args); | ||||
906 | $args = $args ? "$args, $alias" : ", undef, $alias" | ||||
907 | if $alias; | ||||
908 | $name .= ", $args" if $args; | ||||
909 | $block = pad($block, 1) if $PRETTY; | ||||
910 | |||||
911 | return <<EOF; | ||||
912 | |||||
913 | # FILTER | ||||
914 | $OUTPUT do { | ||||
915 | my \$output = ''; | ||||
916 | my \$_tt_filter = \$context->filter($name) | ||||
917 | || \$context->throw(\$context->error); | ||||
918 | |||||
919 | $block | ||||
920 | |||||
921 | &\$_tt_filter(\$output); | ||||
922 | }; | ||||
923 | EOF | ||||
924 | } | ||||
925 | |||||
926 | |||||
927 | #------------------------------------------------------------------------ | ||||
928 | # capture($name, $block) | ||||
929 | #------------------------------------------------------------------------ | ||||
930 | |||||
931 | sub capture { | ||||
932 | my ($self, $name, $block) = @_; | ||||
933 | |||||
934 | if (ref $name) { | ||||
935 | if (scalar @$name == 2 && ! $name->[1]) { | ||||
936 | $name = $name->[0]; | ||||
937 | } | ||||
938 | else { | ||||
939 | $name = '[' . join(', ', @$name) . ']'; | ||||
940 | } | ||||
941 | } | ||||
942 | $block = pad($block, 1) if $PRETTY; | ||||
943 | |||||
944 | return <<EOF; | ||||
945 | |||||
946 | # CAPTURE | ||||
947 | \$stash->set($name, do { | ||||
948 | my \$output = ''; | ||||
949 | $block | ||||
950 | \$output; | ||||
951 | }); | ||||
952 | EOF | ||||
953 | |||||
954 | } | ||||
955 | |||||
956 | |||||
957 | #------------------------------------------------------------------------ | ||||
958 | # macro($name, $block, \@args) | ||||
959 | #------------------------------------------------------------------------ | ||||
960 | |||||
961 | sub macro { | ||||
962 | my ($self, $ident, $block, $args) = @_; | ||||
963 | $block = pad($block, 2) if $PRETTY; | ||||
964 | |||||
965 | if ($args) { | ||||
966 | my $nargs = scalar @$args; | ||||
967 | $args = join(', ', map { "'$_'" } @$args); | ||||
968 | $args = $nargs > 1 | ||||
969 | ? "\@_tt_args{ $args } = splice(\@_, 0, $nargs)" | ||||
970 | : "\$_tt_args{ $args } = shift"; | ||||
971 | |||||
972 | return <<EOF; | ||||
973 | |||||
974 | # MACRO | ||||
975 | \$stash->set('$ident', sub { | ||||
976 | my \$output = ''; | ||||
977 | my (%_tt_args, \$_tt_params); | ||||
978 | $args; | ||||
979 | \$_tt_params = shift; | ||||
980 | \$_tt_params = { } unless ref(\$_tt_params) eq 'HASH'; | ||||
981 | \$_tt_params = { \%_tt_args, %\$_tt_params }; | ||||
982 | |||||
983 | my \$stash = \$context->localise(\$_tt_params); | ||||
984 | eval { | ||||
985 | $block | ||||
986 | }; | ||||
987 | \$stash = \$context->delocalise(); | ||||
988 | die \$@ if \$@; | ||||
989 | return \$output; | ||||
990 | }); | ||||
991 | EOF | ||||
992 | |||||
993 | } | ||||
994 | else { | ||||
995 | return <<EOF; | ||||
996 | |||||
997 | # MACRO | ||||
998 | \$stash->set('$ident', sub { | ||||
999 | my \$_tt_params = \$_[0] if ref(\$_[0]) eq 'HASH'; | ||||
1000 | my \$output = ''; | ||||
1001 | |||||
1002 | my \$stash = \$context->localise(\$_tt_params); | ||||
1003 | eval { | ||||
1004 | $block | ||||
1005 | }; | ||||
1006 | \$stash = \$context->delocalise(); | ||||
1007 | die \$@ if \$@; | ||||
1008 | return \$output; | ||||
1009 | }); | ||||
1010 | EOF | ||||
1011 | } | ||||
1012 | } | ||||
1013 | |||||
1014 | |||||
1015 | sub debug { | ||||
1016 | my ($self, $nameargs) = @_; | ||||
1017 | my ($file, $args) = @$nameargs; | ||||
1018 | my $hash = shift @$args; | ||||
1019 | $args = join(', ', @$file, @$args); | ||||
1020 | $args .= @$hash ? ', { ' . join(', ', @$hash) . ' }' : ''; | ||||
1021 | return "$OUTPUT \$context->debugging($args); ## DEBUG ##"; | ||||
1022 | } | ||||
1023 | |||||
1024 | |||||
1025 | 1 | 5µs | 1; | ||
1026 | |||||
1027 | __END__ | ||||
# spent 845ms within Template::Directive::CORE:match which was called 384174 times, avg 2µs/call:
# 384174 times (845ms+0s) by Template::Directive::template at line 76, avg 2µs/call | |||||
sub Template::Directive::CORE:subst; # opcode | |||||
# spent 235ms within Template::Directive::CORE:substcont which was called 252123 times, avg 934ns/call:
# 252123 times (235ms+0s) by Template::Directive::text at line 155, avg 934ns/call | |||||
# spent 600ns within Template::Directive::__ANON__ which was called:
# once (600ns+0s) by Template::Directive::BEGIN@33 at line 33 |