This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
cfe31f701235ed02d57e2fee52c54c51edd530cd
[perl5.git] / ext / List / Util / lib / List / Util.pm
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 &sum;
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