Commit | Line | Data |
---|---|---|
920dae64 AT |
1 | # List::Util.pm |
2 | # | |
3 | # Copyright (c) 1997-2005 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 | use strict; | |
10 | use vars qw(@ISA @EXPORT_OK $VERSION $XS_VERSION $TESTING_PERL_ONLY); | |
11 | require Exporter; | |
12 | ||
13 | @ISA = qw(Exporter); | |
14 | @EXPORT_OK = qw(first min max minstr maxstr reduce sum shuffle); | |
15 | $VERSION = "1.18"; | |
16 | $XS_VERSION = $VERSION; | |
17 | $VERSION = eval $VERSION; | |
18 | ||
19 | eval { | |
20 | # PERL_DL_NONLAZY must be false, or any errors in loading will just | |
21 | # cause the perl code to be tested | |
22 | local $ENV{PERL_DL_NONLAZY} = 0 if $ENV{PERL_DL_NONLAZY}; | |
23 | eval { | |
24 | require XSLoader; | |
25 | XSLoader::load('List::Util', $XS_VERSION); | |
26 | 1; | |
27 | } 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 | 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 | 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; | |
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 multiple times, setting C<$a> and C<$b> | |
201 | each time. The first call will be with C<$a> and C<$b> set to the first | |
202 | two elements of the list, subsequent calls will be done by | |
203 | setting C<$a> to the result of the previous call and C<$b> to the next | |
204 | 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 COPYRIGHT | |
272 | ||
273 | Copyright (c) 1997-2005 Graham Barr <gbarr@pobox.com>. All rights reserved. | |
274 | This program is free software; you can redistribute it and/or | |
275 | modify it under the same terms as Perl itself. | |
276 | ||
277 | =cut |