ext/List/Util/lib/List/Util.pm

   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 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.19";
  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, 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