| Subject: | $_curry and $_curry_weak |
As promised, somewhat later than I'd hoped:
The attached curry-vars.patch provides the $_curry and $_curry_weak imports:
use curry::weak qw($_curry_weak);
$obj->$_curry_weak(sub { my ($self, $other, $vars, @args) = @_; ... }, qw(other vars));
use curry qw($_curry);
$obj->$_curry(sub { my ($self, $other, $vars, @args) = @_; ... }, qw(other vars));
They're disabled by default.
The only issue I'm aware of is that ->import is no longer proxied, but ->curry::import() seems somewhat unlikely to be desirable in practice.
There's a second patch (which would be applied on top of the first one) to use the new $_curry/$_curry_weak vars in AUTOLOAD, reduces duplication but introduces extra sub-call overhead. Code's simple enough that a bit of duplication in exchange for a tiny performance improvement seems reasonable though.
Also available on github - https://github.com/tm604/curry - if you prefer.
cheers,
Tom
| Subject: | curry-vars.patch |
diff --git a/Changes b/Changes
index 89e2100..35944a0 100644
--- a/Changes
+++ b/Changes
@@ -1,2 +1,6 @@
+2.000000 - 2014-08-25
+ - Support $_curry and $_curry_weak. Note that this means you
+ can no longer use $obj->curry::import().
+
1.000000 - 2012-09-09
- Initial release
diff --git a/lib/curry.pm b/lib/curry.pm
index 58bbeb4..9b52c87 100644
--- a/lib/curry.pm
+++ b/lib/curry.pm
@@ -1,8 +1,18 @@
package curry;
-our $VERSION = '1.000000';
+our $VERSION = '2.000000';
$VERSION = eval $VERSION;
+use Exporter qw(import);
+
+our @EXPORT_OK = qw($_curry);
+
+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 +26,20 @@ package curry::weak;
use Scalar::Util ();
+use Exporter qw(import);
+
+our @EXPORT_OK = qw($_curry_weak);
+
+our $_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 +83,39 @@ is equivalent to:
};
};
+If you want to pass a weakened copy of an object to a coderef, import
+the C< $_curry_weak > variable:
+
+ use curry::weak '$_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 > variable:
+
+ use curry '$_curry';
+
+ my $code = $self->$_curry(sub {
+ my ($self, $var) = @_;
+ print "The stashed value from our ->something method call was $var\n";
+ }, $self->something('complicated'));
+
=head1 RATIONALE
How many times have you written
diff --git a/t/curry-import.t b/t/curry-import.t
new file mode 100644
index 0000000..d4f1f7b
--- /dev/null
+++ b/t/curry-import.t
@@ -0,0 +1,74 @@
+use strict;
+use warnings;
+
+use Test::More tests => 18;
+use Scalar::Util qw(weaken);
+use curry qw($_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(sub {
+ ok(shift->isa('Foo'), '$_curry object is correct class');
+ ok(!@_, '$_curry did not pick up any stray parameters');
+ ++$called;
+ });
+ fail('$_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(sub {
+ ok(shift->isa('Foo'), '$_curry object is correct class');
+ is_deeply(\@_, [qw(one two three)], 'curried code had the expected parameters');
+ ++$called;
+ });
+ fail('$_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(sub {
+ ok(shift->isa('Foo'), '$_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 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-import.t b/t/curry-weak-import.t
new file mode 100644
index 0000000..ee7962d
--- /dev/null
+++ b/t/curry-weak-import.t
@@ -0,0 +1,56 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Scalar::Util qw(weaken);
+use curry::weak qw($_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 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 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;
| Subject: | less_duplication.patch |
diff --git a/lib/curry.pm b/lib/curry.pm
index 9b52c87..ba11852 100644
--- a/lib/curry.pm
+++ b/lib/curry.pm
@@ -16,10 +16,7 @@ our $_curry = sub {
sub AUTOLOAD {
my $invocant = shift;
my ($method) = our $AUTOLOAD =~ /^curry::(.+)$/;
- my @args = @_;
- return sub {
- $invocant->$method(@args => @_);
- }
+ $invocant->$_curry($method => @_);
}
package curry::weak;
@@ -44,11 +41,7 @@ sub AUTOLOAD {
my $invocant = shift;
Scalar::Util::weaken($invocant) if Scalar::Util::blessed($invocant);
my ($method) = our $AUTOLOAD =~ /^curry::weak::(.+)$/;
- my @args = @_;
- return sub {
- return unless $invocant;
- $invocant->$method(@args => @_);
- }
+ $invocant->$_curry_weak($method => @_);
}
1;