Commit | Line | Data |
11d28ce0 |
1 | package curry; |
2 | |
bb3e4610 |
3 | our $VERSION = '1.001000'; |
11d28ce0 |
4 | $VERSION = eval $VERSION; |
5 | |
b1b97495 |
6 | our $curry = sub { |
7 | my ($invocant, $code) = splice @_, 0, 2; |
8 | my @args = @_; |
9 | sub { $invocant->$code(@args => @_) } |
10 | }; |
11 | |
11d28ce0 |
12 | sub AUTOLOAD { |
13 | my $invocant = shift; |
14 | my ($method) = our $AUTOLOAD =~ /^curry::(.+)$/; |
15 | my @args = @_; |
16 | return sub { |
17 | $invocant->$method(@args => @_); |
18 | } |
19 | } |
20 | |
21 | package curry::weak; |
22 | |
23 | use Scalar::Util (); |
24 | |
b1b97495 |
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 | |
11d28ce0 |
35 | sub AUTOLOAD { |
36 | my $invocant = shift; |
37 | Scalar::Util::weaken($invocant) if Scalar::Util::blessed($invocant); |
ee6aa763 |
38 | my ($method) = our $AUTOLOAD =~ /^curry::weak::(.+)$/; |
11d28ce0 |
39 | my @args = @_; |
40 | return sub { |
cfc04a37 |
41 | return unless $invocant; |
11d28ce0 |
42 | $invocant->$method(@args => @_); |
43 | } |
44 | } |
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); |
cfc04a37 |
72 | sub { |
73 | return unless $weak_obj; # in case it already went away |
74 | $weak_obj->frobnicate(foo => @_) |
75 | }; |
11d28ce0 |
76 | }; |
77 | |
b1b97495 |
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 | |
11d28ce0 |
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) <mst@shadowcat.co.uk> |
132 | |
133 | =head1 CONTRIBUTORS |
134 | |
135 | None yet - maybe this software is perfect! (ahahahahahahahahaha) |
136 | |
137 | =head1 COPYRIGHT |
138 | |
bec94f83 |
139 | Copyright (c) 2012 the curry L</AUTHOR> and L</CONTRIBUTORS> |
11d28ce0 |
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. |