← 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:36 2016

Filename/usr/lib/x86_64-linux-gnu/perl5/5.20/Template/Provider.pm
StatementsExecuted 1463 statements in 15.5ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
10114.75ms4.75msTemplate::Provider::::CORE:openTemplate::Provider::CORE:open (opcode)
1111.81ms1.94msTemplate::Provider::::BEGIN@46Template::Provider::BEGIN@46
30211.08ms1.08msTemplate::Provider::::CORE:statTemplate::Provider::CORE:stat (opcode)
1011426µs5.54msTemplate::Provider::::_template_contentTemplate::Provider::_template_content
1011362µs126msTemplate::Provider::::_compileTemplate::Provider::_compile
1021361µs135msTemplate::Provider::::_fetchTemplate::Provider::_fetch
1011238µs1.06msTemplate::Provider::::_decode_unicodeTemplate::Provider::_decode_unicode
1011226µs7.60msTemplate::Provider::::_loadTemplate::Provider::_load
1011203µs135msTemplate::Provider::::fetchTemplate::Provider::fetch
1011201µs605µsTemplate::Provider::::_storeTemplate::Provider::_store
1011184µs184µsTemplate::Provider::::CORE:readlineTemplate::Provider::CORE:readline (opcode)
911177µs81.1msTemplate::Provider::::_fetch_pathTemplate::Provider::_fetch_path
2021119µs1.11msTemplate::Provider::::_template_modifiedTemplate::Provider::_template_modified
101195µs700µsTemplate::Provider::::storeTemplate::Provider::store
91193µs93µsTemplate::Provider::::pathsTemplate::Provider::paths
202169µs69µsTemplate::Provider::::_compiled_filenameTemplate::Provider::_compiled_filename
101167µs403µsTemplate::Provider::::_modifiedTemplate::Provider::_modified
101164µs64µsTemplate::Provider::::CORE:closeTemplate::Provider::CORE:close (opcode)
101147µs89µsTemplate::Provider::::_compiled_is_currentTemplate::Provider::_compiled_is_current
11137µs37µsTemplate::Provider::::_initTemplate::Provider::_init
101127µs27µsTemplate::Provider::::CORE:binmodeTemplate::Provider::CORE:binmode (opcode)
11125µs37µsTemplate::Provider::::BEGIN@41Template::Provider::BEGIN@41
11119µs26µsTemplate::Provider::::BEGIN@1089Template::Provider::BEGIN@1089
11119µs71µsTemplate::Provider::::BEGIN@47Template::Provider::BEGIN@47
11114µs14µsTemplate::Provider::::DESTROYTemplate::Provider::DESTROY
11114µs14µsTemplate::Provider::::BEGIN@44Template::Provider::BEGIN@44
11110µs18µsTemplate::Provider::::BEGIN@42Template::Provider::BEGIN@42
1119µs58µsTemplate::Provider::::BEGIN@43Template::Provider::BEGIN@43
1119µs46µsTemplate::Provider::::BEGIN@50Template::Provider::BEGIN@50
1118µs8µsTemplate::Provider::::BEGIN@48Template::Provider::BEGIN@48
1118µs24µsTemplate::Provider::::BEGIN@52Template::Provider::BEGIN@52
1118µs25µsTemplate::Provider::::BEGIN@45Template::Provider::BEGIN@45
1118µs25µsTemplate::Provider::::BEGIN@51Template::Provider::BEGIN@51
1118µs23µsTemplate::Provider::::BEGIN@53Template::Provider::BEGIN@53
1117µs7µsTemplate::Provider::::CORE:qrTemplate::Provider::CORE:qr (opcode)
1117µs22µsTemplate::Provider::::BEGIN@55Template::Provider::BEGIN@55
1117µs22µsTemplate::Provider::::BEGIN@54Template::Provider::BEGIN@54
9117µs7µsTemplate::Provider::::CORE:regcompTemplate::Provider::CORE:regcomp (opcode)
9116µs6µsTemplate::Provider::::CORE:matchTemplate::Provider::CORE:match (opcode)
1115µs5µsTemplate::Provider::::BEGIN@87Template::Provider::BEGIN@87
0000s0sTemplate::Provider::::_dumpTemplate::Provider::_dump
0000s0sTemplate::Provider::::_dump_cacheTemplate::Provider::_dump_cache
0000s0sTemplate::Provider::::_load_compiledTemplate::Provider::_load_compiled
0000s0sTemplate::Provider::::_refreshTemplate::Provider::_refresh
0000s0sTemplate::Provider::::include_pathTemplate::Provider::include_path
0000s0sTemplate::Provider::::loadTemplate::Provider::load
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::Provider
4#
5# DESCRIPTION
6# This module implements a class which handles the loading, compiling
7# and caching of templates. Multiple Template::Provider objects can
8# be stacked and queried in turn to effect a Chain-of-Command between
9# them. A provider will attempt to return the requested template,
10# an error (STATUS_ERROR) or decline to provide the template
11# (STATUS_DECLINE), allowing subsequent providers to attempt to
12# deliver it. See 'Design Patterns' for further details.
13#
14# AUTHORS
15# Andy Wardley <abw@wardley.org>
16#
17# Refactored by Bill Moseley for v2.19 to add negative caching (i.e.
18# tracking templates that are NOTFOUND so that we can decline quickly)
19# and to provide better support for subclassing the provider.
20#
21# COPYRIGHT
22# Copyright (C) 1996-2007 Andy Wardley. All Rights Reserved.
23#
24# This module is free software; you can redistribute it and/or
25# modify it under the same terms as Perl itself.
26#
27# WARNING:
28# This code is ugly and contorted and is being totally re-written for TT3.
29# In particular, we'll be throwing errors rather than messing around
30# returning (value, status) pairs. With the benefit of hindsight, that
31# was a really bad design decision on my part. I deserve to be knocked
32# to the ground and kicked around a bit by hoards of angry TT developers
33# for that one. Bill's refactoring has made the module easier to subclass,
34# (so you can ease off the kicking now), but it really needs to be totally
35# redesigned and rebuilt from the ground up along with the bits of TT that
36# use it. -- abw 2007/04/27
37#============================================================================
38
39package Template::Provider;
40
41251µs249µs
# spent 37µs (25+12) within Template::Provider::BEGIN@41 which was called: # once (25µs+12µs) by Template::BEGIN@29 at line 41
use strict;
# spent 37µs making 1 call to Template::Provider::BEGIN@41 # spent 12µs making 1 call to strict::import
42240µs226µs
# spent 18µs (10+8) within Template::Provider::BEGIN@42 which was called: # once (10µs+8µs) by Template::BEGIN@29 at line 42
use warnings;
# spent 18µs making 1 call to Template::Provider::BEGIN@42 # spent 8µs making 1 call to warnings::import
43298µs2106µs
# spent 58µs (9+48) within Template::Provider::BEGIN@43 which was called: # once (9µs+48µs) by Template::BEGIN@29 at line 43
use base 'Template::Base';
# spent 58µs making 1 call to Template::Provider::BEGIN@43 # spent 48µs making 1 call to base::import
44225µs114µs
# spent 14µs within Template::Provider::BEGIN@44 which was called: # once (14µs+0s) by Template::BEGIN@29 at line 44
use Template::Config;
# spent 14µs making 1 call to Template::Provider::BEGIN@44
45246µs243µs
# spent 25µs (8+18) within Template::Provider::BEGIN@45 which was called: # once (8µs+18µs) by Template::BEGIN@29 at line 45
use Template::Constants;
# spent 25µs making 1 call to Template::Provider::BEGIN@45 # spent 18µs making 1 call to Exporter::import
462218µs11.94ms
# spent 1.94ms (1.81+124µs) within Template::Provider::BEGIN@46 which was called: # once (1.81ms+124µs) by Template::BEGIN@29 at line 46
use Template::Document;
# spent 1.94ms making 1 call to Template::Provider::BEGIN@46
47295µs2123µs
# spent 71µs (19+52) within Template::Provider::BEGIN@47 which was called: # once (19µs+52µs) by Template::BEGIN@29 at line 47
use File::Basename;
# spent 71µs making 1 call to Template::Provider::BEGIN@47 # spent 52µs making 1 call to Exporter::import
48231µs18µs
# spent 8µs within Template::Provider::BEGIN@48 which was called: # once (8µs+0s) by Template::BEGIN@29 at line 48
use File::Spec;
# spent 8µs making 1 call to Template::Provider::BEGIN@48
49
50269µs283µs
# spent 46µs (9+37) within Template::Provider::BEGIN@50 which was called: # once (9µs+37µs) by Template::BEGIN@29 at line 50
use constant PREV => 0;
# spent 46µs making 1 call to Template::Provider::BEGIN@50 # spent 37µs making 1 call to constant::import
51247µs243µs
# spent 25µs (8+18) within Template::Provider::BEGIN@51 which was called: # once (8µs+18µs) by Template::BEGIN@29 at line 51
use constant NAME => 1; # template name -- indexed by this name in LOOKUP
# spent 25µs making 1 call to Template::Provider::BEGIN@51 # spent 18µs making 1 call to constant::import
52246µs239µs
# spent 24µs (8+16) within Template::Provider::BEGIN@52 which was called: # once (8µs+16µs) by Template::BEGIN@29 at line 52
use constant DATA => 2; # Compiled template
# spent 24µs making 1 call to Template::Provider::BEGIN@52 # spent 16µs making 1 call to constant::import
53244µs239µs
# spent 23µs (8+16) within Template::Provider::BEGIN@53 which was called: # once (8µs+16µs) by Template::BEGIN@29 at line 53
use constant LOAD => 3; # mtime of template
# spent 23µs making 1 call to Template::Provider::BEGIN@53 # spent 16µs making 1 call to constant::import
54243µs238µs
# spent 22µs (7+15) within Template::Provider::BEGIN@54 which was called: # once (7µs+15µs) by Template::BEGIN@29 at line 54
use constant NEXT => 4; # link to next item in cache linked list
# spent 22µs making 1 call to Template::Provider::BEGIN@54 # spent 15µs making 1 call to constant::import
552235µs236µs
# spent 22µs (7+14) within Template::Provider::BEGIN@55 which was called: # once (7µs+14µs) by Template::BEGIN@29 at line 55
use constant STAT => 5; # Time last stat()ed
# spent 22µs making 1 call to Template::Provider::BEGIN@55 # spent 14µs making 1 call to constant::import
56
571500nsour $VERSION = 2.94;
581500nsour $DEBUG = 0 unless defined $DEBUG;
591200nsour $ERROR = '';
60
61# name of document class
621200nsour $DOCUMENT = 'Template::Document' unless defined $DOCUMENT;
63
64# maximum time between performing stat() on file to check staleness
651100nsour $STAT_TTL = 1 unless defined $STAT_TTL;
66
67# maximum number of directories in an INCLUDE_PATH, to prevent runaways
681100nsour $MAX_DIRS = 64 unless defined $MAX_DIRS;
69
70# UNICODE is supported in versions of Perl from 5.007 onwards
7111µsour $UNICODE = $] > 5.007 ? 1 : 0;
72
7312µsmy $boms = [
74 'UTF-8' => "\x{ef}\x{bb}\x{bf}",
75 'UTF-32BE' => "\x{0}\x{0}\x{fe}\x{ff}",
76 'UTF-32LE' => "\x{ff}\x{fe}\x{0}\x{0}",
77 'UTF-16BE' => "\x{fe}\x{ff}",
78 'UTF-16LE' => "\x{ff}\x{fe}",
79];
80
81# regex to match relative paths
82114µs17µsour $RELATIVE_PATH = qr[(?:^|/)\.+/];
# spent 7µs making 1 call to Template::Provider::CORE:qr
83
84
85# hack so that 'use bytes' will compile on versions of Perl earlier than
86# 5.6, even though we never call _decode_unicode() on those systems
87
# spent 5µs within Template::Provider::BEGIN@87 which was called: # once (5µs+0s) by Template::BEGIN@29 at line 92
BEGIN {
8816µs if ($] < 5.006) {
89 package bytes;
90 $INC{'bytes.pm'} = 1;
91 }
9214.42ms15µs}
# spent 5µs making 1 call to Template::Provider::BEGIN@87
93
94
95#========================================================================
96# -- PUBLIC METHODS --
97#========================================================================
98
99#------------------------------------------------------------------------
100# fetch($name)
101#
102# Returns a compiled template for the name specified by parameter.
103# The template is returned from the internal cache if it exists, or
104# loaded and then subsequently cached. The ABSOLUTE and RELATIVE
105# configuration flags determine if absolute (e.g. '/something...')
106# and/or relative (e.g. './something') paths should be honoured. The
107# INCLUDE_PATH is otherwise used to find the named file. $name may
108# also be a reference to a text string containing the template text,
109# or a file handle from which the content is read. The compiled
110# template is not cached in these latter cases given that there is no
111# filename to cache under. A subsequent call to store($name,
112# $compiled) can be made to cache the compiled template for future
113# fetch() calls, if necessary.
114#
115# Returns a compiled template or (undef, STATUS_DECLINED) if the
116# template could not be found. On error (e.g. the file was found
117# but couldn't be read or parsed), the pair ($error, STATUS_ERROR)
118# is returned. The TOLERANT configuration option can be set to
119# downgrade any errors to STATUS_DECLINE.
120#------------------------------------------------------------------------
121
122
# spent 135ms (203µs+135) within Template::Provider::fetch which was called 10 times, avg 13.5ms/call: # 10 times (203µs+135ms) by Template::Context::template at line 140 of Template/Context.pm, avg 13.5ms/call
sub fetch {
123105µs my ($self, $name) = @_;
124103µs my ($data, $error);
125
126
12710180µs2953.9ms if (ref $name) {
# spent 53.9ms making 1 call to Template::Provider::_fetch # spent 40µs making 10 calls to File::Spec::Unix::file_name_is_absolute, avg 4µs/call # spent 7µs making 9 calls to Template::Provider::CORE:regcomp, avg 744ns/call # spent 6µs making 9 calls to Template::Provider::CORE:match, avg 622ns/call
128 # $name can be a reference to a scalar, GLOB or file handle
129 ($data, $error) = $self->_load($name);
130 ($data, $error) = $self->_compile($data)
131 unless $error;
132 $data = $data->{ data }
133 unless $error;
134 }
135 elsif (File::Spec->file_name_is_absolute($name)) {
136 # absolute paths (starting '/') allowed if ABSOLUTE set
137 ($data, $error) = $self->{ ABSOLUTE }
138 ? $self->_fetch($name)
139 : $self->{ TOLERANT }
140 ? (undef, Template::Constants::STATUS_DECLINED)
141 : ("$name: absolute paths are not allowed (set ABSOLUTE option)",
142 Template::Constants::STATUS_ERROR);
143 }
144 elsif ($name =~ m/$RELATIVE_PATH/o) {
145 # anything starting "./" is relative to cwd, allowed if RELATIVE set
146 ($data, $error) = $self->{ RELATIVE }
147 ? $self->_fetch($name)
148 : $self->{ TOLERANT }
149 ? (undef, Template::Constants::STATUS_DECLINED)
150 : ("$name: relative paths are not allowed (set RELATIVE option)",
151 Template::Constants::STATUS_ERROR);
152 }
153 else {
154 # otherwise, it's a file name relative to INCLUDE_PATH
155 ($data, $error) = $self->{ INCLUDE_PATH }
156932µs981.1ms ? $self->_fetch_path($name)
# spent 81.1ms making 9 calls to Template::Provider::_fetch_path, avg 9.01ms/call
157 : (undef, Template::Constants::STATUS_DECLINED);
158 }
159
160# $self->_dump_cache()
161# if $DEBUG > 1;
162
1631030µs return ($data, $error);
164}
165
166
167#------------------------------------------------------------------------
168# store($name, $data)
169#
170# Store a compiled template ($data) in the cached as $name.
171# Returns compiled template
172#------------------------------------------------------------------------
173
174
# spent 700µs (95+605) within Template::Provider::store which was called 10 times, avg 70µs/call: # 10 times (95µs+605µs) by Template::Provider::_fetch at line 490, avg 70µs/call
sub store {
1751015µs my ($self, $name, $data) = @_;
1761076µs10605µs $self->_store($name, {
# spent 605µs making 10 calls to Template::Provider::_store, avg 60µs/call
177 data => $data,
178 load => 0,
179 });
180}
181
182
183#------------------------------------------------------------------------
184# load($name)
185#
186# Load a template without parsing/compiling it, suitable for use with
187# the INSERT directive. There's some duplication with fetch() and at
188# some point this could be reworked to integrate them a little closer.
189#------------------------------------------------------------------------
190
191sub load {
192 my ($self, $name) = @_;
193 my ($data, $error);
194 my $path = $name;
195
196 if (File::Spec->file_name_is_absolute($name)) {
197 # absolute paths (starting '/') allowed if ABSOLUTE set
198 $error = "$name: absolute paths are not allowed (set ABSOLUTE option)"
199 unless $self->{ ABSOLUTE };
200 }
201 elsif ($name =~ m[$RELATIVE_PATH]o) {
202 # anything starting "./" is relative to cwd, allowed if RELATIVE set
203 $error = "$name: relative paths are not allowed (set RELATIVE option)"
204 unless $self->{ RELATIVE };
205 }
206 else {
207 INCPATH: {
208 # otherwise, it's a file name relative to INCLUDE_PATH
209 my $paths = $self->paths()
210 || return ($self->error(), Template::Constants::STATUS_ERROR);
211
212 foreach my $dir (@$paths) {
213 $path = File::Spec->catfile($dir, $name);
214 last INCPATH
215 if $self->_template_modified($path);
216 }
217 undef $path; # not found
218 }
219 }
220
221 # Now fetch the content
222 ($data, $error) = $self->_template_content($path)
223 if defined $path && !$error;
224
225 if ($error) {
226 return $self->{ TOLERANT }
227 ? (undef, Template::Constants::STATUS_DECLINED)
228 : ($error, Template::Constants::STATUS_ERROR);
229 }
230 elsif (! defined $path) {
231 return (undef, Template::Constants::STATUS_DECLINED);
232 }
233 else {
234 return ($data, Template::Constants::STATUS_OK);
235 }
236}
237
- -
240#------------------------------------------------------------------------
241# include_path(\@newpath)
242#
243# Accessor method for the INCLUDE_PATH setting. If called with an
244# argument, this method will replace the existing INCLUDE_PATH with
245# the new value.
246#------------------------------------------------------------------------
247
248sub include_path {
249 my ($self, $path) = @_;
250 $self->{ INCLUDE_PATH } = $path if $path;
251 return $self->{ INCLUDE_PATH };
252}
253
254
255#------------------------------------------------------------------------
256# paths()
257#
258# Evaluates the INCLUDE_PATH list, ignoring any blank entries, and
259# calling and subroutine or object references to return dynamically
260# generated path lists. Returns a reference to a new list of paths
261# or undef on error.
262#------------------------------------------------------------------------
263
264
# spent 93µs within Template::Provider::paths which was called 9 times, avg 10µs/call: # 9 times (93µs+0s) by Template::Provider::_fetch_path at line 520, avg 10µs/call
sub paths {
26594µs my $self = shift;
266919µs my @ipaths = @{ $self->{ INCLUDE_PATH } };
26794µs my (@opaths, $dpaths, $dir);
26894µs my $count = $MAX_DIRS;
269
27099µs while (@ipaths && --$count) {
271278µs $dir = shift @ipaths || next;
272
273 # $dir can be a sub or object ref which returns a reference
274 # to a dynamically generated list of search paths.
275
2762715µs if (ref $dir eq 'CODE') {
277 eval { $dpaths = &$dir() };
278 if ($@) {
279 chomp $@;
280 return $self->error($@);
281 }
282 unshift(@ipaths, @$dpaths);
283 next;
284 }
285 elsif (ref($dir) && UNIVERSAL::can($dir, 'paths')) {
286 $dpaths = $dir->paths()
287 || return $self->error($dir->error());
288 unshift(@ipaths, @$dpaths);
289 next;
290 }
291 else {
292278µs push(@opaths, $dir);
293 }
294 }
29592µs return $self->error("INCLUDE_PATH exceeds $MAX_DIRS directories")
296 if @ipaths;
297
298929µs return \@opaths;
299}
300
301
302#------------------------------------------------------------------------
303# DESTROY
304#
305# The provider cache is implemented as a doubly linked list which Perl
306# cannot free by itself due to the circular references between NEXT <=>
307# PREV items. This cleanup method walks the list deleting all the NEXT/PREV
308# references, allowing the proper cleanup to occur and memory to be
309# repooled.
310#------------------------------------------------------------------------
311
312
# spent 14µs within Template::Provider::DESTROY which was called: # once (14µs+0s) by CGI::Compile::ROOT::home_vagrant_kohaclone_mainpage_2epl::__ANON__[/home/vagrant/kohaclone/mainpage.pl:107] at line 2 of mainpage.pl
sub DESTROY {
3131400ns my $self = shift;
3141100ns my ($slot, $next);
315
3161800ns $slot = $self->{ HEAD };
3171700ns while ($slot) {
318105µs $next = $slot->[ NEXT ];
319102µs undef $slot->[ PREV ];
320101µs undef $slot->[ NEXT ];
321102µs $slot = $next;
322 }
3231600ns undef $self->{ HEAD };
32414µs undef $self->{ TAIL };
325}
326
- -
330#========================================================================
331# -- PRIVATE METHODS --
332#========================================================================
333
334#------------------------------------------------------------------------
335# _init()
336#
337# Initialise the cache.
338#------------------------------------------------------------------------
339
340
# spent 37µs within Template::Provider::_init which was called: # once (37µs+0s) by Template::Base::new at line 65 of Template/Base.pm
sub _init {
3411500ns my ($self, $params) = @_;
3421700ns my $size = $params->{ CACHE_SIZE };
34311µs my $path = $params->{ INCLUDE_PATH } || '.';
3441700ns my $cdir = $params->{ COMPILE_DIR } || '';
3451400ns my $dlim = $params->{ DELIMITER };
3461300ns my $debug;
347
348 # tweak delim to ignore C:/
34913µs unless (defined $dlim) {
350 $dlim = ($^O eq 'MSWin32') ? ':(?!\\/)' : ':';
351 }
352
353 # coerce INCLUDE_PATH to an array ref, if not already so
3541800ns $path = [ split(/$dlim/, $path) ]
355 unless ref $path eq 'ARRAY';
356
357 # don't allow a CACHE_SIZE 1 because it breaks things and the
358 # additional checking isn't worth it
3591400ns $size = 2
360 if defined $size && ($size == 1 || $size < 0);
361
3621600ns if (defined ($debug = $params->{ DEBUG })) {
363 $self->{ DEBUG } = $debug & ( Template::Constants::DEBUG_PROVIDER
364 | Template::Constants::DEBUG_FLAGS );
365 }
366 else {
36717µs $self->{ DEBUG } = $DEBUG;
368 }
369
3701500ns if ($self->{ DEBUG }) {
371 local $" = ', ';
372 $self->debug("creating cache of ",
373 defined $size ? $size : 'unlimited',
374 " slots for [ @$path ]");
375 }
376
377 # create COMPILE_DIR and sub-directories representing each INCLUDE_PATH
378 # element in which to store compiled files
3791300ns if ($cdir) {
380 require File::Path;
381 foreach my $dir (@$path) {
382 next if ref $dir;
383 my $wdir = $dir;
384 $wdir =~ s[:][]g if $^O eq 'MSWin32';
385 $wdir =~ /(.*)/; # untaint
386 $wdir = "$1"; # quotes work around bug in Strawberry Perl
387 $wdir = File::Spec->catfile($cdir, $wdir);
388 File::Path::mkpath($wdir) unless -d $wdir;
389 }
390 }
391
39211µs $self->{ LOOKUP } = { };
39311µs $self->{ NOTFOUND } = { }; # Tracks templates *not* found.
39411µs $self->{ SLOTS } = 0;
39511µs $self->{ SIZE } = $size;
3961400ns $self->{ INCLUDE_PATH } = $path;
3971900ns $self->{ DELIMITER } = $dlim;
3981600ns $self->{ COMPILE_DIR } = $cdir;
39911µs $self->{ COMPILE_EXT } = $params->{ COMPILE_EXT } || '';
4001800ns $self->{ ABSOLUTE } = $params->{ ABSOLUTE } || 0;
4011900ns $self->{ RELATIVE } = $params->{ RELATIVE } || 0;
4021900ns $self->{ TOLERANT } = $params->{ TOLERANT } || 0;
40312µs $self->{ DOCUMENT } = $params->{ DOCUMENT } || $DOCUMENT;
40411µs $self->{ PARSER } = $params->{ PARSER };
40512µs $self->{ DEFAULT } = $params->{ DEFAULT };
40611µs $self->{ ENCODING } = $params->{ ENCODING };
407# $self->{ PREFIX } = $params->{ PREFIX };
40811µs $self->{ STAT_TTL } = $params->{ STAT_TTL } || $STAT_TTL;
4091700ns $self->{ PARAMS } = $params;
410
411 # look for user-provided UNICODE parameter or use default from package var
412 $self->{ UNICODE } = defined $params->{ UNICODE }
41311µs ? $params->{ UNICODE } : $UNICODE;
414
41514µs return $self;
416}
417
418
419#------------------------------------------------------------------------
420# _fetch($name, $t_name)
421#
422# Fetch a file from cache or disk by specification of an absolute or
423# relative filename. No search of the INCLUDE_PATH is made. If the
424# file is found and loaded, it is compiled and cached.
425# Call with:
426# $name = path to search (possible prefixed by INCLUDE_PATH)
427# $t_name = template name
428#------------------------------------------------------------------------
429
430
# spent 135ms (361µs+134) within Template::Provider::_fetch which was called 10 times, avg 13.5ms/call: # 9 times (321µs+80.4ms) by Template::Provider::_fetch_path at line 529, avg 8.97ms/call # once (40µs+53.8ms) by Template::Provider::fetch at line 127
sub _fetch {
431106µs my ($self, $name, $t_name) = @_;
432108µs my $stat_ttl = $self->{ STAT_TTL };
433
434106µs $self->debug("_fetch($name)") if $self->{ DEBUG };
435
436 # First see if the named template is in the memory cache
4371016µs if ((my $slot = $self->{ LOOKUP }->{ $name })) {
438 # Test if cache is fresh, and reload/compile if not.
439 my ($data, $error) = $self->_refresh($slot);
440
441 return $error
442 ? ( $data, $error ) # $data may contain error text
443 : $slot->[ DATA ]; # returned document object
444 }
445
446 # Otherwise, see if we already know the template is not found
447107µs if (my $last_stat_time = $self->{ NOTFOUND }->{ $name }) {
448 my $expires_in = $last_stat_time + $stat_ttl - time;
449 if ($expires_in > 0) {
450 $self->debug(" file [$name] in negative cache. Expires in $expires_in seconds")
451 if $self->{ DEBUG };
452 return (undef, Template::Constants::STATUS_DECLINED);
453 }
454 else {
455 delete $self->{ NOTFOUND }->{ $name };
456 }
457 }
458
459 # Is there an up-to-date compiled version on disk?
4601026µs1089µs if ($self->_compiled_is_current($name)) {
# spent 89µs making 10 calls to Template::Provider::_compiled_is_current, avg 9µs/call
461 # require() the compiled template.
462 my $compiled_template = $self->_load_compiled( $self->_compiled_filename($name) );
463
464 # Store and return the compiled template
465 return $self->store( $name, $compiled_template ) if $compiled_template;
466
467 # Problem loading compiled template:
468 # warn and continue to fetch source template
469 warn($self->error(), "\n");
470 }
471
472 # load template from source
4731032µs107.60ms my ($template, $error) = $self->_load($name, $t_name);
# spent 7.60ms making 10 calls to Template::Provider::_load, avg 760µs/call
474
475104µs if ($error) {
476 # Template could not be fetched. Add to the negative/notfound cache.
477 $self->{ NOTFOUND }->{ $name } = time;
478 return ( $template, $error );
479 }
480
481 # compile template source
4821083µs20126ms ($template, $error) = $self->_compile($template, $self->_compiled_filename($name) );
# spent 126ms making 10 calls to Template::Provider::_compile, avg 12.6ms/call # spent 26µs making 10 calls to Template::Provider::_compiled_filename, avg 3µs/call
483
4841017µs if ($error) {
485 # return any compile time error
486 return ($template, $error);
487 }
488 else {
489 # Store compiled template and return it
49010110µs10700µs return $self->store($name, $template->{data}) ;
# spent 700µs making 10 calls to Template::Provider::store, avg 70µs/call
491 }
492}
493
494
495#------------------------------------------------------------------------
496# _fetch_path($name)
497#
498# Fetch a file from cache or disk by specification of an absolute cache
499# name (e.g. 'header') or filename relative to one of the INCLUDE_PATH
500# directories. If the file isn't already cached and can be found and
501# loaded, it is compiled and cached under the full filename.
502#------------------------------------------------------------------------
503
504
# spent 81.1ms (177µs+80.9) within Template::Provider::_fetch_path which was called 9 times, avg 9.01ms/call: # 9 times (177µs+80.9ms) by Template::Provider::fetch at line 156, avg 9.01ms/call
sub _fetch_path {
50595µs my ($self, $name) = @_;
506
50795µs $self->debug("_fetch_path($name)") if $self->{ DEBUG };
508
509 # the template may have been stored using a non-filename name
510 # so look for the plain name in the cache first
511911µs if ((my $slot = $self->{ LOOKUP }->{ $name })) {
512 # cached entry exists, so refresh slot and extract data
513 my ($data, $error) = $self->_refresh($slot);
514
515 return $error
516 ? ($data, $error)
517 : ($slot->[ DATA ], $error );
518 }
519
520924µs993µs my $paths = $self->paths
# spent 93µs making 9 calls to Template::Provider::paths, avg 10µs/call
521 || return ( $self->error, Template::Constants::STATUS_ERROR );
522
523 # search the INCLUDE_PATH for the file, in cache or on disk
52496µs foreach my $dir (@$paths) {
5259194µs36227µs my $path = File::Spec->catfile($dir, $name);
# spent 157µs making 9 calls to File::Spec::Unix::catfile, avg 17µs/call # spent 52µs making 9 calls to File::Spec::Unix::catdir, avg 6µs/call # spent 19µs making 18 calls to File::Spec::Unix::canonpath, avg 1µs/call
526
52794µs $self->debug("searching path: $path\n") if $self->{ DEBUG };
528
529928µs980.7ms my ($data, $error) = $self->_fetch( $path, $name );
# spent 80.7ms making 9 calls to Template::Provider::_fetch, avg 8.97ms/call
530
531 # Return if no error or if a serious error.
532947µs return ( $data, $error )
533 if !$error || $error == Template::Constants::STATUS_ERROR;
534
535 }
536
537 # not found in INCLUDE_PATH, now try DEFAULT
538 return $self->_fetch_path( $self->{DEFAULT} )
539 if defined $self->{DEFAULT} && $name ne $self->{DEFAULT};
540
541 # We could not handle this template name
542 return (undef, Template::Constants::STATUS_DECLINED);
543}
544
545
# spent 69µs within Template::Provider::_compiled_filename which was called 20 times, avg 3µs/call: # 10 times (42µs+0s) by Template::Provider::_compiled_is_current at line 918, avg 4µs/call # 10 times (26µs+0s) by Template::Provider::_fetch at line 482, avg 3µs/call
sub _compiled_filename {
546208µs my ($self, $file) = @_;
5472026µs my ($compext, $compdir) = @$self{ qw( COMPILE_EXT COMPILE_DIR ) };
548205µs my ($path, $compiled);
549
550 return undef
5512054µs unless $compext || $compdir;
552
553 $path = $file;
554 $path =~ /^(.+)$/s or die "invalid filename: $path";
555 $path =~ s[:][]g if $^O eq 'MSWin32';
556
557 $compiled = "$path$compext";
558 $compiled = File::Spec->catfile($compdir, $compiled) if length $compdir;
559
560 return $compiled;
561}
562
563sub _load_compiled {
564 my ($self, $file) = @_;
565 my $compiled;
566
567 # load compiled template via require(); we zap any
568 # %INC entry to ensure it is reloaded (we don't
569 # want 1 returned by require() to say it's in memory)
570 delete $INC{ $file };
571 eval { $compiled = require $file; };
572 return $@
573 ? $self->error("compiled template $compiled: $@")
574 : $compiled;
575}
576
577#------------------------------------------------------------------------
578# _load($name, $alias)
579#
580# Load template text from a string ($name = scalar ref), GLOB or file
581# handle ($name = ref), or from an absolute filename ($name = scalar).
582# Returns a hash array containing the following items:
583# name filename or $alias, if provided, or 'input text', etc.
584# text template text
585# time modification time of file, or current time for handles/strings
586# load time file was loaded (now!)
587#
588# On error, returns ($error, STATUS_ERROR), or (undef, STATUS_DECLINED)
589# if TOLERANT is set.
590#------------------------------------------------------------------------
591
592
# spent 7.60ms (226µs+7.38) within Template::Provider::_load which was called 10 times, avg 760µs/call: # 10 times (226µs+7.38ms) by Template::Provider::_fetch at line 473, avg 760µs/call
sub _load {
593104µs my ($self, $name, $alias) = @_;
594102µs my ($data, $error);
595106µs my $tolerant = $self->{ TOLERANT };
596105µs my $now = time;
597
598105µs $alias = $name unless defined $alias or ref $name;
599
600 $self->debug("_load($name, ", defined $alias ? $alias : '<no alias>',
601106µs ')') if $self->{ DEBUG };
602
603 # SCALAR ref is the template text
604105µs if (ref $name eq 'SCALAR') {
605 # $name can be a SCALAR reference to the input text...
606 return {
607 name => defined $alias ? $alias : 'input text',
608 path => defined $alias ? $alias : 'input text',
609 text => $$name,
610 time => $now,
611 load => 0,
612 };
613 }
614
615 # Otherwise, assume GLOB as a file handle
616103µs if (ref $name) {
617 local $/;
618 my $text = <$name>;
619 $text = $self->_decode_unicode($text) if $self->{ UNICODE };
620 return {
621 name => defined $alias ? $alias : 'input file handle',
622 path => defined $alias ? $alias : 'input file handle',
623 text => $text,
624 time => $now,
625 load => 0,
626 };
627 }
628
629 # Otherwise, it's the name of the template
6301020µs10774µs if ( $self->_template_modified( $name ) ) { # does template exist?
# spent 774µs making 10 calls to Template::Provider::_template_modified, avg 77µs/call
6311035µs105.54ms my ($text, $error, $mtime ) = $self->_template_content( $name );
# spent 5.54ms making 10 calls to Template::Provider::_template_content, avg 554µs/call
632105µs unless ( $error ) {
6331049µs101.06ms $text = $self->_decode_unicode($text) if $self->{ UNICODE };
# spent 1.06ms making 10 calls to Template::Provider::_decode_unicode, avg 106µs/call
634 return {
6351071µs name => $alias,
636 path => $name,
637 text => $text,
638 time => $mtime,
639 load => $now,
640 };
641 }
642
643 return ( "$alias: $!", Template::Constants::STATUS_ERROR )
644 unless $tolerant;
645 }
646
647 # Unable to process template, pass onto the next Provider.
648 return (undef, Template::Constants::STATUS_DECLINED);
649}
650
651
652#------------------------------------------------------------------------
653# _refresh(\@slot)
654#
655# Private method called to mark a cache slot as most recently used.
656# A reference to the slot array should be passed by parameter. The
657# slot is relocated to the head of the linked list. If the file from
658# which the data was loaded has been upated since it was compiled, then
659# it is re-loaded from disk and re-compiled.
660#------------------------------------------------------------------------
661
662sub _refresh {
663 my ($self, $slot) = @_;
664 my $stat_ttl = $self->{ STAT_TTL };
665 my ($head, $file, $data, $error);
666
667 $self->debug("_refresh([ ",
668 join(', ', map { defined $_ ? $_ : '<undef>' } @$slot),
669 '])') if $self->{ DEBUG };
670
671 # if it's more than $STAT_TTL seconds since we last performed a
672 # stat() on the file then we need to do it again and see if the file
673 # time has changed
674 my $now = time;
675 my $expires_in_sec = $slot->[ STAT ] + $stat_ttl - $now;
676
677 if ( $expires_in_sec <= 0 ) { # Time to check!
678 $slot->[ STAT ] = $now;
679
680 # Grab mtime of template.
681 # Seems like this should be abstracted to compare to
682 # just ask for a newer compiled template (if it's newer)
683 # and let that check for a newer template source.
684 my $template_mtime = $self->_template_modified( $slot->[ NAME ] );
685 if ( ! defined $template_mtime || ( $template_mtime != $slot->[ LOAD ] )) {
686 $self->debug("refreshing cache file ", $slot->[ NAME ])
687 if $self->{ DEBUG };
688
689 ($data, $error) = $self->_load($slot->[ NAME ], $slot->[ DATA ]->{ name });
690 ($data, $error) = $self->_compile($data)
691 unless $error;
692
693 if ($error) {
694 # if the template failed to load/compile then we wipe out the
695 # STAT entry. This forces the provider to try and reload it
696 # each time instead of using the previously cached version
697 # until $STAT_TTL is next up
698 $slot->[ STAT ] = 0;
699 }
700 else {
701 $slot->[ DATA ] = $data->{ data };
702 $slot->[ LOAD ] = $data->{ time };
703 }
704 }
705
706 } elsif ( $self->{ DEBUG } ) {
707 $self->debug( sprintf('STAT_TTL not met for file [%s]. Expires in %d seconds',
708 $slot->[ NAME ], $expires_in_sec ) );
709 }
710
711 # Move this slot to the head of the list
712 unless( $self->{ HEAD } == $slot ) {
713 # remove existing slot from usage chain...
714 if ($slot->[ PREV ]) {
715 $slot->[ PREV ]->[ NEXT ] = $slot->[ NEXT ];
716 }
717 else {
718 $self->{ HEAD } = $slot->[ NEXT ];
719 }
720 if ($slot->[ NEXT ]) {
721 $slot->[ NEXT ]->[ PREV ] = $slot->[ PREV ];
722 }
723 else {
724 $self->{ TAIL } = $slot->[ PREV ];
725 }
726
727 # ..and add to start of list
728 $head = $self->{ HEAD };
729 $head->[ PREV ] = $slot if $head;
730 $slot->[ PREV ] = undef;
731 $slot->[ NEXT ] = $head;
732 $self->{ HEAD } = $slot;
733 }
734
735 return ($data, $error);
736}
737
- -
740#------------------------------------------------------------------------
741# _store($name, $data)
742#
743# Private method called to add a data item to the cache. If the cache
744# size limit has been reached then the oldest entry at the tail of the
745# list is removed and its slot relocated to the head of the list and
746# reused for the new data item. If the cache is under the size limit,
747# or if no size limit is defined, then the item is added to the head
748# of the list.
749# Returns compiled template
750#------------------------------------------------------------------------
751
752
# spent 605µs (201+403) within Template::Provider::_store which was called 10 times, avg 60µs/call: # 10 times (201µs+403µs) by Template::Provider::store at line 176, avg 60µs/call
sub _store {
7531011µs my ($self, $name, $data, $compfile) = @_;
7541014µs my $size = $self->{ SIZE };
755105µs my ($slot, $head);
756
757 # Return if memory cache disabled. (overridding code should also check)
758 # $$$ What's the expected behaviour of store()? Can't tell from the
759 # docs if you can call store() when SIZE = 0.
760106µs return $data->{data} if defined $size and !$size;
761
762 # extract the compiled template from the data hash
763109µs $data = $data->{ data };
764108µs $self->debug("_store($name, $data)") if $self->{ DEBUG };
765
766 # check the modification time -- extra stat here
7671028µs10403µs my $load = $self->_modified($name);
# spent 403µs making 10 calls to Template::Provider::_modified, avg 40µs/call
768
769107µs if (defined $size && $self->{ SLOTS } >= $size) {
770 # cache has reached size limit, so reuse oldest entry
771 $self->debug("reusing oldest cache entry (size limit reached: $size)\nslots: $self->{ SLOTS }") if $self->{ DEBUG };
772
773 # remove entry from tail of list
774 $slot = $self->{ TAIL };
775 $slot->[ PREV ]->[ NEXT ] = undef;
776 $self->{ TAIL } = $slot->[ PREV ];
777
778 # remove name lookup for old node
779 delete $self->{ LOOKUP }->{ $slot->[ NAME ] };
780
781 # add modified node to head of list
782 $head = $self->{ HEAD };
783 $head->[ PREV ] = $slot if $head;
784 @$slot = ( undef, $name, $data, $load, $head, time );
785 $self->{ HEAD } = $slot;
786
787 # add name lookup for new node
788 $self->{ LOOKUP }->{ $name } = $slot;
789 }
790 else {
791 # cache is under size limit, or none is defined
792
793106µs $self->debug("adding new cache entry") if $self->{ DEBUG };
794
795 # add new node to head of list
796108µs $head = $self->{ HEAD };
7971017µs $slot = [ undef, $name, $data, $load, $head, time ];
798107µs $head->[ PREV ] = $slot if $head;
799107µs $self->{ HEAD } = $slot;
800106µs $self->{ TAIL } = $slot unless $self->{ TAIL };
801
802 # add lookup from name to slot and increment nslots
8031022µs $self->{ LOOKUP }->{ $name } = $slot;
804105µs $self->{ SLOTS }++;
805 }
806
8071026µs return $data;
808}
809
810
811#------------------------------------------------------------------------
812# _compile($data)
813#
814# Private method called to parse the template text and compile it into
815# a runtime form. Creates and delegates a Template::Parser object to
816# handle the compilation, or uses a reference passed in PARSER. On
817# success, the compiled template is stored in the 'data' item of the
818# $data hash and returned. On error, ($error, STATUS_ERROR) is returned,
819# or (undef, STATUS_DECLINED) if the TOLERANT flag is set.
820# The optional $compiled parameter may be passed to specify
821# the name of a compiled template file to which the generated Perl
822# code should be written. Errors are (for now...) silently
823# ignored, assuming that failures to open a file for writing are
824# intentional (e.g directory write permission).
825#------------------------------------------------------------------------
826
827
# spent 126ms (362µs+125) within Template::Provider::_compile which was called 10 times, avg 12.6ms/call: # 10 times (362µs+125ms) by Template::Provider::_fetch at line 482, avg 12.6ms/call
sub _compile {
828105µs my ($self, $data, $compfile) = @_;
829108µs my $text = $data->{ text };
830102µs my ($parsedoc, $error);
831
832 $self->debug("_compile($data, ",
833 defined $compfile ? $compfile : '<no compfile>', ')')
834105µs if $self->{ DEBUG };
835
836 my $parser = $self->{ PARSER }
837 ||= Template::Config->parser($self->{ PARAMS })
8381017µs123.8ms || return (Template::Config->error(), Template::Constants::STATUS_ERROR);
# spent 23.8ms making 1 call to Template::Config::parser
839
840 # discard the template text - we don't need it any more
8411014µs delete $data->{ text };
842
843 # call parser to compile template into Perl code
8441035µs1094.2ms if ($parsedoc = $parser->parse($text, $data)) {
# spent 94.2ms making 10 calls to Template::Parser::parse, avg 9.42ms/call
845
846 $parsedoc->{ METADATA } = {
847 'name' => $data->{ name },
848 'modtime' => $data->{ time },
8491047µs %{ $parsedoc->{ METADATA } },
850 };
851
852 # write the Perl code to the file $compfile, if defined
853103µs if ($compfile) {
854 my $basedir = &File::Basename::dirname($compfile);
855 $basedir =~ /(.*)/;
856 $basedir = $1;
857
858 unless (-d $basedir) {
859 eval { File::Path::mkpath($basedir) };
860 $error = "failed to create compiled templates directory: $basedir ($@)"
861 if ($@);
862 }
863
864 unless ($error) {
865 my $docclass = $self->{ DOCUMENT };
866 $error = 'cache failed to write '
867 . &File::Basename::basename($compfile)
868 . ': ' . $docclass->error()
869 unless $docclass->write_perl_file($compfile, $parsedoc);
870 }
871
872 # set atime and mtime of newly compiled file, don't bother
873 # if time is undef
874 if (!defined($error) && defined $data->{ time }) {
875 my ($cfile) = $compfile =~ /^(.+)$/s or do {
876 return("invalid filename: $compfile",
877 Template::Constants::STATUS_ERROR);
878 };
879
880 my ($ctime) = $data->{ time } =~ /^(\d+)$/;
881 unless ($ctime || $ctime eq 0) {
882 return("invalid time: $ctime",
883 Template::Constants::STATUS_ERROR);
884 }
885 utime($ctime, $ctime, $cfile);
886
887 $self->debug(" cached compiled template to file [$compfile]")
888 if $self->{ DEBUG };
889 }
890 }
891
892103µs unless ($error) {
893 return $data ## RETURN ##
89410186µs107.41ms if $data->{ data } = $DOCUMENT->new($parsedoc);
# spent 7.41ms making 10 calls to Template::Document::new, avg 741µs/call
895 $error = $Template::Document::ERROR;
896 }
897 }
898 else {
899 $error = Template::Exception->new( 'parse', "$data->{ name } " .
900 $parser->error() );
901 }
902
903 # return STATUS_ERROR, or STATUS_DECLINED if we're being tolerant
904 return $self->{ TOLERANT }
905 ? (undef, Template::Constants::STATUS_DECLINED)
906 : ($error, Template::Constants::STATUS_ERROR)
907}
908
909#------------------------------------------------------------------------
910# _compiled_is_current( $template_name )
911#
912# Returns true if $template_name and its compiled name
913# exist and they have the same mtime.
914#------------------------------------------------------------------------
915
916
# spent 89µs (47+42) within Template::Provider::_compiled_is_current which was called 10 times, avg 9µs/call: # 10 times (47µs+42µs) by Template::Provider::_fetch at line 460, avg 9µs/call
sub _compiled_is_current {
917104µs my ( $self, $template_name ) = @_;
9181041µs1042µs my $compiled_name = $self->_compiled_filename($template_name) || return;
# spent 42µs making 10 calls to Template::Provider::_compiled_filename, avg 4µs/call
919 my $compiled_mtime = (stat($compiled_name))[9] || return;
920 my $template_mtime = $self->_template_modified( $template_name ) || return;
921
922 # This was >= in the 2.15, but meant that downgrading
923 # a source template would not get picked up.
924 return $compiled_mtime == $template_mtime;
925}
926
927
928#------------------------------------------------------------------------
929# _template_modified($path)
930#
931# Returns the last modified time of the $path.
932# Returns undef if the path does not exist.
933# Override if templates are not on disk, for example
934#------------------------------------------------------------------------
935
936
# spent 1.11ms (119µs+992µs) within Template::Provider::_template_modified which was called 20 times, avg 56µs/call: # 10 times (57µs+718µs) by Template::Provider::_load at line 630, avg 77µs/call # 10 times (62µs+274µs) by Template::Provider::_modified at line 992, avg 34µs/call
sub _template_modified {
937209µs my $self = shift;
938207µs my $template = shift || return;
939201.12ms20992µs return (stat( $template ))[9];
# spent 992µs making 20 calls to Template::Provider::CORE:stat, avg 50µs/call
940}
941
942#------------------------------------------------------------------------
943# _template_content($path)
944#
945# Fetches content pointed to by $path.
946# Returns the content in scalar context.
947# Returns ($data, $error, $mtime) in list context where
948# $data - content
949# $error - error string if there was an error, otherwise undef
950# $mtime - last modified time from calling stat() on the path
951#------------------------------------------------------------------------
952
953
# spent 5.54ms (426µs+5.12) within Template::Provider::_template_content which was called 10 times, avg 554µs/call: # 10 times (426µs+5.12ms) by Template::Provider::_load at line 631, avg 554µs/call
sub _template_content {
954107µs my ($self, $path) = @_;
955
956103µs return (undef, "No path specified to fetch content from ")
957 unless $path;
958
959103µs my $data;
960 my $mod_date;
961 my $error;
962
9631018µs local *FH;
964104.86ms104.75ms if (open(FH, "< $path")) {
# spent 4.75ms making 10 calls to Template::Provider::CORE:open, avg 475µs/call
9651053µs local $/;
9661068µs1027µs binmode(FH);
# spent 27µs making 10 calls to Template::Provider::CORE:binmode, avg 3µs/call
96710228µs10184µs $data = <FH>;
# spent 184µs making 10 calls to Template::Provider::CORE:readline, avg 18µs/call
96810129µs1089µs $mod_date = (stat($path))[9];
# spent 89µs making 10 calls to Template::Provider::CORE:stat, avg 9µs/call
96910117µs1064µs close(FH);
# spent 64µs making 10 calls to Template::Provider::CORE:close, avg 6µs/call
970 }
971 else {
972 $error = "$path: $!";
973 }
974
975 return wantarray
9761070µs ? ( $data, $error, $mod_date )
977 : $data;
978}
979
980
981#------------------------------------------------------------------------
982# _modified($name)
983# _modified($name, $time)
984#
985# When called with a single argument, it returns the modification time
986# of the named template. When called with a second argument it returns
987# true if $name has been modified since $time.
988#------------------------------------------------------------------------
989
990
# spent 403µs (67+336) within Template::Provider::_modified which was called 10 times, avg 40µs/call: # 10 times (67µs+336µs) by Template::Provider::_store at line 767, avg 40µs/call
sub _modified {
991107µs my ($self, $name, $time) = @_;
9921030µs10336µs my $load = $self->_template_modified($name)
# spent 336µs making 10 calls to Template::Provider::_template_modified, avg 34µs/call
993 || return $time ? 1 : 0;
994
9951026µs return $time
996 ? $load > $time
997 : $load;
998}
999
1000#------------------------------------------------------------------------
1001# _dump()
1002#
1003# Debug method which returns a string representing the internal object
1004# state.
1005#------------------------------------------------------------------------
1006
1007sub _dump {
1008 my $self = shift;
1009 my $size = $self->{ SIZE };
1010 my $parser = $self->{ PARSER };
1011 $parser = $parser ? $parser->_dump() : '<no parser>';
1012 $parser =~ s/\n/\n /gm;
1013 $size = 'unlimited' unless defined $size;
1014
1015 my $output = "[Template::Provider] {\n";
1016 my $format = " %-16s => %s\n";
1017 my $key;
1018
1019 $output .= sprintf($format, 'INCLUDE_PATH',
1020 '[ ' . join(', ', @{ $self->{ INCLUDE_PATH } }) . ' ]');
1021 $output .= sprintf($format, 'CACHE_SIZE', $size);
1022
1023 foreach $key (qw( ABSOLUTE RELATIVE TOLERANT DELIMITER
1024 COMPILE_EXT COMPILE_DIR )) {
1025 $output .= sprintf($format, $key, $self->{ $key });
1026 }
1027 $output .= sprintf($format, 'PARSER', $parser);
1028
1029
1030 local $" = ', ';
1031 my $lookup = $self->{ LOOKUP };
1032 $lookup = join('', map {
1033 sprintf(" $format", $_, defined $lookup->{ $_ }
1034 ? ('[ ' . join(', ', map { defined $_ ? $_ : '<undef>' }
1035 @{ $lookup->{ $_ } }) . ' ]') : '<undef>');
1036 } sort keys %$lookup);
1037 $lookup = "{\n$lookup }";
1038
1039 $output .= sprintf($format, LOOKUP => $lookup);
1040
1041 $output .= '}';
1042 return $output;
1043}
1044
1045
1046#------------------------------------------------------------------------
1047# _dump_cache()
1048#
1049# Debug method which prints the current state of the cache to STDERR.
1050#------------------------------------------------------------------------
1051
1052sub _dump_cache {
1053 my $self = shift;
1054 my ($node, $lut, $count);
1055
1056 $count = 0;
1057 if ($node = $self->{ HEAD }) {
1058 while ($node) {
1059 $lut->{ $node } = $count++;
1060 $node = $node->[ NEXT ];
1061 }
1062 $node = $self->{ HEAD };
1063 print STDERR "CACHE STATE:\n";
1064 print STDERR " HEAD: ", $self->{ HEAD }->[ NAME ], "\n";
1065 print STDERR " TAIL: ", $self->{ TAIL }->[ NAME ], "\n";
1066 while ($node) {
1067 my ($prev, $name, $data, $load, $next) = @$node;
1068# $name = '...' . substr($name, -10) if length $name > 10;
1069 $prev = $prev ? "#$lut->{ $prev }<-": '<undef>';
1070 $next = $next ? "->#$lut->{ $next }": '<undef>';
1071 print STDERR " #$lut->{ $node } : [ $prev, $name, $data, $load, $next ]\n";
1072 $node = $node->[ NEXT ];
1073 }
1074 }
1075}
1076
1077#------------------------------------------------------------------------
1078# _decode_unicode
1079#
1080# Decodes encoded unicode text that starts with a BOM and
1081# turns it into perl's internal representation
1082#------------------------------------------------------------------------
1083
1084
# spent 1.06ms (238µs+821µs) within Template::Provider::_decode_unicode which was called 10 times, avg 106µs/call: # 10 times (238µs+821µs) by Template::Provider::_load at line 633, avg 106µs/call
sub _decode_unicode {
1085107µs my $self = shift;
1086103µs my $string = shift;
1087103µs return undef unless defined $string;
1088
10892185µs234µs
# spent 26µs (19+7) within Template::Provider::BEGIN@1089 which was called: # once (19µs+7µs) by Template::BEGIN@29 at line 1089
use bytes;
# spent 26µs making 1 call to Template::Provider::BEGIN@1089 # spent 7µs making 1 call to bytes::import
10901016µs require Encode;
1091
10921052µs1024µs return $string if Encode::is_utf8( $string );
# spent 24µs making 10 calls to Encode::is_utf8, avg 2µs/call
1093
1094 # try all the BOMs in order looking for one (order is important
1095 # 32bit BOMs look like 16bit BOMs)
1096
1097104µs my $count = 0;
1098
10991012µs while ($count < @{ $boms }) {
11005021µs my $enc = $boms->[$count++];
11015021µs my $bom = $boms->[$count++];
1102
1103 # does the string start with the bom?
11045053µs if ($bom eq substr($string, 0, length($bom))) {
1105 # decode it and hand it back
1106 return Encode::decode($enc, substr($string, length($bom)), 1);
1107 }
1108 }
1109
1110 return $self->{ ENCODING }
111110860µs10797µs ? Encode::decode( $self->{ ENCODING }, $string )
# spent 797µs making 10 calls to Encode::decode, avg 80µs/call
1112 : $string;
1113}
1114
1115
111619µs1;
1117
1118__END__
 
