Filename | /usr/lib/x86_64-linux-gnu/perl5/5.28/Template/Stash.pm |
Statements | Executed 7969268 statements in 21.1s |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
376400 | 2 | 1 | 7.80s | 7.80s | clone | Template::Stash::
375387 | 1 | 1 | 3.80s | 3.80s | new | Template::Stash::
375387 | 1 | 1 | 2.24s | 2.24s | update | Template::Stash::
400717 | 27 | 4 | 1.32s | 1.32s | undefined | Template::Stash::
376400 | 2 | 1 | 759ms | 759ms | declone | Template::Stash::
1 | 1 | 1 | 3.42ms | 3.64ms | BEGIN@24 | Template::Stash::
1 | 1 | 1 | 10µs | 12µs | BEGIN@22 | Template::Stash::
1 | 1 | 1 | 10µs | 10µs | BEGIN@25 | Template::Stash::
1 | 1 | 1 | 7µs | 56µs | BEGIN@26 | Template::Stash::
1 | 1 | 1 | 5µs | 17µs | BEGIN@23 | Template::Stash::
1 | 1 | 1 | 4µs | 4µs | CORE:qr (opcode) | Template::Stash::
2 | 2 | 1 | 2µs | 2µs | __ANON__ (xsub) | Template::Stash::
0 | 0 | 0 | 0s | 0s | __ANON__[:317] | Template::Stash::
0 | 0 | 0 | 0s | 0s | __ANON__[:320] | Template::Stash::
0 | 0 | 0 | 0s | 0s | _assign | Template::Stash::
0 | 0 | 0 | 0s | 0s | _dotop | Template::Stash::
0 | 0 | 0 | 0s | 0s | _dump | Template::Stash::
0 | 0 | 0 | 0s | 0s | _dump_frame | Template::Stash::
0 | 0 | 0 | 0s | 0s | _reconstruct_ident | Template::Stash::
0 | 0 | 0 | 0s | 0s | define_vmethod | Template::Stash::
0 | 0 | 0 | 0s | 0s | get | Template::Stash::
0 | 0 | 0 | 0s | 0s | getref | Template::Stash::
0 | 0 | 0 | 0s | 0s | set | Template::Stash::
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 | |||||
20 | package Template::Stash; | ||||
21 | |||||
22 | 2 | 18µs | 2 | 14µs | # spent 12µs (10+2) within Template::Stash::BEGIN@22 which was called:
# once (10µs+2µs) by Template::Stash::XS::BEGIN@17 at line 22 # spent 12µs making 1 call to Template::Stash::BEGIN@22
# spent 2µs making 1 call to strict::import |
23 | 2 | 19µs | 2 | 28µs | # spent 17µs (5+12) within Template::Stash::BEGIN@23 which was called:
# once (5µs+12µs) by Template::Stash::XS::BEGIN@17 at line 23 # spent 17µs making 1 call to Template::Stash::BEGIN@23
# spent 12µs making 1 call to warnings::import |
24 | 2 | 164µs | 2 | 3.64ms | # spent 3.64ms (3.42+215µs) within Template::Stash::BEGIN@24 which was called:
# once (3.42ms+215µs) by Template::Stash::XS::BEGIN@17 at line 24 # spent 3.64ms making 1 call to Template::Stash::BEGIN@24
# spent 1µs making 1 call to Template::Stash::__ANON__ |
25 | 2 | 30µs | 2 | 11µs | # spent 10µs (10+500ns) within Template::Stash::BEGIN@25 which was called:
# once (10µs+500ns) by Template::Stash::XS::BEGIN@17 at line 25 # spent 10µs making 1 call to Template::Stash::BEGIN@25
# spent 500ns making 1 call to Template::Stash::__ANON__ |
26 | 2 | 2.48ms | 2 | 106µs | # spent 56µs (7+49) within Template::Stash::BEGIN@26 which was called:
# once (7µs+49µs) by Template::Stash::XS::BEGIN@17 at line 26 # spent 56µs making 1 call to Template::Stash::BEGIN@26
# spent 49µs making 1 call to Exporter::import |
27 | |||||
28 | 1 | 300ns | our $VERSION = 2.91; | ||
29 | 1 | 200ns | our $DEBUG = 0 unless defined $DEBUG; | ||
30 | 1 | 12µs | 1 | 4µs | our $PRIVATE = qr/^[_.]/; # spent 4µs making 1 call to Template::Stash::CORE:qr |
31 | 1 | 300ns | our $UNDEF_TYPE = 'var.undef'; | ||
32 | 1 | 100ns | our $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 | ||||
36 | 1 | 1µ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 | |||||
48 | our $ROOT_OPS = defined $ROOT_OPS | ||||
49 | 1 | 300ns | ? { %{$Template::VMethods::ROOT_VMETHODS}, %$ROOT_OPS } | ||
50 | : $Template::VMethods::ROOT_VMETHODS; | ||||
51 | |||||
52 | our $SCALAR_OPS = defined $SCALAR_OPS | ||||
53 | 1 | 100ns | ? { %{$Template::VMethods::TEXT_VMETHODS}, %$SCALAR_OPS } | ||
54 | : $Template::VMethods::TEXT_VMETHODS; | ||||
55 | |||||
56 | our $HASH_OPS = defined $HASH_OPS | ||||
57 | 1 | 200ns | ? { %{$Template::VMethods::HASH_VMETHODS}, %$HASH_OPS } | ||
58 | : $Template::VMethods::HASH_VMETHODS; | ||||
59 | |||||
60 | our $LIST_OPS = defined $LIST_OPS | ||||
61 | 1 | 200ns | ? { %{$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 | |||||
73 | sub 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 3.80s within Template::Stash::new which was called 375387 times, avg 10µs/call:
# 375387 times (3.80s+0s) by Template::Config::stash at line 195 of Template/Config.pm, avg 10µs/call | ||||
112 | 375387 | 217ms | my $class = shift; | ||
113 | 375387 | 409ms | my $params = ref $_[0] eq 'HASH' ? shift(@_) : { @_ }; | ||
114 | |||||
115 | 375387 | 2.33s | my $self = { | ||
116 | global => { }, | ||||
117 | %$params, | ||||
118 | %$ROOT_OPS, | ||||
119 | '_PARENT' => undef, | ||||
120 | }; | ||||
121 | |||||
122 | 375387 | 1.86s | 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 7.80s within Template::Stash::clone which was called 376400 times, avg 21µs/call:
# 375387 times (7.75s+0s) by Template::Context::localise at line 567 of Template/Context.pm, avg 21µs/call
# 1013 times (50.5ms+0s) by Template::Context::process at line 312 of Template/Context.pm, avg 50µs/call | ||||
149 | 376400 | 222ms | my ($self, $params) = @_; | ||
150 | 376400 | 114ms | $params ||= { }; | ||
151 | |||||
152 | # look out for magical 'import' argument which imports another hash | ||||
153 | 376400 | 385ms | my $import = $params->{ import }; | ||
154 | 376400 | 400ms | if (defined $import && ref $import eq 'HASH') { | ||
155 | delete $params->{ import }; | ||||
156 | } | ||||
157 | else { | ||||
158 | 376400 | 105ms | undef $import; | ||
159 | } | ||||
160 | |||||
161 | 376400 | 5.65s | 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 | 376400 | 178ms | &{ $HASH_OPS->{ import } }($clone, $import) | ||
169 | if defined $import; | ||||
170 | |||||
171 | 376400 | 1.56s | 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 759ms within Template::Stash::declone which was called 376400 times, avg 2µs/call:
# 375387 times (757ms+0s) by Template::Context::delocalise at line 572 of Template/Context.pm, avg 2µs/call
# 1013 times (2.45ms+0s) by Template::Context::process at line 380 of Template/Context.pm, avg 2µs/call | ||||
187 | 376400 | 105ms | my $self = shift; | ||
188 | 376400 | 1.73s | $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 | |||||
207 | sub 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 | |||||
252 | sub 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 | #------------------------------------------------------------------------ | ||||
294 | |||||
295 | sub getref { | ||||
296 | my ($self, $ident, $args) = @_; | ||||
297 | my ($root, $item, $result); | ||||
298 | $root = $self; | ||||
299 | |||||
300 | if (ref $ident eq 'ARRAY') { | ||||
301 | my $size = $#$ident; | ||||
302 | |||||
303 | foreach (my $i = 0; $i <= $size; $i += 2) { | ||||
304 | ($item, $args) = @$ident[$i, $i + 1]; | ||||
305 | last if $i >= $size - 2; # don't evaluate last node | ||||
306 | last unless defined | ||||
307 | ($root = $self->_dotop($root, $item, $args)); | ||||
308 | } | ||||
309 | } | ||||
310 | else { | ||||
311 | $item = $ident; | ||||
312 | } | ||||
313 | |||||
314 | if (defined $root) { | ||||
315 | return sub { my @args = (@{$args||[]}, @_); | ||||
316 | $self->_dotop($root, $item, \@args); | ||||
317 | } | ||||
318 | } | ||||
319 | else { | ||||
320 | return sub { '' }; | ||||
321 | } | ||||
322 | } | ||||
323 | |||||
- - | |||||
327 | #------------------------------------------------------------------------ | ||||
328 | # update(\%params) | ||||
329 | # | ||||
330 | # Update multiple variables en masse. No magic is performed. Simple | ||||
331 | # variable names only. | ||||
332 | #------------------------------------------------------------------------ | ||||
333 | |||||
334 | # spent 2.24s within Template::Stash::update which was called 375387 times, avg 6µs/call:
# 375387 times (2.24s+0s) by Template::Context::process at line 317 of Template/Context.pm, avg 6µs/call | ||||
335 | 375387 | 206ms | my ($self, $params) = @_; | ||
336 | |||||
337 | # look out for magical 'import' argument to import another hash | ||||
338 | 375387 | 421ms | my $import = $params->{ import }; | ||
339 | 375387 | 220ms | if (defined $import && ref $import eq 'HASH') { | ||
340 | @$self{ keys %$import } = values %$import; | ||||
341 | delete $params->{ import }; | ||||
342 | } | ||||
343 | |||||
344 | 375387 | 2.35s | @$self{ keys %$params } = values %$params; | ||
345 | } | ||||
346 | |||||
347 | |||||
348 | #------------------------------------------------------------------------ | ||||
349 | # undefined($ident, $args) | ||||
350 | # | ||||
351 | # Method called when a get() returns an undefined value. Can be redefined | ||||
352 | # in a subclass to implement alternate handling. | ||||
353 | #------------------------------------------------------------------------ | ||||
354 | |||||
355 | # spent 1.32s within Template::Stash::undefined which was called 400717 times, avg 3µs/call:
# 375387 times (1.25s+0s) by Template::Stash::XS::get at line 323 of Template/Context.pm, avg 3µs/call
# 6063 times (15.0ms+0s) by Template::Stash::XS::get at line 1 of /root/tor-browser-build/input text, avg 2µs/call
# 3982 times (11.4ms+0s) by Template::Stash::XS::get at line 11 of /root/tor-browser-build/input text, avg 3µs/call
# 1992 times (4.68ms+0s) by Template::Stash::XS::get at line 2 of /root/tor-browser-build/input text, avg 2µs/call
# 1991 times (5.84ms+0s) by Template::Stash::XS::get at line 33 of /root/tor-browser-build/input text, avg 3µs/call
# 1991 times (5.00ms+0s) by Template::Stash::XS::get at line 16 of /root/tor-browser-build/input text, avg 3µs/call
# 1991 times (3.74ms+0s) by Template::Stash::XS::get at line 23 of /root/tor-browser-build/input text, avg 2µs/call
# 1990 times (5.07ms+0s) by Template::Stash::XS::get at line 6 of /root/tor-browser-build/input text, avg 3µs/call
# 1007 times (2.19ms+0s) by Template::Stash::XS::get at line 21 of /root/tor-browser-build/input text, avg 2µs/call
# 995 times (3.03ms+0s) by Template::Stash::XS::get at line 9 of /root/tor-browser-build/input text, avg 3µs/call
# 995 times (2.73ms+0s) by Template::Stash::XS::get at line 18 of /root/tor-browser-build/input text, avg 3µs/call
# 993 times (2.58ms+0s) by Template::Stash::XS::get at line 17 of /root/tor-browser-build/input text, avg 3µs/call
# 720 times (1.53ms+0s) by Template::Stash::XS::get at line 24 of /root/tor-browser-build/input text, avg 2µs/call
# 471 times (1.69ms+0s) by Template::Stash::XS::get at line 13 of /root/tor-browser-build/input text, avg 4µs/call
# 15 times (42µs+0s) by Template::Stash::XS::get at line 5 of /root/tor-browser-build/input text, avg 3µs/call
# 15 times (28µs+0s) by Template::Stash::XS::get at line 33 of /root/tor-browser-build/projects/common/runc-config.json, avg 2µs/call
# 15 times (28µs+0s) by Template::Stash::XS::get at line 8 of /root/tor-browser-build/projects/common/runc-config.json, avg 2µs/call
# 15 times (19µs+0s) by Template::Stash::XS::get at line 49 of /root/tor-browser-build/projects/common/runc-config.json, avg 1µs/call
# 15 times (18µs+0s) by Template::Stash::XS::get at line 65 of /root/tor-browser-build/projects/common/runc-config.json, avg 1µs/call
# 15 times (17µs+0s) by Template::Stash::XS::get at line 81 of /root/tor-browser-build/projects/common/runc-config.json, avg 1µs/call
# 15 times (17µs+0s) by Template::Stash::XS::get at line 97 of /root/tor-browser-build/projects/common/runc-config.json, avg 1µs/call
# 14 times (33µs+0s) by Template::Stash::XS::get at line 239 of /root/tor-browser-build/projects/common/runc-config.json, avg 2µs/call
# 14 times (24µs+0s) by Template::Stash::XS::get at line 25 of /root/tor-browser-build/input text, avg 2µs/call
# 7 times (24µs+0s) by Template::Stash::XS::get at line 22 of /root/tor-browser-build/input text, avg 3µs/call
# 4 times (9µs+0s) by Template::Stash::XS::get at line 22 of /root/tor-browser-build/projects/snowflake/build, avg 2µs/call
# 3 times (5µs+0s) by Template::Stash::XS::get at line 10 of /root/tor-browser-build/input text, avg 2µs/call
# 2 times (8µs+0s) by Template::Stash::XS::get at line 8 of /root/tor-browser-build/input text, avg 4µs/call | ||||
356 | 400717 | 275ms | my ($self, $ident, $args) = @_; | ||
357 | |||||
358 | 400717 | 303ms | if ($self->{ _STRICT }) { | ||
359 | # Sorry, but we can't provide a sensible source file and line without | ||||
360 | # re-designing the whole architecture of TT (see TT3) | ||||
361 | die Template::Exception->new( | ||||
362 | $UNDEF_TYPE, | ||||
363 | sprintf( | ||||
364 | $UNDEF_INFO, | ||||
365 | $self->_reconstruct_ident($ident) | ||||
366 | ) | ||||
367 | ) if $self->{ _STRICT }; | ||||
368 | } | ||||
369 | else { | ||||
370 | # There was a time when I thought this was a good idea. But it's not. | ||||
371 | 400717 | 2.10s | return ''; | ||
372 | } | ||||
373 | } | ||||
374 | |||||
375 | sub _reconstruct_ident { | ||||
376 | my ($self, $ident) = @_; | ||||
377 | my ($name, $args, @output); | ||||
378 | my @input = ref $ident eq 'ARRAY' ? @$ident : ($ident); | ||||
379 | |||||
380 | while (@input) { | ||||
381 | $name = shift @input; | ||||
382 | $args = shift @input || 0; | ||||
383 | $name .= '(' . join(', ', map { /^\d+$/ ? $_ : "'$_'" } @$args) . ')' | ||||
384 | if $args && ref $args eq 'ARRAY'; | ||||
385 | push(@output, $name); | ||||
386 | } | ||||
387 | |||||
388 | return join('.', @output); | ||||
389 | } | ||||
390 | |||||
391 | |||||
392 | #======================================================================== | ||||
393 | # ----- PRIVATE OBJECT METHODS ----- | ||||
394 | #======================================================================== | ||||
395 | |||||
396 | #------------------------------------------------------------------------ | ||||
397 | # _dotop($root, $item, \@args, $lvalue) | ||||
398 | # | ||||
399 | # This is the core 'dot' operation method which evaluates elements of | ||||
400 | # variables against their root. All variables have an implicit root | ||||
401 | # which is the stash object itself (a hash). Thus, a non-compound | ||||
402 | # variable 'foo' is actually '(stash.)foo', the compound 'foo.bar' is | ||||
403 | # '(stash.)foo.bar'. The first parameter is a reference to the current | ||||
404 | # root, initially the stash itself. The second parameter contains the | ||||
405 | # name of the variable element, e.g. 'foo'. The third optional | ||||
406 | # parameter is a reference to a list of any parenthesised arguments | ||||
407 | # specified for the variable, which are passed to sub-routines, object | ||||
408 | # methods, etc. The final parameter is an optional flag to indicate | ||||
409 | # if this variable is being evaluated on the left side of an assignment | ||||
410 | # (e.g. foo.bar.baz = 10). When set true, intermediated hashes will | ||||
411 | # be created (e.g. bar) if necessary. | ||||
412 | # | ||||
413 | # Returns the result of evaluating the item against the root, having | ||||
414 | # performed any variable "magic". The value returned can then be used | ||||
415 | # as the root of the next _dotop() in a compound sequence. Returns | ||||
416 | # undef if the variable is undefined. | ||||
417 | #------------------------------------------------------------------------ | ||||
418 | |||||
419 | sub _dotop { | ||||
420 | my ($self, $root, $item, $args, $lvalue) = @_; | ||||
421 | my $rootref = ref $root; | ||||
422 | my $atroot = (blessed $root && $root->isa(ref $self)); | ||||
423 | my ($value, @result); | ||||
424 | |||||
425 | $args ||= [ ]; | ||||
426 | $lvalue ||= 0; | ||||
427 | |||||
428 | # print STDERR "_dotop(root=$root, item=$item, args=[@$args])\n" | ||||
429 | # if $DEBUG; | ||||
430 | |||||
431 | # return undef without an error if either side of the dot is unviable | ||||
432 | return undef unless defined($root) and defined($item); | ||||
433 | |||||
434 | # or if an attempt is made to access a private member, starting _ or . | ||||
435 | return undef if $PRIVATE && $item =~ /$PRIVATE/; | ||||
436 | |||||
437 | if ($atroot || $rootref eq 'HASH') { | ||||
438 | # if $root is a regular HASH or a Template::Stash kinda HASH (the | ||||
439 | # *real* root of everything). We first lookup the named key | ||||
440 | # in the hash, or create an empty hash in its place if undefined | ||||
441 | # and the $lvalue flag is set. Otherwise, we check the HASH_OPS | ||||
442 | # pseudo-methods table, calling the code if found, or return undef. | ||||
443 | |||||
444 | if (defined($value = $root->{ $item })) { | ||||
445 | return $value unless ref $value eq 'CODE'; ## RETURN | ||||
446 | @result = &$value(@$args); ## @result | ||||
447 | } | ||||
448 | elsif ($lvalue) { | ||||
449 | # we create an intermediate hash if this is an lvalue | ||||
450 | return $root->{ $item } = { }; ## RETURN | ||||
451 | } | ||||
452 | # ugly hack: only allow import vmeth to be called on root stash | ||||
453 | elsif (($value = $HASH_OPS->{ $item }) | ||||
454 | && ! $atroot || $item eq 'import') { | ||||
455 | @result = &$value($root, @$args); ## @result | ||||
456 | } | ||||
457 | elsif ( ref $item eq 'ARRAY' ) { | ||||
458 | # hash slice | ||||
459 | return [@$root{@$item}]; ## RETURN | ||||
460 | } | ||||
461 | } | ||||
462 | elsif ($rootref eq 'ARRAY') { | ||||
463 | # if root is an ARRAY then we check for a LIST_OPS pseudo-method | ||||
464 | # or return the numerical index into the array, or undef | ||||
465 | if ($value = $LIST_OPS->{ $item }) { | ||||
466 | @result = &$value($root, @$args); ## @result | ||||
467 | } | ||||
468 | elsif ($item =~ /^-?\d+$/) { | ||||
469 | $value = $root->[$item]; | ||||
470 | return $value unless ref $value eq 'CODE'; ## RETURN | ||||
471 | @result = &$value(@$args); ## @result | ||||
472 | } | ||||
473 | elsif ( ref $item eq 'ARRAY' ) { | ||||
474 | # array slice | ||||
475 | return [@$root[@$item]]; ## RETURN | ||||
476 | } | ||||
477 | } | ||||
478 | |||||
479 | # NOTE: we do the can-can because UNIVSERAL::isa($something, 'UNIVERSAL') | ||||
480 | # doesn't appear to work with CGI, returning true for the first call | ||||
481 | # and false for all subsequent calls. | ||||
482 | |||||
483 | # UPDATE: that doesn't appear to be the case any more | ||||
484 | |||||
485 | elsif (blessed($root) && $root->can('can')) { | ||||
486 | |||||
487 | # if $root is a blessed reference (i.e. inherits from the | ||||
488 | # UNIVERSAL object base class) then we call the item as a method. | ||||
489 | # If that fails then we try to fallback on HASH behaviour if | ||||
490 | # possible. | ||||
491 | eval { @result = $root->$item(@$args); }; | ||||
492 | |||||
493 | if ($@) { | ||||
494 | # temporary hack - required to propagate errors thrown | ||||
495 | # by views; if $@ is a ref (e.g. Template::Exception | ||||
496 | # object then we assume it's a real error that needs | ||||
497 | # real throwing | ||||
498 | |||||
499 | my $class = ref($root) || $root; | ||||
500 | die $@ if ref($@) || ($@ !~ /Can't locate object method "\Q$item\E" via package "\Q$class\E"/); | ||||
501 | |||||
502 | # failed to call object method, so try some fallbacks | ||||
503 | if (reftype $root eq 'HASH') { | ||||
504 | if( defined($value = $root->{ $item })) { | ||||
505 | return $value unless ref $value eq 'CODE'; ## RETURN | ||||
506 | @result = &$value(@$args); | ||||
507 | } | ||||
508 | elsif ($value = $HASH_OPS->{ $item }) { | ||||
509 | @result = &$value($root, @$args); | ||||
510 | } | ||||
511 | elsif ($value = $LIST_OPS->{ $item }) { | ||||
512 | @result = &$value([$root], @$args); | ||||
513 | } | ||||
514 | } | ||||
515 | elsif (reftype $root eq 'ARRAY') { | ||||
516 | if( $value = $LIST_OPS->{ $item }) { | ||||
517 | @result = &$value($root, @$args); | ||||
518 | } | ||||
519 | elsif( $item =~ /^-?\d+$/ ) { | ||||
520 | $value = $root->[$item]; | ||||
521 | return $value unless ref $value eq 'CODE'; ## RETURN | ||||
522 | @result = &$value(@$args); ## @result | ||||
523 | } | ||||
524 | elsif ( ref $item eq 'ARRAY' ) { | ||||
525 | # array slice | ||||
526 | return [@$root[@$item]]; ## RETURN | ||||
527 | } | ||||
528 | } | ||||
529 | elsif ($value = $SCALAR_OPS->{ $item }) { | ||||
530 | @result = &$value($root, @$args); | ||||
531 | } | ||||
532 | elsif ($value = $LIST_OPS->{ $item }) { | ||||
533 | @result = &$value([$root], @$args); | ||||
534 | } | ||||
535 | elsif ($self->{ _DEBUG }) { | ||||
536 | @result = (undef, $@); | ||||
537 | } | ||||
538 | } | ||||
539 | } | ||||
540 | elsif (($value = $SCALAR_OPS->{ $item }) && ! $lvalue) { | ||||
541 | # at this point, it doesn't look like we've got a reference to | ||||
542 | # anything we know about, so we try the SCALAR_OPS pseudo-methods | ||||
543 | # table (but not for l-values) | ||||
544 | @result = &$value($root, @$args); ## @result | ||||
545 | } | ||||
546 | elsif (($value = $LIST_OPS->{ $item }) && ! $lvalue) { | ||||
547 | # last-ditch: can we promote a scalar to a one-element | ||||
548 | # list and apply a LIST_OPS virtual method? | ||||
549 | @result = &$value([$root], @$args); | ||||
550 | } | ||||
551 | elsif ($self->{ _DEBUG }) { | ||||
552 | die "don't know how to access [ $root ].$item\n"; ## DIE | ||||
553 | } | ||||
554 | else { | ||||
555 | @result = (); | ||||
556 | } | ||||
557 | |||||
558 | # fold multiple return items into a list unless first item is undef | ||||
559 | if (defined $result[0]) { | ||||
560 | return ## RETURN | ||||
561 | scalar @result > 1 ? [ @result ] : $result[0]; | ||||
562 | } | ||||
563 | elsif (defined $result[1]) { | ||||
564 | die $result[1]; ## DIE | ||||
565 | } | ||||
566 | elsif ($self->{ _DEBUG }) { | ||||
567 | die "$item is undefined\n"; ## DIE | ||||
568 | } | ||||
569 | |||||
570 | return undef; | ||||
571 | } | ||||
572 | |||||
573 | |||||
574 | #------------------------------------------------------------------------ | ||||
575 | # _assign($root, $item, \@args, $value, $default) | ||||
576 | # | ||||
577 | # Similar to _dotop() above, but assigns a value to the given variable | ||||
578 | # instead of simply returning it. The first three parameters are the | ||||
579 | # root item, the item and arguments, as per _dotop(), followed by the | ||||
580 | # value to which the variable should be set and an optional $default | ||||
581 | # flag. If set true, the variable will only be set if currently false | ||||
582 | # (undefined/zero) | ||||
583 | #------------------------------------------------------------------------ | ||||
584 | |||||
585 | sub _assign { | ||||
586 | my ($self, $root, $item, $args, $value, $default) = @_; | ||||
587 | my $rootref = ref $root; | ||||
588 | my $atroot = ($root eq $self); | ||||
589 | my $result; | ||||
590 | $args ||= [ ]; | ||||
591 | $default ||= 0; | ||||
592 | |||||
593 | # return undef without an error if either side of the dot is unviable | ||||
594 | return undef unless $root and defined $item; | ||||
595 | |||||
596 | # or if an attempt is made to update a private member, starting _ or . | ||||
597 | return undef if $PRIVATE && $item =~ /$PRIVATE/; | ||||
598 | |||||
599 | if ($rootref eq 'HASH' || $atroot) { | ||||
600 | # if the root is a hash we set the named key | ||||
601 | return ($root->{ $item } = $value) ## RETURN | ||||
602 | unless $default && $root->{ $item }; | ||||
603 | } | ||||
604 | elsif ($rootref eq 'ARRAY' && $item =~ /^-?\d+$/) { | ||||
605 | # or set a list item by index number | ||||
606 | return ($root->[$item] = $value) ## RETURN | ||||
607 | unless $default && $root->{ $item }; | ||||
608 | } | ||||
609 | elsif (blessed($root)) { | ||||
610 | # try to call the item as a method of an object | ||||
611 | |||||
612 | return $root->$item(@$args, $value) ## RETURN | ||||
613 | unless $default && $root->$item(); | ||||
614 | |||||
615 | # 2 issues: | ||||
616 | # - method call should be wrapped in eval { } | ||||
617 | # - fallback on hash methods if object method not found | ||||
618 | # | ||||
619 | # eval { $result = $root->$item(@$args, $value); }; | ||||
620 | # | ||||
621 | # if ($@) { | ||||
622 | # die $@ if ref($@) || ($@ !~ /Can't locate object method/); | ||||
623 | # | ||||
624 | # # failed to call object method, so try some fallbacks | ||||
625 | # if (UNIVERSAL::isa($root, 'HASH') && exists $root->{ $item }) { | ||||
626 | # $result = ($root->{ $item } = $value) | ||||
627 | # unless $default && $root->{ $item }; | ||||
628 | # } | ||||
629 | # } | ||||
630 | # return $result; ## RETURN | ||||
631 | } | ||||
632 | else { | ||||
633 | die "don't know how to assign to [$root].[$item]\n"; ## DIE | ||||
634 | } | ||||
635 | |||||
636 | return undef; | ||||
637 | } | ||||
638 | |||||
639 | |||||
640 | #------------------------------------------------------------------------ | ||||
641 | # _dump() | ||||
642 | # | ||||
643 | # Debug method which returns a string representing the internal state | ||||
644 | # of the object. The method calls itself recursively to dump sub-hashes. | ||||
645 | #------------------------------------------------------------------------ | ||||
646 | |||||
647 | sub _dump { | ||||
648 | my $self = shift; | ||||
649 | return "[Template::Stash] " . $self->_dump_frame(2); | ||||
650 | } | ||||
651 | |||||
652 | sub _dump_frame { | ||||
653 | my ($self, $indent) = @_; | ||||
654 | $indent ||= 1; | ||||
655 | my $buffer = ' '; | ||||
656 | my $pad = $buffer x $indent; | ||||
657 | my $text = "{\n"; | ||||
658 | local $" = ', '; | ||||
659 | |||||
660 | my ($key, $value); | ||||
661 | |||||
662 | return $text . "...excessive recursion, terminating\n" | ||||
663 | if $indent > 32; | ||||
664 | |||||
665 | foreach $key (keys %$self) { | ||||
666 | $value = $self->{ $key }; | ||||
667 | $value = '<undef>' unless defined $value; | ||||
668 | next if $key =~ /^\./; | ||||
669 | if (ref($value) eq 'ARRAY') { | ||||
670 | $value = '[ ' . join(', ', map { defined $_ ? $_ : '<undef>' } | ||||
671 | @$value) . ' ]'; | ||||
672 | } | ||||
673 | elsif (ref $value eq 'HASH') { | ||||
674 | $value = _dump_frame($value, $indent + 1); | ||||
675 | } | ||||
676 | |||||
677 | $text .= sprintf("$pad%-16s => $value\n", $key); | ||||
678 | } | ||||
679 | $text .= $buffer x ($indent - 1) . '}'; | ||||
680 | return $text; | ||||
681 | } | ||||
682 | |||||
683 | |||||
684 | 1 | 11µs | 1; | ||
685 | |||||
686 | __END__ | ||||
# spent 4µs within Template::Stash::CORE:qr which was called:
# once (4µs+0s) by Template::Stash::XS::BEGIN@17 at line 30 | |||||
sub Template::Stash::__ANON__; # xsub |