Filename | /usr/lib/perl5/Template/VMethods.pm |
Statements | Executed 41 statements in 3.54ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
2 | 2 | 2 | 45µs | 92µs | text_match | Template::VMethods::
2 | 1 | 1 | 36µs | 36µs | CORE:regcomp (opcode) | Template::VMethods::
1 | 1 | 1 | 18µs | 22µs | BEGIN@24 | Template::VMethods::
1 | 1 | 1 | 18µs | 35µs | BEGIN@379 | Template::VMethods::
1 | 1 | 1 | 17µs | 40µs | BEGIN@104 | Template::VMethods::
1 | 1 | 1 | 16µs | 108µs | BEGIN@26 | Template::VMethods::
1 | 1 | 1 | 15µs | 27µs | BEGIN@110 | Template::VMethods::
1 | 1 | 1 | 12µs | 25µs | BEGIN@406 | Template::VMethods::
1 | 1 | 1 | 11µs | 22µs | BEGIN@412 | Template::VMethods::
1 | 1 | 1 | 11µs | 22µs | BEGIN@25 | Template::VMethods::
2 | 1 | 1 | 11µs | 11µs | CORE:match (opcode) | Template::VMethods::
0 | 0 | 0 | 0s | 0s | __ANON__[:183] | Template::VMethods::
0 | 0 | 0 | 0s | 0s | _list_sort_make_key | Template::VMethods::
0 | 0 | 0 | 0s | 0s | hash_defined | Template::VMethods::
0 | 0 | 0 | 0s | 0s | hash_delete | Template::VMethods::
0 | 0 | 0 | 0s | 0s | hash_each | Template::VMethods::
0 | 0 | 0 | 0s | 0s | hash_exists | Template::VMethods::
0 | 0 | 0 | 0s | 0s | hash_hash | Template::VMethods::
0 | 0 | 0 | 0s | 0s | hash_import | Template::VMethods::
0 | 0 | 0 | 0s | 0s | hash_item | Template::VMethods::
0 | 0 | 0 | 0s | 0s | hash_items | Template::VMethods::
0 | 0 | 0 | 0s | 0s | hash_keys | Template::VMethods::
0 | 0 | 0 | 0s | 0s | hash_list | Template::VMethods::
0 | 0 | 0 | 0s | 0s | hash_nsort | Template::VMethods::
0 | 0 | 0 | 0s | 0s | hash_pairs | Template::VMethods::
0 | 0 | 0 | 0s | 0s | hash_size | Template::VMethods::
0 | 0 | 0 | 0s | 0s | hash_sort | Template::VMethods::
0 | 0 | 0 | 0s | 0s | hash_values | Template::VMethods::
0 | 0 | 0 | 0s | 0s | list_defined | Template::VMethods::
0 | 0 | 0 | 0s | 0s | list_first | Template::VMethods::
0 | 0 | 0 | 0s | 0s | list_grep | Template::VMethods::
0 | 0 | 0 | 0s | 0s | list_hash | Template::VMethods::
0 | 0 | 0 | 0s | 0s | list_import | Template::VMethods::
0 | 0 | 0 | 0s | 0s | list_item | Template::VMethods::
0 | 0 | 0 | 0s | 0s | list_join | Template::VMethods::
0 | 0 | 0 | 0s | 0s | list_last | Template::VMethods::
0 | 0 | 0 | 0s | 0s | list_list | Template::VMethods::
0 | 0 | 0 | 0s | 0s | list_max | Template::VMethods::
0 | 0 | 0 | 0s | 0s | list_merge | Template::VMethods::
0 | 0 | 0 | 0s | 0s | list_nsort | Template::VMethods::
0 | 0 | 0 | 0s | 0s | list_pop | Template::VMethods::
0 | 0 | 0 | 0s | 0s | list_push | Template::VMethods::
0 | 0 | 0 | 0s | 0s | list_reverse | Template::VMethods::
0 | 0 | 0 | 0s | 0s | list_shift | Template::VMethods::
0 | 0 | 0 | 0s | 0s | list_size | Template::VMethods::
0 | 0 | 0 | 0s | 0s | list_slice | Template::VMethods::
0 | 0 | 0 | 0s | 0s | list_sort | Template::VMethods::
0 | 0 | 0 | 0s | 0s | list_splice | Template::VMethods::
0 | 0 | 0 | 0s | 0s | list_unique | Template::VMethods::
0 | 0 | 0 | 0s | 0s | list_unshift | Template::VMethods::
0 | 0 | 0 | 0s | 0s | root_dec | Template::VMethods::
0 | 0 | 0 | 0s | 0s | root_inc | Template::VMethods::
0 | 0 | 0 | 0s | 0s | text_chunk | Template::VMethods::
0 | 0 | 0 | 0s | 0s | text_defined | Template::VMethods::
0 | 0 | 0 | 0s | 0s | text_hash | Template::VMethods::
0 | 0 | 0 | 0s | 0s | text_item | Template::VMethods::
0 | 0 | 0 | 0s | 0s | text_length | Template::VMethods::
0 | 0 | 0 | 0s | 0s | text_list | Template::VMethods::
0 | 0 | 0 | 0s | 0s | text_remove | Template::VMethods::
0 | 0 | 0 | 0s | 0s | text_repeat | Template::VMethods::
0 | 0 | 0 | 0s | 0s | text_replace | Template::VMethods::
0 | 0 | 0 | 0s | 0s | text_search | Template::VMethods::
0 | 0 | 0 | 0s | 0s | text_size | Template::VMethods::
0 | 0 | 0 | 0s | 0s | text_split | Template::VMethods::
0 | 0 | 0 | 0s | 0s | text_substr | Template::VMethods::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | #============================================================= -*-Perl-*- | ||||
2 | # | ||||
3 | # Template::VMethods | ||||
4 | # | ||||
5 | # DESCRIPTION | ||||
6 | # Module defining virtual methods for the Template Toolkit | ||||
7 | # | ||||
8 | # AUTHOR | ||||
9 | # Andy Wardley <abw@wardley.org> | ||||
10 | # | ||||
11 | # COPYRIGHT | ||||
12 | # Copyright (C) 1996-2006 Andy Wardley. All Rights Reserved. | ||||
13 | # | ||||
14 | # This module is free software; you can redistribute it and/or | ||||
15 | # modify it under the same terms as Perl itself. | ||||
16 | # | ||||
17 | # REVISION | ||||
18 | # $Id: VMethods.pm 1245 2009-07-04 17:02:52Z abw $ | ||||
19 | # | ||||
20 | #============================================================================ | ||||
21 | |||||
22 | package Template::VMethods; | ||||
23 | |||||
24 | 3 | 34µs | 2 | 26µs | # spent 22µs (18+4) within Template::VMethods::BEGIN@24 which was called:
# once (18µs+4µs) by Template::Stash::BEGIN@24 at line 24 # spent 22µs making 1 call to Template::VMethods::BEGIN@24
# spent 4µs making 1 call to strict::import |
25 | 3 | 27µs | 2 | 34µs | # spent 22µs (11+12) within Template::VMethods::BEGIN@25 which was called:
# once (11µs+12µs) by Template::Stash::BEGIN@24 at line 25 # spent 22µs making 1 call to Template::VMethods::BEGIN@25
# spent 11µs making 1 call to warnings::import |
26 | 3 | 451µs | 2 | 199µs | # spent 108µs (16+92) within Template::VMethods::BEGIN@26 which was called:
# once (16µs+92µs) by Template::Stash::BEGIN@24 at line 26 # spent 108µs making 1 call to Template::VMethods::BEGIN@26
# spent 92µs making 1 call to Exporter::import |
27 | 1 | 1µs | require Template::Stash; | ||
28 | |||||
29 | 1 | 1µs | our $VERSION = 2.16; | ||
30 | 1 | 800ns | our $DEBUG = 0 unless defined $DEBUG; | ||
31 | 1 | 400ns | our $PRIVATE = $Template::Stash::PRIVATE; | ||
32 | |||||
33 | 1 | 5µs | our $ROOT_VMETHODS = { | ||
34 | inc => \&root_inc, | ||||
35 | dec => \&root_dec, | ||||
36 | }; | ||||
37 | |||||
38 | 1 | 16µs | our $TEXT_VMETHODS = { | ||
39 | item => \&text_item, | ||||
40 | list => \&text_list, | ||||
41 | hash => \&text_hash, | ||||
42 | length => \&text_length, | ||||
43 | size => \&text_size, | ||||
44 | defined => \&text_defined, | ||||
45 | match => \&text_match, | ||||
46 | search => \&text_search, | ||||
47 | repeat => \&text_repeat, | ||||
48 | replace => \&text_replace, | ||||
49 | remove => \&text_remove, | ||||
50 | split => \&text_split, | ||||
51 | chunk => \&text_chunk, | ||||
52 | substr => \&text_substr, | ||||
53 | }; | ||||
54 | |||||
55 | 1 | 15µs | our $HASH_VMETHODS = { | ||
56 | item => \&hash_item, | ||||
57 | hash => \&hash_hash, | ||||
58 | size => \&hash_size, | ||||
59 | each => \&hash_each, | ||||
60 | keys => \&hash_keys, | ||||
61 | values => \&hash_values, | ||||
62 | items => \&hash_items, | ||||
63 | pairs => \&hash_pairs, | ||||
64 | list => \&hash_list, | ||||
65 | exists => \&hash_exists, | ||||
66 | defined => \&hash_defined, | ||||
67 | delete => \&hash_delete, | ||||
68 | import => \&hash_import, | ||||
69 | sort => \&hash_sort, | ||||
70 | nsort => \&hash_nsort, | ||||
71 | }; | ||||
72 | |||||
73 | 1 | 18µs | our $LIST_VMETHODS = { | ||
74 | item => \&list_item, | ||||
75 | list => \&list_list, | ||||
76 | hash => \&list_hash, | ||||
77 | push => \&list_push, | ||||
78 | pop => \&list_pop, | ||||
79 | unshift => \&list_unshift, | ||||
80 | shift => \&list_shift, | ||||
81 | max => \&list_max, | ||||
82 | size => \&list_size, | ||||
83 | defined => \&list_defined, | ||||
84 | first => \&list_first, | ||||
85 | last => \&list_last, | ||||
86 | reverse => \&list_reverse, | ||||
87 | grep => \&list_grep, | ||||
88 | join => \&list_join, | ||||
89 | sort => \&list_sort, | ||||
90 | nsort => \&list_nsort, | ||||
91 | unique => \&list_unique, | ||||
92 | import => \&list_import, | ||||
93 | merge => \&list_merge, | ||||
94 | slice => \&list_slice, | ||||
95 | splice => \&list_splice, | ||||
96 | }; | ||||
97 | |||||
98 | |||||
99 | #======================================================================== | ||||
100 | # root virtual methods | ||||
101 | #======================================================================== | ||||
102 | |||||
103 | sub root_inc { | ||||
104 | 3 | 61µs | 2 | 64µs | # spent 40µs (17+24) within Template::VMethods::BEGIN@104 which was called:
# once (17µs+24µs) by Template::Stash::BEGIN@24 at line 104 # spent 40µs making 1 call to Template::VMethods::BEGIN@104
# spent 24µs making 1 call to warnings::unimport |
105 | my $item = shift; | ||||
106 | ++$item; | ||||
107 | } | ||||
108 | |||||
109 | sub root_dec { | ||||
110 | 3 | 1.63ms | 2 | 39µs | # spent 27µs (15+12) within Template::VMethods::BEGIN@110 which was called:
# once (15µs+12µs) by Template::Stash::BEGIN@24 at line 110 # spent 27µs making 1 call to Template::VMethods::BEGIN@110
# spent 12µs making 1 call to warnings::unimport |
111 | my $item = shift; | ||||
112 | --$item; | ||||
113 | } | ||||
114 | |||||
115 | |||||
116 | #======================================================================== | ||||
117 | # text virtual methods | ||||
118 | #======================================================================== | ||||
119 | |||||
120 | sub text_item { | ||||
121 | $_[0]; | ||||
122 | } | ||||
123 | |||||
124 | sub text_list { | ||||
125 | [ $_[0] ]; | ||||
126 | } | ||||
127 | |||||
128 | sub text_hash { | ||||
129 | { value => $_[0] }; | ||||
130 | } | ||||
131 | |||||
132 | sub text_length { | ||||
133 | length $_[0]; | ||||
134 | } | ||||
135 | |||||
136 | sub text_size { | ||||
137 | return 1; | ||||
138 | } | ||||
139 | |||||
140 | sub text_defined { | ||||
141 | return 1; | ||||
142 | } | ||||
143 | |||||
144 | # spent 92µs (45+47) within Template::VMethods::text_match which was called 2 times, avg 46µs/call:
# once (24µs+23µs) by Template::Stash::XS::get at line 22 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/includes/opac-bottom.inc
# once (22µs+24µs) by Template::Stash::XS::get at line 8 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/includes/doc-head-close.inc | ||||
145 | 8 | 91µs | my ($str, $search, $global) = @_; | ||
146 | return $str unless defined $str and defined $search; | ||||
147 | 4 | 47µs | my @matches = $global ? ($str =~ /$search/g) # spent 36µs making 2 calls to Template::VMethods::CORE:regcomp, avg 18µs/call
# spent 11µs making 2 calls to Template::VMethods::CORE:match, avg 5µs/call | ||
148 | : ($str =~ /$search/); | ||||
149 | return @matches ? \@matches : ''; | ||||
150 | } | ||||
151 | |||||
152 | sub text_search { | ||||
153 | my ($str, $pattern) = @_; | ||||
154 | return $str unless defined $str and defined $pattern; | ||||
155 | return $str =~ /$pattern/; | ||||
156 | } | ||||
157 | |||||
158 | sub text_repeat { | ||||
159 | my ($str, $count) = @_; | ||||
160 | $str = '' unless defined $str; | ||||
161 | return '' unless $count; | ||||
162 | $count ||= 1; | ||||
163 | return $str x $count; | ||||
164 | } | ||||
165 | |||||
166 | sub text_replace { | ||||
167 | my ($text, $pattern, $replace, $global) = @_; | ||||
168 | $text = '' unless defined $text; | ||||
169 | $pattern = '' unless defined $pattern; | ||||
170 | $replace = '' unless defined $replace; | ||||
171 | $global = 1 unless defined $global; | ||||
172 | |||||
173 | if ($replace =~ /\$\d+/) { | ||||
174 | # replacement string may contain backrefs | ||||
175 | my $expand = sub { | ||||
176 | my ($chunk, $start, $end) = @_; | ||||
177 | $chunk =~ s{ \\(\\|\$) | \$ (\d+) }{ | ||||
178 | $1 ? $1 | ||||
179 | : ($2 > $#$start || $2 == 0) ? '' | ||||
180 | : substr($text, $start->[$2], $end->[$2] - $start->[$2]); | ||||
181 | }exg; | ||||
182 | $chunk; | ||||
183 | }; | ||||
184 | if ($global) { | ||||
185 | $text =~ s{$pattern}{ &$expand($replace, [@-], [@+]) }eg; | ||||
186 | } | ||||
187 | else { | ||||
188 | $text =~ s{$pattern}{ &$expand($replace, [@-], [@+]) }e; | ||||
189 | } | ||||
190 | } | ||||
191 | else { | ||||
192 | if ($global) { | ||||
193 | $text =~ s/$pattern/$replace/g; | ||||
194 | } | ||||
195 | else { | ||||
196 | $text =~ s/$pattern/$replace/; | ||||
197 | } | ||||
198 | } | ||||
199 | return $text; | ||||
200 | } | ||||
201 | |||||
202 | sub text_remove { | ||||
203 | my ($str, $search) = @_; | ||||
204 | return $str unless defined $str and defined $search; | ||||
205 | $str =~ s/$search//g; | ||||
206 | return $str; | ||||
207 | } | ||||
208 | |||||
209 | sub text_split { | ||||
210 | my ($str, $split, $limit) = @_; | ||||
211 | $str = '' unless defined $str; | ||||
212 | |||||
213 | # we have to be very careful about spelling out each possible | ||||
214 | # combination of arguments because split() is very sensitive | ||||
215 | # to them, for example C<split(' ', ...)> behaves differently | ||||
216 | # to C<$space=' '; split($space, ...)> | ||||
217 | |||||
218 | if (defined $limit) { | ||||
219 | return [ defined $split | ||||
220 | ? split($split, $str, $limit) | ||||
221 | : split(' ', $str, $limit) ]; | ||||
222 | } | ||||
223 | else { | ||||
224 | return [ defined $split | ||||
225 | ? split($split, $str) | ||||
226 | : split(' ', $str) ]; | ||||
227 | } | ||||
228 | } | ||||
229 | |||||
230 | sub text_chunk { | ||||
231 | my ($string, $size) = @_; | ||||
232 | my @list; | ||||
233 | $size ||= 1; | ||||
234 | if ($size < 0) { | ||||
235 | # sexeger! It's faster to reverse the string, search | ||||
236 | # it from the front and then reverse the output than to | ||||
237 | # search it from the end, believe it nor not! | ||||
238 | $string = reverse $string; | ||||
239 | $size = -$size; | ||||
240 | unshift(@list, scalar reverse $1) | ||||
241 | while ($string =~ /((.{$size})|(.+))/g); | ||||
242 | } | ||||
243 | else { | ||||
244 | push(@list, $1) while ($string =~ /((.{$size})|(.+))/g); | ||||
245 | } | ||||
246 | return \@list; | ||||
247 | } | ||||
248 | |||||
249 | sub text_substr { | ||||
250 | my ($text, $offset, $length, $replacement) = @_; | ||||
251 | $offset ||= 0; | ||||
252 | |||||
253 | if(defined $length) { | ||||
254 | if (defined $replacement) { | ||||
255 | substr( $text, $offset, $length, $replacement ); | ||||
256 | return $text; | ||||
257 | } | ||||
258 | else { | ||||
259 | return substr( $text, $offset, $length ); | ||||
260 | } | ||||
261 | } | ||||
262 | else { | ||||
263 | return substr( $text, $offset ); | ||||
264 | } | ||||
265 | } | ||||
266 | |||||
267 | |||||
268 | #======================================================================== | ||||
269 | # hash virtual methods | ||||
270 | #======================================================================== | ||||
271 | |||||
272 | |||||
273 | sub hash_item { | ||||
274 | my ($hash, $item) = @_; | ||||
275 | $item = '' unless defined $item; | ||||
276 | return if $PRIVATE && $item =~ /$PRIVATE/; | ||||
277 | $hash->{ $item }; | ||||
278 | } | ||||
279 | |||||
280 | sub hash_hash { | ||||
281 | $_[0]; | ||||
282 | } | ||||
283 | |||||
284 | sub hash_size { | ||||
285 | scalar keys %{$_[0]}; | ||||
286 | } | ||||
287 | |||||
288 | sub hash_each { | ||||
289 | # this will be changed in TT3 to do what hash_pairs() does | ||||
290 | [ %{ $_[0] } ]; | ||||
291 | } | ||||
292 | |||||
293 | sub hash_keys { | ||||
294 | [ keys %{ $_[0] } ]; | ||||
295 | } | ||||
296 | |||||
297 | sub hash_values { | ||||
298 | [ values %{ $_[0] } ]; | ||||
299 | } | ||||
300 | |||||
301 | sub hash_items { | ||||
302 | [ %{ $_[0] } ]; | ||||
303 | } | ||||
304 | |||||
305 | sub hash_pairs { | ||||
306 | [ map { | ||||
307 | { key => $_ , value => $_[0]->{ $_ } } | ||||
308 | } | ||||
309 | sort keys %{ $_[0] } | ||||
310 | ]; | ||||
311 | } | ||||
312 | |||||
313 | sub hash_list { | ||||
314 | my ($hash, $what) = @_; | ||||
315 | $what ||= ''; | ||||
316 | return ($what eq 'keys') ? [ keys %$hash ] | ||||
317 | : ($what eq 'values') ? [ values %$hash ] | ||||
318 | : ($what eq 'each') ? [ %$hash ] | ||||
319 | : # for now we do what pairs does but this will be changed | ||||
320 | # in TT3 to return [ $hash ] by default | ||||
321 | [ map { { key => $_ , value => $hash->{ $_ } } } | ||||
322 | sort keys %$hash | ||||
323 | ]; | ||||
324 | } | ||||
325 | |||||
326 | sub hash_exists { | ||||
327 | exists $_[0]->{ $_[1] }; | ||||
328 | } | ||||
329 | |||||
330 | sub hash_defined { | ||||
331 | # return the item requested, or 1 if no argument | ||||
332 | # to indicate that the hash itself is defined | ||||
333 | my $hash = shift; | ||||
334 | return @_ ? defined $hash->{ $_[0] } : 1; | ||||
335 | } | ||||
336 | |||||
337 | sub hash_delete { | ||||
338 | my $hash = shift; | ||||
339 | delete $hash->{ $_ } for @_; | ||||
340 | } | ||||
341 | |||||
342 | sub hash_import { | ||||
343 | my ($hash, $imp) = @_; | ||||
344 | $imp = {} unless ref $imp eq 'HASH'; | ||||
345 | @$hash{ keys %$imp } = values %$imp; | ||||
346 | return ''; | ||||
347 | } | ||||
348 | |||||
349 | sub hash_sort { | ||||
350 | my ($hash) = @_; | ||||
351 | [ sort { lc $hash->{$a} cmp lc $hash->{$b} } (keys %$hash) ]; | ||||
352 | } | ||||
353 | |||||
354 | sub hash_nsort { | ||||
355 | my ($hash) = @_; | ||||
356 | [ sort { $hash->{$a} <=> $hash->{$b} } (keys %$hash) ]; | ||||
357 | } | ||||
358 | |||||
359 | |||||
360 | #======================================================================== | ||||
361 | # list virtual methods | ||||
362 | #======================================================================== | ||||
363 | |||||
364 | |||||
365 | sub list_item { | ||||
366 | $_[0]->[ $_[1] || 0 ]; | ||||
367 | } | ||||
368 | |||||
369 | sub list_list { | ||||
370 | $_[0]; | ||||
371 | } | ||||
372 | |||||
373 | sub list_hash { | ||||
374 | my $list = shift; | ||||
375 | if (@_) { | ||||
376 | my $n = shift || 0; | ||||
377 | return { map { ($n++, $_) } @$list }; | ||||
378 | } | ||||
379 | 3 | 148µs | 2 | 52µs | # spent 35µs (18+17) within Template::VMethods::BEGIN@379 which was called:
# once (18µs+17µs) by Template::Stash::BEGIN@24 at line 379 # spent 35µs making 1 call to Template::VMethods::BEGIN@379
# spent 17µs making 1 call to warnings::unimport |
380 | return { @$list }; | ||||
381 | } | ||||
382 | |||||
383 | sub list_push { | ||||
384 | my $list = shift; | ||||
385 | push(@$list, @_); | ||||
386 | return ''; | ||||
387 | } | ||||
388 | |||||
389 | sub list_pop { | ||||
390 | my $list = shift; | ||||
391 | pop(@$list); | ||||
392 | } | ||||
393 | |||||
394 | sub list_unshift { | ||||
395 | my $list = shift; | ||||
396 | unshift(@$list, @_); | ||||
397 | return ''; | ||||
398 | } | ||||
399 | |||||
400 | sub list_shift { | ||||
401 | my $list = shift; | ||||
402 | shift(@$list); | ||||
403 | } | ||||
404 | |||||
405 | sub list_max { | ||||
406 | 3 | 49µs | 2 | 38µs | # spent 25µs (12+13) within Template::VMethods::BEGIN@406 which was called:
# once (12µs+13µs) by Template::Stash::BEGIN@24 at line 406 # spent 25µs making 1 call to Template::VMethods::BEGIN@406
# spent 13µs making 1 call to warnings::unimport |
407 | my $list = shift; | ||||
408 | $#$list; | ||||
409 | } | ||||
410 | |||||
411 | sub list_size { | ||||
412 | 3 | 948µs | 2 | 33µs | # spent 22µs (11+11) within Template::VMethods::BEGIN@412 which was called:
# once (11µs+11µs) by Template::Stash::BEGIN@24 at line 412 # spent 22µs making 1 call to Template::VMethods::BEGIN@412
# spent 11µs making 1 call to warnings::unimport |
413 | my $list = shift; | ||||
414 | $#$list + 1; | ||||
415 | } | ||||
416 | |||||
417 | sub list_defined { | ||||
418 | # return the item requested, or 1 if no argument to | ||||
419 | # indicate that the hash itself is defined | ||||
420 | my $list = shift; | ||||
421 | return @_ ? defined $list->[$_[0]] : 1; | ||||
422 | } | ||||
423 | |||||
424 | sub list_first { | ||||
425 | my $list = shift; | ||||
426 | return $list->[0] unless @_; | ||||
427 | return [ @$list[0..$_[0]-1] ]; | ||||
428 | } | ||||
429 | |||||
430 | sub list_last { | ||||
431 | my $list = shift; | ||||
432 | return $list->[-1] unless @_; | ||||
433 | return [ @$list[-$_[0]..-1] ]; | ||||
434 | } | ||||
435 | |||||
436 | sub list_reverse { | ||||
437 | my $list = shift; | ||||
438 | [ reverse @$list ]; | ||||
439 | } | ||||
440 | |||||
441 | sub list_grep { | ||||
442 | my ($list, $pattern) = @_; | ||||
443 | $pattern ||= ''; | ||||
444 | return [ grep /$pattern/, @$list ]; | ||||
445 | } | ||||
446 | |||||
447 | sub list_join { | ||||
448 | my ($list, $joint) = @_; | ||||
449 | join(defined $joint ? $joint : ' ', | ||||
450 | map { defined $_ ? $_ : '' } @$list); | ||||
451 | } | ||||
452 | |||||
453 | sub _list_sort_make_key { | ||||
454 | my ($item, $fields) = @_; | ||||
455 | my @keys; | ||||
456 | |||||
457 | if (ref($item) eq 'HASH') { | ||||
458 | @keys = map { $item->{ $_ } } @$fields; | ||||
459 | } | ||||
460 | elsif (blessed $item) { | ||||
461 | @keys = map { $item->can($_) ? $item->$_() : $item } @$fields; | ||||
462 | } | ||||
463 | else { | ||||
464 | @keys = $item; | ||||
465 | } | ||||
466 | |||||
467 | # ugly hack to generate a single string using a delimiter that is | ||||
468 | # unlikely (but not impossible) to be found in the wild. | ||||
469 | return lc join('/*^UNLIKELY^*/', map { defined $_ ? $_ : '' } @keys); | ||||
470 | } | ||||
471 | |||||
472 | sub list_sort { | ||||
473 | my ($list, @fields) = @_; | ||||
474 | return $list unless @$list > 1; # no need to sort 1 item lists | ||||
475 | return [ | ||||
476 | @fields # Schwartzian Transform | ||||
477 | ? map { $_->[0] } # for case insensitivity | ||||
478 | sort { $a->[1] cmp $b->[1] } | ||||
479 | map { [ $_, _list_sort_make_key($_, \@fields) ] } | ||||
480 | @$list | ||||
481 | : map { $_->[0] } | ||||
482 | sort { $a->[1] cmp $b->[1] } | ||||
483 | map { [ $_, lc $_ ] } | ||||
484 | @$list, | ||||
485 | ]; | ||||
486 | } | ||||
487 | |||||
488 | sub list_nsort { | ||||
489 | my ($list, @fields) = @_; | ||||
490 | return $list unless @$list > 1; # no need to sort 1 item lists | ||||
491 | return [ | ||||
492 | @fields # Schwartzian Transform | ||||
493 | ? map { $_->[0] } # for case insensitivity | ||||
494 | sort { $a->[1] <=> $b->[1] } | ||||
495 | map { [ $_, _list_sort_make_key($_, \@fields) ] } | ||||
496 | @$list | ||||
497 | : map { $_->[0] } | ||||
498 | sort { $a->[1] <=> $b->[1] } | ||||
499 | map { [ $_, lc $_ ] } | ||||
500 | @$list, | ||||
501 | ]; | ||||
502 | } | ||||
503 | |||||
504 | sub list_unique { | ||||
505 | my %u; | ||||
506 | [ grep { ++$u{$_} == 1 } @{$_[0]} ]; | ||||
507 | } | ||||
508 | |||||
509 | sub list_import { | ||||
510 | my $list = shift; | ||||
511 | push(@$list, grep defined, map ref eq 'ARRAY' ? @$_ : undef, @_); | ||||
512 | return $list; | ||||
513 | } | ||||
514 | |||||
515 | sub list_merge { | ||||
516 | my $list = shift; | ||||
517 | return [ @$list, grep defined, map ref eq 'ARRAY' ? @$_ : undef, @_ ]; | ||||
518 | } | ||||
519 | |||||
520 | sub list_slice { | ||||
521 | my ($list, $from, $to) = @_; | ||||
522 | $from ||= 0; | ||||
523 | $to = $#$list unless defined $to; | ||||
524 | $from += @$list if $from < 0; | ||||
525 | $to += @$list if $to < 0; | ||||
526 | return [ @$list[$from..$to] ]; | ||||
527 | } | ||||
528 | |||||
529 | sub list_splice { | ||||
530 | my ($list, $offset, $length, @replace) = @_; | ||||
531 | if (@replace) { | ||||
532 | # @replace can contain a list of multiple replace items, or | ||||
533 | # be a single reference to a list | ||||
534 | @replace = @{ $replace[0] } | ||||
535 | if @replace == 1 && ref $replace[0] eq 'ARRAY'; | ||||
536 | return [ splice @$list, $offset, $length, @replace ]; | ||||
537 | } | ||||
538 | elsif (defined $length) { | ||||
539 | return [ splice @$list, $offset, $length ]; | ||||
540 | } | ||||
541 | elsif (defined $offset) { | ||||
542 | return [ splice @$list, $offset ]; | ||||
543 | } | ||||
544 | else { | ||||
545 | return [ splice(@$list) ]; | ||||
546 | } | ||||
547 | } | ||||
548 | |||||
549 | 1 | 40µs | 1; | ||
550 | |||||
551 | __END__ | ||||
# spent 11µs within Template::VMethods::CORE:match which was called 2 times, avg 5µs/call:
# 2 times (11µs+0s) by Template::VMethods::text_match at line 147, avg 5µs/call | |||||
# spent 36µs within Template::VMethods::CORE:regcomp which was called 2 times, avg 18µs/call:
# 2 times (36µs+0s) by Template::VMethods::text_match at line 147, avg 18µs/call |