line |
stmt |
bran |
cond |
sub |
pod |
time |
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 |
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
|
80
|
|
|
80
|
|
649
|
use strict; |
|
80
|
|
|
|
|
274
|
|
|
80
|
|
|
|
|
2742
|
|
25
|
80
|
|
|
80
|
|
406
|
use warnings; |
|
80
|
|
|
|
|
163
|
|
|
80
|
|
|
|
|
2353
|
|
26
|
80
|
|
|
80
|
|
451
|
use Scalar::Util qw( blessed looks_like_number ); |
|
80
|
|
|
|
|
163
|
|
|
80
|
|
|
|
|
5460
|
|
27
|
80
|
|
|
80
|
|
6875
|
use Template::Filters; |
|
80
|
|
|
|
|
166
|
|
|
80
|
|
|
|
|
58602
|
|
28
|
|
|
|
|
|
|
require Template::Stash; |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
our $VERSION = 2.16; |
31
|
|
|
|
|
|
|
our $DEBUG = 0 unless defined $DEBUG; |
32
|
|
|
|
|
|
|
our $PRIVATE = $Template::Stash::PRIVATE; |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
our $ROOT_VMETHODS = { |
35
|
|
|
|
|
|
|
inc => \&root_inc, |
36
|
|
|
|
|
|
|
dec => \&root_dec, |
37
|
|
|
|
|
|
|
}; |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
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
|
|
|
|
|
|
|
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
|
|
|
|
|
|
|
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
|
80
|
|
|
80
|
|
598
|
no warnings; |
|
80
|
|
|
|
|
203
|
|
|
80
|
|
|
|
|
12345
|
|
116
|
4
|
|
|
4
|
0
|
167
|
my $item = shift; |
117
|
4
|
|
|
|
|
33
|
++$item; |
118
|
|
|
|
|
|
|
} |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
sub root_dec { |
121
|
80
|
|
|
80
|
|
449
|
no warnings; |
|
80
|
|
|
|
|
185
|
|
|
80
|
|
|
|
|
211675
|
|
122
|
0
|
|
|
0
|
0
|
0
|
my $item = shift; |
123
|
0
|
|
|
|
|
0
|
--$item; |
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
#======================================================================== |
128
|
|
|
|
|
|
|
# text virtual methods |
129
|
|
|
|
|
|
|
#======================================================================== |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
sub text_item { |
132
|
6
|
|
|
6
|
0
|
63
|
$_[0]; |
133
|
|
|
|
|
|
|
} |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
sub text_list { |
136
|
5
|
|
|
5
|
0
|
116
|
[ $_[0] ]; |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
sub text_hash { |
140
|
3
|
|
|
3
|
0
|
55
|
{ value => $_[0] }; |
141
|
|
|
|
|
|
|
} |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
sub text_length { |
144
|
1
|
|
|
1
|
0
|
4
|
length $_[0]; |
145
|
|
|
|
|
|
|
} |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
sub text_size { |
148
|
1
|
|
|
1
|
0
|
5
|
return 1; |
149
|
|
|
|
|
|
|
} |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
sub text_defined { |
152
|
4
|
|
|
4
|
0
|
11
|
return 1; |
153
|
|
|
|
|
|
|
} |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
sub text_upper { |
156
|
1
|
|
|
1
|
0
|
6
|
return uc $_[0]; |
157
|
|
|
|
|
|
|
} |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
sub text_lower { |
160
|
2
|
|
|
2
|
0
|
10
|
return lc $_[0]; |
161
|
|
|
|
|
|
|
} |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
sub text_ucfirst { |
164
|
3
|
|
|
3
|
0
|
16
|
return ucfirst $_[0]; |
165
|
|
|
|
|
|
|
} |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
sub text_lcfirst { |
168
|
2
|
|
|
2
|
0
|
8
|
return lcfirst $_[0]; |
169
|
|
|
|
|
|
|
} |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
sub text_trim { |
172
|
1
|
|
|
1
|
0
|
4
|
for ($_[0]) { |
173
|
1
|
|
|
|
|
6
|
s/^\s+//; |
174
|
1
|
|
|
|
|
7
|
s/\s+$//; |
175
|
|
|
|
|
|
|
} |
176
|
1
|
|
|
|
|
5
|
return $_[0]; |
177
|
|
|
|
|
|
|
} |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
sub text_collapse { |
180
|
1
|
|
|
1
|
0
|
3
|
for ($_[0]) { |
181
|
1
|
|
|
|
|
7
|
s/^\s+//; |
182
|
1
|
|
|
|
|
7
|
s/\s+$//; |
183
|
1
|
|
|
|
|
9
|
s/\s+/ /g |
184
|
|
|
|
|
|
|
} |
185
|
1
|
|
|
|
|
5
|
return $_[0]; |
186
|
|
|
|
|
|
|
} |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
sub text_match { |
189
|
10
|
|
|
10
|
0
|
23
|
my ($str, $search, $global) = @_; |
190
|
10
|
50
|
33
|
|
|
86
|
return $str unless defined $str and defined $search; |
191
|
10
|
100
|
|
|
|
248
|
my @matches = $global ? ($str =~ /$search/g) |
192
|
|
|
|
|
|
|
: ($str =~ /$search/); |
193
|
10
|
100
|
|
|
|
55
|
return @matches ? \@matches : ''; |
194
|
|
|
|
|
|
|
} |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
sub text_search { |
197
|
5
|
|
|
5
|
0
|
12
|
my ($str, $pattern) = @_; |
198
|
5
|
50
|
33
|
|
|
33
|
return $str unless defined $str and defined $pattern; |
199
|
5
|
|
|
|
|
111
|
return $str =~ /$pattern/; |
200
|
|
|
|
|
|
|
} |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
sub text_repeat { |
203
|
2
|
|
|
2
|
0
|
7
|
my ($str, $count) = @_; |
204
|
2
|
50
|
|
|
|
8
|
$str = '' unless defined $str; |
205
|
2
|
50
|
|
|
|
9
|
return '' unless $count; |
206
|
2
|
|
50
|
|
|
6
|
$count ||= 1; |
207
|
2
|
|
|
|
|
11
|
return $str x $count; |
208
|
|
|
|
|
|
|
} |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
sub text_replace { |
211
|
25
|
|
|
25
|
0
|
56
|
my ($text, $pattern, $replace, $global) = @_; |
212
|
25
|
50
|
|
|
|
60
|
$text = '' unless defined $text; |
213
|
25
|
50
|
|
|
|
64
|
$pattern = '' unless defined $pattern; |
214
|
25
|
50
|
|
|
|
61
|
$replace = '' unless defined $replace; |
215
|
25
|
50
|
|
|
|
64
|
$global = 1 unless defined $global; |
216
|
|
|
|
|
|
|
|
217
|
25
|
100
|
|
|
|
109
|
if ($replace =~ /\$\d+/) { |
218
|
|
|
|
|
|
|
# replacement string may contain backrefs |
219
|
|
|
|
|
|
|
my $expand = sub { |
220
|
35
|
|
|
35
|
|
67
|
my ($chunk, $start, $end) = @_; |
221
|
35
|
|
|
|
|
209
|
$chunk =~ s{ \\(\\|\$) | \$ (\d+) }{ |
222
|
66
|
100
|
100
|
|
|
814
|
$1 ? $1 |
|
|
100
|
|
|
|
|
|
223
|
|
|
|
|
|
|
: ($2 > $#$start || $2 == 0 || !defined $start->[$2]) ? '' |
224
|
|
|
|
|
|
|
: substr($text, $start->[$2], $end->[$2] - $start->[$2]); |
225
|
|
|
|
|
|
|
}exg; |
226
|
35
|
|
|
|
|
201
|
$chunk; |
227
|
17
|
|
|
|
|
96
|
}; |
228
|
17
|
50
|
|
|
|
48
|
if ($global) { |
229
|
17
|
|
|
|
|
388
|
$text =~ s{$pattern}{ &$expand($replace, [@-], [@+]) }eg; |
|
35
|
|
|
|
|
298
|
|
230
|
|
|
|
|
|
|
} |
231
|
|
|
|
|
|
|
else { |
232
|
0
|
|
|
|
|
0
|
$text =~ s{$pattern}{ &$expand($replace, [@-], [@+]) }e; |
|
0
|
|
|
|
|
0
|
|
233
|
|
|
|
|
|
|
} |
234
|
|
|
|
|
|
|
} |
235
|
|
|
|
|
|
|
else { |
236
|
8
|
50
|
|
|
|
22
|
if ($global) { |
237
|
8
|
|
|
|
|
176
|
$text =~ s/$pattern/$replace/g; |
238
|
|
|
|
|
|
|
} |
239
|
|
|
|
|
|
|
else { |
240
|
0
|
|
|
|
|
0
|
$text =~ s/$pattern/$replace/; |
241
|
|
|
|
|
|
|
} |
242
|
|
|
|
|
|
|
} |
243
|
25
|
|
|
|
|
167
|
return $text; |
244
|
|
|
|
|
|
|
} |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
sub text_remove { |
247
|
1
|
|
|
1
|
0
|
3
|
my ($str, $search) = @_; |
248
|
1
|
50
|
33
|
|
|
10
|
return $str unless defined $str and defined $search; |
249
|
1
|
|
|
|
|
23
|
$str =~ s/$search//g; |
250
|
1
|
|
|
|
|
4
|
return $str; |
251
|
|
|
|
|
|
|
} |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
sub text_split { |
254
|
11
|
|
|
11
|
0
|
128
|
my ($str, $split, $limit) = @_; |
255
|
11
|
50
|
|
|
|
38
|
$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 behaves |
260
|
|
|
|
|
|
|
# differently to C<$space=' '; split($space, ...)>. Test 33 of |
261
|
|
|
|
|
|
|
# vmethods/text.t depends on this behaviour. |
262
|
|
|
|
|
|
|
|
263
|
11
|
50
|
|
|
|
48
|
if ($] < 5.018) { |
264
|
0
|
0
|
|
|
|
0
|
if (defined $limit) { |
265
|
0
|
0
|
|
|
|
0
|
return [ defined $split |
266
|
|
|
|
|
|
|
? split($split, $str, $limit) |
267
|
|
|
|
|
|
|
: split(' ', $str, $limit) ]; |
268
|
|
|
|
|
|
|
} |
269
|
|
|
|
|
|
|
else { |
270
|
0
|
0
|
|
|
|
0
|
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 |
280
|
|
|
|
|
|
|
# qr// behaves the same, so use that for user-defined split. |
281
|
|
|
|
|
|
|
|
282
|
11
|
|
|
|
|
20
|
my $split_re; |
283
|
11
|
100
|
|
|
|
34
|
if (defined $split) { |
284
|
8
|
|
|
|
|
14
|
eval { |
285
|
8
|
|
|
|
|
116
|
$split_re = qr/$split/; |
286
|
|
|
|
|
|
|
}; |
287
|
|
|
|
|
|
|
} |
288
|
11
|
100
|
|
|
|
40
|
$split_re = ' ' unless defined $split_re; |
289
|
11
|
|
100
|
|
|
63
|
$limit ||= 0; |
290
|
11
|
|
|
|
|
228
|
return [split($split_re, $str, $limit)]; |
291
|
|
|
|
|
|
|
} |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
sub text_chunk { |
294
|
8
|
|
|
8
|
0
|
109
|
my ($string, $size) = @_; |
295
|
8
|
|
|
|
|
13
|
my @list; |
296
|
8
|
|
50
|
|
|
24
|
$size ||= 1; |
297
|
8
|
100
|
|
|
|
28
|
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
|
5
|
|
|
|
|
16
|
$string = reverse $string; |
302
|
5
|
|
|
|
|
10
|
$size = -$size; |
303
|
5
|
|
|
|
|
220
|
unshift(@list, scalar reverse $1) |
304
|
|
|
|
|
|
|
while ($string =~ /((.{$size})|(.+))/g); |
305
|
|
|
|
|
|
|
} |
306
|
|
|
|
|
|
|
else { |
307
|
3
|
|
|
|
|
159
|
push(@list, $1) while ($string =~ /((.{$size})|(.+))/g); |
308
|
|
|
|
|
|
|
} |
309
|
8
|
|
|
|
|
72
|
return \@list; |
310
|
|
|
|
|
|
|
} |
311
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
sub text_substr { |
313
|
11
|
|
|
11
|
0
|
28
|
my ($text, $offset, $length, $replacement) = @_; |
314
|
11
|
|
100
|
|
|
47
|
$offset ||= 0; |
315
|
|
|
|
|
|
|
|
316
|
11
|
100
|
|
|
|
30
|
if(defined $length) { |
317
|
9
|
100
|
|
|
|
24
|
if (defined $replacement) { |
318
|
2
|
|
|
|
|
9
|
substr( $text, $offset, $length, $replacement ); |
319
|
2
|
|
|
|
|
8
|
return $text; |
320
|
|
|
|
|
|
|
} |
321
|
|
|
|
|
|
|
else { |
322
|
7
|
|
|
|
|
90
|
return substr( $text, $offset, $length ); |
323
|
|
|
|
|
|
|
} |
324
|
|
|
|
|
|
|
} |
325
|
|
|
|
|
|
|
else { |
326
|
2
|
|
|
|
|
14
|
return substr( $text, $offset ); |
327
|
|
|
|
|
|
|
} |
328
|
|
|
|
|
|
|
} |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
sub text_squote { |
331
|
1
|
|
|
1
|
0
|
4
|
my $text = shift; |
332
|
1
|
|
|
|
|
3
|
for ($text) { |
333
|
1
|
|
|
|
|
319
|
s/(['\\])/\\$1/g; |
334
|
|
|
|
|
|
|
} |
335
|
1
|
|
|
|
|
7
|
return $text; |
336
|
|
|
|
|
|
|
} |
337
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
sub text_dquote { |
339
|
1
|
|
|
1
|
0
|
4
|
my $text = shift; |
340
|
1
|
|
|
|
|
3
|
for ($text) { |
341
|
1
|
|
|
|
|
11
|
s/(["\\])/\\$1/g; |
342
|
1
|
|
|
|
|
5
|
s/\n/\\n/g; |
343
|
|
|
|
|
|
|
} |
344
|
1
|
|
|
|
|
5
|
return $text; |
345
|
|
|
|
|
|
|
} |
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
#======================================================================== |
348
|
|
|
|
|
|
|
# hash virtual methods |
349
|
|
|
|
|
|
|
#======================================================================== |
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
sub hash_item { |
353
|
2
|
|
|
2
|
0
|
75
|
my ($hash, $item) = @_; |
354
|
2
|
50
|
|
|
|
10
|
$item = '' unless defined $item; |
355
|
2
|
50
|
33
|
|
|
11
|
return if $PRIVATE && $item =~ /$PRIVATE/; |
356
|
2
|
|
|
|
|
12
|
$hash->{ $item }; |
357
|
|
|
|
|
|
|
} |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
sub hash_hash { |
360
|
0
|
|
|
0
|
0
|
0
|
$_[0]; |
361
|
|
|
|
|
|
|
} |
362
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
sub hash_size { |
364
|
1
|
|
|
1
|
0
|
4
|
scalar keys %{$_[0]}; |
|
1
|
|
|
|
|
5
|
|
365
|
|
|
|
|
|
|
} |
366
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
sub hash_each { |
368
|
|
|
|
|
|
|
# this will be changed in TT3 to do what hash_pairs() does |
369
|
1
|
|
|
1
|
0
|
3
|
[ %{ $_[0] } ]; |
|
1
|
|
|
|
|
8
|
|
370
|
|
|
|
|
|
|
} |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
sub hash_keys { |
373
|
6
|
|
|
6
|
0
|
8
|
[ keys %{ $_[0] } ]; |
|
6
|
|
|
|
|
35
|
|
374
|
|
|
|
|
|
|
} |
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
sub hash_values { |
377
|
1
|
|
|
1
|
0
|
3
|
[ values %{ $_[0] } ]; |
|
1
|
|
|
|
|
6
|
|
378
|
|
|
|
|
|
|
} |
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
sub hash_items { |
381
|
7
|
|
|
7
|
0
|
101
|
[ %{ $_[0] } ]; |
|
7
|
|
|
|
|
72
|
|
382
|
|
|
|
|
|
|
} |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
sub hash_pairs { |
385
|
12
|
|
|
|
|
50
|
[ map { |
386
|
4
|
|
|
|
|
32
|
{ key => $_ , value => $_[0]->{ $_ } } |
387
|
|
|
|
|
|
|
} |
388
|
4
|
|
|
4
|
0
|
15
|
sort keys %{ $_[0] } |
389
|
|
|
|
|
|
|
]; |
390
|
|
|
|
|
|
|
} |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
sub hash_list { |
393
|
1
|
|
|
1
|
0
|
3
|
my ($hash, $what) = @_; |
394
|
1
|
|
50
|
|
|
7
|
$what ||= ''; |
395
|
2
|
|
|
|
|
11
|
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
|
1
|
50
|
|
|
|
13
|
[ map { { key => $_ , value => $hash->{ $_ } } } |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
401
|
|
|
|
|
|
|
sort keys %$hash |
402
|
|
|
|
|
|
|
]; |
403
|
|
|
|
|
|
|
} |
404
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
sub hash_exists { |
406
|
2
|
|
|
2
|
0
|
8
|
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
|
5
|
|
|
5
|
0
|
7
|
my $hash = shift; |
413
|
5
|
100
|
|
|
|
23
|
return @_ ? defined $hash->{ $_[0] } : 1; |
414
|
|
|
|
|
|
|
} |
415
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
sub hash_delete { |
417
|
2
|
|
|
2
|
0
|
31
|
my $hash = shift; |
418
|
2
|
|
|
|
|
17
|
delete $hash->{ $_ } for @_; |
419
|
|
|
|
|
|
|
} |
420
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
sub hash_import { |
422
|
19
|
|
|
19
|
0
|
210
|
my ($hash, $imp) = @_; |
423
|
19
|
100
|
|
|
|
94
|
$imp = {} unless ref $imp eq 'HASH'; |
424
|
19
|
|
|
|
|
77
|
@$hash{ keys %$imp } = values %$imp; |
425
|
19
|
|
|
|
|
159
|
return ''; |
426
|
|
|
|
|
|
|
} |
427
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
sub hash_sort { |
429
|
1
|
|
|
1
|
0
|
4
|
my ($hash) = @_; |
430
|
1
|
|
|
|
|
9
|
[ sort { lc $hash->{$a} cmp lc $hash->{$b} } (keys %$hash) ]; |
|
3
|
|
|
|
|
13
|
|
431
|
|
|
|
|
|
|
} |
432
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
sub hash_nsort { |
434
|
1
|
|
|
1
|
0
|
2
|
my ($hash) = @_; |
435
|
1
|
|
|
|
|
11
|
[ sort { $hash->{$a} <=> $hash->{$b} } (keys %$hash) ]; |
|
3
|
|
|
|
|
12
|
|
436
|
|
|
|
|
|
|
} |
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
#======================================================================== |
440
|
|
|
|
|
|
|
# list virtual methods |
441
|
|
|
|
|
|
|
#======================================================================== |
442
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
sub list_item { |
445
|
8
|
|
100
|
8
|
0
|
158
|
$_[0]->[ $_[1] || 0 ]; |
446
|
|
|
|
|
|
|
} |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
sub list_list { |
449
|
2
|
|
|
2
|
0
|
47
|
$_[0]; |
450
|
|
|
|
|
|
|
} |
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
sub list_hash { |
453
|
5
|
|
|
5
|
0
|
39
|
my $list = shift; |
454
|
5
|
100
|
|
|
|
21
|
if (@_) { |
455
|
2
|
|
100
|
|
|
8
|
my $n = shift || 0; |
456
|
2
|
|
|
|
|
4
|
return { map { ($n++, $_) } @$list }; |
|
8
|
|
|
|
|
27
|
|
457
|
|
|
|
|
|
|
} |
458
|
80
|
|
|
80
|
|
660
|
no warnings; |
|
80
|
|
|
|
|
175
|
|
|
80
|
|
|
|
|
14046
|
|
459
|
3
|
|
|
|
|
21
|
return { @$list }; |
460
|
|
|
|
|
|
|
} |
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
sub list_push { |
463
|
13
|
|
|
13
|
0
|
281
|
my $list = shift; |
464
|
13
|
|
|
|
|
45
|
push(@$list, @_); |
465
|
13
|
|
|
|
|
227
|
return ''; |
466
|
|
|
|
|
|
|
} |
467
|
|
|
|
|
|
|
|
468
|
|
|
|
|
|
|
sub list_pop { |
469
|
1
|
|
|
1
|
0
|
21
|
my $list = shift; |
470
|
1
|
|
|
|
|
5
|
pop(@$list); |
471
|
|
|
|
|
|
|
} |
472
|
|
|
|
|
|
|
|
473
|
|
|
|
|
|
|
sub list_unshift { |
474
|
1
|
|
|
1
|
0
|
27
|
my $list = shift; |
475
|
1
|
|
|
|
|
3
|
unshift(@$list, @_); |
476
|
1
|
|
|
|
|
5
|
return ''; |
477
|
|
|
|
|
|
|
} |
478
|
|
|
|
|
|
|
|
479
|
|
|
|
|
|
|
sub list_shift { |
480
|
2
|
|
|
2
|
0
|
89
|
my $list = shift; |
481
|
2
|
|
|
|
|
9
|
shift(@$list); |
482
|
|
|
|
|
|
|
} |
483
|
|
|
|
|
|
|
|
484
|
|
|
|
|
|
|
sub list_max { |
485
|
80
|
|
|
80
|
|
470
|
no warnings; |
|
80
|
|
|
|
|
174
|
|
|
80
|
|
|
|
|
4551
|
|
486
|
1
|
|
|
1
|
0
|
3
|
my $list = shift; |
487
|
1
|
|
|
|
|
5
|
$#$list; |
488
|
|
|
|
|
|
|
} |
489
|
|
|
|
|
|
|
|
490
|
|
|
|
|
|
|
sub list_size { |
491
|
80
|
|
|
80
|
|
633
|
no warnings; |
|
80
|
|
|
|
|
174
|
|
|
80
|
|
|
|
|
100607
|
|
492
|
4
|
|
|
4
|
0
|
10
|
my $list = shift; |
493
|
4
|
|
|
|
|
15
|
$#$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
|
4
|
|
|
4
|
0
|
6
|
my $list = shift; |
500
|
4
|
100
|
|
|
|
14
|
return 1 unless @_; # list.defined is always true |
501
|
3
|
100
|
|
|
|
17
|
return unless looks_like_number $_[0]; # list.defined('bah') is always false |
502
|
2
|
|
|
|
|
10
|
return defined $list->[$_[0]]; # list.defined(n) |
503
|
|
|
|
|
|
|
} |
504
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
sub list_first { |
506
|
24
|
|
|
24
|
0
|
324
|
my $list = shift; |
507
|
24
|
100
|
|
|
|
158
|
return $list->[0] unless @_; |
508
|
1
|
|
|
|
|
6
|
return [ @$list[0..$_[0]-1] ]; |
509
|
|
|
|
|
|
|
} |
510
|
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
sub list_last { |
512
|
25
|
|
|
25
|
0
|
363
|
my $list = shift; |
513
|
25
|
100
|
|
|
|
184
|
return $list->[-1] unless @_; |
514
|
1
|
|
|
|
|
6
|
return [ @$list[-$_[0]..-1] ]; |
515
|
|
|
|
|
|
|
} |
516
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
sub list_reverse { |
518
|
1
|
|
|
1
|
0
|
3
|
my $list = shift; |
519
|
1
|
|
|
|
|
4
|
[ reverse @$list ]; |
520
|
|
|
|
|
|
|
} |
521
|
|
|
|
|
|
|
|
522
|
|
|
|
|
|
|
sub list_grep { |
523
|
2
|
|
|
2
|
0
|
41
|
my ($list, $pattern) = @_; |
524
|
2
|
|
50
|
|
|
5
|
$pattern ||= ''; |
525
|
2
|
|
|
|
|
61
|
return [ grep /$pattern/, @$list ]; |
526
|
|
|
|
|
|
|
} |
527
|
|
|
|
|
|
|
|
528
|
|
|
|
|
|
|
sub list_join { |
529
|
57
|
|
|
57
|
0
|
103
|
my ($list, $joint) = @_; |
530
|
248
|
50
|
|
|
|
679
|
join(defined $joint ? $joint : ' ', |
531
|
57
|
100
|
|
|
|
233
|
map { defined $_ ? $_ : '' } @$list); |
532
|
|
|
|
|
|
|
} |
533
|
|
|
|
|
|
|
|
534
|
|
|
|
|
|
|
sub _list_sort_make_key { |
535
|
51
|
|
|
51
|
|
111
|
my ($item, $fields) = @_; |
536
|
51
|
|
|
|
|
59
|
my @keys; |
537
|
|
|
|
|
|
|
|
538
|
51
|
100
|
|
|
|
158
|
if (ref($item) eq 'HASH') { |
|
|
50
|
|
|
|
|
|
539
|
34
|
|
|
|
|
48
|
@keys = map { $item->{ $_ } } @$fields; |
|
34
|
|
|
|
|
117
|
|
540
|
|
|
|
|
|
|
} |
541
|
|
|
|
|
|
|
elsif (blessed $item) { |
542
|
17
|
50
|
|
|
|
29
|
@keys = map { $item->can($_) ? $item->$_() : $item } @$fields; |
|
21
|
|
|
|
|
143
|
|
543
|
|
|
|
|
|
|
} |
544
|
|
|
|
|
|
|
else { |
545
|
0
|
|
|
|
|
0
|
@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
|
51
|
50
|
|
|
|
181
|
return lc join('/*^UNLIKELY^*/', map { defined $_ ? $_ : '' } @keys); |
|
55
|
|
|
|
|
356
|
|
551
|
|
|
|
|
|
|
} |
552
|
|
|
|
|
|
|
|
553
|
|
|
|
|
|
|
sub list_sort { |
554
|
55
|
|
|
55
|
0
|
1210
|
my ($list, @fields) = @_; |
555
|
55
|
100
|
|
|
|
200
|
return $list unless @$list > 1; # no need to sort 1 item lists |
556
|
|
|
|
|
|
|
return [ |
557
|
|
|
|
|
|
|
@fields # Schwartzian Transform |
558
|
46
|
|
|
|
|
125
|
? map { $_->[0] } # for case insensitivity |
|
48
|
|
|
|
|
103
|
|
559
|
46
|
|
|
|
|
141
|
sort { $a->[1] cmp $b->[1] } |
560
|
135
|
|
|
|
|
512
|
map { [ $_, _list_sort_make_key($_, \@fields) ] } |
561
|
|
|
|
|
|
|
@$list |
562
|
158
|
|
|
|
|
376
|
: map { $_->[0] } |
563
|
135
|
|
|
|
|
534
|
sort { $a->[1] cmp $b->[1] } |
564
|
52
|
100
|
|
|
|
490
|
map { [ $_, lc $_ ] } |
565
|
|
|
|
|
|
|
@$list, |
566
|
|
|
|
|
|
|
]; |
567
|
|
|
|
|
|
|
} |
568
|
|
|
|
|
|
|
|
569
|
|
|
|
|
|
|
sub list_nsort { |
570
|
6
|
|
|
6
|
0
|
63
|
my ($list, @fields) = @_; |
571
|
6
|
50
|
|
|
|
35
|
return $list unless @$list > 1; # no need to sort 1 item lists |
572
|
|
|
|
|
|
|
return [ |
573
|
|
|
|
|
|
|
@fields # Schwartzian Transform |
574
|
5
|
|
|
|
|
10
|
? map { $_->[0] } # for case insensitivity |
|
8
|
|
|
|
|
16
|
|
575
|
5
|
|
|
|
|
13
|
sort { $a->[1] <=> $b->[1] } |
576
|
35
|
|
|
|
|
190
|
map { [ $_, _list_sort_make_key($_, \@fields) ] } |
577
|
|
|
|
|
|
|
@$list |
578
|
61
|
|
|
|
|
93
|
: map { $_->[0] } |
579
|
35
|
|
|
|
|
147
|
sort { $a->[1] <=> $b->[1] } |
580
|
6
|
100
|
|
|
|
25
|
map { [ $_, lc $_ ] } |
581
|
|
|
|
|
|
|
@$list, |
582
|
|
|
|
|
|
|
]; |
583
|
|
|
|
|
|
|
} |
584
|
|
|
|
|
|
|
|
585
|
|
|
|
|
|
|
sub list_unique { |
586
|
2
|
|
|
2
|
0
|
4
|
my %u; |
587
|
2
|
|
|
|
|
4
|
[ grep { ++$u{$_} == 1 } @{$_[0]} ]; |
|
20
|
|
|
|
|
42
|
|
|
2
|
|
|
|
|
5
|
|
588
|
|
|
|
|
|
|
} |
589
|
|
|
|
|
|
|
|
590
|
|
|
|
|
|
|
sub list_import { |
591
|
2
|
|
|
2
|
0
|
4
|
my $list = shift; |
592
|
2
|
50
|
|
|
|
19
|
push(@$list, grep defined, map ref eq 'ARRAY' ? @$_ : undef, @_); |
593
|
2
|
|
|
|
|
8
|
return $list; |
594
|
|
|
|
|
|
|
} |
595
|
|
|
|
|
|
|
|
596
|
|
|
|
|
|
|
sub list_merge { |
597
|
2
|
|
|
2
|
0
|
4
|
my $list = shift; |
598
|
2
|
50
|
|
|
|
22
|
return [ @$list, grep defined, map ref eq 'ARRAY' ? @$_ : undef, @_ ]; |
599
|
|
|
|
|
|
|
} |
600
|
|
|
|
|
|
|
|
601
|
|
|
|
|
|
|
sub list_slice { |
602
|
4
|
|
|
4
|
0
|
5
|
my ($list, $from, $to) = @_; |
603
|
4
|
|
100
|
|
|
12
|
$from ||= 0; |
604
|
4
|
100
|
|
|
|
10
|
$to = $#$list unless defined $to; |
605
|
4
|
100
|
|
|
|
9
|
$from += @$list if $from < 0; |
606
|
4
|
100
|
|
|
|
7
|
$to += @$list if $to < 0; |
607
|
4
|
|
|
|
|
17
|
return [ @$list[$from..$to] ]; |
608
|
|
|
|
|
|
|
} |
609
|
|
|
|
|
|
|
|
610
|
|
|
|
|
|
|
sub list_splice { |
611
|
7
|
|
|
7
|
0
|
16
|
my ($list, $offset, $length, @replace) = @_; |
612
|
7
|
100
|
|
|
|
26
|
if (@replace) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
613
|
|
|
|
|
|
|
# @replace can contain a list of multiple replace items, or |
614
|
|
|
|
|
|
|
# be a single reference to a list |
615
|
4
|
100
|
100
|
|
|
18
|
@replace = @{ $replace[0] } |
|
2
|
|
|
|
|
5
|
|
616
|
|
|
|
|
|
|
if @replace == 1 && ref $replace[0] eq 'ARRAY'; |
617
|
4
|
|
|
|
|
19
|
return [ splice @$list, $offset, $length, @replace ]; |
618
|
|
|
|
|
|
|
} |
619
|
|
|
|
|
|
|
elsif (defined $length) { |
620
|
1
|
|
|
|
|
5
|
return [ splice @$list, $offset, $length ]; |
621
|
|
|
|
|
|
|
} |
622
|
|
|
|
|
|
|
elsif (defined $offset) { |
623
|
1
|
|
|
|
|
8
|
return [ splice @$list, $offset ]; |
624
|
|
|
|
|
|
|
} |
625
|
|
|
|
|
|
|
else { |
626
|
1
|
|
|
|
|
6
|
return [ splice(@$list) ]; |
627
|
|
|
|
|
|
|
} |
628
|
|
|
|
|
|
|
} |
629
|
|
|
|
|
|
|
|
630
|
|
|
|
|
|
|
1; |
631
|
|
|
|
|
|
|
|
632
|
|
|
|
|
|
|
__END__ |