cpan/List-Util/lib/List/Util/PP.pm

   1 # List::Util::PP.pm
   2 #
   3 # Copyright (c) 1997-2009 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::PP;
   8
   9 use strict;
  10 use warnings;
  11 use vars qw(@ISA @EXPORT $VERSION $a $b);
  12 require Exporter;
  13
  14 @ISA     = qw(Exporter);
  15 @EXPORT  = qw(first min max minstr maxstr reduce sum shuffle);
  16 $VERSION = "1.22";
  17 $VERSION = eval $VERSION;
  18
  19 sub reduce (&@) {
  20   my $code = shift;
  21   require Scalar::Util;
  22   my $type = Scalar::Util::reftype($code);
  23   unless($type and $type eq 'CODE') {
  24     require Carp;
  25     Carp::croak("Not a subroutine reference");
  26   }
  27   no strict 'refs';
  28
  29   return shift unless @_ > 1;
  30
  31   use vars qw($a $b);
  32
  33   my $caller = caller;
  34   local(*{$caller."::a"}) = \my $a;
  35   local(*{$caller."::b"}) = \my $b;
  36
  37   $a = shift;
  38   foreach (@_) {
  39     $b = $_;
  40     $a = &{$code}();
  41   }
  42
  43   $a;
  44 }
  45
  46 sub first (&@) {
  47   my $code = shift;
  48   require Scalar::Util;
  49   my $type = Scalar::Util::reftype($code);
  50   unless($type and $type eq 'CODE') {
  51     require Carp;
  52     Carp::croak("Not a subroutine reference");
  53   }
  54
  55   foreach (@_) {
  56     return $_ if &{$code}();
  57   }
  58
  59   undef;
  60 }
  61
  62
  63 sub sum (@) { reduce { $a + $b } @_ }
  64
  65 sub min (@) { reduce { $a < $b ? $a : $b } @_ }
  66
  67 sub max (@) { reduce { $a > $b ? $a : $b } @_ }
  68
  69 sub minstr (@) { reduce { $a lt $b ? $a : $b } @_ }
  70
  71 sub maxstr (@) { reduce { $a gt $b ? $a : $b } @_ }
  72
  73 sub shuffle (@) {
  74   my @a=\(@_);
  75   my $n;
  76   my $i=@_;
  77   map {
  78     $n = rand($i--);
  79     (${$a[$n]}, $a[$n] = $a[$i])[0];
  80   } @_;
  81 }
  82
  83 1;