File Coverage

blib/lib/curry.pm
Criterion Covered Total %
statement 15 15 100.0
branch 3 4 75.0
condition n/a
subroutine 5 5 100.0
pod n/a
total 23 24 95.8


line stmt bran cond sub pod time code
1             package curry;
2              
3             our $VERSION = '1.001000';
4             $VERSION = eval $VERSION;
5              
6             our $curry = sub {
7             my ($invocant, $code) = splice @_, 0, 2;
8             my @args = @_;
9             sub { $invocant->$code(@args => @_) }
10             };
11              
12             sub AUTOLOAD {
13 2     2   4040 my $invocant = shift;
14 2         10 my ($method) = our $AUTOLOAD =~ /^curry::(.+)$/;
15 2         6 my @args = @_;
16             return sub {
17 1     1   5 $invocant->$method(@args => @_);
18             }
19 2         11 }
20              
21             package curry::weak;
22              
23 3     3   39238 use Scalar::Util ();
  3         9  
  3         640  
24              
25             $curry::weak = sub {
26             my ($invocant, $code) = splice @_, 0, 2;
27             Scalar::Util::weaken($invocant) if Scalar::Util::blessed($invocant);
28             my @args = @_;
29             sub {
30             return unless $invocant;
31             $invocant->$code(@args => @_)
32             }
33             };
34              
35             sub AUTOLOAD {
36 1     1   1258 my $invocant = shift;
37 1 50       11 Scalar::Util::weaken($invocant) if Scalar::Util::blessed($invocant);
38 1         6 my ($method) = our $AUTOLOAD =~ /^curry::weak::(.+)$/;
39 1         11 my @args = @_;
40             return sub {
41 2 100   2   1682 return unless $invocant;
42 1         5 $invocant->$method(@args => @_);
43             }
44 1         8 }
45              
46             1;
47              
48             =head1 NAME
49              
50             curry - Create automatic curried method call closures for any class or object
51              
52             =head1 SYNOPSIS
53              
54             use curry;
55              
56             my $code = $obj->curry::frobnicate('foo');
57              
58             is equivalent to:
59              
60             my $code = sub { $obj->frobnicate(foo => @_) };
61              
62             Additionally,
63              
64             use curry::weak;
65              
66             my $code = $obj->curry::weak::frobnicate('foo');
67              
68             is equivalent to:
69              
70             my $code = do {
71             Scalar::Util::weaken(my $weak_obj = $obj);
72             sub {
73             return unless $weak_obj; # in case it already went away
74             $weak_obj->frobnicate(foo => @_)
75             };
76             };
77              
78             If you want to pass a weakened copy of an object to a coderef, use the
79             C< $weak > package variable:
80              
81             use curry::weak;
82              
83             my $code = $self->$curry::weak(sub {
84             my ($self, @args) = @_;
85             print "$self must still be alive, because we were called (with @args)\n";
86             }, 'xyz');
87              
88             which is much the same as:
89              
90             my $code = do {
91             my $sub = sub {
92             my ($self, @args) = @_;
93             print "$self must still be alive, because we were called (with @args)\n";
94             };
95             Scalar::Util::weaken(my $weak_obj = $self);
96             sub {
97             return unless $weak_obj; # in case it already went away
98             $sub->($weak_obj, 'xyz', @_);
99             }
100             };
101              
102             There's an equivalent - but somewhat less useful - C< $curry > package variable:
103              
104             use curry;
105              
106             my $code = $self->$curry::curry(sub {
107             my ($self, $var) = @_;
108             print "The stashed value from our ->something method call was $var\n";
109             }, $self->something('complicated'));
110              
111             Both of these methods can also be used if your scalar is a method name, rather
112             than a coderef.
113              
114             use curry;
115              
116             my $code = $self->$curry::curry($methodname, $self->something('complicated'));
117              
118             =head1 RATIONALE
119              
120             How many times have you written
121              
122             sub { $obj->something($some, $args, @_) }
123              
124             or worse still needed to weaken it and had to check and re-check your code
125             to be sure you weren't closing over things the wrong way?
126              
127             Right. That's why I wrote this.
128              
129             =head1 AUTHOR
130              
131             mst - Matt S. Trout (cpan:MSTROUT)
132              
133             =head1 CONTRIBUTORS
134              
135             None yet - maybe this software is perfect! (ahahahahahahahahaha)
136              
137             =head1 COPYRIGHT
138              
139             Copyright (c) 2012 the curry L and L
140             as listed above.
141              
142             =head1 LICENSE
143              
144             This library is free software and may be distributed under the same terms
145             as perl itself.