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