add $curry::curry and $curry::weak

diff --git a/Changes b/Changes
index c1e4cd5..edb418d 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,4 +1,6 @@
 Revision history for curry
 
+  - Support $curry::curry and $curry::weak
+
 1.000000 - 2012-09-09
   - Initial release

diff --git a/lib/curry.pm b/lib/curry.pm
index 58bbeb4..5cbaee4 100644 (file)
--- a/lib/curry.pm
+++ b/lib/curry.pm
@@ -3,6 +3,12 @@ package curry;
 our $VERSION = '1.000000';
 $VERSION = eval $VERSION;
 
+our $curry = sub {
+  my ($invocant, $code) = splice @_, 0, 2;
+  my @args = @_;
+  sub { $invocant->$code(@args => @_) }
+};
+
 sub AUTOLOAD {
   my $invocant = shift;
   my ($method) = our $AUTOLOAD =~ /^curry::(.+)$/;
@@ -16,6 +22,16 @@ package curry::weak;
 
 use Scalar::Util ();
 
+$curry::weak = sub {
+  my ($invocant, $code) = splice @_, 0, 2;
+  Scalar::Util::weaken($invocant) if Scalar::Util::blessed($invocant);
+  my @args = @_;
+  sub {
+    return unless $invocant;
+    $invocant->$code(@args => @_)
+  }
+};
+
 sub AUTOLOAD {
   my $invocant = shift;
   Scalar::Util::weaken($invocant) if Scalar::Util::blessed($invocant);
@@ -59,6 +75,46 @@ is equivalent to:
     };
   };
 
+If you want to pass a weakened copy of an object to a coderef, use the
+C< $weak > package variable:
+
+ use curry::weak;
+
+ my $code = $self->$curry::weak(sub {
+  my ($self, @args) = @_;
+  print "$self must still be alive, because we were called (with @args)\n";
+ }, 'xyz');
+
+which is much the same as:
+
+ my $code = do {
+  my $sub = sub {
+   my ($self, @args) = @_;
+   print "$self must still be alive, because we were called (with @args)\n";
+  };
+  Scalar::Util::weaken(my $weak_obj = $self);
+  sub {
+   return unless $weak_obj; # in case it already went away
+   $sub->($weak_obj, 'xyz', @_);
+  }
+ };
+
+There's an equivalent - but somewhat less useful - C< $curry > package variable:
+
+ use curry;
+
+ my $code = $self->$curry::curry(sub {
+  my ($self, $var) = @_;
+  print "The stashed value from our ->something method call was $var\n";
+ }, $self->something('complicated'));
+
+Both of these methods can also be used if your scalar is a method name, rather
+than a coderef.
+
+ use curry;
+
+ my $code = $self->$curry::curry($methodname, $self->something('complicated'));
+
 =head1 RATIONALE
 
 How many times have you written

diff --git a/t/curry-packagevar.t b/t/curry-packagevar.t
new file mode 100644 (file)
index 0000000..e58a972
--- /dev/null
+++ b/t/curry-packagevar.t
@@ -0,0 +1,74 @@
+use strict;
+use warnings;
+
+use Test::More tests => 18;
+use Scalar::Util qw(weaken);
+use curry;
+
+sub dispose_ok($;$) {
+       weaken(my $copy = $_[0]);
+       fail("variable is not a ref") unless ref $_[0];
+       undef $_[0];
+       ok(!defined($copy), $_[1]);
+}
+
+{
+       package Foo;
+       sub new { bless {}, shift }
+}
+
+{ # basic behaviour - can we call without args?
+       my $foo = Foo->new;
+
+       my $called;
+       my $code = $foo->$curry::curry(sub {
+               ok(shift->isa('Foo'), '$curry::curry object is correct class');
+               ok(!@_, '$curry::curry did not pick up any stray parameters');
+               ++$called;
+       });
+       fail('$curry::curry did not give us a coderef') unless ref($code) eq 'CODE';
+       $code->();
+       ok($called, 'curried code was called');
+       undef $foo;
+       $called = 0;
+       $code->();
+       ok($called, 'curried code executed successfully after original object goes out of scope');
+}
+
+{ # parameter passthrough
+       my $foo = Foo->new;
+
+       my $called;
+       my $code = $foo->$curry::curry(sub {
+               ok(shift->isa('Foo'), '$curry::curry object is correct class');
+               is_deeply(\@_, [qw(one two three)], 'curried code had the expected parameters');
+               ++$called;
+       });
+       fail('$curry::curry did not give us a coderef') unless ref($code) eq 'CODE';
+       $code->(qw(one two three));
+       ok($called, 'curried code was called');
+       undef $foo;
+       $called = 0;
+       $code->(qw(one two three));
+       ok($called, 'curried code again executed successfully after original object goes out of scope');
+}
+
+{ # stashed parameters
+       my $foo = Foo->new;
+
+       my $called;
+       my $code = $foo->$curry::curry(sub {
+               ok(shift->isa('Foo'), '$curry::curry object is correct class');
+               is_deeply(\@_, [qw(stashed parameters one two three)], 'curried code had the expected parameters');
+               ++$called;
+       }, qw(stashed parameters));
+       fail('$curry::curry did not give us a coderef') unless ref($code) eq 'CODE';
+       $code->(qw(one two three));
+       ok($called, 'curried code was called');
+       undef $foo;
+       $called = 0;
+       $code->(qw(one two three));
+       ok($called, 'curried code again executed successfully after original object goes out of scope');
+}
+
+done_testing;

diff --git a/t/curry-weak-packagevar.t b/t/curry-weak-packagevar.t
new file mode 100644 (file)
index 0000000..e696f48
--- /dev/null
+++ b/t/curry-weak-packagevar.t
@@ -0,0 +1,56 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Scalar::Util qw(weaken);
+use curry::weak;
+
+sub dispose_ok($;$) {
+       weaken(my $copy = $_[0]);
+       fail("variable is not a ref") unless ref $_[0];
+       undef $_[0];
+       ok(!defined($copy), $_[1]);
+}
+
+{
+       package Foo;
+       sub new { bless {}, shift }
+}
+
+{ # basic behaviour - can we call without args?
+       my $foo = Foo->new;
+
+       my $called;
+       my $code = $foo->$curry::weak(sub {
+               ok(shift->isa('Foo'), '$curry::weak object is correct class');
+               ok(!@_, '$curry::weak did not pick up any stray parameters on the way in');
+               ++$called;
+       });
+       fail('$curry::weak::curry did not give us a coderef') unless ref($code) eq 'CODE';
+       $code->();
+       ok($called, 'curried code was called');
+       dispose_ok($foo, '$foo departs without a fight');
+       $called = 0;
+       $code->();
+       ok(!$called, '... and we can still use the coderef as a no-op');
+}
+
+{ # parameter passthrough
+       my $foo = Foo->new;
+
+       my $called;
+       my $code = $foo->$curry::weak(sub {
+               ok(shift->isa('Foo'), '$curry::weak object is correct class');
+               is_deeply(\@_, [qw(stashed parameters one two three)], 'args passed as expected');
+               ++$called;
+       }, qw(stashed parameters));
+       fail('$curry::weak::curry did not give us a coderef') unless ref($code) eq 'CODE';
+       $code->(qw(one two three));
+       ok($called, 'curried code was called');
+       dispose_ok($foo, '$foo departs without a fight');
+       $called = 0;
+       $code->();
+       ok(!$called, '... and we can still use the coderef as a no-op');
+}
+
+done_testing;