← Index
NYTProf Performance Profile   « line view »
For rbm/rbm
  Run on Wed Feb 12 20:36:06 2020
Reported on Wed Feb 12 21:42:27 2020

Filename/usr/lib/x86_64-linux-gnu/perl5/5.28/Template/Directive.pm
StatementsExecuted 12465579 statements in 31.9s
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
497633227.01s8.44sTemplate::Directive::::textTemplate::Directive::text
495642113.57s12.0sTemplate::Directive::::textblockTemplate::Directive::textblock
376400113.42s4.22sTemplate::Directive::::templateTemplate::Directive::template
378297222.38s2.38sTemplate::Directive::::identTemplate::Directive::ident
375387111.47s1.47sTemplate::Directive::::_initTemplate::Directive::_init
431466111.40s1.40sTemplate::Directive::::blockTemplate::Directive::block
995266211.19s1.19sTemplate::Directive::::CORE:substTemplate::Directive::CORE:subst (opcode)
24279111875ms875msTemplate::Directive::::argsTemplate::Directive::args
37640011803ms803msTemplate::Directive::::CORE:matchTemplate::Directive::CORE:match (opcode)
25734921739ms739msTemplate::Directive::::getTemplate::Directive::get
3710311327ms327msTemplate::Directive::::ifTemplate::Directive::if
25212311236ms236msTemplate::Directive::::CORE:substcontTemplate::Directive::CORE:substcont (opcode)
801321122ms180msTemplate::Directive::::setTemplate::Directive::set
596811111ms131msTemplate::Directive::::foreachTemplate::Directive::foreach
80131158.0ms58.0msTemplate::Directive::::assignTemplate::Directive::assign
10131122.2ms27.7msTemplate::Directive::::includeTemplate::Directive::include
39821113.1ms13.1msTemplate::Directive::::callTemplate::Directive::call
1991119.22ms9.22msTemplate::Directive::::quotedTemplate::Directive::quoted
1013115.43ms5.43msTemplate::Directive::::filenamesTemplate::Directive::filenames
111129µs129µsTemplate::Directive::::BEGIN@33Template::Directive::BEGIN@33
11120µs60µsTemplate::Directive::::BEGIN@31Template::Directive::BEGIN@31
11111µs13µsTemplate::Directive::::BEGIN@29Template::Directive::BEGIN@29
1118µs23µsTemplate::Directive::::BEGIN@32Template::Directive::BEGIN@32
1115µs19µsTemplate::Directive::::BEGIN@30Template::Directive::BEGIN@30
111500ns500nsTemplate::Directive::::__ANON__Template::Directive::__ANON__ (xsub)
0000s0sTemplate::Directive::::OLD_breakTemplate::Directive::OLD_break
0000s0sTemplate::Directive::::anon_blockTemplate::Directive::anon_block
0000s0sTemplate::Directive::::captureTemplate::Directive::capture
0000s0sTemplate::Directive::::clearTemplate::Directive::clear
0000s0sTemplate::Directive::::debugTemplate::Directive::debug
0000s0sTemplate::Directive::::defaultTemplate::Directive::default
0000s0sTemplate::Directive::::filterTemplate::Directive::filter
0000s0sTemplate::Directive::::identrefTemplate::Directive::identref
0000s0sTemplate::Directive::::insertTemplate::Directive::insert
0000s0sTemplate::Directive::::macroTemplate::Directive::macro
0000s0sTemplate::Directive::::multi_wrapperTemplate::Directive::multi_wrapper
0000s0sTemplate::Directive::::nextTemplate::Directive::next
0000s0sTemplate::Directive::::no_perlTemplate::Directive::no_perl
0000s0sTemplate::Directive::::padTemplate::Directive::pad
0000s0sTemplate::Directive::::perlTemplate::Directive::perl
0000s0sTemplate::Directive::::processTemplate::Directive::process
0000s0sTemplate::Directive::::rawperlTemplate::Directive::rawperl
0000s0sTemplate::Directive::::returnTemplate::Directive::return
0000s0sTemplate::Directive::::stopTemplate::Directive::stop
0000s0sTemplate::Directive::::switchTemplate::Directive::switch
0000s0sTemplate::Directive::::throwTemplate::Directive::throw
0000s0sTemplate::Directive::::trace_varsTemplate::Directive::trace_vars
0000s0sTemplate::Directive::::tryTemplate::Directive::try
0000s0sTemplate::Directive::::useTemplate::Directive::use
0000s0sTemplate::Directive::::viewTemplate::Directive::view
0000s0sTemplate::Directive::::whileTemplate::Directive::while
0000s0sTemplate::Directive::::wrapperTemplate::Directive::wrapper
Call graph for these subroutines as a Graphviz dot language file.
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
27package Template::Directive;
28
29220µs215µs
# spent 13µs (11+2) within Template::Directive::BEGIN@29 which was called: # once (11µs+2µs) by Template::Parser::BEGIN@40 at line 29
use strict;
# spent 13µs making 1 call to Template::Directive::BEGIN@29 # spent 2µs making 1 call to strict::import
30221µs232µs
# spent 19µs (5+13) within Template::Directive::BEGIN@30 which was called: # once (5µs+13µs) by Template::Parser::BEGIN@40 at line 30
use warnings;
# spent 19µs making 1 call to Template::Directive::BEGIN@30 # spent 13µs making 1 call to warnings::import
31245µs2101µs
# spent 60µs (20+41) within Template::Directive::BEGIN@31 which was called: # once (20µs+41µs) by Template::Parser::BEGIN@40 at line 31
use base 'Template::Base';
# spent 60µs making 1 call to Template::Directive::BEGIN@31 # spent 41µs making 1 call to base::import
32220µs239µs
# spent 23µs (8+16) within Template::Directive::BEGIN@32 which was called: # once (8µs+16µs) by Template::Parser::BEGIN@40 at line 32
use Template::Constants;
# spent 23µs making 1 call to Template::Directive::BEGIN@32 # spent 16µs making 1 call to Exporter::import
3323.60ms2130µs
# spent 129µs (129+500ns) within Template::Directive::BEGIN@33 which was called: # once (129µs+500ns) by Template::Parser::BEGIN@40 at line 33
use Template::Exception;
# spent 129µs making 1 call to Template::Directive::BEGIN@33 # spent 500ns making 1 call to Template::Directive::__ANON__
34
351300nsour $VERSION = 2.20;
361400nsour $DEBUG = 0 unless defined $DEBUG;
371100nsour $WHILE_MAX = 1000 unless defined $WHILE_MAX;
381100nsour $PRETTY = 0 unless defined $PRETTY;
391300nsour $OUTPUT = '$output .= ';
40
41
42
# spent 1.47s within Template::Directive::_init which was called 375387 times, avg 4µs/call: # 375387 times (1.47s+0s) by Template::Base::new at line 65 of Template/Base.pm, avg 4µs/call
sub _init {
43375387225ms my ($self, $config) = @_;
44375387470ms $self->{ NAMESPACE } = $config->{ NAMESPACE };
453753872.17s return $self;
46}
47
48sub trace_vars {
49 my $self = shift;
50 return @_
51 ? ($self->{ TRACE_VARS } = shift)
52 : $self->{ TRACE_VARS };
53}
54
55sub 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.22s (3.42+803ms) within Template::Directive::template which was called 376400 times, avg 11µs/call: # 376400 times (3.42s+803ms) by Template::Grammar::__ANON__[Parser.yp:64] at line 64 of /root/tor-browser-build/Parser.yp, avg 11µs/call
sub template {
73376400237ms my ($self, $block) = @_;
74376400216ms $block = pad($block, 2) if $PRETTY;
75
763764002.54s376400803ms return "sub { return '' }" unless $block =~ /\S/;
# spent 803ms making 376400 calls to Template::Directive::CORE:match, avg 2µs/call
77
783764002.15s return <<EOF;
79sub {
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}
95EOF
96}
97
98
99#------------------------------------------------------------------------
100# anon_block($block) [% BLOCK %] ... [% END %]
101#------------------------------------------------------------------------
102
103sub 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};
124EOF
125}
126
127
128#------------------------------------------------------------------------
129# block($blocktext)
130#------------------------------------------------------------------------
131
132
# spent 1.40s within Template::Directive::block which was called 431466 times, avg 3µs/call: # 431466 times (1.40s+0s) by Template::Grammar::__ANON__[Parser.yp:67] at line 67 of /root/tor-browser-build/Parser.yp, avg 3µs/call
sub block {
133431466193ms my ($self, $block) = @_;
1344314662.80s return join("\n", @{ $block || [] });
135}
136
137
138#------------------------------------------------------------------------
139# textblock($text)
140#------------------------------------------------------------------------
141
142
# spent 12.0s (3.57+8.41) within Template::Directive::textblock which was called 495642 times, avg 24µs/call: # 495642 times (3.57s+8.41s) by Template::Grammar::__ANON__[Parser.yp:76] at line 76 of /root/tor-browser-build/Parser.yp, avg 24µs/call
sub textblock {
143495642216ms my ($self, $text) = @_;
1444956423.43s4956428.41s return "$OUTPUT " . &text($self, $text) . ';';
# spent 8.41s making 495642 calls to Template::Directive::text, avg 17µs/call
145}
146
147
148#------------------------------------------------------------------------
149# text($text)
150#------------------------------------------------------------------------
151
152
# spent 8.44s (7.01+1.43) within Template::Directive::text which was called 497633 times, avg 17µs/call: # 495642 times (6.99s+1.42s) by Template::Directive::textblock at line 144, avg 17µs/call # 1991 times (23.6ms+6.93ms) by Template::Grammar::__ANON__[Parser.yp:440] at line 440 of /root/tor-browser-build/Parser.yp, avg 15µs/call
sub text {
153497633270ms my ($self, $text) = @_;
154497633493ms for ($text) {
1554976334.32s7497561.02s s/(["\$\@\\])/\\$1/g;
# spent 783ms making 497633 calls to Template::Directive::CORE:subst, avg 2µs/call # spent 236ms making 252123 calls to Template::Directive::CORE:substcont, avg 936ns/call
1564976332.29s497633408ms s/\n/\\n/g;
# spent 408ms making 497633 calls to Template::Directive::CORE:subst, avg 819ns/call
157 }
1584976332.33s return '"' . $text . '"';
159}
160
161
162#------------------------------------------------------------------------
163# quoted(\@items) "foo$bar"
164#------------------------------------------------------------------------
165
166
# spent 9.22ms within Template::Directive::quoted which was called 1991 times, avg 5µs/call: # 1991 times (9.22ms+0s) by Template::Grammar::__ANON__[Parser.yp:307] at line 307 of /root/tor-browser-build/Parser.yp, avg 5µs/call
sub quoted {
16719911.38ms my ($self, $items) = @_;
16819911.34ms return '' unless @$items;
169199118.6ms 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.38s within Template::Directive::ident which was called 378297 times, avg 6µs/call: # 372329 times (2.36s+0s) by Template::Grammar::__ANON__[Parser.yp:305] at line 305 of /root/tor-browser-build/Parser.yp, avg 6µs/call # 5968 times (19.6ms+0s) by Template::Directive::foreach at line 433, avg 3µs/call
sub ident {
182378297185ms my ($self, $ident) = @_;
183378297163ms return "''" unless @$ident;
18437829780.3ms 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
194378297243ms if (ref $self) {
195 # trace variable usage
196378297151ms 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?
210378297219ms 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
219378297484ms if (scalar @$ident <= 2 && ! $ident->[1]) {
220 $ident = $ident->[0];
221 }
222 else {
223246776199ms $ident = '[' . join(', ', @$ident) . ']';
224 }
2253782971.75s return "\$stash->get($ident)";
226}
227
228#------------------------------------------------------------------------
229# identref(\@ident) \foo.bar(baz)
230#------------------------------------------------------------------------
231
232sub 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 58.0ms within Template::Directive::assign which was called 8013 times, avg 7µs/call: # 8013 times (58.0ms+0s) by Template::Directive::set at line 323, avg 7µs/call
sub assign {
250801311.0ms my ($self, $var, $val, $default) = @_;
251
252801315.6ms if (ref $var) {
253 if (scalar @$var == 2 && ! $var->[1]) {
254 $var = $var->[0];
255 }
256 else {
257 $var = '[' . join(', ', @$var) . ']';
258 }
259 }
26080133.64ms $val .= ', 1' if $default;
261801350.5ms return "\$stash->set($var, $val)";
262}
263
264
265#------------------------------------------------------------------------
266# args(\@args) foo, bar, baz = qux
267#------------------------------------------------------------------------
268
269
# spent 875ms within Template::Directive::args which was called 242791 times, avg 4µs/call: # 242791 times (875ms+0s) by Template::Grammar::__ANON__[Parser.yp:342] at line 342 of /root/tor-browser-build/Parser.yp, avg 4µs/call
sub args {
27024279178.7ms my ($self, $args) = @_;
271242791121ms my $hash = shift @$args;
27224279148.6ms push(@$args, '{ ' . join(', ', @$hash) . ' }')
273 if @$hash;
274
27524279185.1ms return '0' unless @$args;
2762427911.29s return '[ ' . join(', ', @$args) . ' ]';
277}
278
279#------------------------------------------------------------------------
280# filenames(\@names)
281#------------------------------------------------------------------------
282
283
# spent 5.43ms within Template::Directive::filenames which was called 1013 times, avg 5µs/call: # 1013 times (5.43ms+0s) by Template::Directive::include at line 368, avg 5µs/call
sub filenames {
2841013555µs my ($self, $names) = @_;
28510131.37ms if (@$names > 1) {
286 $names = '[ ' . join(', ', @$names) . ' ]';
287 }
288 else {
2891013635µs $names = shift @$names;
290 }
291101312.0ms return $names;
292}
293
294
295#------------------------------------------------------------------------
296# get($expr) [% foo %]
297#------------------------------------------------------------------------
298
299
# spent 739ms within Template::Directive::get which was called 257349 times, avg 3µs/call: # 250383 times (727ms+0s) by Template::Grammar::__ANON__[Parser.yp:90] at line 90 of /root/tor-browser-build/Parser.yp, avg 3µs/call # 6966 times (12.8ms+0s) by Template::Grammar::__ANON__[Parser.yp:113] at line 113 of /root/tor-browser-build/Parser.yp, avg 2µs/call
sub get {
300257349118ms my ($self, $expr) = @_;
3012573491.45s return "$OUTPUT $expr;";
302}
303
304
305#------------------------------------------------------------------------
306# call($expr) [% CALL bar %]
307#------------------------------------------------------------------------
308
309
# spent 13.1ms within Template::Directive::call which was called 3982 times, avg 3µs/call: # 3982 times (13.1ms+0s) by Template::Grammar::__ANON__[Parser.yp:114] at line 114 of /root/tor-browser-build/Parser.yp, avg 3µs/call
sub call {
31039823.48ms my ($self, $expr) = @_;
31139822.81ms $expr .= ';';
312398219.8ms return $expr;
313}
314
315
316#------------------------------------------------------------------------
317# set(\@setlist) [% foo = bar, baz = qux %]
318#------------------------------------------------------------------------
319
320
# spent 180ms (122+58.0) within Template::Directive::set which was called 8013 times, avg 22µs/call: # 4031 times (59.3ms+26.6ms) by Template::Grammar::__ANON__[Parser.yp:115] at line 115 of /root/tor-browser-build/Parser.yp, avg 21µs/call # 3982 times (62.9ms+31.4ms) by Template::Grammar::__ANON__[Parser.yp:95] at line 95 of /root/tor-browser-build/Parser.yp, avg 24µs/call
sub set {
32180133.51ms my ($self, $setlist) = @_;
32280132.58ms my $output;
323801370.2ms801358.0ms while (my ($var, $val) = splice(@$setlist, 0, 2)) {
# spent 58.0ms making 8013 calls to Template::Directive::assign, avg 7µs/call
324 $output .= &assign($self, $var, $val) . ";\n";
325 }
32680138.75ms chomp $output;
327801346.5ms return $output;
328}
329
330
331#------------------------------------------------------------------------
332# default(\@setlist) [% DEFAULT foo = bar, baz = qux %]
333#------------------------------------------------------------------------
334
335sub 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
351sub 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 27.7ms (22.2+5.43) within Template::Directive::include which was called 1013 times, avg 27µs/call: # 1013 times (22.2ms+5.43ms) by Template::Grammar::__ANON__[Parser.yp:118] at line 118 of /root/tor-browser-build/Parser.yp, avg 27µs/call
sub include {
3651013519µs my ($self, $nameargs) = @_;
36610132.51ms my ($file, $args) = @$nameargs;
3671013936µs my $hash = shift @$args;
36810134.21ms10135.43ms $file = $self->filenames($file);
# spent 5.43ms making 1013 calls to Template::Directive::filenames, avg 5µs/call
36910131.11ms $file .= @$hash ? ', { ' . join(', ', @$hash) . ' }' : '';
370101313.8ms return "$OUTPUT \$context->include($file);";
371}
372
373
374#------------------------------------------------------------------------
375# process(\@nameargs) [% PROCESS template foo = bar %]
376# # => [ [ $file, ... ], \@args ]
377#------------------------------------------------------------------------
378
379sub 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 327ms within Template::Directive::if which was called 37103 times, avg 9µs/call: # 37103 times (327ms+0s) by Template::Grammar::__ANON__[Parser.yp:141] at line 141 of /root/tor-browser-build/Parser.yp, avg 9µs/call
sub if {
3983710329.6ms my ($self, $expr, $block, $else) = @_;
3993710338.9ms my @else = $else ? @$else : ();
4003710327.5ms $else = pop @else;
4013710319.4ms $block = pad($block, 1) if $PRETTY;
402
4033710335.1ms my $output = "if ($expr) {\n$block\n}\n";
404
4053710327.0ms foreach my $elsif (@else) {
40629881.57ms ($expr, $block) = @$elsif;
4072988392µs $block = pad($block, 1) if $PRETTY;
40829883.56ms $output .= "elsif ($expr) {\n$block\n}\n";
409 }
4103710317.4ms if (defined $else) {
41190073.56ms $else = pad($else, 1) if $PRETTY;
41290077.41ms $output .= "else {\n$else\n}\n";
413 }
414
41537103213ms return $output;
416}
417
418
419#------------------------------------------------------------------------
420# foreach($target, $list, $args, $block) [% FOREACH x = [ foo bar ] %]
421# ...
422# [% END %]
423#------------------------------------------------------------------------
424
425
# spent 131ms (111+19.6) within Template::Directive::foreach which was called 5968 times, avg 22µs/call: # 5968 times (111ms+19.6ms) by Template::Grammar::__ANON__[Parser.yp:168] at line 168 of /root/tor-browser-build/Parser.yp, avg 22µs/call
sub foreach {
42659689.47ms my ($self, $target, $list, $args, $block, $label) = @_;
42759683.80ms $args = shift @$args;
428596819.1ms $args = @$args ? ', { ' . join(', ', @$args) . ' }' : '';
42959681.07ms $label ||= 'LOOP';
430
43159682.73ms my ($loop_save, $loop_set, $loop_restore, $setiter);
43259686.59ms if ($target) {
433596817.2ms596819.6ms $loop_save = 'eval { $_tt_oldloop = ' . &ident($self, ["'loop'"]) . ' }';
# spent 19.6ms making 5968 calls to Template::Directive::ident, avg 3µs/call
43459683.49ms $loop_set = "\$stash->{'$target'} = \$_tt_value";
43559682.90ms $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 }
44559684.16ms $block = pad($block, 3) if $PRETTY;
446
447596852.0ms return <<EOF;
448
449# FOREACH
450do {
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};
474EOF
475}
476
477#------------------------------------------------------------------------
478# next() [% NEXT %]
479#
480# Next iteration of a FOREACH loop (experimental)
481#------------------------------------------------------------------------
482
483sub next {
484 my ($self, $label) = @_;
485 $label ||= 'LOOP';
486 return <<EOF;
487(\$_tt_value, \$_tt_error) = \$_tt_list->get_next();
488next $label;
489EOF
490}
491
492
493#------------------------------------------------------------------------
494# wrapper(\@nameargs, $block) [% WRAPPER template foo = bar %]
495# # => [ [$file,...], \@args ]
496#------------------------------------------------------------------------
497
498sub 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};
522EOF
523}
524
525
526sub 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};
547EOF
548}
549
550
551#------------------------------------------------------------------------
552# while($expr, $block) [% WHILE x < 10 %]
553# ...
554# [% END %]
555#------------------------------------------------------------------------
556
557sub while {
558 my ($self, $expr, $block, $label) = @_;
559 $block = pad($block, 2) if $PRETTY;
560 $label ||= 'LOOP';
561
562 return <<EOF;
563
564# WHILE
565do {
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};
574EOF
575}
576
577
578#------------------------------------------------------------------------
579# switch($expr, \@case) [% SWITCH %]
580# [% CASE foo %]
581# ...
582# [% END %]
583#------------------------------------------------------------------------
584
585sub 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';
600if (grep(/^\\Q\$_tt_result\\E\$/, \@\$_tt_match)) {
601$block
602 last SWITCH;
603}
604EOF
605 }
606
607 $caseblock .= $default
608 if defined $default;
609 $caseblock = pad($caseblock, 2) if $PRETTY;
610
611return <<EOF;
612
613# SWITCH
614do {
615 my \$_tt_result = $expr;
616 my \$_tt_match;
617 SWITCH: {
618$caseblock
619 }
620};
621EOF
622}
623
624
625#------------------------------------------------------------------------
626# try($block, \@catch) [% TRY %]
627# ...
628# [% CATCH %]
629# ...
630# [% END %]
631#------------------------------------------------------------------------
632
633sub 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);
671return <<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};
692EOF
693}
694
695
696#------------------------------------------------------------------------
697# throw(\@nameargs) [% THROW foo "bar error" %]
698# # => [ [$type], \@args ]
699#------------------------------------------------------------------------
700
701sub 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
738sub 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
748sub OLD_break {
749 return 'last LOOP;';
750}
751
752#------------------------------------------------------------------------
753# return() [% RETURN %]
754#------------------------------------------------------------------------
755
756sub return {
757 return "\$context->throw('return', '', \\\$output);";
758}
759
760#------------------------------------------------------------------------
761# stop() [% STOP %]
762#------------------------------------------------------------------------
763
764sub stop {
765 return "\$context->throw('stop', '', \\\$output);";
766}
767
768
769#------------------------------------------------------------------------
770# use(\@lnameargs) [% USE alias = plugin(args) %]
771# # => [ [$file, ...], \@args, $alias ]
772#------------------------------------------------------------------------
773
774sub 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
792sub 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
810do {
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};
823EOF
824}
825
826
827#------------------------------------------------------------------------
828# perl($block)
829#------------------------------------------------------------------------
830
831sub 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};
858EOF
859}
860
861
862#------------------------------------------------------------------------
863# no_perl()
864#------------------------------------------------------------------------
865
866sub 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
879sub 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
892EOF
893}
894
- -
897#------------------------------------------------------------------------
898# filter()
899#------------------------------------------------------------------------
900
901sub 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};
923EOF
924}
925
926
927#------------------------------------------------------------------------
928# capture($name, $block)
929#------------------------------------------------------------------------
930
931sub 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});
952EOF
953
954}
955
956
957#------------------------------------------------------------------------
958# macro($name, $block, \@args)
959#------------------------------------------------------------------------
960
961sub 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});
991EOF
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});
1010EOF
1011 }
1012}
1013
1014
1015sub 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
102516µs1;
1026
1027__END__
 
# spent 803ms within Template::Directive::CORE:match which was called 376400 times, avg 2µs/call: # 376400 times (803ms+0s) by Template::Directive::template at line 76, avg 2µs/call
sub Template::Directive::CORE:match; # opcode
# spent 1.19s within Template::Directive::CORE:subst which was called 995266 times, avg 1µs/call: # 497633 times (783ms+0s) by Template::Directive::text at line 155, avg 2µs/call # 497633 times (408ms+0s) by Template::Directive::text at line 156, avg 819ns/call
sub Template::Directive::CORE:subst; # opcode
# spent 236ms within Template::Directive::CORE:substcont which was called 252123 times, avg 936ns/call: # 252123 times (236ms+0s) by Template::Directive::text at line 155, avg 936ns/call
sub Template::Directive::CORE:substcont; # opcode
# spent 500ns within Template::Directive::__ANON__ which was called: # once (500ns+0s) by Template::Directive::BEGIN@33 at line 33
sub Template::Directive::__ANON__; # xsub
Report produced by the NYTProf 6.06 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.