├── MANIFEST.SKIP ├── .gitignore ├── t ├── 000-load.t ├── lib │ ├── NoEV.pm │ ├── Promises │ │ ├── Test │ │ │ ├── Mojo.pm │ │ │ ├── AE.pm │ │ │ ├── AnyEvent.pm │ │ │ ├── EV.pm │ │ │ └── IO │ │ │ │ └── Async.pm │ │ └── Test.pm │ └── AsyncUtil.pm ├── 030-deferred-default.t ├── 031-deferred-io-async.t ├── late-warning.t ├── 031-deferred-AE.t ├── 070-accepted-rejected.t ├── 033-deferred-EV.t ├── 032-deferred-AnyEvent.t ├── 034-deferred-Mojo.t ├── 080-deferred-as-sub.t ├── 013-collect_hash-params.t ├── warnings.t ├── 060-free-refs.t ├── 007_callable.t ├── 004-error.t ├── 011-collect-w-error.t ├── 013-collect_hash-with-error.t ├── 090-timeout.t ├── 001-basic.t ├── 045-attributes.t ├── 003-post-resolve-then.t ├── 012-collect_hash.t ├── 002-multiples.t ├── 005-multiples-w-error.t ├── 010-collect.t ├── 053-exceptions-mojo.t ├── 051-exceptions-pp-anyevent.t ├── 052-exceptions-ev-anyevent.t ├── 050-exceptions-pp.t ├── 021-chaining-errors.t ├── 020-chaining.t ├── 006-thenable.t ├── 025-recursion.t └── 040_finally.t ├── weaver.ini ├── .travis.yml ├── example ├── example.pl ├── mojo-promises.pl └── chaining-example.pl ├── dist.ini ├── cpanfile ├── lib ├── Promises │ ├── Deferred │ │ ├── IO │ │ │ └── Async.pm │ │ ├── Mojo.pm │ │ ├── AE.pm │ │ ├── EV.pm │ │ └── AnyEvent.pm │ ├── Cookbook │ │ ├── ChainingAndPipelining.pod │ │ ├── ScalaFuturesComparison.pod │ │ ├── Recursion.pod │ │ ├── TIMTOWTDI.pod │ │ ├── SynopsisBreakdown.pod │ │ └── GentleIntro.pod │ ├── Sub.pm │ ├── Promise.pm │ └── Deferred.pm └── Promises.pm ├── MANIFEST ├── README.md ├── CODE_OF_CONDUCT.md └── Changes /MANIFEST.SKIP: -------------------------------------------------------------------------------- 1 | weaver.ini 2 | dist.ini 3 | MANIFEST.SKIP 4 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | Promises-* 2 | __NOTES__.txt 3 | example/test.pl 4 | *.orig 5 | .envrc 6 | .gutctags 7 | tags 8 | .build 9 | -------------------------------------------------------------------------------- /t/000-load.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Test::More; 7 | 8 | BEGIN { 9 | use_ok('Promises'); 10 | } 11 | 12 | 13 | done_testing; -------------------------------------------------------------------------------- /t/lib/NoEV.pm: -------------------------------------------------------------------------------- 1 | package NoEV; 2 | 3 | # prevents EV from loading 4 | 5 | use lib \&_no_EV; 6 | 7 | sub _no_EV { 8 | die "No EV" if $_[1] =~ /EV.pm$/; 9 | return undef; 10 | } 11 | 12 | 1; 13 | -------------------------------------------------------------------------------- /t/lib/Promises/Test/Mojo.pm: -------------------------------------------------------------------------------- 1 | package Promises::Test::Mojo; 2 | 3 | use Mojo::IOLoop; 4 | 5 | sub new { 6 | return bless {}, shift; 7 | } 8 | 9 | sub start { Mojo::IOLoop->start } 10 | sub stop { Mojo::IOLoop->stop } 11 | 12 | 13 | 1; 14 | -------------------------------------------------------------------------------- /t/lib/Promises/Test/AE.pm: -------------------------------------------------------------------------------- 1 | package Promises::Test::AE; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use AE; 7 | 8 | sub new { 9 | return bless {}, shift; 10 | } 11 | 12 | my $cv = AE::cv; 13 | 14 | sub start { $cv->recv } 15 | sub stop { $cv->send } 16 | 17 | 18 | 1; 19 | -------------------------------------------------------------------------------- /t/lib/Promises/Test/AnyEvent.pm: -------------------------------------------------------------------------------- 1 | package Promises::Test::AnyEvent; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use AnyEvent; 7 | 8 | sub new { 9 | return bless {}, shift; 10 | } 11 | 12 | my $cv = AnyEvent->condvar; 13 | 14 | sub start { $cv->recv } 15 | sub stop { $cv->send } 16 | 17 | 18 | 1; 19 | -------------------------------------------------------------------------------- /t/030-deferred-default.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Test::More; 7 | 8 | use Promises 'deferred'; 9 | 10 | my $run = 0; 11 | 12 | my $d = deferred; 13 | $d->then( sub { $run++ }); 14 | $d->resolve; 15 | 16 | is($run, 1, '... run synchronously'); 17 | 18 | done_testing; 19 | 20 | -------------------------------------------------------------------------------- /t/lib/Promises/Test/EV.pm: -------------------------------------------------------------------------------- 1 | package Promises::Test::EV; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use EV; 7 | 8 | sub new { 9 | return bless {}, shift; 10 | } 11 | 12 | sub start { EV::run } 13 | sub stop { 14 | EV::break EV::BREAK_ALL; 15 | Promises::Deferred::EV->cleanup; 16 | } 17 | 18 | 19 | 1; 20 | -------------------------------------------------------------------------------- /weaver.ini: -------------------------------------------------------------------------------- 1 | [@CorePrep] 2 | 3 | [Name] 4 | [Version] 5 | 6 | [Region / prelude] 7 | 8 | [Generic / SYNOPSIS] 9 | [Generic / DESCRIPTION] 10 | [Generic / OVERVIEW] 11 | 12 | [Collect / ATTRIBUTES] 13 | command = attr 14 | 15 | [Collect / METHODS] 16 | command = method 17 | 18 | [Leftovers] 19 | 20 | [Region / postlude] 21 | 22 | [Authors] 23 | [Legal] -------------------------------------------------------------------------------- /t/lib/Promises/Test/IO/Async.pm: -------------------------------------------------------------------------------- 1 | package Promises::Test::IO::Async; 2 | 3 | use IO::Async::Loop; 4 | 5 | my $loop = IO::Async::Loop->new; 6 | 7 | sub new { 8 | return bless {}, shift; 9 | } 10 | 11 | sub set_backend { 12 | Promises->_set_backend( 'IO::Async' ); 13 | } 14 | 15 | sub start { $loop->run } 16 | sub stop { $loop->stop } 17 | 18 | 19 | 1; 20 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | --- 2 | before_install: 3 | - export HARNESS_OPTIONS=j10:c HARNESS_TIMER=1 4 | - git config --global user.name "Dist Zilla Plugin TravisCI" 5 | - git config --global user.email $HOSTNAME":not-for-mail@travis-ci.com" 6 | install: 7 | - cpanm --with-recommends --installdeps -n . 8 | language: perl 9 | matrix: 10 | include: 11 | - perl: '5.22' 12 | - perl: '5.24' 13 | - perl: '5.26' 14 | - perl: '5.28' 15 | - perl: '5.30' 16 | script: 17 | - prove -l t 18 | -------------------------------------------------------------------------------- /t/031-deferred-io-async.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More; 5 | use Test::Requires 'IO::Async'; 6 | 7 | use IO::Async::Loop; 8 | 9 | use Promises backend => ['IO::Async'], 'deferred'; 10 | 11 | my $loop = IO::Async::Loop->new; 12 | 13 | my $run = 0; 14 | 15 | my $d = deferred; 16 | $d->then( sub { $run++ }); 17 | $d->resolve; 18 | 19 | ok !$run,'... not run synchronously'; 20 | 21 | $loop->loop_once(1); 22 | 23 | ok $run, '... run asynchronously'; 24 | 25 | done_testing; 26 | 27 | -------------------------------------------------------------------------------- /t/late-warning.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More; 5 | use Test::Warn; 6 | 7 | use Promises qw(deferred); 8 | 9 | warning_like { 10 | my $d = deferred(); 11 | $d->then(sub {die "boo"})->then(sub { 'stuff' }); 12 | # Simulate run-time requiring a package use-ing warn_on_unhandled_reject 13 | Promises->import('warn_on_unhandled_reject' => [1]); 14 | $d->resolve; 15 | } qr!Promise's rejection.*boo.*at t/late-warning.t line 11!s, "catch a die"; 16 | 17 | 18 | done_testing; 19 | -------------------------------------------------------------------------------- /t/031-deferred-AE.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Test::More; 7 | use Test::Requires 'AE'; 8 | 9 | use AE; 10 | 11 | use Promises backend => ['AE'], 'deferred'; 12 | 13 | my $run = 0; 14 | 15 | my $d = deferred; 16 | $d->then( sub { $run++ }); 17 | $d->resolve; 18 | 19 | is($run, 0, '... not run synchronously'); 20 | 21 | my $cv = AE::cv; 22 | my $w = AE::timer( 0.01, 0, sub{ $cv->send } ); 23 | 24 | $cv->recv; 25 | 26 | is($run, 1, '... run asynchronously'); 27 | 28 | done_testing; 29 | 30 | -------------------------------------------------------------------------------- /t/lib/Promises/Test.pm: -------------------------------------------------------------------------------- 1 | package Promises::Test; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Promises; 7 | use Module::Runtime qw/ use_module /; 8 | 9 | sub backend { 10 | my $backend = shift; 11 | 12 | $SIG{ALRM} = sub { 13 | Test::More::BAIL_OUT( 'test timed out' ); 14 | }; 15 | 16 | alarm( shift || 10 ); 17 | 18 | my $x = eval { 19 | Promises->_set_backend([$backend]) 20 | } or return; 21 | 22 | return use_module( 'Promises::Test::' . $backend )->new; 23 | } 24 | 25 | 26 | 1; 27 | -------------------------------------------------------------------------------- /t/070-accepted-rejected.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Test::More tests => 3; 7 | 8 | use Promises qw/ resolved rejected collect /; 9 | 10 | my $resolved = resolved( 1..3 )->then( 11 | sub { is_deeply \@_, [1..3], 'resolved' }, 12 | sub { fail 'resolved' }, 13 | ); 14 | 15 | my $rejected = rejected( 4..6 )->then( 16 | sub { fail 'rejected' }, 17 | sub { is_deeply \@_, [4..6], 'rejected' }, 18 | ); 19 | 20 | collect( $resolved, $rejected )->finally(sub{ 21 | pass 'all done'; 22 | }); 23 | 24 | done_testing; 25 | -------------------------------------------------------------------------------- /t/033-deferred-EV.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Test::More; 7 | 8 | BEGIN { 9 | if (!eval { require EV; EV->import; 1 }) { 10 | plan skip_all => "EV is required for this test"; 11 | } 12 | } 13 | 14 | use Promises backend => ['EV'], 'deferred'; 15 | 16 | my $run = 0; 17 | 18 | my $d = deferred; 19 | $d->then( sub { $run++ }); 20 | $d->resolve; 21 | 22 | is($run, 0, '... not run synchronously'); 23 | 24 | EV::run EV::RUN_ONCE while $run == 0; 25 | 26 | is($run, 1, '... run asynchronously'); 27 | 28 | done_testing; 29 | 30 | -------------------------------------------------------------------------------- /t/032-deferred-AnyEvent.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Test::More; 7 | use Test::Requires 'AnyEvent'; 8 | 9 | use AnyEvent; 10 | 11 | use Promises backend => ['AnyEvent'], 'deferred'; 12 | 13 | my $run = 0; 14 | 15 | my $d = deferred; 16 | $d->then( sub { $run++ }); 17 | $d->resolve; 18 | 19 | is($run, 0, '... not run synchronously'); 20 | 21 | my $cv = AnyEvent->condvar; 22 | my $w = AnyEvent->timer( after => 0.01, cb => sub{ $cv->send } ); 23 | 24 | $cv->recv; 25 | 26 | is($run, 1, '... run asynchronously'); 27 | 28 | done_testing; 29 | 30 | -------------------------------------------------------------------------------- /t/034-deferred-Mojo.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use lib 't/lib'; 7 | use NoEV; 8 | use Test::More; 9 | 10 | BEGIN { 11 | if (!eval { require Mojo::IOLoop; Mojo::IOLoop->import; 1 }) { 12 | plan skip_all => "Mojo::IOLoop is required for this test"; 13 | } 14 | } 15 | 16 | use Promises backend => ['Mojo'], 'deferred'; 17 | 18 | my $run = 0; 19 | 20 | my $d = deferred; 21 | $d->then( sub { $run++ }); 22 | $d->resolve; 23 | 24 | is($run, 0, '... not run synchronously'); 25 | 26 | Mojo::IOLoop->one_tick; 27 | 28 | is($run, 1, '... run asynchronously'); 29 | 30 | done_testing; 31 | 32 | -------------------------------------------------------------------------------- /example/example.pl: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use AnyEvent::HTTP; 7 | use JSON::XS qw[ decode_json ]; 8 | use Promises qw[ collect ]; 9 | 10 | sub fetch_it { 11 | my ($uri) = @_; 12 | my $d = Promises::Deferred->new; 13 | http_get $uri => sub { $d->resolve( decode_json( $_[0] ) ) }; 14 | $d->promise; 15 | } 16 | 17 | my $cv = AnyEvent->condvar; 18 | 19 | collect( 20 | map { fetch_it('http://en.wikipedia.org/w/api.php?action=opensearch&format=json&search=' . $_) } @ARGV 21 | )->then( 22 | sub { $cv->send( @_ ) }, 23 | sub { $cv->croak( 'ERROR' ) } 24 | ); 25 | 26 | use Data::Dumper; warn Dumper [ $cv->recv ]; -------------------------------------------------------------------------------- /t/080-deferred-as-sub.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Test::More tests => 4; 7 | use Test::Requires 'AnyEvent'; 8 | 9 | use lib 't/lib'; 10 | 11 | use AsyncUtil qw/ delay_me /; 12 | 13 | use Promises qw/ deferred /; 14 | 15 | my $cv = AE::cv; 16 | 17 | my $promise = deferred { 18 | delay_me(2)->then(sub{ $cv->send }); 19 | }; 20 | 21 | my $bad_promise = deferred { 22 | delay_me(2)->then(sub{ die "oops"; }); 23 | }; 24 | 25 | is $promise->status => 'in progress'; 26 | is $bad_promise->status => 'in progress'; 27 | 28 | $cv->recv; 29 | 30 | is $promise->status => 'resolved'; 31 | 32 | is $bad_promise->status => 'rejected'; 33 | -------------------------------------------------------------------------------- /dist.ini: -------------------------------------------------------------------------------- 1 | name = Promises 2 | author = Stevan Little 3 | license = Perl_5 4 | copyright_holder = Infinity Interactive, Inc. 5 | copyright_year = 2014 6 | 7 | [@Filter] 8 | -bundle=@YANICK 9 | -remove=Covenant 10 | import_from_build=cpanfile,CODE_OF_CONDUCT.md 11 | NextVersion::Semantic.format=%d.%02d 12 | GithubMeta.remote=origin 13 | AutoPrereqs.skip= ^(Mojo::|EV|AE|AnyEvent|IO::Async) 14 | Test::Compile.skip=AE|AnyEvent|EV|Async|Mojo 15 | 16 | [Prereqs] 17 | Sub::Exporter = 0 18 | 19 | [Prereqs / TestRequires] 20 | Test::Pod = 0 21 | Test::More = 0.88 22 | Test::Requires = 0 23 | 24 | -------------------------------------------------------------------------------- /t/013-collect_hash-params.t: -------------------------------------------------------------------------------- 1 | use Test::More tests => 3; 2 | 3 | use Promises qw/ resolved collect_hash /; 4 | 5 | collect_hash( 6 | a => 1, 7 | b => resolved( 'good' ), 8 | )->then(sub{ 9 | is_deeply +{ @_ }, { a => 1, b => 'good' }, 'scalars and scalar return promises are good'; 10 | }); 11 | 12 | collect_hash( 13 | a => 1, 14 | b => resolved(), 15 | c => resolved('good'), 16 | )->then(sub{ 17 | is_deeply +{ @_ }, { a => 1, b => undef, c => 'good' }, 'no value gets mapped to "undef"'; 18 | }); 19 | 20 | collect_hash( 21 | a => 1, 22 | b => resolved(1..5), 23 | c => resolved('good'), 24 | )->catch(sub{ 25 | my $error = $_[0]; 26 | like shift() => qr/'collect_hash' promise returned more than one value/, "too many values"; 27 | }); 28 | -------------------------------------------------------------------------------- /t/warnings.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More; 5 | use Test::Warn; 6 | 7 | use Promises qw(deferred), 'warn_on_unhandled_reject' => [1]; 8 | 9 | warning_like { 10 | my $d = deferred(); 11 | $d->then(sub {die "boo"})->then(sub { 'stuff' }); 12 | $d->resolve; 13 | } qr!Promise's rejection.*boo.*at t/warnings.t line 11!s, "catch a die"; 14 | 15 | warning_like { 16 | my $d = deferred(); 17 | $d->then(sub { "boo"})->then(sub { 'stuff' }); 18 | $d->reject(1,2,3); 19 | } qr!Promise's rejection.*line 17!s, "catch regular reject"; 20 | 21 | warning_like { 22 | my $d = deferred(); 23 | $d->then(sub { "boo"})->then(sub { 'stuff' }); 24 | $d->reject(1,2,3); 25 | } qr!Promise's rejection \[ 1, 2, 3 \].*line 23!s, "nicely formatted single-line rejection dump"; 26 | 27 | 28 | done_testing; 29 | -------------------------------------------------------------------------------- /t/060-free-refs.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Promises 'deferred'; 4 | use Scalar::Util qw(weaken); 5 | use Test::More 0.89; 6 | 7 | my $count; 8 | my $cb; 9 | 10 | sub setup { 11 | $count = 0; 12 | $cb = sub { $count++ }; 13 | my $d = deferred; 14 | my $p = $d->promise; 15 | for ( 1 .. 5 ) { 16 | $p = $p->then( $cb, $cb ); 17 | } 18 | 19 | weaken $cb; 20 | return $d; 21 | } 22 | 23 | # Free resolve & reject on resolve() 24 | my $d = setup(); 25 | ok $cb, "Weakened ref exists pre-resolve"; 26 | 27 | $d->resolve(); 28 | 29 | is $count, 5, "Resolve successful"; 30 | ok !$cb, "Weakened ref freed post-resolve"; 31 | 32 | # Free resolve & reject on reject() 33 | $d = setup(); 34 | ok $cb, "Weakened ref exists pre-reject"; 35 | 36 | $d->reject(); 37 | 38 | is $count, 5, "Reject successful"; 39 | ok !$cb, "Weakened ref freed pos-reject"; 40 | 41 | done_testing; 42 | -------------------------------------------------------------------------------- /t/007_callable.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use lib 't/lib'; 7 | use Promises qw(deferred); 8 | use Test::Requires 'AE'; 9 | 10 | use AE; 11 | use Test::More; 12 | 13 | BEGIN { 14 | use_ok('Promises'); 15 | } 16 | 17 | my $cv = AE::cv; 18 | deferred->resolve('foo')->then($cv); 19 | is $cv->recv, 'foo', 'Resolve callable'; 20 | 21 | $cv = AE::cv; 22 | deferred->reject('foo')->then( undef, $cv ); 23 | is $cv->recv, 'foo', 'Reject callable'; 24 | 25 | $cv = AE::cv; 26 | deferred->resolve('foo')->finally($cv); 27 | is $cv->recv, 'foo', 'Resolve finally callable'; 28 | 29 | $cv = AE::cv; 30 | deferred->reject('foo')->finally($cv); 31 | is $cv->recv, 'foo', 'Reject finally callable'; 32 | 33 | $cv = AE::cv; 34 | deferred->resolve('foo')->done($cv); 35 | is $cv->recv, 'foo', 'Resolve done callable'; 36 | 37 | $cv = AE::cv; 38 | deferred->reject('foo')->done( undef, $cv ); 39 | is $cv->recv, 'foo', 'Reject done callable'; 40 | 41 | done_testing; 42 | 43 | -------------------------------------------------------------------------------- /t/004-error.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use lib 't/lib'; 7 | 8 | use Test::More; 9 | use Test::Requires 'AnyEvent'; 10 | 11 | use AnyEvent; 12 | use AsyncUtil qw[ delay_me_error ]; 13 | 14 | BEGIN { 15 | use_ok('Promises'); 16 | } 17 | 18 | my $cv = AnyEvent->condvar; 19 | my $p0 = delay_me_error( 0.1 ); 20 | 21 | $p0->then( 22 | sub { $cv->croak( 'We are expecting an error here, so this shouldn\'t be called' ) }, 23 | sub { $cv->send( 'ERROR', @_, $p0->status, $p0->result ) } 24 | ); 25 | 26 | diag "Delaying for 0.1 second ..."; 27 | 28 | is( $p0->status, Promises::Deferred->IN_PROGRESS, '... got the right status' ); 29 | 30 | is_deeply( 31 | [ $cv->recv ], 32 | [ 33 | 'ERROR', 34 | 'rejected after 0.1', 35 | Promises::Deferred->REJECTED, 36 | [ 'rejected after 0.1' ] 37 | ], 38 | '... got the expected values back' 39 | ); 40 | 41 | is( $p0->status, Promises::Deferred->REJECTED, '... got the right status' ); 42 | 43 | done_testing; 44 | -------------------------------------------------------------------------------- /example/mojo-promises.pl: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Mojo::UserAgent; 7 | use Mojo::IOLoop; 8 | 9 | 10 | { 11 | package Mojo::UserAgent::Promises; 12 | 13 | use strict; 14 | use warnings; 15 | 16 | use Promises qw[ deferred ]; 17 | 18 | use Mojo::Base 'Mojo::UserAgent'; 19 | 20 | sub start { 21 | my ($self, $tx, $cb) = @_; 22 | my $d = deferred; 23 | $self->SUPER::start( $tx, sub { $d->resolve( @_ ) }); 24 | return $d->then( $cb ) if $cb; 25 | return $d->promise; 26 | } 27 | } 28 | 29 | my $ua = Mojo::UserAgent::Promises->new; 30 | my $delay = Mojo::IOLoop->delay; 31 | my @titles; 32 | 33 | foreach my $url (qw[ mojolicious.org www.cpan.org ]) { 34 | my $end = $delay->begin; 35 | $ua->get($url)->then( 36 | sub { 37 | my ($ua, $tx) = @_; 38 | push @titles, $tx->res->dom->at('title')->text; 39 | $end->(); 40 | } 41 | ); 42 | } 43 | $delay->wait; 44 | 45 | print join "\n" => @titles; 46 | print "\n"; 47 | 48 | 1; 49 | 50 | __END__ 51 | -------------------------------------------------------------------------------- /t/011-collect-w-error.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use lib 't/lib'; 7 | 8 | use Test::More; 9 | use Test::Requires 'AnyEvent'; 10 | 11 | use AnyEvent; 12 | use AsyncUtil qw[ delay_me delay_me_error ]; 13 | 14 | BEGIN { 15 | use_ok('Promises', 'collect'); 16 | } 17 | 18 | my $cv = AnyEvent->condvar; 19 | 20 | my $p0 = delay_me_error( 0.1 ); 21 | my $p1 = delay_me( 0.2 ); 22 | 23 | collect( $p0, $p1 )->then( 24 | sub { $cv->croak( 'We are expecting an error here, so this shouldn\'t be called' ) }, 25 | sub { $cv->send( 'ERROR' ) } 26 | ); 27 | 28 | diag "Delaying for 0.2 seconds ..."; 29 | 30 | is( $p0->status, Promises::Deferred->IN_PROGRESS, '... got the right status in promise 0' ); 31 | is( $p1->status, Promises::Deferred->IN_PROGRESS, '... got the right status in promise 1' ); 32 | 33 | is_deeply( 34 | [ $cv->recv ], 35 | [ 'ERROR' ], 36 | '... got the expected values back' 37 | ); 38 | 39 | is( $p0->status, Promises::Deferred->REJECTED, '... got the right status in promise 0' ); 40 | is( $p1->status, Promises::Deferred->IN_PROGRESS, '... got the right status in promise 1' ); 41 | 42 | done_testing; 43 | -------------------------------------------------------------------------------- /t/013-collect_hash-with-error.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use lib 't/lib'; 7 | 8 | use Test::More; 9 | use Test::Requires 'AnyEvent'; 10 | 11 | use AnyEvent; 12 | use AsyncUtil qw[ delay_me delay_me_error ]; 13 | 14 | use Promises 'collect_hash', 'resolved'; 15 | 16 | my $cv = AnyEvent->condvar; 17 | 18 | my $p0 = delay_me_error( 0.1 ); 19 | my $p1 = delay_me( 0.2 ); 20 | 21 | collect_hash( p0 => $p0, p1 => $p1 )->then( 22 | sub { $cv->croak( 'We are expecting an error here, so this shouldn\'t be called' ) }, 23 | sub { $cv->send( 'ERROR' ) } 24 | ); 25 | 26 | diag "Delaying for 0.2 seconds ..."; 27 | 28 | is( $p0->status, Promises::Deferred->IN_PROGRESS, '... got the right status in promise 0' ); 29 | is( $p1->status, Promises::Deferred->IN_PROGRESS, '... got the right status in promise 1' ); 30 | 31 | is_deeply( 32 | [ $cv->recv ], 33 | [ 'ERROR' ], 34 | '... got the expected values back' 35 | ); 36 | 37 | is( $p0->status, Promises::Deferred->REJECTED, '... got the right status in promise 0' ); 38 | is( $p1->status, Promises::Deferred->IN_PROGRESS, '... got the right status in promise 1' ); 39 | 40 | done_testing; 41 | -------------------------------------------------------------------------------- /t/090-timeout.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More; 5 | use Test::Requires 'IO::Async'; 6 | 7 | use lib 't/lib'; 8 | use Promises::Test; 9 | 10 | use Promises 'deferred', 'collect'; 11 | 12 | # EV needs to be at the end 13 | subtest $_, \&test_me, $_ for qw/ 14 | AnyEvent 15 | IO::Async 16 | AE 17 | Mojo 18 | EV 19 | /; 20 | 21 | sub test_me { 22 | my $backend = shift; 23 | 24 | $backend = Promises::Test::backend( $backend ) 25 | or plan skip_all => $@ =~ /^(.*)/; 26 | 27 | plan tests => 6; 28 | 29 | my $p1 = deferred(); 30 | my $p2 = $p1->timeout(1); 31 | my $p3 = $p1->then(sub { is_deeply \@_, [ 'gotcha' ], 'p3 resolved' }); 32 | my $p4 = $p1->timeout(2)->then(sub { is $_[0] => 'gotcha', 'p4 resolved' }); 33 | 34 | collect($p3,$p4)->then(sub{ $backend->stop }); 35 | 36 | ok $p1->is_in_progress; 37 | ok $p2->is_in_progress; 38 | 39 | $p2->catch(sub { 40 | is $_[0] => 'timeout', 'timed out'; 41 | ok $p1->is_in_progress, "p1 still in progress"; 42 | $p1->resolve('gotcha'); 43 | }); 44 | 45 | $backend->start; 46 | } 47 | 48 | done_testing; 49 | 50 | -------------------------------------------------------------------------------- /example/chaining-example.pl: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use AnyEvent::HTTP; 7 | use JSON::XS qw[ decode_json ]; 8 | use URL::Encode qw[ url_encode ]; 9 | use Promises qw[ collect ]; 10 | 11 | sub fetch_it { 12 | my ($uri) = @_; 13 | my $d = Promises::Deferred->new; 14 | http_get $uri => sub { $d->resolve( decode_json( $_[0] ) ) }; 15 | $d->promise; 16 | } 17 | 18 | my $cv = AnyEvent->condvar; 19 | 20 | fetch_it( 21 | 'http://en.wikipedia.org/w/api.php?action=opensearch&format=json&search=' . url_encode( $ARGV[0] ) 22 | )->then( 23 | sub { 24 | my $data = shift; 25 | collect( 26 | map { 27 | fetch_it( 28 | 'http://en.wikipedia.org/w/api.php?action=query&format=json&titles=' 29 | . url_encode( $_ ) 30 | . '&prop=info&inprop=url' 31 | ) 32 | } @{ $data->[1] } 33 | ); 34 | }, 35 | sub { $cv->croak( 'ERROR' ) } 36 | )->then( 37 | sub { $cv->send( map { (values %{ $_->[0]->{'query'}->{'pages'} })[0]->{'fullurl'} } @_ ) }, 38 | sub { $cv->croak( 'ERROR' ) } 39 | ); 40 | 41 | use Data::Dumper; warn Dumper [ $cv->recv ]; -------------------------------------------------------------------------------- /t/001-basic.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use lib 't/lib'; 7 | 8 | use Test::Requires 'AnyEvent'; 9 | 10 | use Test::More; 11 | use AnyEvent; 12 | use AsyncUtil qw[ delay_me ]; 13 | 14 | BEGIN { 15 | use_ok('Promises'); 16 | } 17 | 18 | my $cv = AnyEvent->condvar; 19 | my $p0 = delay_me( 0.1 ); 20 | 21 | $p0->then( 22 | sub { $cv->send( 'ZERO', @_, $p0->status, $p0->result ) }, 23 | sub { $cv->croak( 'ERROR' ) } 24 | ); 25 | 26 | diag "Delaying for 0.1 second ..."; 27 | 28 | is( $p0->status, Promises::Deferred->IN_PROGRESS, '... got the right status' ); 29 | 30 | is_deeply( 31 | [ $cv->recv ], 32 | [ 33 | 'ZERO', 34 | 'resolved after 0.1', 35 | Promises::Deferred->RESOLVED, 36 | [ 'resolved after 0.1' ] 37 | ], 38 | '... got the expected values back' 39 | ); 40 | 41 | is( $p0->status, Promises::Deferred->RESOLVED, '... got the right status' ); 42 | 43 | subtest 'checking predicates' => sub { 44 | # should be true 45 | ok $p0->$_, $_ for qw/ is_resolved is_fulfilled is_done /; 46 | 47 | # should be false 48 | ok !$p0->$_, $_ for qw/ is_rejected is_unfulfilled is_in_progress /; 49 | }; 50 | 51 | done_testing; 52 | -------------------------------------------------------------------------------- /t/lib/AsyncUtil.pm: -------------------------------------------------------------------------------- 1 | package AsyncUtil; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Promises qw[ deferred ]; 7 | use AnyEvent; 8 | 9 | use Sub::Exporter -setup => { 10 | exports => [qw[ 11 | delay_me 12 | delay_me_error 13 | perform_asyncly 14 | ]] 15 | }; 16 | 17 | sub perform_asyncly { 18 | my ($input, $callback) = @_; 19 | my $d = deferred; 20 | my $w; 21 | $w = AnyEvent->timer( 22 | after => 0, 23 | cb => sub { 24 | $d->resolve( $callback->( $input ) ); 25 | undef $w; 26 | } 27 | ); 28 | $d->promise; 29 | } 30 | 31 | sub delay_me { 32 | my $duration = shift; 33 | my $d = deferred; 34 | my $w; 35 | $w = AnyEvent->timer( 36 | after => $duration, 37 | cb => sub { 38 | $d->resolve( 'resolved after ' . $duration ); 39 | undef $w; 40 | } 41 | ); 42 | $d->promise; 43 | } 44 | 45 | sub delay_me_error { 46 | my $duration = shift; 47 | my $d = deferred; 48 | my $w; 49 | $w = AnyEvent->timer( 50 | after => $duration, 51 | cb => sub { 52 | $d->reject( 'rejected after ' . $duration ); 53 | undef $w; 54 | } 55 | ); 56 | $d->promise; 57 | } 58 | 59 | 1; -------------------------------------------------------------------------------- /t/045-attributes.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More tests => 3; 5 | use Test::Exception; 6 | 7 | use Promises 'deferred'; 8 | use parent 'Promises::Sub'; 9 | 10 | use Promises::Sub qw/ defer /; 11 | 12 | 13 | sub shall_concat :Defer { 14 | join ' ', @_; 15 | } 16 | 17 | my @promises = map { deferred } 1..2; 18 | 19 | my @results = ( 20 | shall_concat( @promises ), 21 | shall_concat( 'that is', $promises[1] ), 22 | shall_concat( 'this is', 'straight up' ), 23 | ); 24 | 25 | my @test_results; 26 | $_->then(sub { push @test_results, @_ } ) for @results; 27 | 28 | is_deeply \@test_results, [ 'this is straight up' ]; 29 | 30 | $promises[1]->resolve( 'delayed' ); 31 | 32 | $promises[0]->resolve( 'finally the last one, that was' ); 33 | 34 | is_deeply \@test_results, [ 35 | 'this is straight up', 36 | 'that is delayed', 37 | 'finally the last one, that was delayed', 38 | ]; 39 | 40 | subtest defer => sub { 41 | my $promised_sub = defer sub { 42 | join ' ', @_; 43 | }; 44 | 45 | my $p1 = deferred; 46 | 47 | my @result; 48 | $promised_sub->( 'hello', $p1 )->then( sub { 49 | push @result, shift; 50 | } ); 51 | 52 | is_deeply \@result, [], 'nothing yet'; 53 | 54 | $p1->resolve('world'); 55 | is_deeply \@result, ['hello world'], 'resolved'; 56 | }; 57 | -------------------------------------------------------------------------------- /cpanfile: -------------------------------------------------------------------------------- 1 | # This file is generated by Dist::Zilla::Plugin::CPANFile v6.033 2 | # Do not edit this file directly. To change prereqs, edit the `dist.ini` file. 3 | 4 | requires "Carp" => "0"; 5 | requires "Data::Dumper" => "0"; 6 | requires "Exporter" => "0"; 7 | requires "Module::Runtime" => "0"; 8 | requires "Scalar::Util" => "0"; 9 | requires "Sub::Attribute" => "0"; 10 | requires "Sub::Exporter" => "0"; 11 | requires "constant" => "0"; 12 | requires "parent" => "0"; 13 | requires "strict" => "0"; 14 | requires "warnings" => "0"; 15 | 16 | on 'test' => sub { 17 | requires "ExtUtils::MakeMaker" => "0"; 18 | requires "File::Spec" => "0"; 19 | requires "IO::Handle" => "0"; 20 | requires "IPC::Open3" => "0"; 21 | requires "Test::Exception" => "0"; 22 | requires "Test::Fatal" => "0"; 23 | requires "Test::More" => "0.89"; 24 | requires "Test::Pod" => "0"; 25 | requires "Test::Requires" => "0"; 26 | requires "Test::Warn" => "0"; 27 | requires "lib" => "0"; 28 | requires "perl" => "5.006"; 29 | }; 30 | 31 | on 'test' => sub { 32 | recommends "CPAN::Meta" => "2.120900"; 33 | }; 34 | 35 | on 'configure' => sub { 36 | requires "ExtUtils::MakeMaker" => "0"; 37 | }; 38 | 39 | on 'configure' => sub { 40 | suggests "JSON::PP" => "2.27300"; 41 | }; 42 | 43 | on 'develop' => sub { 44 | requires "Test::More" => "0.96"; 45 | requires "Test::Vars" => "0"; 46 | }; 47 | -------------------------------------------------------------------------------- /t/003-post-resolve-then.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use lib 't/lib'; 7 | 8 | use Test::More; 9 | use Test::Requires 'AnyEvent'; 10 | 11 | use AnyEvent; 12 | use AsyncUtil qw[ delay_me ]; 13 | 14 | BEGIN { 15 | use_ok('Promises'); 16 | } 17 | 18 | my $cv0 = AnyEvent->condvar; 19 | my $cv1 = AnyEvent->condvar; 20 | 21 | my $p0 = delay_me( 0.1 ); 22 | 23 | $p0->then( 24 | sub { $cv0->send( 'ZERO', @_, $p0->status, $p0->result ) }, 25 | sub { $cv0->croak( 'ERROR' ) } 26 | ); 27 | 28 | diag "Delaying for 0.1 second1 ..."; 29 | 30 | is( $p0->status, Promises::Deferred->IN_PROGRESS, '... got the right status in promise 0' ); 31 | 32 | is_deeply( 33 | [ $cv0->recv ], 34 | [ 35 | 'ZERO', 36 | 'resolved after 0.1', 37 | Promises::Deferred->RESOLVED, 38 | [ 'resolved after 0.1' ] 39 | ], 40 | '... got the expected values back' 41 | ); 42 | 43 | is( $p0->status, Promises::Deferred->RESOLVED, '... got the right status in promise 0' ); 44 | 45 | $p0->then( 46 | sub { $cv1->send( 'ONE', @_, $p0->status, $p0->result ) }, 47 | sub { $cv1->croak( 'ERROR' ) } 48 | ); 49 | 50 | is_deeply( 51 | [ $cv1->recv ], 52 | [ 53 | 'ONE', 54 | 'resolved after 0.1', 55 | Promises::Deferred->RESOLVED, 56 | [ 'resolved after 0.1' ] 57 | ], 58 | '... got the expected values back' 59 | ); 60 | 61 | is( $p0->status, Promises::Deferred->RESOLVED, '... got the right status in promise 0' ); 62 | 63 | done_testing; 64 | -------------------------------------------------------------------------------- /t/012-collect_hash.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use lib 't/lib'; 7 | 8 | use Test::More; 9 | use Test::Requires 'AnyEvent'; 10 | 11 | use AnyEvent; 12 | use AsyncUtil qw[ delay_me ]; 13 | 14 | use Promises qw/ collect_hash deferred /; 15 | 16 | my $cv = AnyEvent->condvar; 17 | 18 | my $p0 = delay_me( 0.1 ); 19 | my $p1 = delay_me( 0.2 ); 20 | 21 | collect_hash( p0 => $p0, p1 => $p1, p3 => 'constant' )->then( 22 | sub { $cv->send( @_ ) }, 23 | sub { $cv->croak( 'ERROR' ) } 24 | ); 25 | 26 | diag "Delaying for 0.2 seconds ..."; 27 | 28 | is( $p0->status, Promises::Deferred->IN_PROGRESS, '... got the right status in promise 0' ); 29 | is( $p1->status, Promises::Deferred->IN_PROGRESS, '... got the right status in promise 1' ); 30 | 31 | is_deeply( 32 | [ $cv->recv ], 33 | [ 34 | p0 => 'resolved after 0.1' , 35 | p1 => 'resolved after 0.2' , 36 | p3 => 'constant', 37 | ] , 38 | '... got the expected values back' 39 | ); 40 | 41 | is( $p0->status, Promises::Deferred->RESOLVED, '... got the right status in promise 0' ); 42 | is( $p1->status, Promises::Deferred->RESOLVED, '... got the right status in promise 1' ); 43 | 44 | $p0 = collect_hash( bar => deferred->resolve('foo')->promise )->then( 45 | sub { 46 | is shift()->[0], 'foo', 'Presolved collect'; 47 | } 48 | ); 49 | 50 | $p0 = collect_hash( bar => deferred->reject('foo')->promise )->catch( 51 | sub { 52 | is shift(), 'foo', 'Prerejected collect'; 53 | } 54 | ); 55 | 56 | 57 | 58 | done_testing; 59 | -------------------------------------------------------------------------------- /t/002-multiples.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use lib 't/lib'; 7 | 8 | use Test::Requires 'AnyEvent'; 9 | 10 | use Test::More; 11 | use AnyEvent; 12 | use AsyncUtil qw[ delay_me ]; 13 | 14 | BEGIN { 15 | use_ok('Promises'); 16 | } 17 | 18 | my $cv0 = AnyEvent->condvar; 19 | my $cv1 = AnyEvent->condvar; 20 | 21 | my $p0 = delay_me( 0.1 ); 22 | my $p1 = delay_me( 0.2 ); 23 | 24 | $p1->then( 25 | sub { $cv1->send( 'ONE', @_, $p1->status, $p1->result ) }, 26 | sub { $cv1->croak( 'ERROR' ) } 27 | ); 28 | 29 | $p0->then( 30 | sub { $cv0->send( 'ZERO', @_, $p0->status, $p0->result ) }, 31 | sub { $cv0->croak( 'ERROR' ) } 32 | ); 33 | 34 | diag "Delaying for 0.1 second ..."; 35 | 36 | is( $p0->status, Promises::Deferred->IN_PROGRESS, '... got the right status in promise 0' ); 37 | is( $p1->status, Promises::Deferred->IN_PROGRESS, '... got the right status in promise 1' ); 38 | 39 | is_deeply( 40 | [ $cv0->recv ], 41 | [ 42 | 'ZERO', 43 | 'resolved after 0.1', 44 | Promises::Deferred->RESOLVED, 45 | [ 'resolved after 0.1' ] 46 | ], 47 | '... got the expected values back' 48 | ); 49 | 50 | diag "Delaying for 0.1 more second ..."; 51 | 52 | is_deeply( 53 | [ $cv1->recv ], 54 | [ 55 | 'ONE', 56 | 'resolved after 0.2', 57 | Promises::Deferred->RESOLVED, 58 | [ 'resolved after 0.2' ] 59 | ], 60 | '... got the expected values back' 61 | ); 62 | 63 | is( $p0->status, Promises::Deferred->RESOLVED, '... got the right status in promise 0' ); 64 | is( $p1->status, Promises::Deferred->RESOLVED, '... got the right status in promise 1' ); 65 | 66 | done_testing; 67 | -------------------------------------------------------------------------------- /t/005-multiples-w-error.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use lib 't/lib'; 7 | 8 | use Test::More; 9 | use Test::Requires 'AnyEvent'; 10 | 11 | use AnyEvent; 12 | use AsyncUtil qw[ delay_me delay_me_error ]; 13 | 14 | BEGIN { 15 | use_ok('Promises'); 16 | } 17 | 18 | my $cv0 = AnyEvent->condvar; 19 | my $cv1 = AnyEvent->condvar; 20 | 21 | my $p0 = delay_me_error( 0.1 ); 22 | my $p1 = delay_me( 0.2 ); 23 | 24 | $p1->then( 25 | sub { $cv1->send( 'ONE', @_, $p1->status, $p1->result ) }, 26 | sub { $cv1->croak( 'ERROR' ) } 27 | ); 28 | 29 | $p0->then( 30 | sub { $cv0->croak( 'We are expecting an error here, so this shouldn\'t be called' ) }, 31 | sub { $cv0->send( 'ERROR', @_, $p0->status, $p0->result ) } 32 | ); 33 | 34 | diag "Delaying for 0.1 second ..."; 35 | 36 | is( $p0->status, Promises::Deferred->IN_PROGRESS, '... got the right status in promise 0' ); 37 | is( $p1->status, Promises::Deferred->IN_PROGRESS, '... got the right status in promise 1' ); 38 | 39 | is_deeply( 40 | [ $cv0->recv ], 41 | [ 42 | 'ERROR', 43 | 'rejected after 0.1', 44 | Promises::Deferred->REJECTED, 45 | [ 'rejected after 0.1' ] 46 | ], 47 | '... got the expected values back' 48 | ); 49 | 50 | diag "Delaying for 0.1 more second ..."; 51 | 52 | is_deeply( 53 | [ $cv1->recv ], 54 | [ 55 | 'ONE', 56 | 'resolved after 0.2', 57 | Promises::Deferred->RESOLVED, 58 | [ 'resolved after 0.2' ] 59 | ], 60 | '... got the expected values back' 61 | ); 62 | 63 | is( $p0->status, Promises::Deferred->REJECTED, '... got the right status in promise 0' ); 64 | is( $p1->status, Promises::Deferred->RESOLVED, '... got the right status in promise 1' ); 65 | 66 | done_testing; 67 | -------------------------------------------------------------------------------- /t/010-collect.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use lib 't/lib'; 7 | 8 | use Test::More tests => 10; 9 | use Test::Requires 'AnyEvent'; 10 | 11 | use AnyEvent; 12 | use AsyncUtil qw[ delay_me ]; 13 | 14 | BEGIN { 15 | use_ok( 'Promises', 'collect', 'deferred' ); 16 | } 17 | 18 | my $cv = AnyEvent->condvar; 19 | 20 | my $p0 = delay_me( 0.1 ); 21 | my $p1 = delay_me( 0.2 ); 22 | 23 | collect( $p0, $p1 )->then( 24 | sub { $cv->send( @_ ) }, 25 | sub { $cv->croak( 'ERROR' ) } 26 | ); 27 | 28 | diag "Delaying for 0.2 seconds ..."; 29 | 30 | is( $p0->status, Promises::Deferred->IN_PROGRESS, '... got the right status in promise 0' ); 31 | is( $p1->status, Promises::Deferred->IN_PROGRESS, '... got the right status in promise 1' ); 32 | 33 | is_deeply( 34 | [ $cv->recv ], 35 | [ 36 | [ 'resolved after 0.1' ], 37 | [ 'resolved after 0.2' ] 38 | ], 39 | '... got the expected values back' 40 | ); 41 | 42 | is( $p0->status, Promises::Deferred->RESOLVED, '... got the right status in promise 0' ); 43 | is( $p1->status, Promises::Deferred->RESOLVED, '... got the right status in promise 1' ); 44 | 45 | $p0 = collect( deferred->resolve('foo')->promise )->then( 46 | sub { 47 | is shift()->[0], 'foo', 'Presolved collect'; 48 | } 49 | ); 50 | 51 | $p0 = collect( deferred->reject('foo')->promise )->catch( 52 | sub { 53 | is shift(), 'foo', 'Prerejected collect'; 54 | } 55 | ); 56 | 57 | collect( deferred->resolve('foo')->promise, 'bar' )->then( 58 | sub { 59 | is_deeply \@_, [ [ 'foo' ], [ 'bar' ] ], 'collect with non-promises'; 60 | } 61 | ); 62 | 63 | subtest "empty collect" => sub { 64 | collect()->then( sub { 65 | is scalar @_, 0, "empty array"; 66 | }); 67 | }; 68 | -------------------------------------------------------------------------------- /t/053-exceptions-mojo.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use lib 't/lib'; 7 | use NoEV; 8 | use Test::More; 9 | use Test::Fatal; 10 | 11 | use Test::Requires 'Mojo::IOLoop'; 12 | 13 | use Promises qw/deferred/, backend => ["Mojo"]; 14 | 15 | my @out; 16 | 17 | is( exception { 18 | a_promise() 19 | 20 | # Resolve 21 | ->then( sub {"1: OK"} ) 22 | 23 | # Resolve then die 24 | ->then( sub { push @out, @_; die "2: OK\n" } ) 25 | 26 | # Reject and resolve 27 | ->then( 28 | sub { push @out, "2: Not OK" }, 29 | sub { push @out, @_; "3: OK" } 30 | ) 31 | 32 | # Resolve then die 33 | ->then( 34 | sub { push @out, @_; die "4: OK\n" }, 35 | sub { push @out, @_, "3: Not OK" } 36 | ) 37 | 38 | # Reject then die 39 | ->then( 40 | sub { push @out, "4: Not OK" }, 41 | sub { push @out, @_; die "5: OK\n" } 42 | ) 43 | 44 | # done then die 45 | ->done( 46 | sub { push @out, "4: Not OK" }, 47 | sub { push @out, @_; die "Final\n" } 48 | ); 49 | 50 | Mojo::IOLoop->timer( 0.3, sub { Mojo::IOLoop->stop } ); 51 | Mojo::IOLoop->start; 52 | }, 53 | undef, 54 | "Exception in Mojo done is swallowed" 55 | ); 56 | 57 | is $out[0], '1: OK', "Resolve"; 58 | is $out[1], "2: OK\n", "Resolve then die"; 59 | is $out[2], '3: OK', "Reject then resolve"; 60 | is $out[3], "4: OK\n", "Resolve then die"; 61 | is $out[4], "5: OK\n", "Reject then die"; 62 | 63 | #=================================== 64 | sub a_promise { 65 | #=================================== 66 | my $d = deferred; 67 | Mojo::IOLoop->timer( 0, sub { $d->resolve('OK') } ); 68 | $d->promise; 69 | } 70 | 71 | done_testing; 72 | -------------------------------------------------------------------------------- /lib/Promises/Deferred/IO/Async.pm: -------------------------------------------------------------------------------- 1 | package Promises::Deferred::IO::Async; 2 | # ABSTRACT: IO::Async implementation of Promises 3 | 4 | use strict; 5 | use warnings; 6 | 7 | use IO::Async::Loop; 8 | use IO::Async::Timer::Countdown; 9 | 10 | use parent 'Promises::Deferred'; 11 | 12 | our $Loop = IO::Async::Loop->new; 13 | 14 | # Before the 'later'-based approach used below, there was an 15 | # Async::IO::Timer::Countdown based approach for _notify_backend. 16 | # The current code is much more performant: 17 | 18 | # Original code 19 | # Backend: Promises::Deferred::IO::Async 20 | # Benchmark: running one, two for at least 10 CPU seconds... 21 | # one: 41 wallclock secs @ 815.48/s (n=8954) 22 | # two: 31 wallclock secs @ 373.39/s (n=3760) 23 | 24 | # New approach: 25 | # Backend: Promises::Deferred::IO::Async 26 | # Benchmark: running one, two for at least 10 CPU seconds... 27 | # one: 11 wallclock secs @ 8436.69/s (n=88754) 28 | # two: 10 wallclock secs @ 3150.85/s (n=33273) 29 | 30 | 31 | sub _notify_backend { 32 | my ( $self, $callbacks, $result ) = @_; 33 | $Loop->later(sub { $_->(@$result) for @$callbacks; }); 34 | } 35 | 36 | sub _timeout { 37 | my ( $self, $timeout, $callback ) = @_; 38 | 39 | my $timer = IO::Async::Timer::Countdown->new( 40 | delay => $timeout, 41 | on_expire => $callback, 42 | ); 43 | 44 | $Loop->add( $timer->start ); 45 | 46 | return sub { $timer->stop }; 47 | } 48 | 49 | 1; 50 | 51 | __END__ 52 | 53 | =head1 SYNOPSIS 54 | 55 | use Promises backend => ['IO::Async'], qw[ deferred collect ]; 56 | 57 | # ... everything else is the same 58 | 59 | =head1 DESCRIPTION 60 | 61 | Uses L as the async engine for the promises. 62 | 63 | The L loop used by default is the one given by 64 | C<new>>. It can be queried and modified via the global 65 | variable C<$Promises::Deferred::IO::Async::Loop>. 66 | 67 | 68 | =cut 69 | 70 | -------------------------------------------------------------------------------- /t/051-exceptions-pp-anyevent.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use lib 't/lib'; 7 | use NoEV; 8 | use Test::More; 9 | use Test::Fatal; 10 | 11 | use Test::Requires 'AnyEvent'; 12 | 13 | use Promises 'deferred', backend => ['AnyEvent']; 14 | 15 | my @out; 16 | 17 | my $cv = AE::cv; 18 | is( exception { 19 | a_promise() 20 | 21 | # Resolve 22 | ->then( sub {"1: OK"} ) 23 | 24 | # Resolve then die 25 | ->then( sub { push @out, @_; die "2: OK\n" } ) 26 | 27 | # Reject and resolve 28 | ->then( 29 | sub { push @out, "2: Not OK" }, 30 | sub { push @out, @_; "3: OK" } 31 | ) 32 | 33 | # Resolve then die 34 | ->then( 35 | sub { push @out, @_; die "4: OK\n" }, 36 | sub { push @out, @_, "3: Not OK" } 37 | ) 38 | 39 | # Reject then die 40 | ->then( 41 | sub { push @out, "4: Not OK" }, 42 | sub { push @out, @_; die "5: OK\n" } 43 | ) 44 | 45 | # done then die 46 | ->done( 47 | sub { push @out, "4: Not OK" }, 48 | sub { push @out, @_; die "Final\n" } 49 | ); 50 | 51 | my $w = AE::timer( 1, 0, sub { $cv->send } ); 52 | $cv->recv; 53 | }, 54 | "Final\n", 55 | "Exception in AnyEvent PP done dies" 56 | ); 57 | 58 | is $out[0], '1: OK', "Resolve"; 59 | is $out[1], "2: OK\n", "Resolve then die"; 60 | is $out[2], '3: OK', "Reject then resolve"; 61 | is $out[3], "4: OK\n", "Resolve then die"; 62 | is $out[4], "5: OK\n", "Reject then die"; 63 | 64 | 65 | #=================================== 66 | sub a_promise { 67 | #=================================== 68 | my $d = deferred; 69 | my $w; 70 | $w = AnyEvent->timer( 71 | after => 0, 72 | cb => sub { 73 | $d->resolve('OK'); 74 | undef $w; 75 | } 76 | ); 77 | $d->promise; 78 | } 79 | 80 | done_testing; 81 | -------------------------------------------------------------------------------- /t/052-exceptions-ev-anyevent.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use lib 't/lib'; 7 | use Test::More; 8 | use Test::Fatal; 9 | 10 | use Test::Requires 'EV'; 11 | use Test::Requires 'AnyEvent'; 12 | 13 | use Promises 'deferred', backend => ['EV']; 14 | 15 | my @out; 16 | 17 | my $cv = AE::cv; 18 | is( exception { 19 | a_promise() 20 | 21 | # Resolve 22 | ->then( sub {"1: OK"} ) 23 | 24 | # Resolve then die 25 | ->then( sub { push @out, @_; die "2: OK\n" } ) 26 | 27 | # Reject and resolve 28 | ->then( 29 | sub { push @out, "2: Not OK" }, 30 | sub { push @out, @_; "3: OK" } 31 | ) 32 | 33 | # Resolve then die 34 | ->then( 35 | sub { push @out, @_; die "4: OK\n" }, 36 | sub { push @out, @_, "3: Not OK" } 37 | ) 38 | 39 | # Reject then die 40 | ->then( 41 | sub { push @out, "4: Not OK" }, 42 | sub { push @out, @_; die "5: OK\n" } 43 | ) 44 | 45 | # done then die 46 | ->done( 47 | sub { push @out, "4: Not OK" }, 48 | sub { push @out, @_; die "Final\n" } 49 | ); 50 | 51 | my $w = AE::timer( 1, 0, sub { $cv->send } ); 52 | $cv->recv; 53 | }, 54 | undef, 55 | "Exception in EV done is swallowed" 56 | ); 57 | 58 | is $out[0], '1: OK', "Resolve"; 59 | is $out[1], "2: OK\n", "Resolve then die"; 60 | is $out[2], '3: OK', "Reject then resolve"; 61 | is $out[3], "4: OK\n", "Resolve then die"; 62 | is $out[4], "5: OK\n", "Reject then die"; 63 | 64 | #=================================== 65 | sub a_promise { 66 | #=================================== 67 | my $d = deferred; 68 | my $w; 69 | $w = AnyEvent->timer( 70 | after => 0, 71 | cb => sub { 72 | $d->resolve('OK'); 73 | undef $w; 74 | } 75 | ); 76 | $d->promise; 77 | } 78 | 79 | done_testing; 80 | -------------------------------------------------------------------------------- /MANIFEST: -------------------------------------------------------------------------------- 1 | CODE_OF_CONDUCT.md 2 | CONTRIBUTORS 3 | Changes 4 | INSTALL 5 | LICENSE 6 | MANIFEST 7 | META.json 8 | META.yml 9 | Makefile.PL 10 | README.md 11 | README.mkdn 12 | SIGNATURE 13 | cpanfile 14 | doap.xml 15 | example/chaining-example.pl 16 | example/example.pl 17 | example/mojo-promises.pl 18 | lib/Promises.pm 19 | lib/Promises/Cookbook/ChainingAndPipelining.pod 20 | lib/Promises/Cookbook/GentleIntro.pod 21 | lib/Promises/Cookbook/Recursion.pod 22 | lib/Promises/Cookbook/ScalaFuturesComparison.pod 23 | lib/Promises/Cookbook/SynopsisBreakdown.pod 24 | lib/Promises/Cookbook/TIMTOWTDI.pod 25 | lib/Promises/Deferred.pm 26 | lib/Promises/Deferred/AE.pm 27 | lib/Promises/Deferred/AnyEvent.pm 28 | lib/Promises/Deferred/EV.pm 29 | lib/Promises/Deferred/IO/Async.pm 30 | lib/Promises/Deferred/Mojo.pm 31 | lib/Promises/Promise.pm 32 | lib/Promises/Sub.pm 33 | t/00-compile.t 34 | t/00-report-prereqs.dd 35 | t/00-report-prereqs.t 36 | t/000-load.t 37 | t/001-basic.t 38 | t/002-multiples.t 39 | t/003-post-resolve-then.t 40 | t/004-error.t 41 | t/005-multiples-w-error.t 42 | t/006-thenable.t 43 | t/007_callable.t 44 | t/010-collect.t 45 | t/011-collect-w-error.t 46 | t/012-collect_hash.t 47 | t/013-collect_hash-params.t 48 | t/013-collect_hash-with-error.t 49 | t/020-chaining.t 50 | t/021-chaining-errors.t 51 | t/025-recursion.t 52 | t/030-deferred-default.t 53 | t/031-deferred-AE.t 54 | t/031-deferred-io-async.t 55 | t/032-deferred-AnyEvent.t 56 | t/033-deferred-EV.t 57 | t/034-deferred-Mojo.t 58 | t/040_finally.t 59 | t/045-attributes.t 60 | t/050-exceptions-pp.t 61 | t/051-exceptions-pp-anyevent.t 62 | t/052-exceptions-ev-anyevent.t 63 | t/053-exceptions-mojo.t 64 | t/060-free-refs.t 65 | t/070-accepted-rejected.t 66 | t/080-deferred-as-sub.t 67 | t/090-timeout.t 68 | t/late-warning.t 69 | t/lib/AsyncUtil.pm 70 | t/lib/NoEV.pm 71 | t/lib/Promises/Test.pm 72 | t/lib/Promises/Test/AE.pm 73 | t/lib/Promises/Test/AnyEvent.pm 74 | t/lib/Promises/Test/EV.pm 75 | t/lib/Promises/Test/IO/Async.pm 76 | t/lib/Promises/Test/Mojo.pm 77 | t/warnings.t 78 | xt/release/unused-vars.t 79 | -------------------------------------------------------------------------------- /t/050-exceptions-pp.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Test::More; 7 | use Test::Requires 'AnyEvent'; 8 | 9 | use lib 't/lib'; 10 | use NoEV; 11 | use AnyEvent; 12 | use Test::Fatal; 13 | 14 | BEGIN { 15 | if ( $^V lt "v5.14" ) { 16 | plan skip_all => 17 | 'Localizing $@ before Perl 5.14 clobbers the exception'; 18 | done_testing; 19 | exit; 20 | } 21 | use_ok 'Promises::Deferred'; 22 | } 23 | 24 | my @out; 25 | 26 | my $cv = AE::cv; 27 | is( exception { 28 | a_promise() 29 | 30 | # Resolve 31 | ->then( sub {"1: OK"} ) 32 | 33 | # Resolve then die 34 | ->then( sub { push @out, @_; die "2: OK\n" } ) 35 | 36 | # Reject and resolve 37 | ->then( 38 | sub { push @out, "2: Not OK" }, 39 | sub { push @out, @_; "3: OK" } 40 | ) 41 | 42 | # Resolve then die 43 | ->then( 44 | sub { push @out, @_; die "4: OK\n" }, 45 | sub { push @out, @_, "3: Not OK" } 46 | ) 47 | 48 | # Reject then die 49 | ->then( 50 | sub { push @out, "4: Not OK" }, 51 | sub { push @out, @_; die "5: OK\n" } 52 | ) 53 | 54 | # done then die 55 | ->done( 56 | sub { push @out, "4: Not OK" }, 57 | sub { push @out, @_; die "Final\n" } 58 | ); 59 | 60 | my $w = AE::timer( 1, 0, sub { $cv->send } ); 61 | $cv->recv; 62 | }, 63 | "Final\n", 64 | "Exception in PP done dies" 65 | ); 66 | 67 | is $out[0], '1: OK', "Resolve"; 68 | is $out[1], "2: OK\n", "Resolve then die"; 69 | is $out[2], '3: OK', "Reject then resolve"; 70 | is $out[3], "4: OK\n", "Resolve then die"; 71 | is $out[4], "5: OK\n", "Reject then die"; 72 | 73 | #=================================== 74 | sub a_promise { 75 | #=================================== 76 | my $d = Promises::Deferred->new; 77 | my $w; 78 | $w = AnyEvent->timer( 79 | after => 0, 80 | cb => sub { 81 | $d->resolve('OK'); 82 | undef $w; 83 | } 84 | ); 85 | $d->promise; 86 | } 87 | 88 | done_testing; 89 | -------------------------------------------------------------------------------- /t/021-chaining-errors.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Test::More; 7 | 8 | BEGIN { 9 | use_ok('Promises'); 10 | } 11 | 12 | # make sure chained promises bubble 13 | # to the right handlers 14 | 15 | Promises::Deferred->new->resolve("foo")->then( 16 | sub { 17 | my $result = shift; 18 | is($result, "foo", "... resolved foo"); 19 | return Promises::Deferred->new->reject("bar")->promise; 20 | } 21 | )->then( 22 | sub { fail("This should never be called") }, 23 | sub { 24 | my $result = shift; 25 | is($result, "bar", "... rejected bar"); 26 | } 27 | ); 28 | 29 | Promises::Deferred->new->resolve("foo")->then( 30 | sub { 31 | my $result = shift; 32 | is($result, "foo", "... resolved foo"); 33 | return Promises::Deferred->new->reject("bar")->promise; 34 | } 35 | )->then( 36 | sub { fail("This should never be called") }, 37 | )->then( 38 | sub { fail("This should never be called") }, 39 | )->then( 40 | sub { fail("This should never be called") }, 41 | )->then( 42 | sub { fail("This should never be called") }, 43 | sub { 44 | my $result = shift; 45 | is($result, "bar", "... rejected bar (at arbitrary depth)"); 46 | } 47 | ); 48 | 49 | # check the chaining of literal values as well ... 50 | 51 | Promises::Deferred->new->resolve("foo")->then( 52 | sub { 53 | my $result = shift; 54 | is($result, "foo", "... resolved foo"); 55 | "bar"; 56 | } 57 | )->then( 58 | sub { 59 | my $result = shift; 60 | is($result, "bar", "... chained-resolve bar"); 61 | } 62 | ); 63 | 64 | Promises::Deferred->new->reject("bar")->then( 65 | sub { fail("This should never be called") }, 66 | sub { 67 | my $result = shift; 68 | is($result, "bar", "... rejected bar"); 69 | die "foo\n"; 70 | } 71 | )->then( 72 | sub { fail("This should never be called") }, 73 | sub { 74 | my $result = shift; 75 | is($result, "foo\n", "... chained-reject foo"); 76 | "baz" 77 | } 78 | )->then( 79 | sub { 80 | my $result = shift; 81 | is($result, "baz", "... handled-reject baz"); 82 | }, 83 | sub { fail("This should never be called") }, 84 | ); 85 | 86 | 87 | done_testing; 88 | -------------------------------------------------------------------------------- /lib/Promises/Deferred/Mojo.pm: -------------------------------------------------------------------------------- 1 | package Promises::Deferred::Mojo; 2 | # ABSTRACT: An implementation of Promises in Perl 3 | 4 | use strict; 5 | use warnings; 6 | 7 | use Mojo::IOLoop; 8 | 9 | use parent 'Promises::Deferred'; 10 | 11 | 12 | # Before the next_tick-based approach used below, there was a 13 | # Mojo::IOLoop->timer()-based approach for _notify_backend. 14 | # The current code is more performant: 15 | 16 | # Original code (using the Mojo::Reactor::EV backend): 17 | # Backend: Promises::Deferred::Mojo 18 | # Benchmark: running one, two for at least 10 CPU seconds... 19 | # one: 46 wallclock secs @ 758.45/s (n=8032) 20 | # two: 44 wallclock secs @ 309.08/s (n=3097) 21 | 22 | 23 | # New approach: 24 | # Backend: Promises::Deferred::Mojo 25 | # Benchmark: running one, two for at least 10 CPU seconds... 26 | # one: 29 wallclock secs @ 1714.56/s (n=17197) 27 | # two: 24 wallclock secs @ 1184.80/s (n=12156) 28 | 29 | 30 | 31 | sub _notify_backend { 32 | my ( $self, $callbacks, $result ) = @_; 33 | Mojo::IOLoop->next_tick(sub { 34 | foreach my $cb (@$callbacks) { 35 | $cb->(@$result); 36 | } 37 | }); 38 | } 39 | 40 | sub _timeout { 41 | my ( $self, $timeout, $callback ) = @_; 42 | 43 | my $id = Mojo::IOLoop->timer( $timeout => $callback ); 44 | 45 | return sub { Mojo::IOLoop->remove($id) }; 46 | } 47 | 48 | 1; 49 | 50 | __END__ 51 | 52 | =head1 SYNOPSIS 53 | 54 | use Promises backend => ['Mojo'], qw[ deferred collect ]; 55 | 56 | # ... everything else is the same 57 | 58 | =head1 DESCRIPTION 59 | 60 | The "Promise/A+" spec strongly suggests that the callbacks 61 | given to C should be run asynchronously (meaning in the 62 | next turn of the event loop), this module provides support for 63 | doing so using the L module. 64 | 65 | Module authors should not care which event loop will be used but 66 | instead should just the Promises module directly: 67 | 68 | package MyClass; 69 | 70 | use Promises qw(deferred collect); 71 | 72 | End users of the module can specify which backend to use at the start of 73 | the application: 74 | 75 | use Promises -backend => ['Mojo']; 76 | use MyClass; 77 | 78 | B If you are using Mojolicious with the L event loop, then you 79 | should use the L backend instead. 80 | 81 | =cut 82 | 83 | -------------------------------------------------------------------------------- /lib/Promises/Cookbook/ChainingAndPipelining.pod: -------------------------------------------------------------------------------- 1 | package Promises::Cookbook::ChainingAndPipelining; 2 | 3 | # ABSTRACT: Examples of chaining/pipelining of asynchronous operations 4 | 5 | =pod 6 | 7 | =head1 SYNOPSIS 8 | 9 | my $cv = AnyEvent->condvar; 10 | 11 | fetch_it( 12 | 'http://rest.api.example.com/-/user/search?access_level=admin' 13 | )->then( 14 | sub { 15 | my $admins = shift; 16 | collect( 17 | map { 18 | fetch_it( 'http://rest.api.example.com/-/user/' . url_encode( $_->{user_id} ) ) 19 | } @$admins 20 | ); 21 | } 22 | )->then( 23 | sub { $cv->send( @_ ) }, 24 | sub { $cv->croak( 'ERROR' ) } 25 | ); 26 | 27 | my @all_admins = $cv->recv; 28 | 29 | =head1 DESCRIPTION 30 | 31 | So one of the real benefits of the Promise pattern is how it allows 32 | you to write code that flows and reads more like synchronous code 33 | by using the chaining nature of Promises. In example above we are 34 | first fetching a list of users whose access level is 'admin', in 35 | our fictional web-service we get back a list of JSON objects with 36 | only minimal information, just a user_id and full_name for instance. 37 | From here we can then loop through the results and fetch the full 38 | user object for each one of these users, passing all of the promises 39 | returned by C into C, which itself returns a promise. 40 | 41 | So despite being completely asynchronous, this code reads much like 42 | a blocking synchronous version would read, from top to bottom. 43 | 44 | my @all_admins; 45 | try { 46 | my $admins = fetch_it( 'http://rest.api.example.com/-/user/search?access_level=admin' ); 47 | @all_admins = map { 48 | fetch_it( 'http://rest.api.example.com/-/user/' . url_encode( $_->{user_id} ) ) 49 | } @$admins; 50 | } catch { 51 | die $_; 52 | }; 53 | # do something with @all_admins ... 54 | 55 | The only difference really are the C wrappers and the way in 56 | which we handle errors, but even that is very similar since we are 57 | not including an error callback in the first C and allowing 58 | the errors to bubble till the final C, which maps very closely 59 | to the C block. And of course the Promise version runs 60 | asynchronously and reaps all the benefits that brings. 61 | 62 | =cut 63 | 64 | __END__ 65 | -------------------------------------------------------------------------------- /t/020-chaining.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use lib 't/lib'; 7 | 8 | use Test::More; 9 | use Test::Requires 'AnyEvent'; 10 | 11 | use AnyEvent; 12 | use AsyncUtil qw[ perform_asyncly ]; 13 | 14 | BEGIN { 15 | use_ok('Promises'); 16 | } 17 | 18 | my $cv = AnyEvent->condvar; 19 | 20 | subtest 'with thens' => sub { 21 | 22 | perform_asyncly( 23 | 'The quick brown fox jumped over the lazy dog', 24 | sub { split /\s/ => shift } 25 | )->then( 26 | sub { 27 | my @words = @_; 28 | perform_asyncly( 29 | \@words, 30 | sub { map { lc $_ } @{ $_[0] } } 31 | ); 32 | } 33 | )->then( 34 | sub { 35 | my @lowercased = @_; 36 | perform_asyncly( 37 | \@lowercased, 38 | sub { sort { $a cmp $b } @{ $_[0] } } 39 | ) 40 | } 41 | )->then( 42 | sub { 43 | my @sorted = @_; 44 | perform_asyncly( 45 | \@sorted, 46 | sub { my %seen; grep { not $seen{$_}++ } @{ $_[0] } } 47 | ) 48 | } 49 | )->then( 50 | sub { $cv->send( @_ ) }, 51 | sub { $cv->croak( 'ERROR' ) } 52 | ); 53 | 54 | is_deeply( 55 | [ $cv->recv ], 56 | [ qw[ brown dog fox jumped lazy over quick the ] ], 57 | '... got the expected values back' 58 | ); 59 | 60 | }; 61 | 62 | subtest 'with chains' => sub { 63 | 64 | perform_asyncly( 65 | 'The quick brown fox jumped over the lazy dog', 66 | sub { split /\s/ => shift } 67 | )->chain( 68 | sub { 69 | my @words = @_; 70 | perform_asyncly( 71 | \@words, 72 | sub { map { lc $_ } @{ $_[0] } } 73 | ); 74 | }, 75 | sub { 76 | my @lowercased = @_; 77 | perform_asyncly( 78 | \@lowercased, 79 | sub { sort { $a cmp $b } @{ $_[0] } } 80 | ) 81 | }, 82 | sub { 83 | my @sorted = @_; 84 | perform_asyncly( 85 | \@sorted, 86 | sub { my %seen; grep { not $seen{$_}++ } @{ $_[0] } } 87 | ) 88 | }, 89 | sub { $cv->send( @_ ) }, 90 | )->catch( 91 | sub { $cv->croak( 'ERROR' ) } 92 | ); 93 | 94 | is_deeply( 95 | [ $cv->recv ], 96 | [ qw[ brown dog fox jumped lazy over quick the ] ], 97 | '... got the expected values back' 98 | ); 99 | 100 | }; 101 | 102 | done_testing; 103 | -------------------------------------------------------------------------------- /lib/Promises/Deferred/AE.pm: -------------------------------------------------------------------------------- 1 | package Promises::Deferred::AE; 2 | # ABSTRACT: An implementation of Promises in Perl 3 | 4 | use strict; 5 | use warnings; 6 | 7 | use AE; 8 | 9 | use parent 'Promises::Deferred'; 10 | 11 | # Before the pipe-based approach used below, there was an AE::postpone-based 12 | # approach for _notify_backend. The current code is much more performant: 13 | 14 | # Original code (on a laptop on battery power): 15 | # Backend: Promises::Deferred::AE 16 | # Benchmark: running one, two for at least 10 CPU seconds... 17 | # one: 44 wallclock secs @ 3083.99/s (n=31210) 18 | # two: 29 wallclock secs @ 1723.66/s (n=17340) 19 | 20 | # New approach: 21 | # Backend: Promises::Deferred::AE 22 | # Benchmark: running one, two for at least 10 CPU seconds... 23 | # one: 11 wallclock secs @ 10457.90/s (n=108553) 24 | # two: 11 wallclock secs @ 3878.69/s (n=40959) 25 | 26 | 27 | my ($socket_pid, $socket_send, $socket_recv, $socket_io, 28 | $read_buf, @io_callbacks); 29 | 30 | sub _do_callbacks { 31 | my @cbs = @io_callbacks; 32 | @io_callbacks = (); 33 | sysread $socket_recv, $read_buf, 16; 34 | for my $cb_grp (@cbs) { 35 | my ($result, $cbs) = @$cb_grp; 36 | my @r = @$result; 37 | $_->(@r) for @$cbs; 38 | } 39 | } 40 | 41 | sub _notify_backend { 42 | if (! $socket_pid || $socket_pid != $$) { 43 | $socket_pid = $$; 44 | close($socket_send) if defined $socket_send; 45 | close($socket_recv) if defined $socket_recv; 46 | pipe($socket_recv, $socket_send); 47 | $socket_io = AE::io($socket_recv, 0, \&_do_callbacks); 48 | } 49 | 50 | # skip signalling when there are callbacks already waiting 51 | if (not @io_callbacks) { 52 | syswrite $socket_send, ' '; 53 | } 54 | push @io_callbacks, [ $_[2], $_[1] ]; 55 | } 56 | 57 | sub _timeout { 58 | my ( $self, $timeout, $callback ) = @_; 59 | 60 | my $id = AE::timer $timeout, 0, $callback; 61 | 62 | return sub { undef $id }; 63 | } 64 | 65 | 1; 66 | 67 | __END__ 68 | 69 | =head1 SYNOPSIS 70 | 71 | use Promises backend => ['AE'], qw[ deferred collect ]; 72 | 73 | # ... everything else is the same 74 | 75 | =head1 DESCRIPTION 76 | 77 | The "Promise/A+" spec strongly suggests that the callbacks 78 | given to C should be run asynchronously (meaning in the 79 | next turn of the event loop), this module provides support for 80 | doing so using the L module. 81 | 82 | Module authors should not care which event loop will be used but 83 | instead should just the Promises module directly: 84 | 85 | package MyClass; 86 | 87 | use Promises qw(deferred collect); 88 | 89 | End users of the module can specify which backend to use at the start of 90 | the application: 91 | 92 | use Promises -backend => ['AE']; 93 | use MyClass; 94 | 95 | =cut 96 | 97 | -------------------------------------------------------------------------------- /lib/Promises/Deferred/EV.pm: -------------------------------------------------------------------------------- 1 | package Promises::Deferred::EV; 2 | # ABSTRACT: An implementation of Promises in Perl 3 | 4 | use strict; 5 | use warnings; 6 | 7 | use EV; 8 | 9 | use parent 'Promises::Deferred'; 10 | 11 | # Before the pipe-based approach used below, there was an EV::timer-based 12 | # approach for _notify_backend. The current code is much more performant: 13 | 14 | # Original code (on a laptop on battery power): 15 | # Backend: Promises::Deferred::EV 16 | # Benchmark: running one, two for at least 10 CPU seconds... 17 | # Benchmark: running one, two for at least 10 CPU seconds... 18 | # one: 67 wallclock secs @ 1755.16/s (n=17692) 19 | # two: 53 wallclock secs @ 770.03/s (n=7785) 20 | 21 | # New approach: 22 | # Backend: Promises::Deferred::EV 23 | # Benchmark: running one, two for at least 10 CPU seconds... 24 | # one: 10 wallclock secs @ 10949.19/s (n=115076) 25 | # two: 10 wallclock secs @ 3964.58/s (n=41747) 26 | 27 | 28 | my ($socket_pid, $socket_send, $socket_recv, $socket_io, 29 | $read_buf, @io_callbacks); 30 | 31 | sub _do_callbacks { 32 | my @cbs = @io_callbacks; 33 | @io_callbacks = (); 34 | sysread $socket_recv, $read_buf, 16; 35 | for my $cb_grp (@cbs) { 36 | my ($result, $cbs) = @$cb_grp; 37 | my @r = @$result; 38 | $_->(@r) for @$cbs; 39 | } 40 | } 41 | 42 | sub _notify_backend { 43 | if (! $socket_pid || $socket_pid != $$) { 44 | $socket_pid = $$; 45 | close($socket_send) if defined $socket_send; 46 | close($socket_recv) if defined $socket_recv; 47 | pipe($socket_recv, $socket_send); 48 | $socket_io = EV::io($socket_recv, EV::READ, \&_do_callbacks); 49 | $socket_io->keepalive(0); 50 | } 51 | 52 | # skip signalling when there are callbacks already waiting 53 | if (not @io_callbacks) { 54 | syswrite $socket_send, ' '; 55 | } 56 | push @io_callbacks, [ $_[2], $_[1] ]; 57 | } 58 | 59 | sub _timeout { 60 | my ( $self, $timeout, $callback ) = @_; 61 | 62 | my $id = EV::timer $timeout, 0, $callback; 63 | 64 | return sub { undef $id }; 65 | } 66 | 67 | 1; 68 | 69 | __END__ 70 | 71 | =head1 SYNOPSIS 72 | 73 | use Promises backend => ['EV'], qw[ deferred collect ]; 74 | 75 | # ... everything else is the same 76 | 77 | =head1 DESCRIPTION 78 | 79 | The "Promise/A+" spec strongly suggests that the callbacks 80 | given to C should be run asynchronously (meaning in the 81 | next turn of the event loop), this module provides support for 82 | doing so using the L module. 83 | 84 | Module authors should not care which event loop will be used but 85 | instead should just the Promises module directly: 86 | 87 | package MyClass; 88 | 89 | use Promises qw(deferred collect); 90 | 91 | End users of the module can specify which backend to use at the start of 92 | the application: 93 | 94 | use Promises -backend => ['EV']; 95 | use MyClass; 96 | 97 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Promises for Perl 2 | 3 | [![CPAN version](https://badge.fury.io/pl/Promises.svg)](https://metacpan.org/pod/Promises) 4 | 5 | This module is an implementation of the "Promise/A+" pattern for 6 | asynchronous programming. Promises are meant to be a way to 7 | better deal with the resulting callback spaghetti that can often 8 | result in asynchronous programs. 9 | 10 | ## SYNOPSIS 11 | 12 | ```perl 13 | use AnyEvent::HTTP; 14 | use JSON::XS qw[ decode_json ]; 15 | use Promises qw[ collect deferred ]; 16 | 17 | sub fetch_it { 18 | my ($uri) = @_; 19 | my $d = deferred; 20 | http_get $uri => sub { 21 | my ($body, $headers) = @_; 22 | $headers->{Status} == 200 23 | ? $d->resolve( decode_json( $body ) ) 24 | : $d->reject( $body ) 25 | }; 26 | $d->promise; 27 | } 28 | 29 | my $cv = AnyEvent->condvar; 30 | 31 | collect( 32 | fetch_it('http://rest.api.example.com/-/product/12345'), 33 | fetch_it('http://rest.api.example.com/-/product/suggestions?for_sku=12345'), 34 | fetch_it('http://rest.api.example.com/-/product/reviews?for_sku=12345'), 35 | )->then( 36 | sub { 37 | my ($product, $suggestions, $reviews) = @_; 38 | $cv->send({ 39 | product => $product, 40 | suggestions => $suggestions, 41 | reviews => $reviews, 42 | }) 43 | }, 44 | sub { $cv->croak( 'ERROR' ) } 45 | ); 46 | 47 | my $all_product_info = $cv->recv; 48 | ``` 49 | 50 | ## INSTALLATION 51 | 52 | To install this module from its CPAN tarball, type the following: 53 | 54 | perl Makefile.PL 55 | make 56 | make test 57 | make install 58 | 59 | 60 | If you cloned the github repo, the branch `releases` has the 61 | same code than the one living in CPAN, so the same `Makefile` 62 | dance will work. The` master` branch, however, needs to be built using 63 | Dist::Zilla: 64 | 65 | dzil install 66 | 67 | Be warned that the Dist::Zilla configuration is fine-tuned 68 | to my needs, so the dependency 69 | list to get it running is ludicrously huge. If you want a quick 70 | and dirty install, you can also do: 71 | 72 | git checkout releases -- Makefile.PL 73 | perl Makefile.PL 74 | make test 75 | make install 76 | 77 | ## DEPENDENCIES 78 | 79 | This module requires these other modules and libraries: 80 | 81 | Test::More 82 | 83 | This module optionally requires these other modules and libraries in 84 | order to support some specific features. 85 | 86 | AnyEvent 87 | Mojo::IOLoop 88 | EV 89 | IO::Async 90 | 91 | ## SEE ALSO 92 | 93 | - http://promises-aplus.github.io/promises-spec/ 94 | 95 | ## COPYRIGHT AND LICENCE 96 | 97 | Copyright (C) 2012-2014 Infinity Interactive, Inc. 98 | 99 | http://www.iinteractive.com 100 | 101 | This library is free software; you can redistribute it and/or modify 102 | it under the same terms as Perl itself. 103 | 104 | -------------------------------------------------------------------------------- /lib/Promises/Deferred/AnyEvent.pm: -------------------------------------------------------------------------------- 1 | package Promises::Deferred::AnyEvent; 2 | # ABSTRACT: An implementation of Promises in Perl 3 | 4 | use strict; 5 | use warnings; 6 | 7 | use AnyEvent; 8 | 9 | use parent 'Promises::Deferred'; 10 | 11 | # Before the pipe-based approach used below, there was an 12 | # AnyEvent->postpone-based approach for _notify_backend. 13 | # The current code is much more performant: 14 | 15 | # Original code (on a laptop on battery power): 16 | # Backend: Promises::Deferred::AnyEvent 17 | # Benchmark: running one, two for at least 10 CPU seconds... 18 | # one: 47 wallclock secs @ 2754.62/s (n=32780) 19 | # two: 37 wallclock secs @ 2450.45/s (n=24676) 20 | 21 | # New approach: 22 | # Backend: Promises::Deferred::AnyEvent 23 | # Benchmark: running one, two for at least 10 CPU seconds... 24 | # one: 10 wallclock secs @ 10182.12/s (n=106505) 25 | # two: 10 wallclock secs @ 3847.01/s (n=39855) 26 | 27 | 28 | my ($socket_pid, $socket_send, $socket_recv, $socket_io, 29 | $read_buf, @io_callbacks); 30 | 31 | sub _do_callbacks { 32 | my @cbs = @io_callbacks; 33 | @io_callbacks = (); 34 | sysread $socket_recv, $read_buf, 16; 35 | for my $cb_grp (@cbs) { 36 | my ($result, $cbs) = @$cb_grp; 37 | my @r = @$result; 38 | $_->(@r) for @$cbs; 39 | } 40 | } 41 | 42 | sub _notify_backend { 43 | if (! $socket_pid || $socket_pid != $$) { 44 | $socket_pid = $$; 45 | close($socket_send) if defined $socket_send; 46 | close($socket_recv) if defined $socket_recv; 47 | pipe($socket_recv, $socket_send); 48 | $socket_io = AnyEvent->io( 49 | fh => $socket_recv, 50 | poll => 'r', 51 | cb => \&_do_callbacks); 52 | } 53 | 54 | # skip signalling when there are callbacks already waiting 55 | if (not @io_callbacks) { 56 | syswrite $socket_send, ' '; 57 | } 58 | push @io_callbacks, [ $_[2], $_[1] ]; 59 | } 60 | 61 | sub _timeout { 62 | my ( $self, $timeout, $callback ) = @_; 63 | 64 | my $id = AnyEvent->timer( after => $timeout, cb => $callback ); 65 | 66 | return sub { undef $id }; 67 | } 68 | 69 | 1; 70 | 71 | __END__ 72 | 73 | =head1 SYNOPSIS 74 | 75 | use Promises backend => ['AnyEvent'], qw[ deferred collect ]; 76 | 77 | # ... everything else is the same 78 | 79 | =head1 DESCRIPTION 80 | 81 | The "Promise/A+" spec strongly suggests that the callbacks 82 | given to C should be run asynchronously (meaning in the 83 | next turn of the event loop), this module provides support for 84 | doing so using the L module. 85 | 86 | Module authors should not care which event loop will be used but 87 | instead should just the Promises module directly: 88 | 89 | package MyClass; 90 | 91 | use Promises qw(deferred collect); 92 | 93 | End users of the module can specify which backend to use at the start of 94 | the application: 95 | 96 | use Promises -backend => ['AnyEvent']; 97 | use MyClass; 98 | 99 | =cut 100 | 101 | -------------------------------------------------------------------------------- /t/006-thenable.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use lib 't/lib'; 7 | use Promises qw(deferred); 8 | use Test::More; 9 | 10 | BEGIN { 11 | use_ok('Promises'); 12 | } 13 | 14 | my @out; 15 | 16 | my $then = Dummy::Then->new( \@out ); 17 | 18 | deferred->resolve->then( 19 | sub { 20 | push @out, 'Resolve'; 21 | return $then; 22 | } 23 | )->then( 24 | sub { push @out, 'Resolve'; push @out, @_ }, 25 | sub { push @out, 'Error' } 26 | ); 27 | 28 | $then->resolve('bar'); 29 | 30 | test( 'Resolve thenable', [ 'Resolve', 'Then resolved', 'Resolve', 'bar' ] ); 31 | 32 | @out = (); 33 | deferred->resolve->then( 34 | sub { 35 | push @out, 'Resolve'; 36 | return $then; 37 | } 38 | )->then( 39 | sub { push @out, 'Error' }, 40 | sub { push @out, 'Reject'; push @out, @_; } 41 | ); 42 | 43 | $then->reject('bar'); 44 | 45 | test( 'Reject thenable', [ 'Resolve', 'Then rejected', 'Reject', 'bar' ] ); 46 | 47 | @out = (); 48 | deferred->resolve->then( 49 | sub { 50 | push @out, 'Resolve'; 51 | return $then; 52 | } 53 | )->finally( sub { push @out, 'Finally'; push @out, @_; } )->then( 54 | sub { push @out, 'Reject'; push @out, @_ }, 55 | sub { push @out, 'Error' } 56 | ); 57 | 58 | $then->resolve('bar'); 59 | test( 'Finally resolve thenable', 60 | [ 'Resolve', 'Then resolved', 'Finally', 'bar', 'Reject', 'bar' ] ); 61 | 62 | @out = (); 63 | @out = (); 64 | deferred->resolve->then( 65 | sub { 66 | push @out, 'Resolve'; 67 | return $then; 68 | } 69 | )->finally( sub { push @out, 'Finally'; push @out, @_ } )->then( 70 | sub { push @out, 'Error' }, 71 | sub { push @out, 'Reject'; push @out, @_; } 72 | ); 73 | 74 | $then->reject('bar'); 75 | 76 | test( 'Finally reject thenable', 77 | [ 'Resolve', 'Then rejected', 'Finally', 'bar', 'Reject', 'bar' ] ); 78 | 79 | done_testing; 80 | 81 | #=================================== 82 | sub test { 83 | #=================================== 84 | my ( $name, $expect ) = @_; 85 | 86 | # diag ""; 87 | # diag "$name"; 88 | # diag "Expect: @$expect"; 89 | # diag "Got: @out"; 90 | no warnings 'uninitialized'; 91 | return fail $name unless @out == @$expect; 92 | for ( 0 .. @out ) { 93 | return fail $name unless $out[$_] eq $expect->[$_]; 94 | } 95 | pass $name; 96 | 97 | } 98 | 99 | package Dummy::Then; 100 | 101 | sub new { 102 | my ( $class, $out ) = @_; 103 | bless { out => $out }, $class; 104 | } 105 | 106 | sub then { 107 | my ( $self, $cb, $err ) = @_; 108 | $self->{cb} = $cb; 109 | $self->{err} = $err; 110 | return (); 111 | } 112 | 113 | sub resolve { 114 | my $self = shift; 115 | push @{ $self->{out} }, 'Then resolved'; 116 | $self->{cb}->(@_); 117 | } 118 | 119 | sub reject { 120 | my $self = shift; 121 | push @{ $self->{out} }, 'Then rejected'; 122 | $self->{err}->(@_); 123 | } 124 | 125 | 1 126 | 127 | -------------------------------------------------------------------------------- /lib/Promises/Sub.pm: -------------------------------------------------------------------------------- 1 | package Promises::Sub; 2 | # ABSTRACT: Turns functions into promises 3 | 4 | use strict; 5 | use warnings; 6 | 7 | use Sub::Attribute; 8 | use Carp; 9 | 10 | use Promises qw/ collect /; 11 | 12 | use parent 'Exporter'; 13 | 14 | our @EXPORT_OK = qw/ defer /; 15 | 16 | sub defer(&) { 17 | my $coderef = shift; 18 | 19 | return sub { 20 | collect( @_ )->then( sub { $coderef->( map { @$_ } @_ ) } ); 21 | } 22 | 23 | } 24 | 25 | sub Defer :ATTR_SUB { 26 | my( undef, $symbol, $referent ) = @_; 27 | 28 | croak "can't use attribute :Defer on an anonynous sub, use 'defer' instead" 29 | unless $symbol; 30 | 31 | no warnings 'redefine'; 32 | $$symbol = defer { $referent->(@_) }; 33 | } 34 | 35 | 36 | 1; 37 | 38 | __END__ 39 | 40 | =head1 SYNOPSIS 41 | 42 | use Promises 'deferred'; 43 | use parent 'Promises::Sub'; 44 | 45 | sub shall_concat :Defer { 46 | join ' ', @_; 47 | } 48 | 49 | my @promises = map { deferred } 1..2; 50 | 51 | my @results = ( 52 | shall_concat( @promises ), 53 | shall_concat( 'that is', $promises[1] ), 54 | shall_concat( 'this is', 'straight up' ), 55 | ); 56 | 57 | say "all results are promises"; 58 | 59 | $_->then(sub { say @_ } ) for @results; 60 | # prints 'this is straight up' 61 | 62 | say "two results are still waiting..."; 63 | 64 | $promises[1]->resolve( 'delayed' ); 65 | # prints 'this is delayed' 66 | 67 | say "only one left..."; 68 | 69 | $promises[0]->resolve( 'finally the last one, that was' ); 70 | # prints 'finally the last one, that was delayed' 71 | 72 | =head1 DESCRIPTION 73 | 74 | Any function tagged with the C<:Defer> will be turned into a promise, so you can do 75 | 76 | sub add :Defer { $_[0] + $_[1] } 77 | 78 | add( 1,2 )->then(sub { say "the result is ", @_ } ); 79 | 80 | Additionally, if any of the arguments to the functions are promises themselves, 81 | the function call will wait until those promises are fulfilled before running. 82 | 83 | my $number = deferred; 84 | 85 | add( 1, $number )->then(sub { say "result: ", @_ } ); 86 | 87 | # $number is not fulfilled yet, nothing is printed 88 | 89 | $number->resolve(47); 90 | # prints 'result: 48' 91 | 92 | Bear in mind that to use the C<:Defer> attribute, you have to 93 | do C, 94 | and not C in the target namespace. 95 | 96 | =head2 Anonymous functions 97 | 98 | The C<:Defer> attribute won't work for anonymous functions and will throw 99 | an exception. For those, you can 100 | export the function C, which will wrap any coderef the same way that 101 | C<:Defer> does. 102 | 103 | use Promises::Sub qw/ defer /; 104 | 105 | my $promised_sub = defer sub { 106 | join ' ', @_; 107 | }; 108 | 109 | my $p1 = deferred; 110 | 111 | $promised_sub->( 'hello', $p1 )->then( sub { 112 | say shift; 113 | } ); 114 | 115 | # prints nothing 116 | 117 | $p1->resolve('world'); 118 | # => prints 'hello world' 119 | -------------------------------------------------------------------------------- /t/025-recursion.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use lib 't/lib'; 7 | 8 | use Test::More; 9 | use Test::Requires 'AnyEvent'; 10 | 11 | use Scalar::Util qw(weaken); 12 | use AnyEvent; 13 | 14 | BEGIN { 15 | use_ok 'Promises::Deferred'; 16 | use_ok 'Promises::Deferred::AE'; 17 | } 18 | 19 | our ( $Max, $Live, $Iter ); 20 | 21 | # class type iter max 22 | test( 'Promises::Deferred', 'resolve', 5, 8 ); 23 | test( 'Promises::Deferred', 'resolve', 10, 8 ); 24 | test( 'Promises::Deferred', 'reject', 5, 8 ); 25 | test( 'Promises::Deferred', 'reject', 10, 8 ); 26 | test( 'Promises::Deferred::AE', 'resolve', 5, 5 ); 27 | test( 'Promises::Deferred::AE', 'resolve', 10, 5 ); 28 | test( 'Promises::Deferred::AE', 'reject', 5, 5 ); 29 | test( 'Promises::Deferred::AE', 'reject', 10, 5 ); 30 | 31 | #=================================== 32 | sub test { 33 | #=================================== 34 | my ( $class, $type, $iter, $max ) = @_; 35 | 36 | $Iter = $iter; 37 | 38 | my $wrap = wrap_class($class); 39 | my $cv = AnyEvent->condvar; 40 | 41 | test_loop( $wrap, $type eq 'reject' ) 42 | ->then( sub { $cv->send(@_) }, sub { $cv->send(@_) } ); 43 | 44 | is $cv->recv, $type . ':' . $max, "$class - $type - $iter"; 45 | 46 | } 47 | 48 | #=================================== 49 | sub test_loop { 50 | #=================================== 51 | my $class = shift; 52 | my $fail = shift; 53 | 54 | my $d = $class->new; 55 | my $weak_loop; 56 | my $loop = sub { 57 | if ( --$Iter == 0 ) { 58 | $d->resolve( 'resolve:' . $Max ); 59 | return; 60 | } 61 | 62 | # async promise 63 | a_promise($class) 64 | 65 | # should we fail 66 | ->then( sub { die if $fail && $Iter == 1 } ) 67 | 68 | # noop 69 | ->then( sub {@_} ) 70 | 71 | # loop or fail 72 | ->done( 73 | $weak_loop, 74 | sub { 75 | $d->reject( 'reject:' . $Max ); 76 | } 77 | ); 78 | }; 79 | weaken( $weak_loop = $loop ); 80 | $loop->(); 81 | return $d->promise; 82 | } 83 | 84 | #=================================== 85 | sub wrap_class { 86 | #=================================== 87 | my $class = shift; 88 | my $wrapped_class = $class . '::Track'; 89 | 90 | unless ( $wrapped_class->can('new') ) { 91 | eval < \$Max; 97 | ${wrapped_class}->SUPER::new 98 | } 99 | 100 | sub DESTROY { \$Live-- } 101 | 102 | 1 103 | 104 | CLASS 105 | } 106 | $Live = 0; 107 | $Max = 0; 108 | return $wrapped_class; 109 | } 110 | 111 | #=================================== 112 | sub a_promise { 113 | #=================================== 114 | my ($class) = @_; 115 | my $d = $class->new; 116 | my $w; 117 | $w = AnyEvent->timer( 118 | after => 0, 119 | cb => sub { 120 | $d->resolve('OK'); 121 | undef $w; 122 | } 123 | ); 124 | $d->promise; 125 | } 126 | 127 | done_testing; 128 | -------------------------------------------------------------------------------- /lib/Promises/Promise.pm: -------------------------------------------------------------------------------- 1 | package Promises::Promise; 2 | 3 | # ABSTRACT: An implementation of Promises in Perl 4 | 5 | use strict; 6 | use warnings; 7 | 8 | use Scalar::Util qw[ blessed ]; 9 | use Carp qw[ confess ]; 10 | 11 | sub new { 12 | my ( $class, $deferred ) = @_; 13 | ( blessed $deferred && $deferred->isa('Promises::Deferred') ) 14 | || confess "You must supply an instance of Promises::Deferred"; 15 | bless { 'deferred' => $deferred } => $class; 16 | } 17 | 18 | sub then { (shift)->{'deferred'}->then(@_) } 19 | sub chain { (shift)->{'deferred'}->chain(@_) } 20 | sub catch { (shift)->{'deferred'}->catch(@_) } 21 | sub done { (shift)->{'deferred'}->done(@_) } 22 | sub finally { (shift)->{'deferred'}->finally(@_) } 23 | sub status { (shift)->{'deferred'}->status } 24 | sub result { (shift)->{'deferred'}->result } 25 | sub timeout { (shift)->{'deferred'}->timeout } 26 | 27 | sub is_unfulfilled { (shift)->{'deferred'}->is_unfulfilled } 28 | sub is_fulfilled { (shift)->{'deferred'}->is_fulfilled } 29 | sub is_failed { (shift)->{'deferred'}->is_failed } 30 | sub is_done { (shift)->{'deferred'}->is_done } 31 | 32 | sub is_in_progress { (shift)->{'deferred'}->is_in_progress } 33 | sub is_resolved { (shift)->{'deferred'}->is_resolved } 34 | sub is_rejected { (shift)->{'deferred'}->is_rejected } 35 | 36 | 1; 37 | 38 | __END__ 39 | 40 | =head1 DESCRIPTION 41 | 42 | Promise objects are typically not created by hand, they 43 | are typically returned from the C method of 44 | a L instance. It is best to think 45 | of a L instance as a handle for 46 | L instances. 47 | 48 | Most of the documentation here points back to the 49 | documentation in the L module. 50 | 51 | Additionally L contains a long 52 | explanation of how this module, and all its components 53 | are meant to work together. 54 | 55 | =head1 METHODS 56 | 57 | =over 4 58 | 59 | =item C 60 | 61 | The constructor only takes one parameter and that is an 62 | instance of L that you want this 63 | object to proxy. 64 | 65 | =item C 66 | 67 | This calls C on the proxied L instance. 68 | 69 | =item C 70 | 71 | This calls C on the proxied L instance. 72 | 73 | =item C 74 | 75 | This calls C on the proxied L instance. 76 | 77 | =item C 78 | 79 | This calls C on the proxied L instance. 80 | 81 | =item C 82 | 83 | This calls C on the proxied L instance. 84 | 85 | =item C 86 | 87 | This calls C on the proxied L instance. 88 | 89 | =item C 90 | 91 | This calls C on the proxied L instance. 92 | 93 | =item C 94 | 95 | This calls C on the proxied L instance. 96 | 97 | =item C 98 | 99 | This calls C on the proxied L instance. 100 | 101 | =item C 102 | 103 | This calls C on the proxied L instance. 104 | 105 | =item C 106 | 107 | This calls C on the proxied L instance. 108 | 109 | =item C 110 | 111 | This calls C on the proxied L instance. 112 | 113 | =item C 114 | 115 | This calls C on the proxied L instance. 116 | 117 | =item C 118 | 119 | This calls C on the proxied L instance. 120 | 121 | =item C 122 | 123 | This calls C on the proxied L instance. 124 | 125 | =back 126 | 127 | -------------------------------------------------------------------------------- /lib/Promises/Cookbook/ScalaFuturesComparison.pod: -------------------------------------------------------------------------------- 1 | package Promises::Cookbook::ScalaFuturesComparison; 2 | 3 | # ABSTRACT: A comparison of Scala Futures with Promises 4 | 5 | =pod 6 | 7 | =head1 DESCRIPTION 8 | 9 | Here is the example Scala code, it assumes a function called C 10 | which when given a URL will return a Future. 11 | 12 | def getThumbnail(url: String): Future[Webpage] = { 13 | val promise = new Promise[Webpage] 14 | fetch(url) onSuccess { page => 15 | fetch(page.imageLinks(0)) onSuccess { p => 16 | promise.setValue(p) 17 | } onFailure { exc => 18 | promise.setException(exc) 19 | } 20 | } onFailure { exc => 21 | promise.setException(exc) 22 | } 23 | promise 24 | } 25 | 26 | If we take this and translate this into Perl code using the 27 | L library, the C function would look 28 | like this: 29 | 30 | sub fetch { 31 | state $ua = Mojo::UserAgent->new; 32 | my $url = shift; 33 | my $d = deferred; 34 | $ua->get($url => sub { 35 | my ($ua, $tx) = @_; 36 | $d->resolve( $tx ); 37 | }); 38 | $d->promise; 39 | } 40 | 41 | And if we were to take the C function and 42 | translate it exactly, we would end up with this: 43 | 44 | sub get_thumbnail { 45 | my $url = shift; 46 | my $d = deferred; 47 | fetch( $url )->then( 48 | sub { 49 | my $tx = shift; 50 | fetch( $tx->res->dom->find('img')->[0]->{'src'} )->then( 51 | sub { $d->resolve( $_[0] ) }, 52 | sub { $d->reject( $_[0] ) }, 53 | ) 54 | }, 55 | sub { $d->reject( $_[0] ) } 56 | ); 57 | $d->promise; 58 | } 59 | 60 | Scala Futures have a method called C, which takes a 61 | function that given value will return another Future. Here is 62 | an example of how the C method can be simplified 63 | by using it. 64 | 65 | def getThumbnail(url: String): Future[Webpage] = 66 | fetch(url) flatMap { page => 67 | fetch(page.imageLinks(0)) 68 | } 69 | 70 | But since our C method actually creates a new promise 71 | and wraps the callbacks to chain to that promise, we don't 72 | need this C combinator and so this, Just Works. 73 | 74 | sub get_thumbnail { 75 | my $url = shift; 76 | fetch( $url )->then( 77 | sub { 78 | my $tx = shift; 79 | fetch( $tx->res->dom->find('img')->[0]->{'src'} ); 80 | } 81 | ); 82 | } 83 | 84 | Scala Futures also have a C method which can serve as 85 | a kind of catch block that potentially will return another 86 | Future. 87 | 88 | val f = fetch(url) rescue { 89 | case ConnectionFailed => 90 | fetch(url) 91 | } 92 | 93 | Just as with C, since our callbacks are wrapped and 94 | chained with a new Promise, we can do a rescue just by using 95 | the error callback The Promise returned by C will get 96 | chained and so this will depend on it. 97 | 98 | sub get_thumbnail { 99 | my $url = shift; 100 | fetch( $url )->then( 101 | sub { 102 | my $page = shift; 103 | fetch( $page->image_links->[0] ); 104 | }, 105 | sub { 106 | given ( $_[0] ) { 107 | when ('connection_failed') { 108 | return fetch( $url ); 109 | } 110 | default { 111 | return "failed"; 112 | } 113 | } 114 | } 115 | ); 116 | } 117 | 118 | TODO ... figure out how retry can be generic ... 119 | 120 | =head1 SEE ALSO 121 | 122 | Systems Programming at Twitter - L 123 | 124 | =cut 125 | 126 | __END__ 127 | -------------------------------------------------------------------------------- /lib/Promises/Cookbook/Recursion.pod: -------------------------------------------------------------------------------- 1 | package Promises::Cookbook::Recursion; 2 | 3 | # ABSTRACT: Examples of recursive asynchronous operations 4 | 5 | =pod 6 | 7 | =head1 SYNOPSIS 8 | 9 | package MyClass; 10 | 11 | use Promises backend => ['AE'], 'deferred'; 12 | 13 | sub new {...} 14 | sub process {...} 15 | sub is_finished {...} 16 | sub fetch_next_from_db {...} # returns a promise 17 | 18 | sub fetch_all { 19 | my $self = shift; 20 | my $deferred = deferred; 21 | 22 | $self->_fetch_loop($deferred); 23 | return $deferred->promise; 24 | } 25 | 26 | sub _fetch_loop { 27 | my ($self,$deferred) = @_; 28 | if ( $self->is_finished ) { 29 | $deferred->resolve; 30 | return 31 | } 32 | $self->fetch_next_from_db 33 | ->then( sub { $self->process(@_) }) 34 | ->done( 35 | sub { $self->_fetch_loop($deferred) } 36 | sub { $deferred->reject(@_) } 37 | ); 38 | } 39 | 40 | package main; 41 | 42 | my $cv = AnyEvent->condvar; 43 | my $obj = MyClass->new(...); 44 | $obj->fetch_all->then( 45 | sub { $cv->send(@_) }, 46 | sub { $cv->croak('ERROR',@_) } 47 | ); 48 | 49 | $cv->recv; 50 | 51 | =head1 DESCRIPTION 52 | 53 | While C allows you to wait for multiple promises which 54 | are executing in parallel, sometimes you need to execute each step 55 | in order, by using promises recursively. For instance: 56 | 57 | =over 58 | 59 | =item 1 60 | 61 | Fetch next page of results 62 | 63 | =item 2 64 | 65 | Process page of results 66 | 67 | =item 3 68 | 69 | If there are no more results, return success 70 | 71 | =item 4 72 | 73 | Otherwise, goto step 1 74 | 75 | =back 76 | 77 | However, recursion can result in very deep stacks and out of memory 78 | conditions. There are two important steps for dealing with recursion 79 | effectively. 80 | 81 | The first is to use one of the event-loop backends: 82 | 83 | use Promises backend => ['AE'], 'deferred'; 84 | 85 | While the default L implementation calls the 86 | C callbacks synchronously, the event-loop backends call 87 | the callbacks asynchronously in the context of the event loop. 88 | 89 | However, each C passes its return value on to the next 90 | C etc, so you still end up using a lot of memory with 91 | recursion. We can avoid this by breaking the chain. 92 | 93 | In our example, all we care about is whether all the steps in our 94 | process completed successfully or not. Each execution of steps 1 to 95 | 4 is independent. Step 1 does not need to receive the return value 96 | from step 4. 97 | 98 | We can break the chain by using C instead of C. 99 | While C returns a new C to continue the chain, 100 | C will execute either the success callback or the 101 | error callback and return an empty list, breaking the chain and 102 | rolling back the stack. 103 | 104 | To work through the code in the L: 105 | 106 | sub fetch_all { 107 | my $self = shift; 108 | my $deferred = deferred; 109 | 110 | $self->_fetch_loop($deferred); 111 | return $deferred->promise; 112 | } 113 | 114 | The C<$deferred> variable (and the promise that we return to the caller) 115 | will either be resolved once all results have been fetched and 116 | processed by the C<_fetch_loop()>, or rejected if an error occurs at 117 | any stage of execution. 118 | 119 | sub _fetch_loop { 120 | my ($self,$deferred) = @_; 121 | 122 | if ( $self->is_finished ) { 123 | $deferred->resolve; 124 | return; 125 | } 126 | 127 | If C returns a true value (eg there are no more results to fetch), 128 | then we can resolve our promise, indicating success, and exit the loop. 129 | 130 | $self->fetch_next_from_db 131 | ->then( sub { $self->process(@_) }) 132 | ->done( 133 | sub { $self->_fetch_loop($deferred) } 134 | sub { $deferred->reject(@_) } 135 | ); 136 | } 137 | 138 | Otherwise we fetch the next page of results aynchronously from the DB and 139 | process them. If either of these steps (fetching or processing) fails, 140 | then we signal failure by rejecting our deferred promise and exiting the loop. 141 | If there is no failure, we recurse back into our loop by calling 142 | C<_fetch_loop()> again. 143 | 144 | However,this recursion happens asynchronously. What this code actually does 145 | is to schedule the call to C<_fetch_loop()> in the next tick of the event 146 | loop. And because we used C instead of C, we don't 147 | wait around for the return result but instead return immediately, 148 | exiting the current execution, discarding the return results and 149 | rolling back the stack. 150 | 151 | =cut 152 | 153 | __END__ 154 | -------------------------------------------------------------------------------- /CODE_OF_CONDUCT.md: -------------------------------------------------------------------------------- 1 | # Contributor Covenant Code of Conduct 2 | 3 | ## Our Pledge 4 | 5 | We as members, contributors, and leaders pledge to make participation in our 6 | community a harassment-free experience for everyone, regardless of age, body 7 | size, visible or invisible disability, ethnicity, sex characteristics, gender 8 | identity and expression, level of experience, education, socio-economic status, 9 | nationality, personal appearance, race, religion, or sexual identity 10 | and orientation. 11 | 12 | We pledge to act and interact in ways that contribute to an open, welcoming, 13 | diverse, inclusive, and healthy community. 14 | 15 | ## Our Standards 16 | 17 | Examples of behavior that contributes to a positive environment for our 18 | community include: 19 | 20 | * Demonstrating empathy and kindness toward other people 21 | * Being respectful of differing opinions, viewpoints, and experiences 22 | * Giving and gracefully accepting constructive feedback 23 | * Accepting responsibility and apologizing to those affected by our mistakes, 24 | and learning from the experience 25 | * Focusing on what is best not just for us as individuals, but for the 26 | overall community 27 | 28 | Examples of unacceptable behavior include: 29 | 30 | * The use of sexualized language or imagery, and sexual attention or 31 | advances of any kind 32 | * Trolling, insulting or derogatory comments, and personal or political attacks 33 | * Public or private harassment 34 | * Publishing others' private information, such as a physical or email 35 | address, without their explicit permission 36 | * Other conduct which could reasonably be considered inappropriate in a 37 | professional setting 38 | 39 | ## Enforcement Responsibilities 40 | 41 | Community leaders are responsible for clarifying and enforcing our standards of 42 | acceptable behavior and will take appropriate and fair corrective action in 43 | response to any behavior that they deem inappropriate, threatening, offensive, 44 | or harmful. 45 | 46 | Community leaders have the right and responsibility to remove, edit, or reject 47 | comments, commits, code, wiki edits, issues, and other contributions that are 48 | not aligned to this Code of Conduct, and will communicate reasons for moderation 49 | decisions when appropriate. 50 | 51 | ## Scope 52 | 53 | This Code of Conduct applies within all community spaces, and also applies when 54 | an individual is officially representing the community in public spaces. 55 | Examples of representing our community include using an official e-mail address, 56 | posting via an official social media account, or acting as an appointed 57 | representative at an online or offline event. 58 | 59 | ## Enforcement 60 | 61 | Instances of abusive, harassing, or otherwise unacceptable behavior may be 62 | reported to the community leaders responsible for enforcement at 63 | stevan.little@iinteractive.com. 64 | All complaints will be reviewed and investigated promptly and fairly. 65 | 66 | All community leaders are obligated to respect the privacy and security of the 67 | reporter of any incident. 68 | 69 | ## Enforcement Guidelines 70 | 71 | Community leaders will follow these Community Impact Guidelines in determining 72 | the consequences for any action they deem in violation of this Code of Conduct: 73 | 74 | ### 1. Correction 75 | 76 | **Community Impact**: Use of inappropriate language or other behavior deemed 77 | unprofessional or unwelcome in the community. 78 | 79 | **Consequence**: A private, written warning from community leaders, providing 80 | clarity around the nature of the violation and an explanation of why the 81 | behavior was inappropriate. A public apology may be requested. 82 | 83 | ### 2. Warning 84 | 85 | **Community Impact**: A violation through a single incident or series 86 | of actions. 87 | 88 | **Consequence**: A warning with consequences for continued behavior. No 89 | interaction with the people involved, including unsolicited interaction with 90 | those enforcing the Code of Conduct, for a specified period of time. This 91 | includes avoiding interactions in community spaces as well as external channels 92 | like social media. Violating these terms may lead to a temporary or 93 | permanent ban. 94 | 95 | ### 3. Temporary Ban 96 | 97 | **Community Impact**: A serious violation of community standards, including 98 | sustained inappropriate behavior. 99 | 100 | **Consequence**: A temporary ban from any sort of interaction or public 101 | communication with the community for a specified period of time. No public or 102 | private interaction with the people involved, including unsolicited interaction 103 | with those enforcing the Code of Conduct, is allowed during this period. 104 | Violating these terms may lead to a permanent ban. 105 | 106 | ### 4. Permanent Ban 107 | 108 | **Community Impact**: Demonstrating a pattern of violation of community 109 | standards, including sustained inappropriate behavior, harassment of an 110 | individual, or aggression toward or disparagement of classes of individuals. 111 | 112 | **Consequence**: A permanent ban from any sort of public interaction within 113 | the community. 114 | 115 | ## Attribution 116 | 117 | This Code of Conduct is adapted from the [Contributor Covenant][homepage], 118 | version 2.0, available at 119 | https://www.contributor-covenant.org/version/2/0/code_of_conduct.html. 120 | 121 | Community Impact Guidelines were inspired by [Mozilla's code of conduct 122 | enforcement ladder](https://github.com/mozilla/diversity). 123 | 124 | [homepage]: https://www.contributor-covenant.org 125 | 126 | For answers to common questions about this code of conduct, see the FAQ at 127 | https://www.contributor-covenant.org/faq. Translations are available at 128 | https://www.contributor-covenant.org/translations. 129 | -------------------------------------------------------------------------------- /lib/Promises/Cookbook/TIMTOWTDI.pod: -------------------------------------------------------------------------------- 1 | package Promises::Cookbook::TIMTOWTDI; 2 | 3 | # ABSTRACT: Counter examples to Promises 4 | 5 | =pod 6 | 7 | =head1 DESCRIPTION 8 | 9 | So, like I said before, Promises are a means by which you can more 10 | effectively manage your async operations and avoid callback spaghetti. 11 | But of course this is Perl and therefore there is always another way 12 | to do it. In this section I am going to show a few examples of other 13 | ways you could accomplish the same thing. 14 | 15 | =head2 Caveat 16 | 17 | Please note that I am specifically illustrating ways to do this which 18 | I feel are inferior or less elegant then Promises. This is not meant 19 | to be a slight on the API of other modules at all, I am simply using 20 | these modules to try and illustrate other (perhaps more familiar) 21 | idioms in hopes that it will help people understand Promises. 22 | 23 | I am sure there are other ways to do some of these things and do 24 | them more effectively, and I am fully willing to admit my ignorance 25 | here. I welcome any patches which might illustrate said ignorance, as 26 | I do not claim at all to be an expert in async programming. 27 | 28 | =head1 AnyEvent::HTTP 29 | 30 | So, enough caveating, please consider this (more traditional) version 31 | of our the L SYNOPSIS example using L. 32 | 33 | my $cv = AnyEvent->condvar; 34 | 35 | http_get('http://rest.api.example.com/-/product/12345', sub { 36 | my ($product) = @_; 37 | http_get('http://rest.api.example.com/-/product/suggestions?for_sku=12345', sub { 38 | my ($suggestions) = @_; 39 | http_get('http://rest.api.example.com/-/product/reviews?for_sku=12345', sub { 40 | my ($reviews) = @_; 41 | $cv->send({ 42 | product => $product, 43 | suggestions => $suggestions, 44 | reviews => $reviews, 45 | }) 46 | }), 47 | }); 48 | }); 49 | 50 | my $all_product_info = $cv->recv; 51 | 52 | Not only do we have deeply nested callbacks, but we have an enforced 53 | order of operations. If you wanted to try and avoid that order of 54 | operations, you might end up writing something like this: 55 | 56 | my $product_cv = AnyEvent->condvar; 57 | my $suggestion_cv = AnyEvent->condvar; 58 | my $review_cv = AnyEvent->condvar; 59 | 60 | http_get('http://rest.api.example.com/-/product/12345', sub { 61 | my ($product) = @_; 62 | $product_cv->send( $product ); 63 | }); 64 | 65 | http_get('http://rest.api.example.com/-/product/suggestions?for_sku=12345', sub { 66 | my ($suggestions) = @_; 67 | $suggestion_cv->send( $suggestions ); 68 | }); 69 | 70 | http_get('http://rest.api.example.com/-/product/reviews?for_sku=12345', sub { 71 | my ($reviews) = @_; 72 | $reviews_cv->send( $reviews ) 73 | }), 74 | 75 | my $all_product_info = { 76 | product => $product_cv->recv, 77 | suggestions => $suggestions_cv->recv, 78 | reviews => $reviews_cv->recv 79 | }; 80 | 81 | But actually, this doesn't work either, while we do gain something by 82 | allowing the C calls to be run in whatever order works best, 83 | we still end up still enforcing some order in the way we call C 84 | on our three C (Oh yeah, and we had to create and manage three 85 | C as well). 86 | 87 | The following example was submitted to me by James Wright (via RT #83992) 88 | as an alternate approach which is non-nested, uses only one condvar, and 89 | has no fixed-order. 90 | 91 | my $cv = AnyEvent->condvar; 92 | my ( $product, $suggestions, $reviews ) = ( [], [], [] ); 93 | 94 | $cv->begin; 95 | http_get('http://rest.api.example.com/-/product/12345', sub { 96 | ($product) = @_; 97 | $cv->end; 98 | }); 99 | 100 | $cv->begin; 101 | http_get('http://rest.api.example.com/-/product/suggestions?for_sku=12345', sub { 102 | ($suggestions) = @_; 103 | $cv->end; 104 | }); 105 | 106 | $cv->begin; 107 | http_get('http://rest.api.example.com/-/product/reviews?for_sku=12345', sub { 108 | ($reviews) = @_; 109 | $cv->end; 110 | }); 111 | 112 | $cv->cb(sub { 113 | $cv->send({ 114 | product => $product, 115 | suggestions => $suggestions, 116 | reviews => $reviews, 117 | }); 118 | }); 119 | 120 | my $all_product_info = $cv->recv; 121 | 122 | The only real issue I have with this approach is the semi-global variable usage 123 | (C<$product>, C<$suggestions> and C<$reviews>), but otherwise it works fine. 124 | 125 | NOTE: Again, if you can think of a better way to do this that I missed, 126 | please let me know. 127 | 128 | =head1 Mojo::UserAgent 129 | 130 | #!/usr/bin/env perl 131 | 132 | use Mojo::Base -strict; 133 | use Mojo::UserAgent; 134 | 135 | my $titles; 136 | 137 | my $ua = Mojo::UserAgent->new; 138 | Mojo::IOLoop->delay( 139 | sub { 140 | my $delay = shift; 141 | $ua->get('http://google.com/', $delay->begin); 142 | $ua->get('http://yahoo.com/', $delay->begin); 143 | $ua->get('http://perlmonks.org/', $delay->begin); 144 | }, 145 | sub { 146 | my ($delay, $tx1, $tx2, $tx3) = @_; 147 | $titles = { 148 | google => $tx1->res->dom->at('title')->text, 149 | yahoo => $tx2->res->dom->at('title')->text, 150 | perlmonks => $tx3->res->dom->at('title')->text, 151 | }; 152 | }, 153 | )->catch( 154 | sub { 155 | my ($delay, $err) = @_; 156 | warn "failed to download or parse title\n"; 157 | } 158 | )->wait; 159 | 160 | say Mojo::Util::dumper($titles); 161 | 162 | =cut 163 | 164 | __END__ 165 | 166 | 167 | -------------------------------------------------------------------------------- /Changes: -------------------------------------------------------------------------------- 1 | Revision history for Perl extension Promises 2 | 3 | {{$NEXT}} 4 | [API CHANGES] 5 | 6 | [BUG FIXES] 7 | 8 | [DOCUMENTATION] 9 | 10 | [ENHANCEMENTS] 11 | 12 | [NEW FEATURES] 13 | 14 | [STATISTICS] 15 | 16 | 1.05 2025-06-24 17 | [ENHANCEMENTS] 18 | - Fix quadratic slowdown in collect(). (GH#96, mauke) 19 | - Use `confess` instead of `die` for more useful debugging information. 20 | (GH#94, maros) 21 | 22 | [STATISTICS] 23 | - code churn: 6 files changed, 132 insertions(+), 55 deletions(-) 24 | 25 | 1.04 2020-02-23 26 | [ENHANCEMENTS] 27 | - P::D::EV has a new `cleanup` class method clearing up the EV handler. 28 | (GH#91, wangvisual) 29 | 30 | [STATISTICS] 31 | - code churn: 4 files changed, 173 insertions(+), 160 deletions(-) 32 | 33 | 1.03 2020-01-06 34 | [BUG FIXES] 35 | - Modified tests as AnyEvent began to fail when waiting for 0 seconds. 36 | (GH#88) 37 | 38 | [DOCUMENTATION] 39 | - Add two more promise modules in SEE ALSO. (GH#90, FGasper) 40 | - Add directives to how to install from master. (GH#89) 41 | 42 | [ENHANCEMENTS] 43 | - In similar vain to PR61, optimize _notify_backend for Mojo. (GH#86, Erik 44 | Huelsmann) 45 | 46 | [STATISTICS] 47 | - code churn: 12 files changed, 153 insertions(+), 24 deletions(-) 48 | 49 | 1.02 2019-06-22 50 | [DOCUMENTATION] 51 | - Fixed pod error as reported by CPANTS. (GH#83, Mohammad S Anwar) 52 | 53 | [ENHANCEMENTS] 54 | - In similar vain to PR #61, optimize _notify_backend (for IO::Async). 55 | (GH#85, Erik Huelsmann) 56 | 57 | [STATISTICS] 58 | - code churn: 3 files changed, 31 insertions(+), 9 deletions(-) 59 | 60 | 1.01 2019-06-15 61 | [ENHANCEMENTS] 62 | - Performance enhancements. (GH#61, GH#83, Erik Huelsmann, Tom van der 63 | Woerdt) 64 | 65 | [STATISTICS] 66 | - code churn: 7 files changed, 159 insertions(+), 57 deletions(-) 67 | 68 | 1.00 2019-05-15 69 | [BUG FIXES] 70 | - Change inner working of collect() so that it deals with being passed 71 | nothing. (GH#82) 72 | - warn_on_unhandled_reject: deal with case where there is no caller. 73 | (Peter Valdemar Morch, GH#76) 74 | 75 | [DOCUMENTATION] 76 | - Remove extra bracket in example. (perlover, GH#78) 77 | - Minor text changes in POD. (manwar, GH#79) 78 | - Mention other modules implementing promises. (GH#64) 79 | 80 | [ENHANCEMENTS] 81 | - add Promises::Sub. (GH#54, yanick) 82 | 83 | [STATISTICS] 84 | - code churn: 13 files changed, 304 insertions(+), 65 deletions(-) 85 | 86 | 0.99 2017-10-29 87 | [BUG FIXES] 88 | - skip all backend compile tests (RT#123404) 89 | 90 | [STATISTICS] 91 | - code churn: 2 files changed, 11 insertions(+), 3 deletions(-) 92 | 93 | 0.98 2017-10-22 94 | [BUG FIXES] 95 | - removed hard-dependency on the different backends. 96 | 97 | [STATISTICS] 98 | - code churn: 3 files changed, 120 insertions(+), 161 deletions(-) 99 | 100 | 0.97 2017-10-22 101 | [DOCUMENTATION] 102 | - Add a reference to the IO::Async deferred backend. (GH#71, Luke 103 | Triantafyllidis) 104 | 105 | [ENHANCEMENTS] 106 | - add new function 'collect_hash'. (GH#52, yanick) 107 | - add 'timeout' method. (GH#70, yanick) 108 | 109 | [MISC] 110 | - make tests use proper api. (TdvW) 111 | - have test load AnyEvent. (GH#72, Luke Triantafyllidis) 112 | 113 | [STATISTICS] 114 | - code churn: 29 files changed, 640 insertions(+), 50 deletions(-) 115 | 116 | 0.96 2017-08-26 117 | - Promotion of trial release to the real deal. 118 | 119 | 0.94 Monday, December 29, 2014 120 | - fixing the other side of the AutoPrereqs issue, which is actually 121 | making sure that test runs succeed if you do not have those pre-reqs, 122 | again, sorry about this. 123 | 124 | 0.93 Wednesday, April 9th, 2014 125 | - fix the AutoPrereqs issue so that EV, AE, AnyEvent and Mojo::IOLoop are 126 | not required anymore, sorry about that. 127 | 128 | 0.92 Wednesday, April 9th, 2014 129 | - just a quick update to make Mojo::IOLoop recommended instead of 130 | required. 131 | 132 | 0.91 Wednesday, March 19th, 2014 133 | - fixed issue with re-resolved promises not working correctly - thanks to 134 | Gregory Oschwald for the bug - thanks to Clinton Gormley for the fix - 135 | github issue #28 & #29 136 | - thanks to Sean Zellmer for some typo fix 137 | 138 | 0.90 Saturday, Feb. 8th, 2014 139 | - !! 140 | - BACKWARDS COMPATIBILITY WARNING !! 141 | - !! 142 | - This is the first step towards full !! 143 | - compatibility with the Promises/A+ !! 144 | - spec, at which we will declare this !! 145 | - to be module to be 1.0 !! 146 | - NOTE: Pretty much everything in this release is thanks to the work of 147 | Clinton Gormley++ 148 | - Fixed the behavior of finally() to make sure @results are passed along 149 | correctly 150 | - Handle any "then"-able object to be returned as a result, instead of 151 | only accepting Promise objects 152 | - then/done/finally now accept both callbacks (CODE refs) and "Callable" 153 | objects (objects of classes that overload the CODE de-ref operator) 154 | - New docs in Promises::Cookbook::GentleIntro. 155 | - Doc fixes and CPAN repository metadata added, thanks to David 156 | Steinbrunner for this 157 | 158 | 0.08 Tuesday, Jan. 21, 2014 159 | - Thanks to clinton gormley for all these 160 | - changes. Please take note of the backcompat 161 | - breaking change for finalize(). 162 | - then() callbacks are now wrapped in an eval block to prevent fatal 163 | exceptions and to ensure that rejected promises are propagated correctly 164 | - renamed finalize() to done() 165 | - added catch() sugar which takes just an error handler 166 | - added finally() handler which will always be called, regardles of 167 | whether the promise is resolved or rejected, much like try/catch/finally 168 | 169 | 0.07 Saturday, Jan. 18, 2014 170 | - fixing a issues with localizing exceptions that were found by CPAN 171 | testers - thanks to clinton gormley for providing the fix for this 172 | 173 | 0.06 Friday, Jan. 17, 2014 174 | - make sure to clear both resolved and rejected callbacks after 175 | resolution, thanks to clinton gormley for this. 176 | - add event-loop specific backends to allow promises to be resolved in an 177 | async manner (as Promises/A+ suggests) - thanks to clinton gormley for 178 | starting this feature - backend created for AE, AnyEvent and EV - 179 | backend for Mojo::IOLoop, thanks to clinton gormley for this - tests 180 | added 181 | - add in finalize() operator for ending a chain of promises (see docs for 182 | more info) - thanks to clinton gormley for this feature, docs and tests 183 | 184 | 0.05 Monday, Dec. 23, 2013 185 | - catch exceptions in any callback and call reject if they happen 186 | - the 'promise' method on deferred objects will now return a new 187 | Promises::Promise instance each time it is called - this prevents the 188 | memory cycle we originally had 189 | 190 | 0.04 Thursday, Oct. 17, 2013 191 | - DEPRECATION WARNING *** 192 | - The 'when' helper in Promises.pm is being deprecated because it clashes 193 | with the perl keyword. See RT #84024 for more info. 194 | - 'when' renamed to 'collect' - tests and docs adjusted accordingly 195 | 196 | 0.03 Sunday, Feb. 17th, 2013 197 | - added a `deferred` helper function to Promises.pm 198 | - fixed the reject call in `when` (thanks to rafl for this) - added tests 199 | for this 200 | - large doc reworking - moved things into a cookbook - added example of 201 | usage with Mojo::IOLoop - added comparison with Scala futures - this 202 | still needs some work, but the basics are ther 203 | 204 | 0.02 Saturday, Nov. 24th, 2012 205 | - add several predicate methods to help when interrogating status, this 206 | resolves RT #81278. - thanks to Toby Inkster for this 207 | - fixed error chaining so that the result of an error in one step of the 208 | chain will be passed onto the next step as well, this resolves RT 209 | #81358. - thanks to TOSHIOITO for this 210 | - made error callbacks optional and ensured that the errors will bubble to 211 | the next promise in the chain, this resolves RT #81356. - thanks again 212 | to TOSHIOITO for this 213 | 214 | 0.01 Friday, Nov. 16th, 2012 215 | - First release to an unsuspecting world 216 | 217 | 0.95_TRIAL 2017-08-19 218 | [BUG FIXES] 219 | - fix case where exception exists but is false. (GH#48, stuckdownawell) 220 | 221 | [DOCUMENTATION] 222 | - doc fix from Amelia Ireland (RT#107559) 223 | - fix typos in docs (GH#43, yanick) 224 | - POD fixes. (GH#39, hatorikibble) 225 | - fix Mojo example (GH#41, InfinityGone) 226 | 227 | [ENHANCEMENTS] 228 | - add support for IO::Async. (GH#62) 229 | - add Mojo::UserAgent example (GH#56, powerman) 230 | - add $WARN_ON_UNHANDLED_REJECT. (GH#37, ruz) 231 | - add `is_done` predicate. (GH#45, yanick) 232 | - add `chain` method. (GH#47, yanick) 233 | - add methods `resolved`, `rejected` and `deferred` now accept a coderef. 234 | (GH#50, yanick) 235 | - allows non-promises in 'collect'. (GH#53, yanick) 236 | 237 | [MISC] 238 | - skip tests if AnyEvent is not installed (GH#42, yanick) 239 | - add a META.json (GH#40, hatorikibble) 240 | - README.md improvement. (GH#51, Andy Kogut + yanick) 241 | -------------------------------------------------------------------------------- /t/040_finally.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use lib 't/lib'; 7 | 8 | use Test::More; 9 | use Test::Requires 'AnyEvent'; 10 | 11 | use AnyEvent; 12 | use AsyncUtil qw[ delay_me delay_me_error ]; 13 | 14 | BEGIN { 15 | use_ok('Promises'); 16 | } 17 | 18 | my @vals = ( 'val_1', 'val_2' ); 19 | 20 | my $cv = AnyEvent->condvar; 21 | my @out; 22 | 23 | # Finally executes normally 24 | test( 25 | "Resolve - Finally - Resolve", 26 | sub { 27 | delay_me(0.1) # 28 | ->then( sub {@vals} ) # 29 | ->finally( sub { got_vals(@_); out('Finally') } ) # 30 | ->then( \&got_vals ); 31 | }, 32 | [ 'Got vals', 'Finally', 'Got vals' ] 33 | ); 34 | 35 | test( 36 | "Reject resolves - Finally - Resolve", 37 | sub { 38 | delay_me_error(0.1) # 39 | ->catch( sub {@vals} ) # 40 | ->finally( sub { got_vals(@_); out('Finally') } ) # 41 | ->then( \&got_vals ); 42 | }, 43 | [ 'Got vals', 'Finally', 'Got vals' ] 44 | ); 45 | 46 | test( 47 | "Reject dies - Finally - Reject", 48 | sub { 49 | delay_me_error(0.1) # 50 | ->catch( sub { die "Died\n" } ) # 51 | ->finally( sub { got_error(@_); out('Finally') } ) # 52 | ->catch( \&got_error ); 53 | }, 54 | [ 'Got error', 'Finally', 'Got error' ] 55 | ); 56 | 57 | test( 58 | "Resolve dies - Finally - Reject", 59 | sub { 60 | delay_me(0.1) # 61 | ->then( sub { die "Died\n" } ) # 62 | ->finally( sub { got_error(@_); out('Finally') } ) # 63 | ->catch( \&got_error ); 64 | }, 65 | [ 'Got error', 'Finally', 'Got error' ] 66 | ); 67 | 68 | # Finally throws error 69 | test( 70 | "Resolve - Finally dies - Resolve", 71 | sub { 72 | delay_me(0.1) # 73 | ->then( sub {@vals} ) # 74 | ->finally( sub { got_vals(@_); out('Finally'); die('Foo') } ) # 75 | ->then( \&got_vals ); 76 | }, 77 | [ 'Got vals', 'Finally', 'Got vals' ] 78 | ); 79 | 80 | test( 81 | "Reject resolves - Finally dies - Resolve", 82 | sub { 83 | delay_me_error(0.1) # 84 | ->catch( sub {@vals} ) # 85 | ->finally( sub { got_vals(@_); out('Finally'); die('Foo') } ) # 86 | ->then( \&got_vals ); 87 | }, 88 | [ 'Got vals', 'Finally', 'Got vals' ] 89 | ); 90 | 91 | test( 92 | "Reject dies - Finally dies - Reject", 93 | sub { 94 | delay_me_error(0.1) # 95 | ->catch( sub { die "Died\n" } ) # 96 | ->finally( sub { got_error(@_); out('Finally'); die('Foo') } ) # 97 | ->catch( \&got_error ); 98 | }, 99 | [ 'Got error', 'Finally', 'Got error' ] 100 | ); 101 | 102 | test( 103 | "Resolve dies - Finally dies - Reject", 104 | sub { 105 | delay_me(0.1) # 106 | ->then( sub { die "Died\n" } ) # 107 | ->finally( sub { got_error(@_); out('Finally'); die('Foo') } ) # 108 | ->catch( \&got_error ); 109 | }, 110 | [ 'Got error', 'Finally', 'Got error' ] 111 | ); 112 | 113 | # Finally returns resolved promise 114 | test( 115 | "Resolve - Finally resolves - Resolve", 116 | sub { 117 | delay_me(0.1) # 118 | ->then( sub {@vals} ) # 119 | ->finally( 120 | sub { 121 | got_vals(@_); 122 | out('Finally'); 123 | delay_me(0.1)->then( sub { out('Resolved') } ); 124 | } 125 | ) # 126 | ->then( \&got_vals ); 127 | }, 128 | [ 'Got vals', 'Finally', 'Resolved', 'Got vals' ] 129 | ); 130 | 131 | test( 132 | "Reject resolves - Finally resolves - Resolve", 133 | sub { 134 | delay_me_error(0.1) # 135 | ->catch( sub {@vals} ) # 136 | ->finally( 137 | sub { 138 | got_vals(@_); 139 | out('Finally'); 140 | delay_me(0.1)->then( sub { out('Resolved') } ); 141 | } 142 | ) # 143 | ->then( \&got_vals ); 144 | }, 145 | [ 'Got vals', 'Finally', 'Resolved', 'Got vals' ] 146 | ); 147 | 148 | test( 149 | "Reject dies - Finally resolves - Reject", 150 | sub { 151 | delay_me_error(0.1) # 152 | ->catch( sub { die "Died\n" } ) # 153 | ->finally( 154 | sub { 155 | got_error(@_); 156 | out('Finally'); 157 | delay_me(0.1)->then( sub { out('Resolved') } ); 158 | } 159 | ) # 160 | ->catch( \&got_error ); 161 | }, 162 | [ 'Got error', 'Finally', 'Resolved', 'Got error' ] 163 | ); 164 | 165 | test( 166 | "Resolve dies - Finally resolves - Reject", 167 | sub { 168 | delay_me(0.1) # 169 | ->then( sub { die "Died\n" } ) # 170 | ->finally( 171 | sub { 172 | got_error(@_); 173 | out('Finally'); 174 | delay_me(0.1)->then( sub { out('Resolved') } ); 175 | } 176 | ) # 177 | ->catch( \&got_error ); 178 | }, 179 | [ 'Got error', 'Finally', 'Resolved', 'Got error' ] 180 | ); 181 | 182 | # Finally returns rejected promise 183 | test( 184 | "Resolve - Finally rejects - Resolve", 185 | sub { 186 | delay_me(0.1) # 187 | ->then( sub {@vals} ) # 188 | ->finally( 189 | sub { 190 | got_vals(@_), out('Finally'); 191 | delay_me_error(0.1)->catch( sub { out('Rejected') } ); 192 | } 193 | ) # 194 | ->then( \&got_vals, sub {"NO"} ); 195 | }, 196 | [ 'Got vals', 'Finally', 'Rejected', 'Got vals' ] 197 | ); 198 | 199 | test( 200 | "Reject resolves - Finally rejects - Resolve", 201 | sub { 202 | delay_me_error(0.1) # 203 | ->catch( sub {@vals} ) # 204 | ->finally( 205 | sub { 206 | got_vals(@_); 207 | out('Finally'); 208 | delay_me_error(0.1)->catch( sub { out('Rejected') } ); 209 | } 210 | ) # 211 | ->then( \&got_vals ); 212 | }, 213 | [ 'Got vals', 'Finally', 'Rejected', 'Got vals' ] 214 | ); 215 | 216 | test( 217 | "Reject dies - Finally rejects - Reject", 218 | sub { 219 | delay_me_error(0.1) # 220 | ->catch( sub { die "Died\n" } ) # 221 | ->finally( 222 | sub { 223 | got_error(@_); 224 | out('Finally'); 225 | delay_me_error(0.1)->catch( sub { out('Rejected') } ); 226 | } 227 | ) # 228 | ->catch( \&got_error ); 229 | }, 230 | [ 'Got error', 'Finally', 'Rejected', 'Got error' ] 231 | ); 232 | 233 | test( 234 | "Resolve dies - Finally rejects - Reject", 235 | sub { 236 | delay_me(0.1) # 237 | ->then( sub { die "Died\n" } ) # 238 | ->finally( 239 | sub { 240 | got_error(@_); 241 | out('Finally'); 242 | delay_me_error(0.1)->catch( sub { out('Rejected') } ); 243 | } 244 | ) # 245 | ->catch( \&got_error ); 246 | }, 247 | [ 'Got error', 'Finally', 'Rejected', 'Got error' ] 248 | ); 249 | 250 | #=================================== 251 | sub test { 252 | #=================================== 253 | my ( $name, $cb, $expect ) = @_; 254 | @out = (); 255 | my $cv = AE::cv; 256 | 257 | $cb->()->then( sub { $cv->send }, sub { $cv->send } ); 258 | $cv->recv; 259 | 260 | # diag ""; 261 | # diag "$name"; 262 | # diag "Expect: @$expect"; 263 | # diag "Got: @out"; 264 | no warnings 'uninitialized'; 265 | return fail $name unless @out == @$expect; 266 | for ( 0 .. @out ) { 267 | return fail $name unless $out[$_] eq $expect->[$_]; 268 | } 269 | pass $name; 270 | 271 | } 272 | 273 | sub got_vals { 274 | no warnings 'uninitialized'; 275 | $_[0] eq $vals[0] && $_[1] eq $vals[1] 276 | ? out('Got vals') 277 | : out('No vals'); 278 | } 279 | 280 | sub got_error { 281 | no warnings 'uninitialized'; 282 | $_[0] eq "Died\n" 283 | ? out('Got error') 284 | : out('No error'); 285 | } 286 | 287 | sub out { 288 | push @out, shift(); 289 | } 290 | 291 | done_testing; 292 | -------------------------------------------------------------------------------- /lib/Promises/Cookbook/SynopsisBreakdown.pod: -------------------------------------------------------------------------------- 1 | package Promises::Cookbook::SynopsisBreakdown; 2 | 3 | # ABSTRACT: A breakdown of the SYNOPSIS section of Promises 4 | 5 | =pod 6 | 7 | =head1 SYNOPSIS 8 | 9 | use AnyEvent::HTTP; 10 | use JSON::XS qw[ decode_json ]; 11 | use Promises qw[ collect deferred ]; 12 | 13 | sub fetch_it { 14 | my ($uri) = @_; 15 | my $d = deferred; 16 | http_get $uri => sub { 17 | my ($body, $headers) = @_; 18 | $headers->{Status} == 200 19 | ? $d->resolve( decode_json( $body ) ) 20 | : $d->reject( $body ) 21 | }; 22 | $d->promise; 23 | } 24 | 25 | my $cv = AnyEvent->condvar; 26 | 27 | collect( 28 | fetch_it('http://rest.api.example.com/-/product/12345'), 29 | fetch_it('http://rest.api.example.com/-/product/suggestions?for_sku=12345'), 30 | fetch_it('http://rest.api.example.com/-/product/reviews?for_sku=12345'), 31 | )->then( 32 | sub { 33 | my ($product, $suggestions, $reviews) = @_; 34 | $cv->send({ 35 | product => $product, 36 | suggestions => $suggestions, 37 | reviews => $reviews, 38 | }) 39 | }, 40 | sub { $cv->croak( 'ERROR' ) } 41 | ); 42 | 43 | my $all_product_info = $cv->recv; 44 | 45 | =head1 DESCRIPTION 46 | 47 | The example in the synopsis actually demonstrates a number of the 48 | features of this module, this section will break down each part 49 | and explain them in order. 50 | 51 | sub fetch_it { 52 | my ($uri) = @_; 53 | my $d = deferred; 54 | http_get $uri => sub { 55 | my ($body, $headers) = @_; 56 | $headers->{Status} == 200 57 | ? $d->resolve( decode_json( $body ) ) 58 | : $d->reject( $body ) 59 | }; 60 | $d->promise; 61 | } 62 | 63 | First is the C function, the pattern within this function 64 | is the typical way in which you might wrap an async function call 65 | of some kind. The first thing we do it to create an instance of 66 | L using the C function, this is the 67 | class which does the majority of the work or managing callbacks 68 | and the like. Then within the callback for our async function, 69 | we will call methods on the L instance. In the 70 | case we first check the response headers to see if the request was 71 | a success, if so, then we call the C method and pass the 72 | decoded JSON to it. If the request failed, we then call the C 73 | method and send back the data from the body. Finally we call the 74 | C method and return the promise 'handle' for this deferred 75 | instance. 76 | 77 | At this point out asynchronous operation will typically be in 78 | progress, but control has been returned to the rest of our 79 | program. Now, before we dive into the rest of the example, lets 80 | take a quick detour to look at what promises do. Take the following 81 | code for example: 82 | 83 | my $p = fetch_it('http://rest.api.example.com/-/user/bob@example.com'); 84 | 85 | At this point, our async operation is running, but we have not yet 86 | given it anything to do when the callback is fired. We will get to 87 | that shortly, but first lets look at what information we can get 88 | from the promise. 89 | 90 | $p->status; 91 | 92 | Calling the C method will return a string representing the 93 | status of the promise. This will be either I, I, 94 | I (meaning it is in the process of resolving), I 95 | or I (meaning it is in the process of rejecting). 96 | (NOTE: these are also constants on the L class, 97 | C, C, C, etc., but they are also 98 | available as predicate methods in both the L class 99 | and proxied in the L class). At this point, this 100 | method call is likely to return I. Next is the C 101 | method: 102 | 103 | $p->result; 104 | 105 | which will give us back the values that are passed to either C 106 | or C on the associated L instance. 107 | 108 | Now, one thing to keep in mind before we go any further is that our 109 | promise is really just a thin proxy over the associated L 110 | instance, it stores no state itself, and when these methods are called on 111 | it, it simply forwards the call to the associated L 112 | instance (which, as I said before, is where all the work is done). 113 | 114 | So, now, lets actually do something with this promise. So as I said above 115 | the goal of the Promise pattern is to reduce the callback spaghetti that 116 | is often created with writing async code. This does not mean that we have 117 | no callbacks at all, we still need to have some kind of callback, the 118 | difference is all in how those callbacks are managed and how we can more 119 | easily go about providing some level of sequencing and control. 120 | 121 | That all said, lets register a callback with our promise. 122 | 123 | $p->then( 124 | sub { 125 | my ($user) = @_; 126 | do_something_with_a_user( $user ); 127 | }, 128 | sub { 129 | my ($err) = @_; 130 | warn "An error was received : $err"; 131 | } 132 | ); 133 | 134 | As you can see, we use the C method (again, keep in mind this is 135 | just proxying to the associated L instance) and 136 | passed it two callbacks, the first is for the success case (if C 137 | has been called on our associated L instance) and 138 | the second is the error case (if C has been called on our 139 | associated L instance). Both of these callbacks will 140 | receive the arguments that were passed to C or C as 141 | their only arguments, as you might have guessed, these values are the 142 | same values you would get if you called C on the promise 143 | (assuming the async operation was completed). 144 | 145 | It should be noted that the error callback is optional. If it is not 146 | specified then errors will be silently eaten (similar to a C block 147 | that has not C). If there is a chain of promises however, the 148 | error will continue to bubble to the last promise in the chain and 149 | if there is an error callback there, it will be called. This allows 150 | you to concentrate error handling in the places where it makes the most 151 | sense, and ignore it where it doesn't make sense. As I alluded to above, 152 | this is very similar to nested C blocks. 153 | 154 | And really, that's all there is to it. You can continue to call C 155 | on a promise and it will continue to accumulate callbacks, which will 156 | be executed in FIFO order once a call is made to either C 157 | or C on the associated L instance. And in 158 | fact, it will even work after the async operation is complete. Meaning 159 | that if you call C and the async operation is already completed, 160 | your callback will be executed immediately. 161 | 162 | So, now lets get back to our original example. I will briefly explain 163 | my usage of the L C, but I encourage you to review 164 | the docs for L yourself if my explanation is not enough. 165 | 166 | So, the idea behind my usage of the C is to provide a 167 | merge-point in my code at which point I want all the asynchronous 168 | operations to converge, after which I can resume normal synchronous 169 | programming (if I so choose). It provides a kind of a transaction 170 | wrapper if you will, around my async operations. So, first step is 171 | to actually create that C. 172 | 173 | my $cv = AnyEvent->condvar; 174 | 175 | Next, we jump back into the land of Promises. Now I am breaking apart 176 | the calling of C and the subsequent chained C call here 177 | to help keep things in digestible chunks, but also to illustrate that 178 | C just returns a promise (as you might have guessed anyway). 179 | 180 | my $p = collect( 181 | fetch_it('http://rest.api.example.com/-/product/12345'), 182 | fetch_it('http://rest.api.example.com/-/product/suggestions?for_sku=12345'), 183 | fetch_it('http://rest.api.example.com/-/product/reviews?for_sku=12345'), 184 | ); 185 | 186 | So, what is going on here is that we want to be able to run multiple 187 | async operations in parallel, but we need to wait for all of them to 188 | complete before we can move on, and C gives us that ability. 189 | As we know from above, C is returning a promise, so obviously 190 | C takes an array of promises as its parameters. As we said before 191 | C also returns a promise, which is just a handle on a 192 | C instance it created to watch and handle the 193 | multiple promises you passed it. Okay, so now lets move onto adding 194 | callbacks to our promise that C returned to us. 195 | 196 | $p->then( 197 | sub { 198 | my ($product, $suggestions, $reviews) = @_; 199 | $cv->send({ 200 | product => $product, 201 | suggestions => $suggestions, 202 | reviews => $reviews, 203 | }) 204 | }, 205 | sub { $cv->croak( 'ERROR' ) } 206 | ); 207 | 208 | So, you will notice that, as before, we provide a success and an error 209 | callback, but you might notice one slight difference in the success 210 | callback. It is actually being passed multiple arguments, these are 211 | the results of the three C calls passed into C, and yes, 212 | they are passed to the callback in the same order you passed them into 213 | C. So from here we jump back into the world of C, and 214 | we call the C method and pass it our newly assembled set of 215 | collected product info. As I said above, C are a way of 216 | wrapping your async operations into a transaction like block, when 217 | code execution encounters a C, such as in our next line of code: 218 | 219 | my $all_product_info = $cv->recv; 220 | 221 | the event loop will block until a corresponding C is called on 222 | the C. While you are not required to pass arguments to C 223 | it will accept them and the will in turn be the return values of 224 | the corresponding C, which makes for an incredibly convenient 225 | means of passing data around your asynchronous program. 226 | 227 | It is also worth noting the usage of the C method on the 228 | C in the error callback. This is the preferred way of 229 | dealing with exceptions in L because it will actually 230 | cause the exception to be thrown from C and not somewhere 231 | deep within a callback. 232 | 233 | And that is all of it, once C returns, our program will go 234 | back to normal synchronous operation and we can do whatever it is 235 | we like with C<$all_product_info>. 236 | 237 | =cut 238 | 239 | __END__ 240 | -------------------------------------------------------------------------------- /lib/Promises/Deferred.pm: -------------------------------------------------------------------------------- 1 | package Promises::Deferred; 2 | 3 | # ABSTRACT: An implementation of Promises in Perl 4 | 5 | use strict; 6 | use warnings; 7 | 8 | use Scalar::Util qw[ blessed reftype ]; 9 | use Carp qw[ confess carp ]; 10 | 11 | use Promises::Promise; 12 | 13 | use constant IN_PROGRESS => 'in progress'; 14 | use constant RESOLVED => 'resolved'; 15 | use constant REJECTED => 'rejected'; 16 | 17 | sub new { 18 | my $class = shift; 19 | 20 | my $caller = $Promises::WARN_ON_UNHANDLED_REJECT ? _trace() : undef ; 21 | 22 | bless { 23 | _caller => $caller, 24 | resolved => [], 25 | rejected => [], 26 | status => IN_PROGRESS 27 | } => $class; 28 | } 29 | 30 | sub _trace { 31 | my $i = 0; 32 | 33 | while( my( $package, $filename, $line ) = caller($i++) ) { 34 | return [ $filename, $line ] unless $package =~ /^Promises/; 35 | } 36 | 37 | return 38 | } 39 | 40 | sub promise { Promises::Promise->new(shift) } 41 | sub status { (shift)->{'status'} } 42 | sub result { (shift)->{'result'} } 43 | 44 | # predicates for all the status possibilities 45 | sub is_in_progress { (shift)->{'status'} eq IN_PROGRESS } 46 | sub is_resolved { (shift)->{'status'} eq RESOLVED } 47 | sub is_rejected { (shift)->{'status'} eq REJECTED } 48 | sub is_done { ! $_[0]->is_in_progress } 49 | 50 | # the three possible states according to the spec ... 51 | sub is_unfulfilled { (shift)->is_in_progress } 52 | sub is_fulfilled { $_[0]->is_resolved } 53 | sub is_failed { $_[0]->is_rejected } 54 | 55 | sub resolve { 56 | my $self = shift; 57 | 58 | confess "Cannot resolve. Already " . $self->status 59 | unless $self->is_in_progress; 60 | 61 | $self->{'result'} = [@_]; 62 | $self->{'status'} = RESOLVED; 63 | $self->_notify; 64 | $self; 65 | } 66 | 67 | sub reject { 68 | my $self = shift; 69 | confess "Cannot reject. Already " . $self->status 70 | unless $self->is_in_progress; 71 | 72 | $self->{'result'} = [@_]; 73 | $self->{'status'} = REJECTED; 74 | $self->_notify; 75 | $self; 76 | } 77 | 78 | sub then { 79 | my $self = shift; 80 | my ( $callback, $error ) = $self->_callable_or_undef(@_); 81 | 82 | my $d = ( ref $self )->new; 83 | push @{ $self->{'resolved'} } => $self->_wrap( $d, $callback, 'resolve' ); 84 | push @{ $self->{'rejected'} } => $self->_wrap( $d, $error, 'reject' ); 85 | 86 | $self->_notify unless $self->is_in_progress; 87 | $d->promise; 88 | } 89 | 90 | sub chain { 91 | my $self = shift; 92 | $self = $self->then($_) for @_; 93 | return $self; 94 | } 95 | 96 | sub catch { 97 | my $self = shift; 98 | $self->then( undef, @_ ); 99 | } 100 | 101 | sub done { 102 | my $self = shift; 103 | my ( $callback, $error ) = $self->_callable_or_undef(@_); 104 | push @{ $self->{'resolved'} } => $callback if defined $callback; 105 | push @{ $self->{'rejected'} } => $error if defined $error; 106 | 107 | $self->_notify unless $self->is_in_progress; 108 | (); 109 | } 110 | 111 | sub finally { 112 | my $self = shift; 113 | my ($callback) = $self->_callable_or_undef(@_); 114 | 115 | my $d = ( ref $self )->new; 116 | 117 | if (defined $callback) { 118 | my ( @result, $method ); 119 | my $finish_d = sub { $d->$method(@result); () }; 120 | 121 | my $f = sub { 122 | ( $method, @result ) = @_; 123 | local $@; 124 | my ($p) = eval { $callback->(@result) }; 125 | if ( $p && blessed $p && $p->can('then') ) { 126 | return $p->then( $finish_d, $finish_d ); 127 | } 128 | $finish_d->(); 129 | (); 130 | }; 131 | 132 | push @{ $self->{'resolved'} } => sub { $f->( 'resolve', @_ ) }; 133 | push @{ $self->{'rejected'} } => sub { $f->( 'reject', @_ ) }; 134 | 135 | $self->_notify unless $self->is_in_progress; 136 | } 137 | $d->promise; 138 | 139 | } 140 | 141 | sub timeout { 142 | my ( $self, $timeout ) = @_; 143 | 144 | unless( $self->can('_timeout') ) { 145 | carp "timeout mechanism not implemented for Promise backend ", ref $self; 146 | return $self->promise; 147 | } 148 | 149 | my $deferred = ref($self)->new; 150 | 151 | my $cancel = $deferred->_timeout($timeout, sub { 152 | return if $deferred->is_done; 153 | $deferred->reject( 'timeout' ); 154 | } ); 155 | 156 | $self->finally( $cancel )->then( 157 | sub { 'resolve', @_ }, 158 | sub { 'reject', @_ }, 159 | )->then(sub { 160 | my( $action, @args ) = @_; 161 | $deferred->$action(@args) unless $deferred->is_done; 162 | }); 163 | 164 | return $deferred->promise; 165 | } 166 | 167 | sub _wrap { 168 | my ( $self, $d, $f, $method ) = @_; 169 | 170 | return sub { $d->$method( @{ $self->result } ) } 171 | unless defined $f; 172 | 173 | return sub { 174 | local $@; 175 | my ( @results, $error ); 176 | eval { 177 | @results = do { $f->(@_) }; 178 | 1; 179 | } 180 | || do { $error = defined $@ ? $@ : 'Unknown reason' }; 181 | 182 | if ($error) { 183 | $d->reject($error); 184 | } 185 | elsif ( @results == 1 186 | and blessed $results[0] 187 | and $results[0]->can('then') ) 188 | { 189 | $results[0]->then( 190 | sub { $d->resolve(@_); () }, 191 | sub { $d->reject(@_); () }, 192 | ); 193 | } 194 | else { 195 | $d->resolve(@results); 196 | } 197 | return; 198 | }; 199 | } 200 | 201 | sub _notify { 202 | my ($self) = @_; 203 | 204 | my $cbs = $self->is_resolved ? $self->{resolved} : $self->{rejected}; 205 | 206 | $self->{_reject_was_handled} = $self->is_rejected && @$cbs; 207 | 208 | $self->{'resolved'} = []; 209 | $self->{'rejected'} = []; 210 | 211 | return $self->_notify_backend( $cbs, $self->result ); 212 | } 213 | 214 | sub _notify_backend { 215 | my ( $self, $cbs, $result ) = @_; 216 | $_->(@$result) foreach @$cbs; 217 | } 218 | 219 | sub _callable_or_undef { 220 | shift; 221 | map { 222 | # coderef or object overloaded as coderef 223 | ref && reftype $_ eq 'CODE' || blessed $_ && $_->can('()') 224 | ? $_ 225 | : undef 226 | } @_; 227 | } 228 | 229 | 230 | 1; 231 | 232 | __END__ 233 | 234 | =head1 SYNOPSIS 235 | 236 | use Promises::Deferred; 237 | 238 | sub fetch_it { 239 | my ($uri) = @_; 240 | my $d = Promises::Deferred->new; 241 | http_get $uri => sub { 242 | my ($body, $headers) = @_; 243 | $headers->{Status} == 200 244 | ? $d->resolve( decode_json( $body ) ) 245 | : $d->reject( $body ) 246 | }; 247 | $d->promise; 248 | } 249 | 250 | =head1 DESCRIPTION 251 | 252 | This class is meant only to be used by an implementor, 253 | meaning users of your functions/classes/modules should 254 | always interact with the associated promise object, but 255 | you (as the implementor) should use this class. Think 256 | of this as the engine that drives the promises and the 257 | promises as the steering wheels that control the 258 | direction taken. 259 | 260 | =head1 CALLBACKS 261 | 262 | Wherever a callback is mentioned below, it may take the form 263 | of a coderef: 264 | 265 | sub {...} 266 | 267 | or an object which has been overloaded to allow calling as a 268 | coderef: 269 | 270 | use AnyEvent; 271 | 272 | my $cv = AnyEvent->cond_var; 273 | fetch_it('http://metacpan.org') 274 | ->then( sub { say "Success"; return @_ }) 275 | ->then( $cv, sub { $cv->croak(@_)} ) 276 | 277 | 278 | =head1 METHODS 279 | 280 | =over 4 281 | 282 | =item C 283 | 284 | This will construct an instance, it takes no arguments. 285 | 286 | =item C 287 | 288 | This will return a L that can be used 289 | as a handle for this object. It will return a new one 290 | every time it is called. 291 | 292 | =item C 293 | 294 | This will return the status of the asynchronous 295 | operation, which will be either 'in progress', 'resolved' 296 | or 'rejected'. These three strings are also constants 297 | in this package (C, C and C 298 | respectively), which can be used to check these values. 299 | 300 | =item C 301 | 302 | This will return the result that has been passed to either 303 | the C or C methods. It will always return 304 | an ARRAY reference since both C and C 305 | take a variable number of arguments. 306 | 307 | =item C 308 | 309 | This method is used to register two callbacks, both of which are optional. The 310 | first C<$callback> will be called on success and it will be passed all the 311 | values that were sent to the corresponding call to C. The second, 312 | C<$error> will be called on error, and will be passed all the values that were 313 | sent to the corresponding C. It should be noted that this method will 314 | always return a new L instance so that you can chain things 315 | if you like. 316 | 317 | The success and error callbacks are wrapped in an C block, so you can 318 | safely call C within a callback to signal an error without killing your 319 | application. If an exception is caught, the next link in the chain will be 320 | C'ed and receive the exception in C<@_>. 321 | 322 | If this is the last link in the chain, and there is no C<$error> callback, the 323 | error will be swallowed silently. You can still find it by checking the 324 | C method, but no action will be taken. If this is not the last link in 325 | the chain, and no C<$error> is specified, we will attempt to bubble the error 326 | to the next link in the chain. This allows error handling to be consolidated 327 | at the point in the chain where it makes the most sense. 328 | 329 | =item C 330 | 331 | Utility method that takes a list of callbacks and turn them into a sequence 332 | of Cs. 333 | 334 | $promise->then( sub { ...code A... } ) 335 | ->then( sub { ...code B... } ) 336 | ->then( sub { ...code C... } ); 337 | 338 | # equivalent to 339 | 340 | $promise->chain( 341 | sub { ...code A... } ), 342 | sub { ...code B... } ), 343 | sub { ...code C... } ), 344 | ); 345 | 346 | 347 | =item C 348 | 349 | This method registers a a single error callback. It is the equivalent 350 | of calling: 351 | 352 | $promise->then( sub {@_}, $error ); 353 | 354 | =item C 355 | 356 | This method is used to register two callbacks, the first C<$callback> will be 357 | called on success and it will be passed all the values that were sent to the 358 | corresponding call to C. The second, C<$error> is optional and will 359 | be called on error, and will be passed the all the values that were sent to 360 | the corresponding C. 361 | 362 | Unlike the C method, C returns an empty list specifically to 363 | break the chain and to avoid deep recursion. See the explanation in 364 | L. 365 | 366 | Also unlike the C method, C callbacks are not wrapped in an 367 | C block, so calling C is not safe. What will happen if a C 368 | callback calls C depends on which event loop you are running: the pure 369 | Perl L will throw an exception, while L and 370 | L will warn and continue running. 371 | 372 | =item C 373 | 374 | This method is like the C keyword in a C/C block. It 375 | will execute regardless of whether the promise has been resolved or rejected. 376 | Typically it is used to clean up resources, like closing open files etc. It 377 | returns a L and so can be chained. The return value is 378 | discarded and the success or failure of the C callback will have no 379 | effect on promises further down the chain. 380 | 381 | =item C 382 | 383 | For asynchronous backend, returns a new promise that either takes on 384 | the result of the current promise or is rejected after the given delay, 385 | whichever comes first. 386 | 387 | The default synchronous backend does not implement a timer function. The method, in 388 | that case, returns a chained promise that carries over the resolution of the 389 | current promise and emits a warning. 390 | 391 | 392 | =item C 393 | 394 | This is the method to call upon the successful completion of your asynchronous 395 | operation, meaning typically you would call this within the callback that you 396 | gave to the asynchronous function/method. It takes an arbitrary list of 397 | arguments and captures them as the C of this promise (so obviously 398 | they can be retrieved with the C method). 399 | 400 | =item C 401 | 402 | This is the method to call when an error occurs during your asynchronous 403 | operation, meaning typically you would call this within the callback that you 404 | gave to the asynchronous function/method. It takes an arbitrary list of 405 | arguments and captures them as the C of this promise (so obviously 406 | they can be retrieved with the C method). 407 | 408 | =item C 409 | 410 | This is a predicate method against the status value, it 411 | returns true if the status is C. 412 | 413 | =item C 414 | 415 | This is a predicate method against the status value, it 416 | returns true if the status is C. 417 | 418 | =item C 419 | 420 | This is a predicate method against the status value, it 421 | returns true if the status is C. 422 | 423 | =item C 424 | 425 | This is a predicate method against the status value, it 426 | returns true if the status is either C or C. 427 | 428 | =item C 429 | 430 | This is a predicate method against the status value, it 431 | returns true if the status is still C. 432 | 433 | =item C 434 | 435 | This is a predicate method against the status value, it 436 | returns true if the status is C or if the 437 | status is C. 438 | 439 | =item C 440 | 441 | This is a predicate method against the status value, it 442 | returns true of the status is C or if the 443 | status if C. 444 | 445 | =back 446 | 447 | 448 | 449 | -------------------------------------------------------------------------------- /lib/Promises.pm: -------------------------------------------------------------------------------- 1 | package Promises; 2 | 3 | # ABSTRACT: An implementation of Promises in Perl 4 | 5 | use strict; 6 | use warnings; 7 | 8 | use Scalar::Util qw[ blessed ]; 9 | use Promises::Deferred; 10 | our $Backend = 'Promises::Deferred'; 11 | 12 | our $WARN_ON_UNHANDLED_REJECT = 0; 13 | 14 | use Sub::Exporter -setup => { 15 | 16 | collectors => [ 17 | 'backend' => \'_set_backend', 18 | 'warn_on_unhandled_reject' => \'_set_warn_on_unhandled_reject', 19 | ], 20 | exports => [qw[ 21 | deferred resolved rejected 22 | collect collect_hash 23 | ]] 24 | }; 25 | 26 | sub _set_warn_on_unhandled_reject { 27 | my( undef, $arg ) = @_; 28 | 29 | if( $WARN_ON_UNHANDLED_REJECT = $arg->[0] ) { 30 | # only brings the big guns if asked for 31 | 32 | *Promises::Deferred::DESTROY = sub { 33 | 34 | return unless $WARN_ON_UNHANDLED_REJECT; 35 | 36 | my $self = shift; 37 | 38 | return unless 39 | $self->is_rejected and not $self->{_reject_was_handled}; 40 | 41 | require Data::Dumper; 42 | 43 | my $dump = 44 | Data::Dumper->new([$self->result])->Terse(1)->Dump; 45 | 46 | chomp $dump; 47 | $dump =~ s/\n\s*/ /g; 48 | 49 | warn "Promise's rejection ", $dump, 50 | " was not handled", 51 | ($self->{_caller} ? ( ' at ', join ' line ', @{$self->{_caller}} ) : ()) , "\n"; 52 | }; 53 | } 54 | } 55 | 56 | sub _set_backend { 57 | my ( undef, $arg ) = @_; 58 | my $backend = $arg->[0] or return; 59 | 60 | unless ( $backend =~ s/^\+// ) { 61 | $backend = 'Promises::Deferred::' . $backend; 62 | } 63 | require Module::Runtime; 64 | $Backend = Module::Runtime::use_module($backend) || return; 65 | return 1; 66 | 67 | } 68 | 69 | sub deferred(;&) { 70 | my $promise = $Backend->new; 71 | 72 | if ( my $code = shift ) { 73 | $promise->resolve; 74 | return $promise->then(sub{ 75 | $code->($promise); 76 | }); 77 | } 78 | 79 | return $promise; 80 | } 81 | 82 | sub resolved { deferred->resolve(@_) } 83 | sub rejected { deferred->reject(@_) } 84 | 85 | sub collect_hash { 86 | collect(@_)->then( sub { 87 | map { 88 | my @values = @$_; 89 | die "'collect_hash' promise returned more than one value: [@{[ join ', ', @values ]} ]\n" 90 | if @values > 1; 91 | 92 | @values == 1 ? $values[0] : undef; 93 | } @_ }) 94 | } 95 | 96 | sub collect { 97 | my @promises = @_; 98 | 99 | my $all_done = resolved(); 100 | 101 | my @results; 102 | for my $p ( @promises ) { 103 | if ( $p && blessed $p && $p->can('then') ) { 104 | $all_done = $all_done->then( sub { 105 | $p->then( sub { 106 | push @results, [ @_ ]; 107 | return; 108 | } ) 109 | } ); 110 | } else { 111 | # not actually a promise; collect directly 112 | $all_done = $all_done->then( sub { 113 | push @results, [ $p ]; 114 | return; 115 | } ); 116 | } 117 | } 118 | 119 | return $all_done->then( sub { @results } ); 120 | } 121 | 122 | 1; 123 | 124 | __END__ 125 | 126 | =head1 SYNOPSIS 127 | 128 | use AnyEvent::HTTP; 129 | use JSON::XS qw[ decode_json ]; 130 | use Promises qw[ collect deferred ]; 131 | 132 | sub fetch_it { 133 | my ($uri) = @_; 134 | my $d = deferred; 135 | http_get $uri => sub { 136 | my ($body, $headers) = @_; 137 | $headers->{Status} == 200 138 | ? $d->resolve( decode_json( $body ) ) 139 | : $d->reject( $body ) 140 | }; 141 | $d->promise; 142 | } 143 | 144 | my $cv = AnyEvent->condvar; 145 | 146 | collect( 147 | fetch_it('http://rest.api.example.com/-/product/12345'), 148 | fetch_it('http://rest.api.example.com/-/product/suggestions?for_sku=12345'), 149 | fetch_it('http://rest.api.example.com/-/product/reviews?for_sku=12345'), 150 | )->then( 151 | sub { 152 | my ($product, $suggestions, $reviews) = @_; 153 | $cv->send({ 154 | product => $product, 155 | suggestions => $suggestions, 156 | reviews => $reviews, 157 | }) 158 | }, 159 | sub { $cv->croak( 'ERROR' ) } 160 | ); 161 | 162 | my $all_product_info = $cv->recv; 163 | 164 | =head1 DESCRIPTION 165 | 166 | This module is an implementation of the "Promise/A+" pattern for 167 | asynchronous programming. Promises are meant to be a way to 168 | better deal with the resulting callback spaghetti that can often 169 | result in asynchronous programs. 170 | 171 | =head1 FUTURE BACKWARDS COMPATIBILITY WARNING 172 | 173 | The version of this module is being bumped up to 0.90 as the first 174 | step towards 1.0 in which the goal is to have full Promises/A+ spec 175 | compatibility. This is a departure to the previous goal of being 176 | compatible with the Promises/A spec, this means that behavior may 177 | change in subtle ways (we will attempt to document this completely 178 | and clearly whenever possible). 179 | 180 | It is B recommended that you test things very thoroughly 181 | before upgrading to this version. 182 | 183 | =head1 BACKWARDS COMPATIBILITY WARNING 184 | 185 | In version up to and including 0.08 there was a bug in how 186 | rejected promises were handled. According to the spec, a 187 | rejected callback can: 188 | 189 | =over 190 | 191 | =item * 192 | 193 | Rethrow the exception, in which case the next rejected handler 194 | in the chain would be called, or 195 | 196 | =item * 197 | 198 | Handle the exception (by not Cing), in which case the next 199 | B handler in the chain would be called. 200 | 201 | =back 202 | 203 | In previous versions of L, this last step was handled incorrectly: 204 | a rejected handler had no way of handling the exception. Once a promise 205 | was rejected, only rejected handlers in the chain would be called. 206 | 207 | =head2 Relation to the various Perl event loops 208 | 209 | This module is actually Event Loop agnostic, the SYNOPSIS above 210 | uses L, but that is just an example, it can work 211 | with any of the existing event loops out on CPAN. Over the next 212 | few releases I will try to add in documentation illustrating each 213 | of the different event loops and how best to use Promises with 214 | them. 215 | 216 | =head2 Relation to the Promise/A spec 217 | 218 | We are, with some differences, following the API spec called 219 | "Promise/A" (and the clarification that is called "Promise/A+") 220 | which was created by the Node.JS community. This is, for the most 221 | part, the same API that is implemented in the latest jQuery and 222 | in the YUI Deferred plug-in (though some purists argue that they 223 | both go it wrong, google it if you care). We differ in some 224 | respects to this spec, mostly because Perl idioms and best 225 | practices are not the same as Javascript idioms and best 226 | practices. However, the one important difference that should be 227 | noted is that "Promise/A+" strongly suggests that the callbacks 228 | given to C should be run asynchronously (meaning in the 229 | next turn of the event loop). We do not do this by default, 230 | because doing so would bind us to a given event loop 231 | implementation, which we very much want to avoid. However we 232 | now allow you to specify an event loop "backend" when using 233 | Promises, and assuming a Deferred backend has been written 234 | it will provide this feature accordingly. 235 | 236 | =head2 Using a Deferred backend 237 | 238 | As mentioned above, the default Promises::Deferred class calls the 239 | success or error C callback synchronously, because it isn't 240 | tied to a particular event loop. However, it is recommended that you 241 | use the appropriate Deferred backend for whichever event loop you are 242 | running. 243 | 244 | Typically an application uses a single event loop, so all Promises 245 | should use the same event-loop. Module implementers should just use the 246 | Promises class directly: 247 | 248 | package MyClass; 249 | use Promises qw(deferred collect); 250 | 251 | End users should specify which Deferred backend they wish to use. For 252 | instance if you are using AnyEvent, you can do: 253 | 254 | use Promises backend => ['AnyEvent']; 255 | use MyClass; 256 | 257 | The Promises returned by MyClass will automatically use whichever 258 | event loop AnyEvent is using. 259 | 260 | See: 261 | 262 | =over 1 263 | 264 | =item * L 265 | 266 | =item * L 267 | 268 | =item * L 269 | 270 | =item * L 271 | 272 | =item * L 273 | 274 | =back 275 | 276 | =head2 Relation to Promises/Futures in Scala 277 | 278 | Scala has a notion of Promises and an associated idea of Futures 279 | as well. The differences and similarities between this module 280 | and the Promises found in Scalar are highlighted in depth in a 281 | cookbook entry below. 282 | 283 | =head2 Cookbook 284 | 285 | =over 1 286 | 287 | =item L 288 | 289 | Read this first! This cookbook provides a step-by-step explanation 290 | of how Promises work and how to use them. 291 | 292 | =item L 293 | 294 | This breaks down the example in the SYNOPSIS and walks through 295 | much of the details of Promises and how they work. 296 | 297 | =item L 298 | 299 | Promise are just one of many ways to do async programming, this 300 | entry takes the Promises SYNOPSIS again and illustrates some 301 | counter examples with various modules. 302 | 303 | =item L 304 | 305 | One of the key benefits of Promises is that it retains much of 306 | the flow of a synchronous program, this entry illustrates that 307 | and compares it with a synchronous (or blocking) version. 308 | 309 | =item L 310 | 311 | This entry explains how to keep the stack under control when 312 | using Promises recursively. 313 | 314 | =item L 315 | 316 | This entry takes some examples of Futures in the Scala language 317 | and translates them into Promises. This entry also showcases 318 | using Promises with L. 319 | 320 | =back 321 | 322 | =head1 EXPORTS 323 | 324 | =over 4 325 | 326 | =item C 327 | 328 | This just creates an instance of the L class 329 | it is purely for convenience. 330 | 331 | Can take a coderef, which will be dealt with as a C argument. 332 | 333 | my $promise = deferred sub { 334 | ... do stuff ... 335 | 336 | return $something; 337 | }; 338 | 339 | # equivalent to 340 | 341 | my $dummy = deferred; 342 | 343 | my $promise = $dummy->then(sub { 344 | ... do stuff ... 345 | 346 | return $something; 347 | }); 348 | 349 | $dummy->resolve; 350 | 351 | =item C 352 | 353 | Creates an instance of L resolved with 354 | the provided C<@values>. Purely a shortcut for 355 | 356 | my $promise = deferred; 357 | $promise->resolve(@values); 358 | 359 | =item C 360 | 361 | Creates an instance of L rejected with 362 | the provided C<@values>. Purely a shortcut for 363 | 364 | my $promise = deferred; 365 | $promise->reject(@values); 366 | 367 | =item C 368 | 369 | Accepts a list of L objects and then 370 | returns a L object which will be called 371 | once all the C<@promises> have completed (either as an error 372 | or as a success). 373 | 374 | The eventual result of the returned promise 375 | object will be an array of all the results of each 376 | of the C<@promises> in the order in which they where passed 377 | to C originally, wrapped in arrayrefs, or the first error if 378 | at least one of the promises fail. 379 | 380 | If C is passed a value that is not a promise, it'll be wrapped 381 | in an arrayref and passed through. 382 | 383 | my $p1 = deferred; 384 | my $p2 = deferred; 385 | $p1->resolve(1); 386 | $p2->resolve(2,3); 387 | 388 | collect( 389 | $p1, 390 | 'not a promise', 391 | $p2, 392 | )->then(sub{ 393 | print join ' : ', map { join ', ', @$_ } @_; # => "1 : not a promise : 2, 3" 394 | }) 395 | 396 | =item C 397 | 398 | Like C, but flatten its returned arrayref into a single 399 | hash-friendly list. 400 | 401 | C can be useful to a structured hash instead 402 | of a long list of promise values. 403 | 404 | For example, 405 | 406 | my $id = 12345; 407 | 408 | collect( 409 | fetch_it("http://rest.api.example.com/-/product/$id"), 410 | fetch_it("http://rest.api.example.com/-/product/suggestions?for_sku=$id"), 411 | fetch_it("http://rest.api.example.com/-/product/reviews?for_sku=$id"), 412 | )->then( 413 | sub { 414 | my ($product, $suggestions, $reviews) = @_; 415 | $cv->send({ 416 | product => $product, 417 | suggestions => $suggestions, 418 | reviews => $reviews, 419 | id => $id 420 | }) 421 | }, 422 | sub { $cv->croak( 'ERROR' ) } 423 | ); 424 | 425 | could be rewritten as 426 | 427 | my $id = 12345; 428 | 429 | collect_hash( 430 | id => $id, 431 | product => fetch_it("http://rest.api.example.com/-/product/$id"), 432 | suggestions => fetch_it("http://rest.api.example.com/-/product/suggestions?for_sku=$id"), 433 | reviews => fetch_it("http://rest.api.example.com/-/product/reviews?for_sku=$id"), 434 | )->then( 435 | sub { 436 | my %results = @_; 437 | $cv->send(\%results); 438 | }, 439 | sub { $cv->croak( 'ERROR' ) } 440 | ); 441 | 442 | Note that all promise values of the key/value pairs passed to C 443 | must return a scalar or nothing, as returning more than one value would 444 | mess up the returned hash format. If a promise does return more than 445 | one value, C will consider it as having failed. 446 | 447 | If you know that a 448 | promise can return more than one value, you can do: 449 | 450 | my $collected = collect_hash( 451 | this => $promise_returning_scalar, 452 | that => $promise_returning_list->then(sub{ [ @_ ] } ), 453 | ); 454 | 455 | =back 456 | 457 | =head1 SEE ALSO 458 | 459 | =head2 Promises in General 460 | 461 | =over 4 462 | 463 | =item L 464 | 465 | =item L 466 | 467 | =item L 468 | 469 | =item L 470 | 471 | =item L 472 | 473 | =back 474 | 475 | =head2 Perl Alternatives 476 | 477 | =over 478 | 479 | =item L 480 | 481 | =item L 482 | 483 | Part of the L package. 484 | 485 | =item L 486 | 487 | =item L 488 | 489 | =item L 490 | 491 | =item L 492 | 493 | =back 494 | 495 | 496 | 497 | 498 | 499 | 500 | 501 | 502 | 503 | -------------------------------------------------------------------------------- /lib/Promises/Cookbook/GentleIntro.pod: -------------------------------------------------------------------------------- 1 | package Promises::Cookbook::GentleIntro; 2 | 3 | # ABSTRACT: All you need to know about Promises 4 | 5 | =pod 6 | 7 | =head1 All you need to know about Promises 8 | 9 | =encoding utf8 10 | 11 | If you have ever done any async programming, you will be familiar with 12 | "callback hell", where one callback calls another, calls another, calls 13 | another... Promises give us back a top-to-bottom coding style, making async 14 | code easier to manage and understand. It looks like synchronous code, but 15 | execution is asynchronous. 16 | 17 | The L module is event loop agnostic - it can be used with any event 18 | loop. Backends exist for L (and thus all the event loops supported 19 | by AnyEvent) and L. But more of this later in 20 | L. 21 | 22 | There are two moving parts: 23 | 24 | =over 25 | 26 | =item Deferred objects 27 | 28 | Deferred objects provide the interface to a specific async request. They 29 | execute some asynchronous action and return a promise. 30 | 31 | =item Promise objects 32 | 33 | A promise is like a placeholder for a future result. The promise will either 34 | be I in case of success, or I in case of failure. Promises 35 | can be chained together, and each step in the chain is executed sequentially. 36 | 37 | =back 38 | 39 | The easiest way to understand how Deferred and Promise objects work is by 40 | example. 41 | 42 | =head2 Deferred objects 43 | 44 | A deferred object is used to signal the success or failure of some async 45 | action which can be implemented in the async library of your choice. For 46 | instance: 47 | 48 | use Promises qw(deferred); 49 | use AnyEvent::HTTP qw(http_get); 50 | use JSON qw(decode_json); 51 | 52 | sub fetch_it { 53 | my ($uri) = @_; 54 | my $deferred = deferred; 55 | http_get $uri => sub { 56 | my ($body, $headers) = @_; 57 | $headers->{Status} == 200 58 | ? $deferred->resolve( decode_json($body) ) 59 | : $deferred->reject( $headers->{Reason} ) 60 | }; 61 | $deferred->promise; 62 | } 63 | 64 | 65 | The above code makes an asynchronous C request to the specified 66 | C<$uri>. The result of the request at the time the subroutine returns is like 67 | Schrödinger's cat: both dead and alive. In the future it may succeed or it 68 | may fail. 69 | 70 | This sub creates a L object using C, which is either: 71 | 72 | =over 73 | 74 | =item * resolved on success, in which case it returns the request C, or 75 | 76 | =item * rejected on failure, in which case it returns the reason for failure. 77 | 78 | =back 79 | 80 | As a final step, the deferred object returns a L object 81 | which represents the future result. 82 | 83 | That's all there is to know about L. 84 | 85 | =head2 Promise objects 86 | 87 | Promises are a lot like C/C/C blocks except that they can 88 | be chained together. The most important part of a promise is the C 89 | method: 90 | 91 | 92 | $promise->then( 93 | sub { success! }, 94 | sub { failure } 95 | ); 96 | 97 | The C method takes two arguments: a success callback and a failure 98 | callback. But the important part is that it returns a B promise, which 99 | is the thing that allows promises to be chained together. 100 | 101 | The simple genius of promises (and I can say that because I didn't invent them) 102 | will not be immediately obvious, but bear with me. Promises are very simple, 103 | as long as you understand the execution flow: 104 | 105 | =head3 Resolving or rejecting a Promise 106 | 107 | use Promises qw(deferred); 108 | 109 | my $deferred = deferred; 110 | $deferred->promise->then( 111 | sub { say "OK! We received: ".shift(@_)}, # on resolve 112 | sub { say "Bah! We failed with: ". shift(@_)} # on reject 113 | ); 114 | 115 | What this code does depends on what happens to the C<$deferred> object: 116 | 117 | $deferred->resolve('Yay!'); 118 | # prints: "OK! We received: Yay!" 119 | 120 | $deferred->reject('Pooh!'); 121 | # prints "Bah! We failed with: Pooh!" 122 | 123 | A Deferred object can only be resolved or rejected once. Once it is resolved 124 | or rejected, it informs all its promises of the outcome. 125 | 126 | =head3 Chaining resolve callbacks 127 | 128 | As mentioned earlier, the C method returns a new promise which will be 129 | resolved or rejected in turn. Each C callback will receive the return 130 | value of the previous C callback: 131 | 132 | deferred 133 | ->resolve('red','green') 134 | ->promise 135 | 136 | ->then(sub { 137 | # @_ contains ('red','green') 138 | return ('foo','bar'); 139 | }) 140 | 141 | ->then(sub { 142 | # @_ contains ('foo,bar'); 143 | return 10; 144 | }) 145 | 146 | ->then( sub { 147 | # @_ contains (10) 148 | }); 149 | 150 | All of these example callbacks have just returned a simple value (or values), 151 | so execution has moved from one callback to the next. 152 | 153 | =head3 Chaining reject callbacks 154 | 155 | Note that in the above example, in each call to C we specified only a 156 | I callback, not a I callback. If a promise is resolved or 157 | rejected, the action gets passed down the chain until it finds a resolved or 158 | rejected handler. This means that errors can be handled in the appropriate 159 | place in the chain: 160 | 161 | my $deferred = deferred; 162 | 163 | $deferred->promise 164 | ->then( 165 | sub { 166 | my $count = shift(); 167 | say "Count: $count"; 168 | return $count+1; 169 | } 170 | ) 171 | ->then( 172 | sub { 173 | my $count = shift(); 174 | say "Count: $count"; 175 | return $count+1; 176 | } 177 | )->then( 178 | sub { 179 | my $count = shift(); 180 | say "Final count: $count"; 181 | return $count+1; 182 | }, 183 | sub { 184 | my $reason = shift; 185 | warn "Failed to count: $reason" 186 | } 187 | ); 188 | 189 | If the C<$deferred> object is resolved, it will call each resolved callback in 190 | turn: 191 | 192 | $deferred->resolve(5); 193 | # prints: 194 | # Count: 5 195 | # Count: 6 196 | # Final count: 7 197 | 198 | If the C<$deferred> object is rejected, however, it will skip all of the steps 199 | in the chain until it hits the first rejected callback: 200 | 201 | $deferred->reject('Poor example'); 202 | # warns: 203 | # "Failed to count: Poor example" 204 | 205 | B: Event loops do not like fatal exceptions! For this reason the 206 | I and I callbacks are run in C blocks. Exceptions 207 | thrown in either type of callback are passed down the chain to the next 208 | I handler. If there are no more I handlers, then the 209 | error is silently swallowed. 210 | 211 | =head3 Throwing and handling exceptions 212 | 213 | While you can signal success or failure by calling C or C 214 | on the C<$deferred> object, you can also signal success or failure in each 215 | step of the promises chain. 216 | 217 | =over 218 | 219 | =item * 220 | 221 | I callbacks are like C blocks: they can either execute some 222 | code successfully or throw an exception. 223 | 224 | =item * 225 | 226 | I callbacks are like C blocks: they can either handle the 227 | exception or rethrow it. 228 | 229 | =back 230 | 231 | $deferred = deferred; 232 | 233 | $deferred->promise 234 | ->then( 235 | sub { 236 | my $count = shift; 237 | die "Count too high!" if $count > 100; 238 | return $count 239 | } 240 | )->then( 241 | sub { 242 | say "The count is OK. Continuing"; 243 | return @_ 244 | }, 245 | sub { 246 | my $error = shift; 247 | warn "We have a problem: $error"; 248 | die $error; 249 | } 250 | )->then( 251 | undef, # no resolved handler 252 | sub { return 1; } 253 | )-> then( 254 | sub { 255 | my $count = shift; 256 | say "Got count: $count"; 257 | } 258 | ) 259 | 260 | There are a few ways this code can execute. We can resolve the C<$deferred> 261 | object with a reasonable count: 262 | 263 | $deferred->resolve(5); 264 | # prints: 265 | # The count is OK. Continuing 266 | # Got count: 5 267 | 268 | $defer 269 | 270 | If we reject the C<$deferred> object, the first I handler is called. 271 | It warns, then rethrows the exception with C which calls the next 272 | I handler. This handler resolves the exception (that is, it doesn't 273 | call C) and returns a value which gets passed to the next I 274 | handler: 275 | 276 | $deferred->reject('For example purposes') 277 | # warns: 278 | # We have a problem: For example purposes 279 | # prints: 280 | # Got count: 1 281 | 282 | Finally, if we resolve the C<$deferred> object with a too large count, the 283 | first I handler throws an exception, which calls the next 284 | I handler: 285 | 286 | $deferred->resolve(1000); 287 | # warns: 288 | # We have a problem: Count too high! 289 | # prints: 290 | # Got count: 1 291 | 292 | =head3 C 293 | 294 | In the above example, we called C with C instead of a 295 | I callback. This could be rewritten to look a bit cleaner using the 296 | C method, which takes just a I callback. 297 | 298 | # these two lines are equivalent: 299 | $promise->then( undef, sub { rejected cb} ) 300 | $promise->catch( sub { rejected cb } ) 301 | 302 | =head3 C 303 | 304 | Any C/C implementation has a C block, which can be used 305 | to clean up resources regardless of whether the code in the C block 306 | succeeded or failed. Promises offer this functionality too. 307 | 308 | The C method accepts a single callback which is called regardless 309 | of whether the previous step was resolved or rejected. The return value 310 | (or any exception thrown in the callback) are thrown away, and the chain 311 | continues as if it were not there: 312 | 313 | $deferred = deferred; 314 | $deferred->promise 315 | ->then( 316 | sub { 317 | my $count = shift; 318 | if ($count > 10) { die "Count too high"} 319 | return $count 320 | } 321 | )->finally( 322 | sub { say "Finally got: ".shift(@_) } 323 | )->then( 324 | sub { say "OK: ". shift(@_) }, 325 | sub { say "Bah!: ". shift(@_) } 326 | ); 327 | 328 | If we resolve the C<$deferred> object with a good count, we see: 329 | 330 | $d->resolve(5); 331 | # prints: 332 | # Finally got: 5 333 | # OK: 5 334 | 335 | With a high count we get: 336 | 337 | $d->resolve(20); 338 | # prints: 339 | # Finally got: Count to high 340 | # Bah: 20 341 | 342 | =head3 Chaining async callbacks 343 | 344 | This is where the magic starts: each I/I handler can not 345 | only return a value (or values), it can also B. Remember 346 | that a Promise represents a future value, which means that execution of the 347 | chain will stop until the new Promise has been either resolved or rejected! 348 | 349 | For instance, we could write the following code using the C sub 350 | (see L) which returns a promise: 351 | 352 | fetch_it('http://domain.com/user/123') 353 | ->then( 354 | sub { 355 | my $user = shift; 356 | say "User name: ".$user->{name}; 357 | say "Fetching total comments"; 358 | return fetch_id($user->{total_comments_url}); 359 | } 360 | )->then( 361 | sub { 362 | my $total = shift; 363 | say "User has left $total comments" 364 | } 365 | ) 366 | ->catch( 367 | sub { 368 | warn @_ 369 | } 370 | ); 371 | 372 | This code sends an asynchronous request to get the page for user C<123> and 373 | returns a promise. Once the promise is resolved, it sends an asynchronous 374 | request to get the total comments for that user and again returns a promise. 375 | Once the second promise is resolved, it prints out the total number of 376 | comments. If either promise were to be rejected, it would skip down the chain 377 | looking for the first I handler and execute that. 378 | 379 | This is organised to look like synchronous code. Each step is executed 380 | sequentially, it is easy to read and easy to understand, but it works 381 | asynchronously. While we are waiting for a response from C 382 | (while our promise remains unfulfilled), the event loop can happily continue 383 | running code elsewhere in the application. 384 | 385 | In fact, it's not just L objects that can be returned, it 386 | can be any object that is ``thenable'' (ie it has a C method). So 387 | if you want to integrate your Promises code with a library which is using 388 | L objects, you should be able to do it. 389 | 390 | =head3 Running async requests in parallel 391 | 392 | Sometimes order doesn't matter: perhaps we want to retrieve several web pages 393 | at the same time. For that we can use the C helper: 394 | 395 | use Promises qw(collect); 396 | 397 | collect( 398 | fetch_it('http://rest.api.example.com/-/product/12345'), 399 | fetch_it('http://rest.api.example.com/-/product/suggestions?for_sku=12345'), 400 | fetch_it('http://rest.api.example.com/-/product/reviews?for_sku=12345'), 401 | )->then( 402 | sub { 403 | my ($product, $suggestions, $reviews) = @_; 404 | # do something with these values 405 | }, 406 | sub { warn @_ } 407 | ); 408 | 409 | C accepts a list of promises and returns a new promise (which we'll 410 | call C<$p> for clarification purposes. When all of its promises have been 411 | resolved, it resolves C<$p> with the values returned by every promise, in the 412 | same order as they were passed in to C. 413 | 414 | B Each promise can return multiple values, so C<$product>, 415 | C<$suggestions> and C<$reviews> in the example above will all be array refs. 416 | 417 | If any of the passed in promises is rejected, then C<$p> will also be rejected 418 | with the reason for the failure. C<$p> can only be rejected once, so we wil 419 | only find out about the first failure. 420 | 421 | =head2 Integration with event loops 422 | 423 | In order to run asynchronous code, you need to run some event loop. That can 424 | be as simple as using L to run the event loop 425 | just until a particular condition is met: 426 | 427 | use AnyEvent; 428 | 429 | my $cv = AnyEvent->condvar; 430 | collect( 431 | fetch_it('http://rest.api.example.com/-/product/12345'), 432 | fetch_it('http://rest.api.example.com/-/product/suggestions?for_sku=12345'), 433 | fetch_it('http://rest.api.example.com/-/product/reviews?for_sku=12345'), 434 | )->then( 435 | sub { 436 | my ($product, $suggestions, $reviews) = @_; 437 | $cv->send({ 438 | product => $product->[0], 439 | suggestions => $suggestions->[0], 440 | reviews => $reviews->[0], 441 | }) 442 | }, 443 | sub { $cv->croak( 'ERROR' ) } 444 | ); 445 | 446 | # wait for $cv->send or $cv->croak 447 | my $results = $cv->recv; 448 | 449 | More usually though, a whole application is intended to be asynchronous, in 450 | which case the event loop just runs continuously. Normally you would only need 451 | to use C<$cv>'s or the equivalent at the point where your application uses a 452 | specific async library, as explained in L. The rest of your 453 | code can deal purely with Promises. 454 | 455 | =head3 Event loop specific backends 456 | 457 | The I and I callbacks should be run by the event loop, 458 | rather than having one callback call the next, which calls the next etc. 459 | 460 | In other words, if a promise is resolved, it doesn't call the I 461 | callback directly. Instead it adds it to the event loop's queue, then returns 462 | immediately. The next time the event loop checks its queue, it'll find the 463 | callback in the queue and will call it. 464 | 465 | By default, L is event loop agnostic, which means that it doesn't 466 | know which event loop to use and so each callback ends up calling the next, 467 | etc. If you're writing L-based modules for CPAN, then your code 468 | should also be event loop agnostic, in which case you want to use Promises 469 | like this: 470 | 471 | use Promises qw(deferred collect); 472 | 473 | However, if you are an end user, then you should specify which event loop 474 | you are using at the start of your application: 475 | 476 | use Promises backend => ['AnyEvent']; # or "EV" or "Mojo" 477 | 478 | You only need to specify the backend once - any code in the application 479 | which uses L will automatically use the specified backend. 480 | 481 | 482 | =head2 Recursing safely with with C 483 | 484 | One of the cool things about working with promises is that the return value 485 | gets passed down the chain as if the code were synchronous. However that is 486 | not always what we want. 487 | 488 | Imagine that we want to process every line in a file, which could be millions 489 | of lines. We don't care about the results from each line, all we care about is 490 | whether the whole file was processed successfully, or whether something 491 | failed. 492 | 493 | In sync code we'd write something like this: 494 | 495 | sub process_file { 496 | my $fh = shift; 497 | while (my $line = <$fh>) { 498 | process_line($line) 499 | || die "Failed" 500 | } 501 | } 502 | 503 | Now imagine that C runs asynchronously and returns a promise. 504 | By the time it returns, it probably hasn't executed anything yet. We can't go 505 | ahead and read the next line of the file otherwise we could generate a billion 506 | promises before any of them has had time to execute. 507 | 508 | Instead, we need to wait for C to complete and only then move 509 | on to reading the next line. We could do this as follows: 510 | 511 | # WARNING: EXAMPLE OF INCORRECT CODE # 512 | 513 | use Promises qw(deferred); 514 | 515 | sub process_file { 516 | my $fh = shift; 517 | my $deferred = deferred; 518 | my $processor = sub { 519 | my $line = <$fh>; 520 | unless (defined $line) { 521 | # we're done 522 | return $deferred->resolve; 523 | } 524 | process_line($line)->then( 525 | 526 | # on success, call $processor again 527 | __SUB__, 528 | 529 | # on failure: 530 | sub { 531 | return $deferred->reject("Failed") 532 | } 533 | ) 534 | } 535 | 536 | # start the loop 537 | $processor->(); 538 | 539 | return $deferred->promise 540 | } 541 | 542 | This code has two stack problems. The first is that, every time we process a 543 | line, we recurse into the current C<__SUB__> B the current sub. This 544 | problem is solved by specifying one of the L somewhere 545 | in our application, which we discussed above. 546 | 547 | The second problem is that every time we recurse into the current 548 | C<__SUB__> we're waiting for the return value. Other languages use the 549 | L to 550 | keep the return stack flat, but we don't have this option. 551 | 552 | Instead, we have the C method which, like C, accepts a I callback 553 | and a I callback. But it differs from C in two ways: 554 | 555 | =over 556 | 557 | =item * 558 | 559 | It doesn't return a promise, which means that the chain ends with the C step. 560 | 561 | =item * 562 | 563 | Callbacks are not run in an C block, so calling C will throw a 564 | fatal exception. (Most event loops, however will catch the exception, warn, 565 | and continue running.) 566 | 567 | =back 568 | 569 | The code can be rewritten using C instead of C and an event 570 | loop specific backend, and it will happily process millions of lines without 571 | memory leaks or stack oveflows: 572 | 573 | 574 | use Promises backend => ['EV'], 'deferred'; 575 | 576 | sub process_file { 577 | my $fh = shift; 578 | my $deferred = deferred; 579 | my $processor = sub { 580 | my $line = <$fh>; 581 | unless (defined $line) { 582 | # we're done 583 | return $deferred->resolve; 584 | } 585 | #### USE done() TO END THE CHAIN #### 586 | process_line($line)->done( 587 | 588 | # on success, call $processor again 589 | __SUB__, 590 | 591 | # on failure: 592 | sub { 593 | return $deferred->reject("Failed") 594 | } 595 | ) 596 | } 597 | 598 | # start the loop 599 | $processor->(); 600 | 601 | return $deferred->promise 602 | } 603 | 604 | =cut 605 | 606 | 607 | __END__ 608 | 609 | 610 | 611 | 612 | 613 | 614 | 615 | 616 | 617 | 618 | 619 | 620 | 621 | 622 | 623 | 624 | 625 | --------------------------------------------------------------------------------