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