Commit | Line | Data |
---|---|---|
2ff28616 GB |
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); | |
4daffb2b | 16 | $VERSION = "1.23"; |
2ff28616 GB |
17 | $VERSION = eval $VERSION; |
18 | ||
19 | sub reduce (&@) { | |
20 | my $code = shift; | |
a1248f17 GB |
21 | require Scalar::Util; |
22 | my $type = Scalar::Util::reftype($code); | |
23 | unless($type and $type eq 'CODE') { | |
2ff28616 GB |
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; | |
a1248f17 GB |
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 | } | |
2ff28616 GB |
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; |