# spent 27µs within Template::Provider::CORE:binmode which was called 10 times, avg 3µs/call: # 10 times (27µs+0s) by Template::Provider::_template_content at line 966, avg 3µs/call
sub Template::Provider::CORE:binmode; # opcode
# spent 64µs within Template::Provider::CORE:close which was called 10 times, avg 6µs/call: # 10 times (64µs+0s) by Template::Provider::_template_content at line 969, avg 6µs/call
sub Template::Provider::CORE:close; # opcode
# spent 6µs within Template::Provider::CORE:match which was called 9 times, avg 622ns/call: # 9 times (6µs+0s) by Template::Provider::fetch at line 127, avg 622ns/call
sub Template::Provider::CORE:match; # opcode
# spent 4.75ms within Template::Provider::CORE:open which was called 10 times, avg 475µs/call: # 10 times (4.75ms+0s) by Template::Provider::_template_content at line 964, avg 475µs/call
sub Template::Provider::CORE:open; # opcode
# spent 7µs within Template::Provider::CORE:qr which was called: # once (7µs+0s) by Template::BEGIN@29 at line 82
sub Template::Provider::CORE:qr; # opcode
# spent 184µs within Template::Provider::CORE:readline which was called 10 times, avg 18µs/call: # 10 times (184µs+0s) by Template::Provider::_template_content at line 967, avg 18µs/call
sub Template::Provider::CORE:readline; # opcode
# spent 7µs within Template::Provider::CORE:regcomp which was called 9 times, avg 744ns/call: # 9 times (7µs+0s) by Template::Provider::fetch at line 127, avg 744ns/call
sub Template::Provider::CORE:regcomp; # opcode
# spent 1.08ms within Template::Provider::CORE:stat which was called 30 times, avg 36µs/call: # 20 times (992µs+0s) by Template::Provider::_template_modified at line 939, avg 50µs/call # 10 times (89µs+0s) by Template::Provider::_template_content at line 968, avg 9µs/call
sub Template::Provider::CORE:stat; # opcode
Report produced by the NYTProf 6.02 Perl profiler, developed by Tim Bunce and Adam Kaplan.