[ Index ]

PHP Cross Reference of Unnamed Project

title

Body

[close]

/se3-unattended/var/se3/unattended/install/linuxaux/opt/perl/lib/5.10.0/i586-linux-thread-multi/List/ -> Util.pm (source)

   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


Generated: Tue Mar 17 22:47:18 2015 Cross-referenced by PHPXref 0.7.1