← Index
NYTProf Performance Profile   « line view »
For starman worker -M FindBin --max-requests 50 --workers 2 --user=kohadev-koha --group kohadev-koha --pid /var/run/koha/kohadev/plack.pid --daemonize --access-log /var/log/koha/kohadev/plack.log --error-log /var/log/koha/kohadev/plack-error.log -E deployment --socket /var/run/koha/kohadev/plack.sock /etc/koha/sites/kohadev/plack.psgi
  Run on Fri Jan 8 14:31:06 2016
Reported on Fri Jan 8 14:31:39 2016

Filename/usr/lib/x86_64-linux-gnu/perl5/5.20/Template/Directive.pm
StatementsExecuted 5145 statements in 13.2ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
293223.08ms5.20msTemplate::Directive::::textTemplate::Directive::text
586211.28ms1.28msTemplate::Directive::::CORE:substTemplate::Directive::CORE:subst (opcode)
29211908µs6.10msTemplate::Directive::::textblockTemplate::Directive::textblock
95011835µs835µsTemplate::Directive::::CORE:substcontTemplate::Directive::CORE:substcont (opcode)
19622754µs754µsTemplate::Directive::::identTemplate::Directive::ident
7931490µs490µsTemplate::Directive::::ifTemplate::Directive::if
11111404µs404µsTemplate::Directive::::blockTemplate::Directive::block
8621145µs145µsTemplate::Directive::::getTemplate::Directive::get
1011123µs153µsTemplate::Directive::::templateTemplate::Directive::template
41172µs88µsTemplate::Directive::::foreachTemplate::Directive::foreach
91170µs95µsTemplate::Directive::::useTemplate::Directive::use
91167µs86µsTemplate::Directive::::includeTemplate::Directive::include
213265µs65µsTemplate::Directive::::argsTemplate::Directive::args
101130µs30µsTemplate::Directive::::CORE:matchTemplate::Directive::CORE:match (opcode)
32129µs36µsTemplate::Directive::::filterTemplate::Directive::filter
11128µs28µsTemplate::Directive::::tryTemplate::Directive::try
21124µs36µsTemplate::Directive::::setTemplate::Directive::set
91120µs20µsTemplate::Directive::::filenamesTemplate::Directive::filenames
11115µs22µsTemplate::Directive::::BEGIN@29Template::Directive::BEGIN@29
11113µs45µsTemplate::Directive::::BEGIN@31Template::Directive::BEGIN@31
21112µs12µsTemplate::Directive::::assignTemplate::Directive::assign
1119µs13µsTemplate::Directive::::BEGIN@30Template::Directive::BEGIN@30
1118µs21µsTemplate::Directive::::BEGIN@32Template::Directive::BEGIN@32
1117µs7µsTemplate::Directive::::BEGIN@33Template::Directive::BEGIN@33
1117µs7µsTemplate::Directive::::_initTemplate::Directive::_init
1114µs4µsTemplate::Directive::::quotedTemplate::Directive::quoted
0000s0sTemplate::Directive::::OLD_breakTemplate::Directive::OLD_break
0000s0sTemplate::Directive::::anon_blockTemplate::Directive::anon_block
0000s0sTemplate::Directive::::callTemplate::Directive::call
0000s0sTemplate::Directive::::captureTemplate::Directive::capture
0000s0sTemplate::Directive::::clearTemplate::Directive::clear
0000s0sTemplate::Directive::::debugTemplate::Directive::debug
0000s0sTemplate::Directive::::defaultTemplate::Directive::default
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::::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, particulary 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
29244µs230µs
# spent 22µs (15+7) within Template::Directive::BEGIN@29 which was called: # once (15µs+7µs) by Template::Parser::BEGIN@40 at line 29
use strict;
# spent 22µs making 1 call to Template::Directive::BEGIN@29 # spent 7µs making 1 call to strict::import
30233µs218µs
# spent 13µs (9+4) within Template::Directive::BEGIN@30 which was called: # once (9µs+4µs) by Template::Parser::BEGIN@40 at line 30
use warnings;
# spent 13µs making 1 call to Template::Directive::BEGIN@30 # spent 4µs making 1 call to warnings::import
31268µs277µs
# spent 45µs (13+32) within Template::Directive::BEGIN@31 which was called: # once (13µs+32µs) by Template::Parser::BEGIN@40 at line 31
use base 'Template::Base';
# spent 45µs making 1 call to Template::Directive::BEGIN@31 # spent 32µs making 1 call to base::import
32240µs234µs
# spent 21µs (8+13) within Template::Directive::BEGIN@32 which was called: # once (8µs+13µs) by Template::Parser::BEGIN@40 at line 32
use Template::Constants;
# spent 21µs making 1 call to Template::Directive::BEGIN@32 # spent 13µs making 1 call to Exporter::import
3323.52ms17µs
# spent 7µs within Template::Directive::BEGIN@33 which was called: # once (7µs+0s) by Template::Parser::BEGIN@40 at line 33
use Template::Exception;
# spent 7µs making 1 call to Template::Directive::BEGIN@33
34
35154µsour $VERSION = 2.20;
36136µsour $DEBUG = 0 unless defined $DEBUG;
37123µsour $WHILE_MAX = 1000 unless defined $WHILE_MAX;
38116µsour $PRETTY = 0 unless defined $PRETTY;
39111µsour $OUTPUT = '$output .= ';
40
41
42
# spent 7µs within Template::Directive::_init which was called: # once (7µs+0s) by Template::Base::new at line 65 of Template/Base.pm
sub _init {
4311µs my ($self, $config) = @_;
4414µs $self->{ NAMESPACE } = $config->{ NAMESPACE };
4515µs 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 153µs (123+30) within Template::Directive::template which was called 10 times, avg 15µs/call: # 10 times (123µs+30µs) by Template::Grammar::__ANON__[Parser.yp:64] at line 64 of Parser.yp, avg 15µs/call
sub template {
73108µs my ($self, $block) = @_;
74103µs $block = pad($block, 2) if $PRETTY;
75
761064µs1030µs return "sub { return '' }" unless $block =~ /\S/;
# spent 30µs making 10 calls to Template::Directive::CORE:match, avg 3µs/call
77
781090µs 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 404µs within Template::Directive::block which was called 111 times, avg 4µs/call: # 111 times (404µs+0s) by Template::Grammar::__ANON__[Parser.yp:67] at line 67 of Parser.yp, avg 4µs/call
sub block {
13311127µs my ($self, $block) = @_;
134111538µs return join("\n", @{ $block || [] });
135}
136
137
138#------------------------------------------------------------------------
139# textblock($text)
140#------------------------------------------------------------------------
141
142
# spent 6.10ms (908µs+5.19) within Template::Directive::textblock which was called 292 times, avg 21µs/call: # 292 times (908µs+5.19ms) by Template::Grammar::__ANON__[Parser.yp:76] at line 76 of Parser.yp, avg 21µs/call
sub textblock {
14329283µs my ($self, $text) = @_;
144292808µs2925.19ms return "$OUTPUT " . &text($self, $text) . ';';
# spent 5.19ms making 292 calls to Template::Directive::text, avg 18µs/call
145}
146
147
148#------------------------------------------------------------------------
149# text($text)
150#------------------------------------------------------------------------
151
152
# spent 5.20ms (3.08+2.12) within Template::Directive::text which was called 293 times, avg 18µs/call: # 292 times (3.08ms+2.11ms) by Template::Directive::textblock at line 144, avg 18µs/call # once (9µs+4µs) by Template::Grammar::__ANON__[Parser.yp:440] at line 440 of Parser.yp
sub text {
15329364µs my ($self, $text) = @_;
154293152µs for ($text) {
1552933.28ms12431.45ms s/(["\$\@\\])/\\$1/g;
# spent 835µs making 950 calls to Template::Directive::CORE:substcont, avg 879ns/call # spent 614µs making 293 calls to Template::Directive::CORE:subst, avg 2µs/call
1562931.30ms293668µs s/\n/\\n/g;
# spent 668µs making 293 calls to Template::Directive::CORE:subst, avg 2µs/call
157 }
158293648µs return '"' . $text . '"';
159}
160
161
162#------------------------------------------------------------------------
163# quoted(\@items) "foo$bar"
164#------------------------------------------------------------------------
165
166
# spent 4µs within Template::Directive::quoted which was called: # once (4µs+0s) by Template::Grammar::__ANON__[Parser.yp:307] at line 307 of Parser.yp
sub quoted {
1671500ns my ($self, $items) = @_;
1681300ns return '' unless @$items;
16916µs 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 754µs within Template::Directive::ident which was called 196 times, avg 4µs/call: # 192 times (738µs+0s) by Template::Grammar::__ANON__[Parser.yp:305] at line 305 of Parser.yp, avg 4µs/call # 4 times (17µs+0s) by Template::Directive::foreach at line 433, avg 4µs/call
sub ident {
18219641µs my ($self, $ident) = @_;
18319629µs return "''" unless @$ident;
18419623µs 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
19419685µs if (ref $self) {
195 # trace variable usage
19619646µs 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?
21019666µs 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
219196101µs if (scalar @$ident <= 2 && ! $ident->[1]) {
220 $ident = $ident->[0];
221 }
222 else {
2235590µs $ident = '[' . join(', ', @$ident) . ']';
224 }
225196524µs 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 12µs within Template::Directive::assign which was called 2 times, avg 6µs/call: # 2 times (12µs+0s) by Template::Directive::set at line 323, avg 6µs/call
sub assign {
25021µs my ($self, $var, $val, $default) = @_;
251
25223µs if (ref $var) {
253 if (scalar @$var == 2 && ! $var->[1]) {
254 $var = $var->[0];
255 }
256 else {
257 $var = '[' . join(', ', @$var) . ']';
258 }
259 }
2602700ns $val .= ', 1' if $default;
261210µs return "\$stash->set($var, $val)";
262}
263
264
265#------------------------------------------------------------------------
266# args(\@args) foo, bar, baz = qux
267#------------------------------------------------------------------------
268
269
# spent 65µs within Template::Directive::args which was called 21 times, avg 3µs/call: # 9 times (32µs+0s) by Template::Grammar::__ANON__[Parser.yp:342] at line 342 of Parser.yp, avg 4µs/call # 9 times (25µs+0s) by Template::Directive::use at line 779, avg 3µs/call # 3 times (7µs+0s) by Template::Directive::filter at line 905, avg 2µs/call
sub args {
270215µs my ($self, $args) = @_;
271218µs my $hash = shift @$args;
272214µs push(@$args, '{ ' . join(', ', @$hash) . ' }')
273 if @$hash;
274
2752135µs return '0' unless @$args;
2761040µs return '[ ' . join(', ', @$args) . ' ]';
277}
278
279#------------------------------------------------------------------------
280# filenames(\@names)
281#------------------------------------------------------------------------
282
283
# spent 20µs within Template::Directive::filenames which was called 9 times, avg 2µs/call: # 9 times (20µs+0s) by Template::Directive::include at line 368, avg 2µs/call
sub filenames {
28492µs my ($self, $names) = @_;
28595µs if (@$names > 1) {
286 $names = '[ ' . join(', ', @$names) . ' ]';
287 }
288 else {
28993µs $names = shift @$names;
290 }
291920µs return $names;
292}
293
294
295#------------------------------------------------------------------------
296# get($expr) [% foo %]
297#------------------------------------------------------------------------
298
299
# spent 145µs within Template::Directive::get which was called 86 times, avg 2µs/call: # 85 times (144µs+0s) by Template::Grammar::__ANON__[Parser.yp:90] at line 90 of Parser.yp, avg 2µs/call # once (1µs+0s) by Template::Grammar::__ANON__[Parser.yp:109] at line 109 of Parser.yp
sub get {
3008621µs my ($self, $expr) = @_;
30186235µs return "$OUTPUT $expr;";
302}
303
304
305#------------------------------------------------------------------------
306# call($expr) [% CALL bar %]
307#------------------------------------------------------------------------
308
309sub call {
310 my ($self, $expr) = @_;
311 $expr .= ';';
312 return $expr;
313}
314
315
316#------------------------------------------------------------------------
317# set(\@setlist) [% foo = bar, baz = qux %]
318#------------------------------------------------------------------------
319
320
# spent 36µs (24+12) within Template::Directive::set which was called 2 times, avg 18µs/call: # 2 times (24µs+12µs) by Template::Grammar::__ANON__[Parser.yp:115] at line 115 of Parser.yp, avg 18µs/call
sub set {
3212900ns my ($self, $setlist) = @_;
3222800ns my $output;
323213µs212µs while (my ($var, $val) = splice(@$setlist, 0, 2)) {
# spent 12µs making 2 calls to Template::Directive::assign, avg 6µs/call
324 $output .= &assign($self, $var, $val) . ";\n";
325 }
32623µs chomp $output;
32727µs 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 86µs (67+20) within Template::Directive::include which was called 9 times, avg 10µs/call: # 9 times (67µs+20µs) by Template::Grammar::__ANON__[Parser.yp:118] at line 118 of Parser.yp, avg 10µs/call
sub include {
36593µs my ($self, $nameargs) = @_;
36695µs my ($file, $args) = @$nameargs;
36794µs my $hash = shift @$args;
368915µs920µs $file = $self->filenames($file);
# spent 20µs making 9 calls to Template::Directive::filenames, avg 2µs/call
36998µs $file .= @$hash ? ', { ' . join(', ', @$hash) . ' }' : '';
370929µs 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 490µs within Template::Directive::if which was called 79 times, avg 6µs/call: # 77 times (477µs+0s) by Template::Grammar::__ANON__[Parser.yp:141] at line 141 of Parser.yp, avg 6µs/call # once (8µs+0s) by Template::Grammar::__ANON__[Parser.yp:145] at line 145 of Parser.yp # once (5µs+0s) by Template::Grammar::__ANON__[Parser.yp:144] at line 144 of Parser.yp
sub if {
3987929µs my ($self, $expr, $block, $else) = @_;
3997940µs my @else = $else ? @$else : ();
4007924µs $else = pop @else;
4017915µs $block = pad($block, 1) if $PRETTY;
402
40379146µs my $output = "if ($expr) {\n$block\n}\n";
404
4057960µs foreach my $elsif (@else) {
406 ($expr, $block) = @$elsif;
407 $block = pad($block, 1) if $PRETTY;
408 $output .= "elsif ($expr) {\n$block\n}\n";
409 }
4107921µs if (defined $else) {
411153µs $else = pad($else, 1) if $PRETTY;
4121553µs $output .= "else {\n$else\n}\n";
413 }
414
41579195µs return $output;
416}
417
418
419#------------------------------------------------------------------------
420# foreach($target, $list, $args, $block) [% FOREACH x = [ foo bar ] %]
421# ...
422# [% END %]
423#------------------------------------------------------------------------
424
425
# spent 88µs (72+17) within Template::Directive::foreach which was called 4 times, avg 22µs/call: # 4 times (72µs+17µs) by Template::Grammar::__ANON__[Parser.yp:168] at line 168 of Parser.yp, avg 22µs/call
sub foreach {
42643µs my ($self, $target, $list, $args, $block, $label) = @_;
42742µs $args = shift @$args;
42842µs $args = @$args ? ', { ' . join(', ', @$args) . ' }' : '';
4294800ns $label ||= 'LOOP';
430
4314600ns my ($loop_save, $loop_set, $loop_restore, $setiter);
43242µs if ($target) {
433410µs417µs $loop_save = 'eval { $_tt_oldloop = ' . &ident($self, ["'loop'"]) . ' }';
# spent 17µs making 4 calls to Template::Directive::ident, avg 4µs/call
43445µs $loop_set = "\$stash->{'$target'} = \$_tt_value";
43542µs $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 }
4454900ns $block = pad($block, 3) if $PRETTY;
446
447441µs 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
633
# spent 28µs within Template::Directive::try which was called: # once (28µs+0s) by Template::Grammar::__ANON__[Parser.yp:187] at line 187 of Parser.yp
sub try {
6341500ns my ($self, $block, $catch) = @_;
6351800ns my @catch = @$catch;
6361500ns my ($match, $mblock, $default, $final, $n);
6371400ns my $catchblock = '';
6381400ns my $handlers = [];
639
6401400ns $block = pad($block, 2) if $PRETTY;
6411400ns $final = pop @catch;
64212µs $final = "# FINAL\n" . ($final ? "$final\n" : '')
643 . 'die $_tt_error if $_tt_error;' . "\n" . '$output;';
6441200ns $final = pad($final, 1) if $PRETTY;
645
6461400ns $n = 0;
64711µs foreach $catch (@catch) {
64811µs $match = $catch->[0] || do {
6491500ns $default ||= $catch->[1];
6501500ns 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 }
6591500ns $catchblock .= "\$_tt_error = 0;";
6601300ns $catchblock = pad($catchblock, 3) if $PRETTY;
6611500ns if ($default) {
6621200ns $default = pad($default, 1) if $PRETTY;
66312µs $default = "else {\n # DEFAULT\n$default\n \$_tt_error = '';\n}";
664 }
665 else {
666 $default = '# NO DEFAULT';
667 }
6681300ns $default = pad($default, 2) if $PRETTY;
669
67011µs $handlers = join(', ', @$handlers);
671117µsreturn <<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
774
# spent 95µs (70+25) within Template::Directive::use which was called 9 times, avg 11µs/call: # 9 times (70µs+25µs) by Template::Grammar::__ANON__[Parser.yp:203] at line 203 of Parser.yp, avg 11µs/call
sub use {
77593µs my ($self, $lnameargs) = @_;
77696µs my ($file, $args, $alias) = @$lnameargs;
77794µs $file = shift @$file; # same production rule as INCLUDE
77892µs $alias ||= $file;
779913µs925µs $args = &args($self, $args);
# spent 25µs making 9 calls to Template::Directive::args, avg 3µs/call
78092µs $file .= ", $args" if $args;
781# my $set = &assign($self, $alias, '$plugin');
782937µs 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
901
# spent 36µs (29+7) within Template::Directive::filter which was called 3 times, avg 12µs/call: # 2 times (18µs+5µs) by Template::Grammar::__ANON__[Parser.yp:227] at line 227 of Parser.yp, avg 12µs/call # once (11µs+3µs) by Template::Grammar::__ANON__[Parser.yp:229] at line 229 of Parser.yp
sub filter {
90232µs my ($self, $lnameargs, $block) = @_;
90332µs my ($name, $args, $alias) = @$lnameargs;
90432µs $name = shift @$name;
90533µs37µs $args = &args($self, $args);
# spent 7µs making 3 calls to Template::Directive::args, avg 2µs/call
9063700ns $args = $args ? "$args, $alias" : ", undef, $alias"
907 if $alias;
90833µs $name .= ", $args" if $args;
9093800ns $block = pad($block, 1) if $PRETTY;
910
911316µs 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
1025114µs1;
1026
1027__END__
 
# spent 30µs within Template::Directive::CORE:match which was called 10 times, avg 3µs/call: # 10 times (30µs+0s) by Template::Directive::template at line 76, avg 3µs/call
sub Template::Directive::CORE:match; # opcode
# spent 1.28ms within Template::Directive::CORE:subst which was called 586 times, avg 2µs/call: # 293 times (668µs+0s) by Template::Directive::text at line 156, avg 2µs/call # 293 times (614µs+0s) by Template::Directive::text at line 155, avg 2µs/call
sub Template::Directive::CORE:subst; # opcode
# spent 835µs within Template::Directive::CORE:substcont which was called 950 times, avg 879ns/call: # 950 times (835µs+0s) by Template::Directive::text at line 155, avg 879ns/call
sub Template::Directive::CORE:substcont; # opcode
Report produced by the NYTProf 6.02 Perl profiler, developed by Tim Bunce and Adam Kaplan.