← Index
NYTProf Performance Profile   « block view • line view • sub view »
For /usr/share/koha/opac/cgi-bin/opac/opac-search.pl
  Run on Tue Oct 15 17:10:45 2013
Reported on Tue Oct 15 17:11:27 2013

Filename/usr/lib/perl5/Template/Stash.pm
StatementsExecuted 1186 statements in 7.38ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1117.31ms7.73msTemplate::Stash::::BEGIN@24Template::Stash::BEGIN@24
9211.77ms1.77msTemplate::Stash::::cloneTemplate::Stash::clone
3545271.58ms1.58msTemplate::Stash::::undefinedTemplate::Stash::undefined
92142µs42µsTemplate::Stash::::decloneTemplate::Stash::declone
11136µs43µsTemplate::Stash::::BEGIN@22Template::Stash::BEGIN@22
11123µs23µsTemplate::Stash::::newTemplate::Stash::new
11121µs126µsTemplate::Stash::::BEGIN@26Template::Stash::BEGIN@26
11114µs14µsTemplate::Stash::::CORE:qrTemplate::Stash::CORE:qr (opcode)
11114µs16µsTemplate::Stash::::BEGIN@25Template::Stash::BEGIN@25
11112µs25µsTemplate::Stash::::BEGIN@23Template::Stash::BEGIN@23
1119µs9µsTemplate::Stash::::updateTemplate::Stash::update
0000s0sTemplate::Stash::::__ANON__[:318]Template::Stash::__ANON__[:318]
0000s0sTemplate::Stash::::__ANON__[:321]Template::Stash::__ANON__[:321]
0000s0sTemplate::Stash::::_assignTemplate::Stash::_assign
0000s0sTemplate::Stash::::_dotopTemplate::Stash::_dotop
0000s0sTemplate::Stash::::_dumpTemplate::Stash::_dump
0000s0sTemplate::Stash::::_dump_frameTemplate::Stash::_dump_frame
0000s0sTemplate::Stash::::_reconstruct_identTemplate::Stash::_reconstruct_ident
0000s0sTemplate::Stash::::define_vmethodTemplate::Stash::define_vmethod
0000s0sTemplate::Stash::::getTemplate::Stash::get
0000s0sTemplate::Stash::::getrefTemplate::Stash::getref
0000s0sTemplate::Stash::::setTemplate::Stash::set
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::Stash
4#
5# DESCRIPTION
6# Definition of an object class which stores and manages access to
7# variables for the Template Toolkit.
8#
9# AUTHOR
10# Andy Wardley <abw@wardley.org>
11#
12# COPYRIGHT
13# Copyright (C) 1996-2007 Andy Wardley. All Rights Reserved.
14#
15# This module is free software; you can redistribute it and/or
16# modify it under the same terms as Perl itself.
17#
18#============================================================================
19
20package Template::Stash;
21
22341µs250µs
# spent 43µs (36+7) within Template::Stash::BEGIN@22 which was called: # once (36µs+7µs) by Template::Stash::XS::BEGIN@17 at line 22
use strict;
# spent 43µs making 1 call to Template::Stash::BEGIN@22 # spent 7µs making 1 call to strict::import
23328µs238µs
# spent 25µs (12+13) within Template::Stash::BEGIN@23 which was called: # once (12µs+13µs) by Template::Stash::XS::BEGIN@17 at line 23
use warnings;
# spent 25µs making 1 call to Template::Stash::BEGIN@23 # spent 13µs making 1 call to warnings::import
243152µs27.74ms
# spent 7.73ms (7.31+426µs) within Template::Stash::BEGIN@24 which was called: # once (7.31ms+426µs) by Template::Stash::XS::BEGIN@17 at line 24
use Template::VMethods;
# spent 7.73ms making 1 call to Template::Stash::BEGIN@24 # spent 6µs making 1 call to UNIVERSAL::import
25341µs217µs
# spent 16µs (14+2) within Template::Stash::BEGIN@25 which was called: # once (14µs+2µs) by Template::Stash::XS::BEGIN@17 at line 25
use Template::Exception;
# spent 16µs making 1 call to Template::Stash::BEGIN@25 # spent 2µs making 1 call to UNIVERSAL::import
2632.64ms2231µs
# spent 126µs (21+105) within Template::Stash::BEGIN@26 which was called: # once (21µs+105µs) by Template::Stash::XS::BEGIN@17 at line 26
use Scalar::Util qw( blessed reftype );
# spent 126µs making 1 call to Template::Stash::BEGIN@26 # spent 105µs making 1 call to Exporter::import
27
2811µsour $VERSION = 2.91;
291800nsour $DEBUG = 0 unless defined $DEBUG;
30136µs114µsour $PRIVATE = qr/^[_.]/;
# spent 14µs making 1 call to Template::Stash::CORE:qr
311700nsour $UNDEF_TYPE = 'var.undef';
321600nsour $UNDEF_INFO = 'undefined variable: %s';
33
34# alias _dotop() to dotop() so that we have a consistent method name
35# between the Perl and XS stash implementations
3613µs*dotop = \&_dotop;
37
38
39#------------------------------------------------------------------------
40# Virtual Methods
41#
42# If any of $ROOT_OPS, $SCALAR_OPS, $HASH_OPS or $LIST_OPS are already
43# defined then we merge their contents with the default virtual methods
44# define by Template::VMethods. Otherwise we can directly alias the
45# corresponding Template::VMethod package vars.
46#------------------------------------------------------------------------
47
48our $ROOT_OPS = defined $ROOT_OPS
491700ns ? { %{$Template::VMethods::ROOT_VMETHODS}, %$ROOT_OPS }
50 : $Template::VMethods::ROOT_VMETHODS;
51
52our $SCALAR_OPS = defined $SCALAR_OPS
531500ns ? { %{$Template::VMethods::TEXT_VMETHODS}, %$SCALAR_OPS }
54 : $Template::VMethods::TEXT_VMETHODS;
55
56our $HASH_OPS = defined $HASH_OPS
571500ns ? { %{$Template::VMethods::HASH_VMETHODS}, %$HASH_OPS }
58 : $Template::VMethods::HASH_VMETHODS;
59
60our $LIST_OPS = defined $LIST_OPS
611900ns ? { %{$Template::VMethods::LIST_VMETHODS}, %$LIST_OPS }
62 : $Template::VMethods::LIST_VMETHODS;
63
64
65#------------------------------------------------------------------------
66# define_vmethod($type, $name, \&sub)
67#
68# Defines a virtual method of type $type (SCALAR, HASH, or LIST), with
69# name $name, that invokes &sub when called. It is expected that &sub
70# be able to handle the type that it will be called upon.
71#------------------------------------------------------------------------
72
73sub define_vmethod {
74 my ($class, $type, $name, $sub) = @_;
75 my $op;
76 $type = lc $type;
77
78 if ($type =~ /^scalar|item$/) {
79 $op = $SCALAR_OPS;
80 }
81 elsif ($type eq 'hash') {
82 $op = $HASH_OPS;
83 }
84 elsif ($type =~ /^list|array$/) {
85 $op = $LIST_OPS;
86 }
87 else {
88 die "invalid vmethod type: $type\n";
89 }
90
91 $op->{ $name } = $sub;
92
93 return 1;
94}
95
96
97#========================================================================
98# ----- CLASS METHODS -----
99#========================================================================
100
101#------------------------------------------------------------------------
102# new(\%params)
103#
104# Constructor method which creates a new Template::Stash object.
105# An optional hash reference may be passed containing variable
106# definitions that will be used to initialise the stash.
107#
108# Returns a reference to a newly created Template::Stash.
109#------------------------------------------------------------------------
110
111
# spent 23µs within Template::Stash::new which was called: # once (23µs+0s) by Template::Config::stash at line 195 of Template/Config.pm
sub new {
112427µs my $class = shift;
113 my $params = ref $_[0] eq 'HASH' ? shift(@_) : { @_ };
114
115 my $self = {
116 global => { },
117 %$params,
118 %$ROOT_OPS,
119 '_PARENT' => undef,
120 };
121
122 bless $self, $class;
123}
124
125
126#========================================================================
127# ----- PUBLIC OBJECT METHODS -----
128#========================================================================
129
130#------------------------------------------------------------------------
131# clone(\%params)
132#
133# Creates a copy of the current stash object to effect localisation
134# of variables. The new stash is blessed into the same class as the
135# parent (which may be a derived class) and has a '_PARENT' member added
136# which contains a reference to the parent stash that created it
137# ($self). This member is used in a successive declone() method call to
138# return the reference to the parent.
139#
140# A parameter may be provided which should reference a hash of
141# variable/values which should be defined in the new stash. The
142# update() method is called to define these new variables in the cloned
143# stash.
144#
145# Returns a reference to a cloned Template::Stash.
146#------------------------------------------------------------------------
147
148
# spent 1.77ms within Template::Stash::clone which was called 9 times, avg 197µs/call: # 8 times (1.51ms+0s) by Template::Context::process at line 312 of Template/Context.pm, avg 188µs/call # once (261µs+0s) by Template::Context::localise at line 567 of Template/Context.pm
sub clone {
149721.81ms my ($self, $params) = @_;
150 $params ||= { };
151
152 # look out for magical 'import' argument which imports another hash
153 my $import = $params->{ import };
154 if (defined $import && ref $import eq 'HASH') {
155 delete $params->{ import };
156 }
157 else {
158 undef $import;
159 }
160
161 my $clone = bless {
162 %$self, # copy all parent members
163 %$params, # copy all new data
164 '_PARENT' => $self, # link to parent
165 }, ref $self;
166
167 # perform hash import if defined
168 &{ $HASH_OPS->{ import } }($clone, $import)
169 if defined $import;
170
171 return $clone;
172}
173
174
175#------------------------------------------------------------------------
176# declone($export)
177#
178# Returns a reference to the PARENT stash. When called in the following
179# manner:
180# $stash = $stash->declone();
181# the reference count on the current stash will drop to 0 and be "freed"
182# and the caller will be left with a reference to the parent. This
183# contains the state of the stash before it was cloned.
184#------------------------------------------------------------------------
185
186
# spent 42µs within Template::Stash::declone which was called 9 times, avg 5µs/call: # 8 times (36µs+0s) by Template::Context::process at line 380 of Template/Context.pm, avg 5µs/call # once (6µs+0s) by Template::Context::delocalise at line 572 of Template/Context.pm
sub declone {
1871857µs my $self = shift;
188 $self->{ _PARENT } || $self;
189}
190
191
192#------------------------------------------------------------------------
193# get($ident)
194#
195# Returns the value for an variable stored in the stash. The variable
196# may be specified as a simple string, e.g. 'foo', or as an array
197# reference representing compound variables. In the latter case, each
198# pair of successive elements in the list represent a node in the
199# compound variable. The first is the variable name, the second a
200# list reference of arguments or 0 if undefined. So, the compound
201# variable [% foo.bar('foo').baz %] would be represented as the list
202# [ 'foo', 0, 'bar', ['foo'], 'baz', 0 ]. Returns the value of the
203# identifier or an empty string if undefined. Errors are thrown via
204# die().
205#------------------------------------------------------------------------
206
207sub get {
208 my ($self, $ident, $args) = @_;
209 my ($root, $result);
210 $root = $self;
211
212 if (ref $ident eq 'ARRAY'
213 || ($ident =~ /\./)
214 && ($ident = [ map { s/\(.*$//; ($_, 0) } split(/\./, $ident) ])) {
215 my $size = $#$ident;
216
217 # if $ident is a list reference, then we evaluate each item in the
218 # identifier against the previous result, using the root stash
219 # ($self) as the first implicit 'result'...
220
221 foreach (my $i = 0; $i <= $size; $i += 2) {
222 $result = $self->_dotop($root, @$ident[$i, $i+1]);
223 last unless defined $result;
224 $root = $result;
225 }
226 }
227 else {
228 $result = $self->_dotop($root, $ident, $args);
229 }
230
231 return defined $result
232 ? $result
233 : $self->undefined($ident, $args);
234}
235
236
237#------------------------------------------------------------------------
238# set($ident, $value, $default)
239#
240# Updates the value for a variable in the stash. The first parameter
241# should be the variable name or array, as per get(). The second
242# parameter should be the intended value for the variable. The third,
243# optional parameter is a flag which may be set to indicate 'default'
244# mode. When set true, the variable will only be updated if it is
245# currently undefined or has a false value. The magical 'IMPORT'
246# variable identifier may be used to indicate that $value is a hash
247# reference whose values should be imported. Returns the value set,
248# or an empty string if not set (e.g. default mode). In the case of
249# IMPORT, returns the number of items imported from the hash.
250#------------------------------------------------------------------------
251
252sub set {
253 my ($self, $ident, $value, $default) = @_;
254 my ($root, $result, $error);
255
256 $root = $self;
257
258 ELEMENT: {
259 if (ref $ident eq 'ARRAY'
260 || ($ident =~ /\./)
261 && ($ident = [ map { s/\(.*$//; ($_, 0) }
262 split(/\./, $ident) ])) {
263
264 # a compound identifier may contain multiple elements (e.g.
265 # foo.bar.baz) and we must first resolve all but the last,
266 # using _dotop() with the $lvalue flag set which will create
267 # intermediate hashes if necessary...
268 my $size = $#$ident;
269 foreach (my $i = 0; $i < $size - 2; $i += 2) {
270 $result = $self->_dotop($root, @$ident[$i, $i+1], 1);
271 last ELEMENT unless defined $result;
272 $root = $result;
273 }
274
275 # then we call _assign() to assign the value to the last element
276 $result = $self->_assign($root, @$ident[$size-1, $size],
277 $value, $default);
278 }
279 else {
280 $result = $self->_assign($root, $ident, 0, $value, $default);
281 }
282 }
283
284 return defined $result ? $result : '';
285}
286
287
288#------------------------------------------------------------------------
289# getref($ident)
290#
291# Returns a "reference" to a particular item. This is represented as a
292# closure which will return the actual stash item when called.
293# WARNING: still experimental!
294#------------------------------------------------------------------------
295
296sub getref {
297 my ($self, $ident, $args) = @_;
298 my ($root, $item, $result);
299 $root = $self;
300
301 if (ref $ident eq 'ARRAY') {
302 my $size = $#$ident;
303
304 foreach (my $i = 0; $i <= $size; $i += 2) {
305 ($item, $args) = @$ident[$i, $i + 1];
306 last if $i >= $size - 2; # don't evaluate last node
307 last unless defined
308 ($root = $self->_dotop($root, $item, $args));
309 }
310 }
311 else {
312 $item = $ident;
313 }
314
315 if (defined $root) {
316 return sub { my @args = (@{$args||[]}, @_);
317 $self->_dotop($root, $item, \@args);
318 }
319 }
320 else {
321 return sub { '' };
322 }
323}
324
- -
328#------------------------------------------------------------------------
329# update(\%params)
330#
331# Update multiple variables en masse. No magic is performed. Simple
332# variable names only.
333#------------------------------------------------------------------------
334
335
# spent 9µs within Template::Stash::update which was called: # once (9µs+0s) by Template::Context::process at line 317 of Template/Context.pm
sub update {
336414µs my ($self, $params) = @_;
337
338 # look out for magical 'import' argument to import another hash
339 my $import = $params->{ import };
340 if (defined $import && ref $import eq 'HASH') {
341 @$self{ keys %$import } = values %$import;
342 delete $params->{ import };
343 }
344
345 @$self{ keys %$params } = values %$params;
346}
347
348
349#------------------------------------------------------------------------
350# undefined($ident, $args)
351#
352# Method called when a get() returns an undefined value. Can be redefined
353# in a subclass to implement alternate handling.
354#------------------------------------------------------------------------
355
356
# spent 1.58ms within Template::Stash::undefined which was called 354 times, avg 4µs/call: # 50 times (172µs+0s) by Template::Stash::XS::get at line 458 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/modules/opac-results.tt, avg 3µs/call # 35 times (214µs+0s) by Template::Stash::XS::get at line 8 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/includes/opac-facets.inc, avg 6µs/call # 26 times (169µs+0s) by Template::Stash::XS::get at line 16 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/includes/opac-facets.inc, avg 7µs/call # 25 times (109µs+0s) by Template::Stash::XS::get at line 429 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/modules/opac-results.tt, avg 4µs/call # 25 times (106µs+0s) by Template::Stash::XS::get at line 480 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/modules/opac-results.tt, avg 4µs/call # 25 times (104µs+0s) by Template::Stash::XS::get at line 501 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/modules/opac-results.tt, avg 4µs/call # 25 times (96µs+0s) by Template::Stash::XS::get at line 496 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/modules/opac-results.tt, avg 4µs/call # 25 times (92µs+0s) by Template::Stash::XS::get at line 505 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/modules/opac-results.tt, avg 4µs/call # 25 times (92µs+0s) by Template::Stash::XS::get at line 462 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/modules/opac-results.tt, avg 4µs/call # 25 times (90µs+0s) by Template::Stash::XS::get at line 498 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/modules/opac-results.tt, avg 4µs/call # 20 times (95µs+0s) by Template::Stash::XS::get at line 10 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/includes/page-numbers.inc, avg 5µs/call # 4 times (16µs+0s) by Template::Stash::XS::get at line 68 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/includes/masthead.inc, avg 4µs/call # 2 times (16µs+0s) by Template::Stash::XS::get at line 10 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/includes/opac-facets.inc, avg 8µs/call # 2 times (15µs+0s) by Template::Stash::XS::get at line 3 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/includes/page-numbers.inc, avg 7µs/call # 2 times (9µs+0s) by Template::Stash::XS::get at line 1 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/modules/opac-results.tt, avg 5µs/call # 2 times (4µs+0s) by Template::Stash::XS::get at line 36 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/includes/masthead.inc, avg 2µs/call # once (38µs+0s) by Template::Stash::XS::get at line 11 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/includes/opac-facets.inc # once (11µs+0s) by Template::Stash::XS::get at line 323 of Template/Context.pm # once (10µs+0s) by Template::Stash::XS::get at line 11 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/includes/doc-head-close.inc # once (10µs+0s) by Template::Stash::XS::get at line 4 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/includes/opac-facets.inc # once (9µs+0s) by Template::Stash::XS::get at line 532 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/modules/opac-results.tt # once (7µs+0s) by Template::Stash::XS::get at line 394 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/modules/opac-results.tt # once (6µs+0s) by Template::Stash::XS::get at line 5 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/includes/opac-facets.inc # once (5µs+0s) by Template::Stash::XS::get at line 3 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/includes/masthead.inc # once (5µs+0s) by Template::Stash::XS::get at line 14 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/includes/doc-head-close.inc # once (4µs+0s) by Template::Stash::XS::get at line 150 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/modules/opac-results.tt # once (4µs+0s) by Template::Stash::XS::get at line 107 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/includes/doc-head-close.inc # once (4µs+0s) by Template::Stash::XS::get at line 80 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/includes/masthead.inc # once (4µs+0s) by Template::Stash::XS::get at line 323 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/modules/opac-results.tt # once (4µs+0s) by Template::Stash::XS::get at line 2 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/includes/doc-head-open.inc # once (4µs+0s) by Template::Stash::XS::get at line 520 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/modules/opac-results.tt # once (3µs+0s) by Template::Stash::XS::get at line 81 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/includes/masthead.inc # once (3µs+0s) by Template::Stash::XS::get at line 387 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/modules/opac-results.tt # once (3µs+0s) by Template::Stash::XS::get at line 15 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/includes/page-numbers.inc # once (3µs+0s) by Template::Stash::XS::get at line 22 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/includes/masthead.inc # once (3µs+0s) by Template::Stash::XS::get at line 203 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/modules/opac-results.tt # once (3µs+0s) by Template::Stash::XS::get at line 50 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/includes/masthead.inc # once (3µs+0s) by Template::Stash::XS::get at line 110 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/includes/doc-head-close.inc # once (3µs+0s) by Template::Stash::XS::get at line 8 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/modules/opac-results.tt # once (3µs+0s) by Template::Stash::XS::get at line 101 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/includes/masthead.inc # once (3µs+0s) by Template::Stash::XS::get at line 87 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/includes/masthead.inc # once (3µs+0s) by Template::Stash::XS::get at line 24 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/includes/masthead.inc # once (2µs+0s) by Template::Stash::XS::get at line 32 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/includes/masthead.inc # once (2µs+0s) by Template::Stash::XS::get at line 54 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/includes/masthead.inc # once (2µs+0s) by Template::Stash::XS::get at line 326 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/modules/opac-results.tt # once (2µs+0s) by Template::Stash::XS::get at line 30 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/includes/masthead.inc # once (2µs+0s) by Template::Stash::XS::get at line 6 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/includes/masthead.inc # once (2µs+0s) by Template::Stash::XS::get at line 5 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/includes/masthead.inc # once (2µs+0s) by Template::Stash::XS::get at line 518 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/modules/opac-results.tt # once (2µs+0s) by Template::Stash::XS::get at line 208 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/modules/opac-results.tt # once (2µs+0s) by Template::Stash::XS::get at line 26 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/includes/masthead.inc # once (2µs+0s) by Template::Stash::XS::get at line 28 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/includes/masthead.inc
sub undefined {
35710622.51ms my ($self, $ident, $args) = @_;
358
359 if ($self->{ _STRICT }) {
360 # Sorry, but we can't provide a sensible source file and line without
361 # re-designing the whole architecure of TT (see TT3)
362 die Template::Exception->new(
363 $UNDEF_TYPE,
364 sprintf(
365 $UNDEF_INFO,
366 $self->_reconstruct_ident($ident)
367 )
368 ) if $self->{ _STRICT };
369 }
370 else {
371 # There was a time when I thought this was a good idea. But it's not.
372 return '';
373 }
374}
375
376sub _reconstruct_ident {
377 my ($self, $ident) = @_;
378 my ($name, $args, @output);
379 my @input = ref $ident eq 'ARRAY' ? @$ident : ($ident);
380
381 while (@input) {
382 $name = shift @input;
383 $args = shift @input || 0;
384 $name .= '(' . join(', ', map { /^\d+$/ ? $_ : "'$_'" } @$args) . ')'
385 if $args && ref $args eq 'ARRAY';
386 push(@output, $name);
387 }
388
389 return join('.', @output);
390}
391
392
393#========================================================================
394# ----- PRIVATE OBJECT METHODS -----
395#========================================================================
396
397#------------------------------------------------------------------------
398# _dotop($root, $item, \@args, $lvalue)
399#
400# This is the core 'dot' operation method which evaluates elements of
401# variables against their root. All variables have an implicit root
402# which is the stash object itself (a hash). Thus, a non-compound
403# variable 'foo' is actually '(stash.)foo', the compound 'foo.bar' is
404# '(stash.)foo.bar'. The first parameter is a reference to the current
405# root, initially the stash itself. The second parameter contains the
406# name of the variable element, e.g. 'foo'. The third optional
407# parameter is a reference to a list of any parenthesised arguments
408# specified for the variable, which are passed to sub-routines, object
409# methods, etc. The final parameter is an optional flag to indicate
410# if this variable is being evaluated on the left side of an assignment
411# (e.g. foo.bar.baz = 10). When set true, intermediated hashes will
412# be created (e.g. bar) if necessary.
413#
414# Returns the result of evaluating the item against the root, having
415# performed any variable "magic". The value returned can then be used
416# as the root of the next _dotop() in a compound sequence. Returns
417# undef if the variable is undefined.
418#------------------------------------------------------------------------
419
420sub _dotop {
421 my ($self, $root, $item, $args, $lvalue) = @_;
422 my $rootref = ref $root;
423 my $atroot = (blessed $root && $root->isa(ref $self));
424 my ($value, @result);
425
426 $args ||= [ ];
427 $lvalue ||= 0;
428
429# print STDERR "_dotop(root=$root, item=$item, args=[@$args])\n"
430# if $DEBUG;
431
432 # return undef without an error if either side of the dot is unviable
433 return undef unless defined($root) and defined($item);
434
435 # or if an attempt is made to access a private member, starting _ or .
436 return undef if $PRIVATE && $item =~ /$PRIVATE/;
437
438 if ($atroot || $rootref eq 'HASH') {
439 # if $root is a regular HASH or a Template::Stash kinda HASH (the
440 # *real* root of everything). We first lookup the named key
441 # in the hash, or create an empty hash in its place if undefined
442 # and the $lvalue flag is set. Otherwise, we check the HASH_OPS
443 # pseudo-methods table, calling the code if found, or return undef.
444
445 if (defined($value = $root->{ $item })) {
446 return $value unless ref $value eq 'CODE'; ## RETURN
447 @result = &$value(@$args); ## @result
448 }
449 elsif ($lvalue) {
450 # we create an intermediate hash if this is an lvalue
451 return $root->{ $item } = { }; ## RETURN
452 }
453 # ugly hack: only allow import vmeth to be called on root stash
454 elsif (($value = $HASH_OPS->{ $item })
455 && ! $atroot || $item eq 'import') {
456 @result = &$value($root, @$args); ## @result
457 }
458 elsif ( ref $item eq 'ARRAY' ) {
459 # hash slice
460 return [@$root{@$item}]; ## RETURN
461 }
462 }
463 elsif ($rootref eq 'ARRAY') {
464 # if root is an ARRAY then we check for a LIST_OPS pseudo-method
465 # or return the numerical index into the array, or undef
466 if ($value = $LIST_OPS->{ $item }) {
467 @result = &$value($root, @$args); ## @result
468 }
469 elsif ($item =~ /^-?\d+$/) {
470 $value = $root->[$item];
471 return $value unless ref $value eq 'CODE'; ## RETURN
472 @result = &$value(@$args); ## @result
473 }
474 elsif ( ref $item eq 'ARRAY' ) {
475 # array slice
476 return [@$root[@$item]]; ## RETURN
477 }
478 }
479
480 # NOTE: we do the can-can because UNIVSERAL::isa($something, 'UNIVERSAL')
481 # doesn't appear to work with CGI, returning true for the first call
482 # and false for all subsequent calls.
483
484 # UPDATE: that doesn't appear to be the case any more
485
486 elsif (blessed($root) && $root->can('can')) {
487
488 # if $root is a blessed reference (i.e. inherits from the
489 # UNIVERSAL object base class) then we call the item as a method.
490 # If that fails then we try to fallback on HASH behaviour if
491 # possible.
492 eval { @result = $root->$item(@$args); };
493
494 if ($@) {
495 # temporary hack - required to propogate errors thrown
496 # by views; if $@ is a ref (e.g. Template::Exception
497 # object then we assume it's a real error that needs
498 # real throwing
499
500 my $class = ref($root) || $root;
501 die $@ if ref($@) || ($@ !~ /Can't locate object method "\Q$item\E" via package "\Q$class\E"/);
502
503 # failed to call object method, so try some fallbacks
504 if (reftype $root eq 'HASH') {
505 if( defined($value = $root->{ $item })) {
506 return $value unless ref $value eq 'CODE'; ## RETURN
507 @result = &$value(@$args);
508 }
509 elsif ($value = $HASH_OPS->{ $item }) {
510 @result = &$value($root, @$args);
511 }
512 elsif ($value = $LIST_OPS->{ $item }) {
513 @result = &$value([$root], @$args);
514 }
515 }
516 elsif (reftype $root eq 'ARRAY') {
517 if( $value = $LIST_OPS->{ $item }) {
518 @result = &$value($root, @$args);
519 }
520 elsif( $item =~ /^-?\d+$/ ) {
521 $value = $root->[$item];
522 return $value unless ref $value eq 'CODE'; ## RETURN
523 @result = &$value(@$args); ## @result
524 }
525 elsif ( ref $item eq 'ARRAY' ) {
526 # array slice
527 return [@$root[@$item]]; ## RETURN
528 }
529 }
530 elsif ($value = $SCALAR_OPS->{ $item }) {
531 @result = &$value($root, @$args);
532 }
533 elsif ($value = $LIST_OPS->{ $item }) {
534 @result = &$value([$root], @$args);
535 }
536 elsif ($self->{ _DEBUG }) {
537 @result = (undef, $@);
538 }
539 }
540 }
541 elsif (($value = $SCALAR_OPS->{ $item }) && ! $lvalue) {
542 # at this point, it doesn't look like we've got a reference to
543 # anything we know about, so we try the SCALAR_OPS pseudo-methods
544 # table (but not for l-values)
545 @result = &$value($root, @$args); ## @result
546 }
547 elsif (($value = $LIST_OPS->{ $item }) && ! $lvalue) {
548 # last-ditch: can we promote a scalar to a one-element
549 # list and apply a LIST_OPS virtual method?
550 @result = &$value([$root], @$args);
551 }
552 elsif ($self->{ _DEBUG }) {
553 die "don't know how to access [ $root ].$item\n"; ## DIE
554 }
555 else {
556 @result = ();
557 }
558
559 # fold multiple return items into a list unless first item is undef
560 if (defined $result[0]) {
561 return ## RETURN
562 scalar @result > 1 ? [ @result ] : $result[0];
563 }
564 elsif (defined $result[1]) {
565 die $result[1]; ## DIE
566 }
567 elsif ($self->{ _DEBUG }) {
568 die "$item is undefined\n"; ## DIE
569 }
570
571 return undef;
572}
573
574
575#------------------------------------------------------------------------
576# _assign($root, $item, \@args, $value, $default)
577#
578# Similar to _dotop() above, but assigns a value to the given variable
579# instead of simply returning it. The first three parameters are the
580# root item, the item and arguments, as per _dotop(), followed by the
581# value to which the variable should be set and an optional $default
582# flag. If set true, the variable will only be set if currently false
583# (undefined/zero)
584#------------------------------------------------------------------------
585
586sub _assign {
587 my ($self, $root, $item, $args, $value, $default) = @_;
588 my $rootref = ref $root;
589 my $atroot = ($root eq $self);
590 my $result;
591 $args ||= [ ];
592 $default ||= 0;
593
594 # return undef without an error if either side of the dot is unviable
595 return undef unless $root and defined $item;
596
597 # or if an attempt is made to update a private member, starting _ or .
598 return undef if $PRIVATE && $item =~ /$PRIVATE/;
599
600 if ($rootref eq 'HASH' || $atroot) {
601 # if the root is a hash we set the named key
602 return ($root->{ $item } = $value) ## RETURN
603 unless $default && $root->{ $item };
604 }
605 elsif ($rootref eq 'ARRAY' && $item =~ /^-?\d+$/) {
606 # or set a list item by index number
607 return ($root->[$item] = $value) ## RETURN
608 unless $default && $root->{ $item };
609 }
610 elsif (blessed($root)) {
611 # try to call the item as a method of an object
612
613 return $root->$item(@$args, $value) ## RETURN
614 unless $default && $root->$item();
615
616# 2 issues:
617# - method call should be wrapped in eval { }
618# - fallback on hash methods if object method not found
619#
620# eval { $result = $root->$item(@$args, $value); };
621#
622# if ($@) {
623# die $@ if ref($@) || ($@ !~ /Can't locate object method/);
624#
625# # failed to call object method, so try some fallbacks
626# if (UNIVERSAL::isa($root, 'HASH') && exists $root->{ $item }) {
627# $result = ($root->{ $item } = $value)
628# unless $default && $root->{ $item };
629# }
630# }
631# return $result; ## RETURN
632 }
633 else {
634 die "don't know how to assign to [$root].[$item]\n"; ## DIE
635 }
636
637 return undef;
638}
639
640
641#------------------------------------------------------------------------
642# _dump()
643#
644# Debug method which returns a string representing the internal state
645# of the object. The method calls itself recursively to dump sub-hashes.
646#------------------------------------------------------------------------
647
648sub _dump {
649 my $self = shift;
650 return "[Template::Stash] " . $self->_dump_frame(2);
651}
652
653sub _dump_frame {
654 my ($self, $indent) = @_;
655 $indent ||= 1;
656 my $buffer = ' ';
657 my $pad = $buffer x $indent;
658 my $text = "{\n";
659 local $" = ', ';
660
661 my ($key, $value);
662
663 return $text . "...excessive recursion, terminating\n"
664 if $indent > 32;
665
666 foreach $key (keys %$self) {
667 $value = $self->{ $key };
668 $value = '<undef>' unless defined $value;
669 next if $key =~ /^\./;
670 if (ref($value) eq 'ARRAY') {
671 $value = '[ ' . join(', ', map { defined $_ ? $_ : '<undef>' }
672 @$value) . ' ]';
673 }
674 elsif (ref $value eq 'HASH') {
675 $value = _dump_frame($value, $indent + 1);
676 }
677
678 $text .= sprintf("$pad%-16s => $value\n", $key);
679 }
680 $text .= $buffer x ($indent - 1) . '}';
681 return $text;
682}
683
684
685116µs1;
686
687__END__
 
# spent 14µs within Template::Stash::CORE:qr which was called: # once (14µs+0s) by Template::Stash::XS::BEGIN@17 at line 30
sub Template::Stash::CORE:qr; # opcode
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.