File | /opt/wise/lib/perl5/5.10.0/x86_64-linux-thread-multi/List/Util.pm | Statements Executed | 21 | Total Time | 0.000658 seconds |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine | |
---|---|---|---|---|---|---|
0 | 0 | 0 | 0 | 0 | List::Util:: | BEGIN |
Line | Stmts. | Exclusive Time | Avg. | Code |
---|---|---|---|---|
1 | # List::Util.pm | |||
2 | # | |||
3 | # Copyright (c) 1997-2006 Graham Barr <gbarr@pobox.com>. All rights reserved. | |||
4 | # This program is free software; you can redistribute it and/or | |||
5 | # modify it under the same terms as Perl itself. | |||
6 | ||||
7 | package List::Util; | |||
8 | ||||
9 | 3 | 4.1e-5 | 1.4e-5 | use strict; # spent 11µs making 1 call to strict::import |
10 | 3 | 0.00020 | 6.7e-5 | use vars qw(@ISA @EXPORT_OK $VERSION $XS_VERSION $TESTING_PERL_ONLY); # spent 76µs making 1 call to vars::import |
11 | 1 | 1.0e-6 | 1.0e-6 | require Exporter; |
12 | ||||
13 | 1 | 8.0e-6 | 8.0e-6 | @ISA = qw(Exporter); |
14 | 1 | 2.0e-6 | 2.0e-6 | @EXPORT_OK = qw(first min max minstr maxstr reduce sum shuffle); |
15 | 1 | 1.0e-6 | 1.0e-6 | $VERSION = "1.19"; |
16 | 1 | 0 | 0 | $XS_VERSION = $VERSION; |
17 | 1 | 2.4e-5 | 2.4e-5 | $VERSION = eval $VERSION; |
18 | ||||
19 | 1 | 1.0e-6 | 1.0e-6 | eval { |
20 | # PERL_DL_NONLAZY must be false, or any errors in loading will just | |||
21 | # cause the perl code to be tested | |||
22 | 1 | 1.0e-6 | 1.0e-6 | local $ENV{PERL_DL_NONLAZY} = 0 if $ENV{PERL_DL_NONLAZY}; |
23 | eval { | |||
24 | 1 | 1.0e-6 | 1.0e-6 | require XSLoader; |
25 | 1 | 0.00036 | 0.00036 | XSLoader::load('List::Util', $XS_VERSION); # spent 358µs making 1 call to XSLoader::load |
26 | 1 | 1.0e-6 | 1.0e-6 | 1; |
27 | 1 | 2.0e-6 | 2.0e-6 | } or do { |
28 | require DynaLoader; | |||
29 | local @ISA = qw(DynaLoader); | |||
30 | bootstrap List::Util $XS_VERSION; | |||
31 | }; | |||
32 | } unless $TESTING_PERL_ONLY; | |||
33 | ||||
34 | ||||
35 | # This code is only compiled if the XS did not load | |||
36 | # of for perl < 5.6.0 | |||
37 | ||||
38 | 1 | 1.0e-6 | 1.0e-6 | if (!defined &reduce) { |
39 | eval <<'ESQ' | |||
40 | ||||
41 | sub reduce (&@) { | |||
42 | my $code = shift; | |||
43 | no strict 'refs'; | |||
44 | ||||
45 | return shift unless @_ > 1; | |||
46 | ||||
47 | use vars qw($a $b); | |||
48 | ||||
49 | my $caller = caller; | |||
50 | local(*{$caller."::a"}) = \my $a; | |||
51 | local(*{$caller."::b"}) = \my $b; | |||
52 | ||||
53 | $a = shift; | |||
54 | foreach (@_) { | |||
55 | $b = $_; | |||
56 | $a = &{$code}(); | |||
57 | } | |||
58 | ||||
59 | $a; | |||
60 | } | |||
61 | ||||
62 | sub first (&@) { | |||
63 | my $code = shift; | |||
64 | ||||
65 | foreach (@_) { | |||
66 | return $_ if &{$code}(); | |||
67 | } | |||
68 | ||||
69 | undef; | |||
70 | } | |||
71 | ||||
72 | ESQ | |||
73 | } | |||
74 | ||||
75 | # This code is only compiled if the XS did not load | |||
76 | 1 | 0 | 0 | eval <<'ESQ' if !defined ∑ |
77 | ||||
78 | use vars qw($a $b); | |||
79 | ||||
80 | sub sum (@) { reduce { $a + $b } @_ } | |||
81 | ||||
82 | sub min (@) { reduce { $a < $b ? $a : $b } @_ } | |||
83 | ||||
84 | sub max (@) { reduce { $a > $b ? $a : $b } @_ } | |||
85 | ||||
86 | sub minstr (@) { reduce { $a lt $b ? $a : $b } @_ } | |||
87 | ||||
88 | sub maxstr (@) { reduce { $a gt $b ? $a : $b } @_ } | |||
89 | ||||
90 | sub shuffle (@) { | |||
91 | my @a=\(@_); | |||
92 | my $n; | |||
93 | my $i=@_; | |||
94 | map { | |||
95 | $n = rand($i--); | |||
96 | (${$a[$n]}, $a[$n] = $a[$i])[0]; | |||
97 | } @_; | |||
98 | } | |||
99 | ||||
100 | ESQ | |||
101 | ||||
102 | 1 | 1.5e-5 | 1.5e-5 | 1; |
103 | ||||
104 | __END__ | |||
105 | ||||
106 | =head1 NAME | |||
107 | ||||
108 | List::Util - A selection of general-utility list subroutines | |||
109 | ||||
110 | =head1 SYNOPSIS | |||
111 | ||||
112 | use List::Util qw(first max maxstr min minstr reduce shuffle sum); | |||
113 | ||||
114 | =head1 DESCRIPTION | |||
115 | ||||
116 | C<List::Util> contains a selection of subroutines that people have | |||
117 | expressed would be nice to have in the perl core, but the usage would | |||
118 | not really be high enough to warrant the use of a keyword, and the size | |||
119 | so small such that being individual extensions would be wasteful. | |||
120 | ||||
121 | By default C<List::Util> does not export any subroutines. The | |||
122 | subroutines defined are | |||
123 | ||||
124 | =over 4 | |||
125 | ||||
126 | =item first BLOCK LIST | |||
127 | ||||
128 | Similar to C<grep> in that it evaluates BLOCK setting C<$_> to each element | |||
129 | of LIST in turn. C<first> returns the first element where the result from | |||
130 | BLOCK is a true value. If BLOCK never returns true or LIST was empty then | |||
131 | C<undef> is returned. | |||
132 | ||||
133 | $foo = first { defined($_) } @list # first defined value in @list | |||
134 | $foo = first { $_ > $value } @list # first value in @list which | |||
135 | # is greater than $value | |||
136 | ||||
137 | This function could be implemented using C<reduce> like this | |||
138 | ||||
139 | $foo = reduce { defined($a) ? $a : wanted($b) ? $b : undef } undef, @list | |||
140 | ||||
141 | for example wanted() could be defined() which would return the first | |||
142 | defined value in @list | |||
143 | ||||
144 | =item max LIST | |||
145 | ||||
146 | Returns the entry in the list with the highest numerical value. If the | |||
147 | list is empty then C<undef> is returned. | |||
148 | ||||
149 | $foo = max 1..10 # 10 | |||
150 | $foo = max 3,9,12 # 12 | |||
151 | $foo = max @bar, @baz # whatever | |||
152 | ||||
153 | This function could be implemented using C<reduce> like this | |||
154 | ||||
155 | $foo = reduce { $a > $b ? $a : $b } 1..10 | |||
156 | ||||
157 | =item maxstr LIST | |||
158 | ||||
159 | Similar to C<max>, but treats all the entries in the list as strings | |||
160 | and returns the highest string as defined by the C<gt> operator. | |||
161 | If the list is empty then C<undef> is returned. | |||
162 | ||||
163 | $foo = maxstr 'A'..'Z' # 'Z' | |||
164 | $foo = maxstr "hello","world" # "world" | |||
165 | $foo = maxstr @bar, @baz # whatever | |||
166 | ||||
167 | This function could be implemented using C<reduce> like this | |||
168 | ||||
169 | $foo = reduce { $a gt $b ? $a : $b } 'A'..'Z' | |||
170 | ||||
171 | =item min LIST | |||
172 | ||||
173 | Similar to C<max> but returns the entry in the list with the lowest | |||
174 | numerical value. If the list is empty then C<undef> is returned. | |||
175 | ||||
176 | $foo = min 1..10 # 1 | |||
177 | $foo = min 3,9,12 # 3 | |||
178 | $foo = min @bar, @baz # whatever | |||
179 | ||||
180 | This function could be implemented using C<reduce> like this | |||
181 | ||||
182 | $foo = reduce { $a < $b ? $a : $b } 1..10 | |||
183 | ||||
184 | =item minstr LIST | |||
185 | ||||
186 | Similar to C<min>, but treats all the entries in the list as strings | |||
187 | and returns the lowest string as defined by the C<lt> operator. | |||
188 | If the list is empty then C<undef> is returned. | |||
189 | ||||
190 | $foo = minstr 'A'..'Z' # 'A' | |||
191 | $foo = minstr "hello","world" # "hello" | |||
192 | $foo = minstr @bar, @baz # whatever | |||
193 | ||||
194 | This function could be implemented using C<reduce> like this | |||
195 | ||||
196 | $foo = reduce { $a lt $b ? $a : $b } 'A'..'Z' | |||
197 | ||||
198 | =item reduce BLOCK LIST | |||
199 | ||||
200 | Reduces LIST by calling BLOCK, in a scalar context, multiple times, | |||
201 | setting C<$a> and C<$b> each time. The first call will be with C<$a> | |||
202 | and C<$b> set to the first two elements of the list, subsequent | |||
203 | calls will be done by setting C<$a> to the result of the previous | |||
204 | call and C<$b> to the next element in the list. | |||
205 | ||||
206 | Returns the result of the last call to BLOCK. If LIST is empty then | |||
207 | C<undef> is returned. If LIST only contains one element then that | |||
208 | element is returned and BLOCK is not executed. | |||
209 | ||||
210 | $foo = reduce { $a < $b ? $a : $b } 1..10 # min | |||
211 | $foo = reduce { $a lt $b ? $a : $b } 'aa'..'zz' # minstr | |||
212 | $foo = reduce { $a + $b } 1 .. 10 # sum | |||
213 | $foo = reduce { $a . $b } @bar # concat | |||
214 | ||||
215 | =item shuffle LIST | |||
216 | ||||
217 | Returns the elements of LIST in a random order | |||
218 | ||||
219 | @cards = shuffle 0..51 # 0..51 in a random order | |||
220 | ||||
221 | =item sum LIST | |||
222 | ||||
223 | Returns the sum of all the elements in LIST. If LIST is empty then | |||
224 | C<undef> is returned. | |||
225 | ||||
226 | $foo = sum 1..10 # 55 | |||
227 | $foo = sum 3,9,12 # 24 | |||
228 | $foo = sum @bar, @baz # whatever | |||
229 | ||||
230 | This function could be implemented using C<reduce> like this | |||
231 | ||||
232 | $foo = reduce { $a + $b } 1..10 | |||
233 | ||||
234 | =back | |||
235 | ||||
236 | =head1 KNOWN BUGS | |||
237 | ||||
238 | With perl versions prior to 5.005 there are some cases where reduce | |||
239 | will return an incorrect result. This will show up as test 7 of | |||
240 | reduce.t failing. | |||
241 | ||||
242 | =head1 SUGGESTED ADDITIONS | |||
243 | ||||
244 | The following are additions that have been requested, but I have been reluctant | |||
245 | to add due to them being very simple to implement in perl | |||
246 | ||||
247 | # One argument is true | |||
248 | ||||
249 | sub any { $_ && return 1 for @_; 0 } | |||
250 | ||||
251 | # All arguments are true | |||
252 | ||||
253 | sub all { $_ || return 0 for @_; 1 } | |||
254 | ||||
255 | # All arguments are false | |||
256 | ||||
257 | sub none { $_ && return 0 for @_; 1 } | |||
258 | ||||
259 | # One argument is false | |||
260 | ||||
261 | sub notall { $_ || return 1 for @_; 0 } | |||
262 | ||||
263 | # How many elements are true | |||
264 | ||||
265 | sub true { scalar grep { $_ } @_ } | |||
266 | ||||
267 | # How many elements are false | |||
268 | ||||
269 | sub false { scalar grep { !$_ } @_ } | |||
270 | ||||
271 | =head1 SEE ALSO | |||
272 | ||||
273 | L<Scalar::Util>, L<List::MoreUtils> | |||
274 | ||||
275 | =head1 COPYRIGHT | |||
276 | ||||
277 | Copyright (c) 1997-2006 Graham Barr <gbarr@pobox.com>. All rights reserved. | |||
278 | This program is free software; you can redistribute it and/or | |||
279 | modify it under the same terms as Perl itself. | |||
280 | ||||
281 | =cut |