← Index
NYTProf Performance Profile   « block view • line view • sub view »
For /usr/bin/epoll_server.pl
  Run on Wed Jan 5 05:34:33 2011
Reported on Wed Jan 5 05:42:56 2011

File /usr/lib/perl5/vendor_perl/5.10.1/i386-linux-thread-multi/Template/Document.pm
Statements Executed 329
Statement Execution Time 26.0ms
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
91118.2ms18.3msTemplate::Document::::newTemplate::Document::new
14113.41ms16.7sTemplate::Document::::processTemplate::Document::process
912137µs137µsTemplate::Document::::CORE:matchTemplate::Document::CORE:match (opcode)
111117µs129µsTemplate::Document::::BEGIN@24Template::Document::BEGIN@24
101159µs59µsTemplate::Document::::blocksTemplate::Document::blocks
11133µs105µsTemplate::Document::::BEGIN@27Template::Document::BEGIN@27
11132µs86µsTemplate::Document::::BEGIN@25Template::Document::BEGIN@25
11131µs203µsTemplate::Document::::BEGIN@26Template::Document::BEGIN@26
11126µs26µsTemplate::Document::::BEGIN@34Template::Document::BEGIN@34
0000s0sTemplate::Document::::AUTOLOADTemplate::Document::AUTOLOAD
0000s0sTemplate::Document::::_dumpTemplate::Document::_dump
0000s0sTemplate::Document::::as_perlTemplate::Document::as_perl
0000s0sTemplate::Document::::blockTemplate::Document::block
0000s0sTemplate::Document::::catch_warningsTemplate::Document::catch_warnings
0000s0sTemplate::Document::::write_perl_fileTemplate::Document::write_perl_file
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::Document
4#
5# DESCRIPTION
6# Module defining a class of objects which encapsulate compiled
7# templates, storing additional block definitions and metadata
8# as well as the compiled Perl sub-routine representing the main
9# template content.
10#
11# AUTHOR
12# Andy Wardley <abw@wardley.org>
13#
14# COPYRIGHT
15# Copyright (C) 1996-2007 Andy Wardley. All Rights Reserved.
16#
17# This module is free software; you can redistribute it and/or
18# modify it under the same terms as Perl itself.
19#
20#============================================================================
21
22package Template::Document;
23
24391µs2141µs
# spent 129µs (117+12) within Template::Document::BEGIN@24 which was called # once (117µs+12µs) by Template::Provider::BEGIN@46 at line 24
use strict;
# spent 129µs making 1 call to Template::Document::BEGIN@24 # spent 12µs making 1 call to strict::import
25387µs2141µs
# spent 86µs (32+55) within Template::Document::BEGIN@25 which was called # once (32µs+55µs) by Template::Provider::BEGIN@46 at line 25
use warnings;
# spent 86µs making 1 call to Template::Document::BEGIN@25 # spent 55µs making 1 call to warnings::import
263141µs2203µs
# spent 203µs (31+172) within Template::Document::BEGIN@26 which was called # once (31µs+172µs) by Template::Provider::BEGIN@46 at line 26
use base 'Template::Base';
# spent 203µs making 1 call to Template::Document::BEGIN@26 # spent 172µs making 1 call to base::import, recursion: max depth 1, time 172µs
273477µs2177µs
# spent 105µs (33+72) within Template::Document::BEGIN@27 which was called # once (33µs+72µs) by Template::Provider::BEGIN@46 at line 27
use Template::Constants;
# spent 105µs making 1 call to Template::Document::BEGIN@27 # spent 72µs making 1 call to Exporter::import
28
2912µsour $VERSION = 2.79;
3012µsour $DEBUG = 0 unless defined $DEBUG;
3112µsour $ERROR = '';
3212µsour ($COMPERR, $AUTOLOAD, $UNICODE);
33
34
# spent 26µs within Template::Document::BEGIN@34 which was called # once (26µs+0s) by Template::Provider::BEGIN@46 at line 47
BEGIN {
35 # UNICODE is supported in versions of Perl from 5.008 onwards
36120µs if ($UNICODE = $] > 5.007 ? 1 : 0) {
3717µs if ($] > 5.008) {
38 # utf8::is_utf8() available from Perl 5.8.1 onwards
39 *is_utf8 = \&utf8::is_utf8;
40 }
41 elsif ($] == 5.008) {
42 # use Encode::is_utf8() for Perl 5.8.0
43 require Encode;
44 *is_utf8 = \&Encode::is_utf8;
45 }
46 }
4713.39ms126µs}
# spent 26µs making 1 call to Template::Document::BEGIN@34
48
49
50#========================================================================
51# ----- PUBLIC METHODS -----
52#========================================================================
53
54#------------------------------------------------------------------------
55# new(\%document)
56#
57# Creates a new self-contained Template::Document object which
58# encapsulates a compiled Perl sub-routine, $block, any additional
59# BLOCKs defined within the document ($defblocks, also Perl sub-routines)
60# and additional $metadata about the document.
61#------------------------------------------------------------------------
62
63
# spent 18.3ms (18.2+137µs) within Template::Document::new which was called 9 times, avg 2.04ms/call: # 9 times (18.2ms+137µs) by Template::Provider::_compile at line 894 of Template/Provider.pm, avg 2.04ms/call
sub new {
64931µs my ($class, $doc) = @_;
65975µs my ($block, $defblocks, $metadata) = @$doc{ qw( BLOCK DEFBLOCKS METADATA ) };
66914µs $defblocks ||= { };
67912µs $metadata ||= { };
68
69 # evaluate Perl code in $block to create sub-routine reference if necessary
70928µs unless (ref $block) {
719124µs local $SIG{__WARN__} = \&catch_warnings;
72919µs $COMPERR = '';
73
74 # DON'T LOOK NOW! - blindly untainting can make you go blind!
759389µs9137µs $block =~ /(.*)/s;
# spent 137µs making 9 calls to Template::Document::CORE:match, avg 15µs/call
76987µs $block = $1;
77
78917.0ms1484µs $block = eval $block;
# spent 84µs making 14 calls to Template::Context::stash, avg 6µs/call
799109µs return $class->error($@)
80 unless defined $block;
81 }
82
83 # same for any additional BLOCK definitions
84 @$defblocks{ keys %$defblocks } =
85 # MORE BLIND UNTAINTING - turn away if you're squeamish
86 map {
87995µs ref($_)
88 ? $_
89 : ( /(.*)/s && eval($1) or return $class->error($@) )
90 } values %$defblocks;
91
929292µs bless {
93 %$metadata,
94 _BLOCK => $block,
95 _DEFBLOCKS => $defblocks,
96 _HOT => 0,
97 }, $class;
98}
99
100
101#------------------------------------------------------------------------
102# block()
103#
104# Returns a reference to the internal sub-routine reference, _BLOCK,
105# that constitutes the main document template.
106#------------------------------------------------------------------------
107
108sub block {
109 return $_[0]->{ _BLOCK };
110}
111
112
113#------------------------------------------------------------------------
114# blocks()
115#
116# Returns a reference to a hash array containing any BLOCK definitions
117# from the template. The hash keys are the BLOCK nameand the values
118# are references to Template::Document objects. Returns 0 (# an empty hash)
119# if no blocks are defined.
120#------------------------------------------------------------------------
121
122
# spent 59µs within Template::Document::blocks which was called 10 times, avg 6µs/call: # 10 times (59µs+0s) by Template::Context::process at line 339 of Template/Context.pm, avg 6µs/call
sub blocks {
12310136µs return $_[0]->{ _DEFBLOCKS };
124}
125
126
127#------------------------------------------------------------------------
128# process($context)
129#
130# Process the document in a particular context. Checks for recursion,
131# registers the document with the context via visit(), processes itself,
132# and then unwinds with a large gin and tonic.
133#------------------------------------------------------------------------
134
135
# spent 16.7s (3.41ms+16.7) within Template::Document::process which was called 14 times, avg 1.19s/call: # 14 times (3.41ms+16.7s) by Template::Context::process at line 347 of Template/Context.pm, avg 1.19s/call
sub process {
13614141µs my ($self, $context) = @_;
1371426µs my $defblocks = $self->{ _DEFBLOCKS };
1381415µs my $output;
139
140
141 # check we're not already visiting this template
142 return $context->throw(Template::Constants::ERROR_FILE,
143 "recursion into '$self->{ name }'")
1441420µs if $self->{ _HOT } && ! $context->{ RECURSION }; ## RETURN ##
145
14614266µs14303µs $context->visit($self, $defblocks);
# spent 303µs making 14 calls to Template::Context::visit, avg 22µs/call
147
1481427µs $self->{ _HOT } = 1;
1491441µs eval {
1501455µs my $block = $self->{ _BLOCK };
15114373µs1416.8s $output = &$block($context);
# spent 16.4s making 1 call to Template::Document::__ANON__[Epoll/root/templates/admin/voters.tt:105] # spent 173ms making 3 calls to Template::Document::__ANON__[Epoll/root/mail/voting_passwd.tt:39], avg 57.7ms/call # spent 76.7ms making 1 call to Template::Document::__ANON__[Epoll/root/templates/includes/header.tt:65] # spent 49.4ms making 1 call to Template::Document::__ANON__[Epoll/root/templates/includes/admin_menu.tt:31] # spent 27.0ms making 1 call to Template::Document::__ANON__[Epoll/root/templates/includes/locale_select_form.tt:13] # spent 10.2ms making 1 call to Template::Document::__ANON__[Epoll/root/templates/includes/footer.tt:15] # spent 2.82ms making 2 calls to Template::Document::__ANON__[Epoll/root/templates/includes/locale_select.tt:36], avg 1.41ms/call # spent 175µs making 3 calls to Template::Document::__ANON__[Epoll/root/mail/includes/loc.tt:17], avg 58µs/call # spent 90µs making 1 call to Template::Document::__ANON__[Epoll/root/templates/includes/loc.tt:17]
152 };
1531436µs $self->{ _HOT } = 0;
154
15514105µs14118µs $context->leave();
# spent 118µs making 14 calls to Template::Context::leave, avg 8µs/call
156
1571416µs die $context->catch($@)
158 if $@;
159
160142.25ms return $output;
161}
162
163
164#------------------------------------------------------------------------
165# AUTOLOAD
166#
167# Provides pseudo-methods for read-only access to various internal
168# members.
169#------------------------------------------------------------------------
170
171sub AUTOLOAD {
172 my $self = shift;
173 my $method = $AUTOLOAD;
174
175 $method =~ s/.*:://;
176 return if $method eq 'DESTROY';
177# my ($pkg, $file, $line) = caller();
178# print STDERR "called $self->AUTOLOAD($method) from $file line $line\n";
179 return $self->{ $method };
180}
181
182
183#========================================================================
184# ----- PRIVATE METHODS -----
185#========================================================================
186
187
188#------------------------------------------------------------------------
189# _dump()
190#
191# Debug method which returns a string representing the internal state
192# of the object.
193#------------------------------------------------------------------------
194
195sub _dump {
196 my $self = shift;
197 my $dblks;
198 my $output = "$self : $self->{ name }\n";
199
200 $output .= "BLOCK: $self->{ _BLOCK }\nDEFBLOCKS:\n";
201
202 if ($dblks = $self->{ _DEFBLOCKS }) {
203 foreach my $b (keys %$dblks) {
204 $output .= " $b: $dblks->{ $b }\n";
205 }
206 }
207
208 return $output;
209}
210
211
212#========================================================================
213# ----- CLASS METHODS -----
214#========================================================================
215
216#------------------------------------------------------------------------
217# as_perl($content)
218#
219# This method expects a reference to a hash passed as the first argument
220# containing 3 items:
221# METADATA # a hash of template metadata
222# BLOCK # string containing Perl sub definition for main block
223# DEFBLOCKS # hash containing further subs for addional BLOCK defs
224# It returns a string containing Perl code which, when evaluated and
225# executed, will instantiate a new Template::Document object with the
226# above data. On error, it returns undef with an appropriate error
227# message set in $ERROR.
228#------------------------------------------------------------------------
229
230sub as_perl {
231 my ($class, $content) = @_;
232 my ($block, $defblocks, $metadata) = @$content{ qw( BLOCK DEFBLOCKS METADATA ) };
233
234 $block =~ s/\n(?!#line)/\n /g;
235 $block =~ s/\s+$//;
236
237 $defblocks = join('', map {
238 my $code = $defblocks->{ $_ };
239 $code =~ s/\n(?!#line)/\n /g;
240 $code =~ s/\s*$//;
241 " '$_' => $code,\n";
242 } keys %$defblocks);
243 $defblocks =~ s/\s+$//;
244
245 $metadata = join('', map {
246 my $x = $metadata->{ $_ };
247 $x =~ s/(['\\])/\\$1/g;
248 " '$_' => '$x',\n";
249 } keys %$metadata);
250 $metadata =~ s/\s+$//;
251
252 return <<EOF
253#------------------------------------------------------------------------
254# Compiled template generated by the Template Toolkit version $Template::VERSION
255#------------------------------------------------------------------------
256
257$class->new({
258 METADATA => {
259$metadata
260 },
261 BLOCK => $block,
262 DEFBLOCKS => {
263$defblocks
264 },
265});
266EOF
267}
268
269
270#------------------------------------------------------------------------
271# write_perl_file($filename, \%content)
272#
273# This method calls as_perl() to generate the Perl code to represent a
274# compiled template with the content passed as the second argument.
275# It then writes this to the file denoted by the first argument.
276#
277# Returns 1 on success. On error, sets the $ERROR package variable
278# to contain an error message and returns undef.
279#------------------------------------------------------------------------
280
281sub write_perl_file {
282 my ($class, $file, $content) = @_;
283 my ($fh, $tmpfile);
284
285 return $class->error("invalid filename: $file")
286 unless $file =~ /^(.+)$/s;
287
288 eval {
289 require File::Temp;
290 require File::Basename;
291 ($fh, $tmpfile) = File::Temp::tempfile(
292 DIR => File::Basename::dirname($file)
293 );
294 my $perlcode = $class->as_perl($content) || die $!;
295
296 if ($UNICODE && is_utf8($perlcode)) {
297 $perlcode = "use utf8;\n\n$perlcode";
298 binmode $fh, ":utf8";
299 }
300 print $fh $perlcode;
301 close($fh);
302 };
303 return $class->error($@) if $@;
304 return rename($tmpfile, $file)
305 || $class->error($!);
306}
307
308
309#------------------------------------------------------------------------
310# catch_warnings($msg)
311#
312# Installed as
313#------------------------------------------------------------------------
314
315sub catch_warnings {
316 $COMPERR .= join('', @_);
317}
318
319
320113µs1;
321
322__END__
323
324=head1 NAME
325
326Template::Document - Compiled template document object
327
328=head1 SYNOPSIS
329
330 use Template::Document;
331
332 $doc = Template::Document->new({
333 BLOCK => sub { # some perl code; return $some_text },
334 DEFBLOCKS => {
335 header => sub { # more perl code; return $some_text },
336 footer => sub { # blah blah blah; return $some_text },
337 },
338 METADATA => {
339 author => 'Andy Wardley',
340 version => 3.14,
341 }
342 }) || die $Template::Document::ERROR;
343
344 print $doc->process($context);
345
346=head1 DESCRIPTION
347
348This module defines an object class whose instances represent compiled
349template documents. The L<Template::Parser> module creates a
350C<Template::Document> instance to encapsulate a template as it is compiled
351into Perl code.
352
353The constructor method, L<new()>, expects a reference to a hash array
354containing the C<BLOCK>, C<DEFBLOCKS> and C<METADATA> items.
355
356The C<BLOCK> item should contain a reference to a Perl subroutine or a textual
357representation of Perl code, as generated by the L<Template::Parser> module.
358This is then evaluated into a subroutine reference using C<eval()>.
359
360The C<DEFLOCKS> item should reference a hash array containing further named
361C<BLOCK>s which may be defined in the template. The keys represent C<BLOCK>
362names and the values should be subroutine references or text strings of Perl
363code as per the main C<BLOCK> item.
364
365The C<METADATA> item should reference a hash array of metadata items relevant
366to the document.
367
368The L<process()> method can then be called on the instantiated
369C<Template::Document> object, passing a reference to a L<Template::Context>
370object as the first parameter. This will install any locally defined blocks
371(C<DEFBLOCKS>) in the C<BLOCKS> cache in the context (via a call to
372L<visit()|Template::Context#visit()>) so that they may be subsequently
373resolved by the context. The main C<BLOCK> subroutine is then executed,
374passing the context reference on as a parameter. The text returned from the
375template subroutine is then returned by the L<process()> method, after calling
376the context L<leave()|Template::Context#leave()> method to permit cleanup and
377de-registration of named C<BLOCKS> previously installed.
378
379An C<AUTOLOAD> method provides access to the C<METADATA> items for the
380document. The L<Template::Service> module installs a reference to the main
381C<Template::Document> object in the stash as the C<template> variable. This allows
382metadata items to be accessed from within templates, including C<PRE_PROCESS>
383templates.
384
385header:
386
387 <html>
388 <head>
389 <title>[% template.title %]
390 </head>
391 ...
392
393C<Template::Document> objects are usually created by the L<Template::Parser>
394but can be manually instantiated or sub-classed to provide custom
395template components.
396
397=head1 METHODS
398
399=head2 new(\%config)
400
401Constructor method which accept a reference to a hash array containing the
402structure as shown in this example:
403
404 $doc = Template::Document->new({
405 BLOCK => sub { # some perl code; return $some_text },
406 DEFBLOCKS => {
407 header => sub { # more perl code; return $some_text },
408 footer => sub { # blah blah blah; return $some_text },
409 },
410 METADATA => {
411 author => 'Andy Wardley',
412 version => 3.14,
413 }
414 }) || die $Template::Document::ERROR;
415
416C<BLOCK> and C<DEFBLOCKS> items may be expressed as references to Perl subroutines
417or as text strings containing Perl subroutine definitions, as is generated
418by the L<Template::Parser> module. These are evaluated into subroutine references
419using C<eval()>.
420
421Returns a new C<Template::Document> object or C<undef> on error. The
422L<error()|Template::Base#error()> class method can be called, or the C<$ERROR>
423package variable inspected to retrieve the relevant error message.
424
425=head2 process($context)
426
427Main processing routine for the compiled template document. A reference to a
428L<Template::Context> object should be passed as the first parameter. The
429method installs any locally defined blocks via a call to the context
430L<visit()|Template::Context#visit()> method, processes its own template,
431(passing the context reference as a parameter) and then calls
432L<leave()|Template::Context#leave()> in the context to allow cleanup.
433
434 print $doc->process($context);
435
436Returns a text string representing the generated output for the template.
437Errors are thrown via C<die()>.
438
439=head2 block()
440
441Returns a reference to the main C<BLOCK> subroutine.
442
443=head2 blocks()
444
445Returns a reference to the hash array of named C<DEFBLOCKS> subroutines.
446
447=head2 AUTOLOAD
448
449An autoload method returns C<METADATA> items.
450
451 print $doc->author();
452
453=head1 PACKAGE SUB-ROUTINES
454
455=head2 write_perl_file(\%config)
456
457This package subroutine is provided to effect persistence of compiled
458templates. If the C<COMPILE_EXT> option (to indicate a file extension
459for saving compiled templates) then the L<Template::Parser> module calls
460this subroutine before calling the L<new()> constructor. At this stage,
461the parser has a representation of the template as text strings
462containing Perl code. We can write that to a file, enclosed in a
463small wrapper which will allow us to susequently C<require()> the file
464and have Perl parse and compile it into a C<Template::Document>. Thus we
465have persistence of compiled templates.
466
467=head1 AUTHOR
468
469Andy Wardley E<lt>abw@wardley.orgE<gt> L<http://wardley.org/>
470
471=head1 COPYRIGHT
472
473Copyright (C) 1996-2007 Andy Wardley. All Rights Reserved.
474
475This module is free software; you can redistribute it and/or
476modify it under the same terms as Perl itself.
477
478=head1 SEE ALSO
479
480L<Template>, L<Template::Parser>
481
482=cut
483
484# Local Variables:
485# mode: perl
486# perl-indent-level: 4
487# indent-tabs-mode: nil
488# End:
489#
490# vim: expandtab shiftwidth=4:
# spent 137µs within Template::Document::CORE:match which was called 9 times, avg 15µs/call: # 9 times (137µs+0s) by Template::Document::new at line 75 of Template/Document.pm, avg 15µs/call
sub Template::Document::CORE:match; # xsub
Report produced by the NYTProf 3.11 Perl profiler, developed by Tim Bunce and Adam Kaplan.