From: Matt S Trout Date: Tue, 17 Jul 2012 22:54:40 +0000 (+0000) Subject: fixup start, add then:: X-Git-Tag: v0.002002~14 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=11e7c8a508b90595385fe78e9036f8f8313d9dbd;p=scpubgit%2FObject-Remote.git fixup start, add then:: --- diff --git a/lib/Object/Remote/Future.pm b/lib/Object/Remote/Future.pm index c5ac7ee..04bc251 100644 --- a/lib/Object/Remote/Future.pm +++ b/lib/Object/Remote/Future.pm @@ -34,9 +34,6 @@ package start; sub AUTOLOAD { my $invocant = shift; my ($method) = our $AUTOLOAD =~ /^start::(.+)$/; - if (ref($invocant) eq 'ARRAY') { - return [ map $_->${\"start::${method}"}, @$invocant ]; - } my $res; unless (eval { $res = $invocant->$method(@_); 1 }) { my $f = CPS::Future->new; @@ -51,6 +48,25 @@ sub AUTOLOAD { return $res; } +package then; + +sub AUTOLOAD { + my $invocant = shift; + my ($method) = our $AUTOLOAD =~ /^then::(.+)$/; + my @args = @_; + # Need two copies since if we're called on an already complete future + # $f will be freed immediately + my $ret = my $f = CPS::Future->new; + $invocant->on_fail(sub { $f->fail(@_); undef($f); }); + $invocant->on_done(sub { + my ($obj) = @_; + my $next = $obj->${\"start::${method}"}(@args); + $next->on_done(sub { $f->done(@_); undef($f); }); + $next->on_fail(sub { $f->fail(@_); undef($f); }); + }); + return $ret; +} + 1; =head1 NAME diff --git a/t/start_core.t b/t/start_core.t new file mode 100644 index 0000000..31d5349 --- /dev/null +++ b/t/start_core.t @@ -0,0 +1,78 @@ +use strictures 1; +use Test::More; + +{ + package S1S; + + use Moo; + + sub get_s2 { + S2S->new + } +} + +{ + package S1F; + + use Object::Remote::Future; + use Moo; + + our $C; + + sub get_s2 { + future { + my $f = shift; + $C = sub { $f->done(S2F->new); undef($f); }; + $f; + } + } +} + +{ + package S2S; + + use Moo; + + sub get_s3 { 'S3' } +} + +{ + package S2F; + + use Object::Remote::Future; + use Moo; + + our $C; + + sub get_s3 { + future { + my $f = shift; + $C = sub { $f->done('S3'); undef($f); }; + $f; + } + } +} + +my $res; + +S1S->start::get_s2->then::get_s3->on_ready(sub { ($res) = $_[0]->get }); + +is($res, 'S3', 'Synchronous code ok'); + +undef($res); + +S1F->start::get_s2->then::get_s3->on_ready(sub { ($res) = $_[0]->get }); + +ok(!$S2F::C, 'Second future not yet constructed'); + +$S1F::C->(); + +ok($S2F::C, 'Second future constructed after first future completed'); + +ok(!$res, 'Nothing happened yet'); + +$S2F::C->(); + +is($res, 'S3', 'Asynchronous code ok'); + +done_testing;