Comparing Promises, Future and Async::Defer in four (+1) scenarios

promises_future_defer.pl

#!/usr/bin/env perl

=pod

=head1 NAME

Comparing Promises, Future and Async::Defer in four (+1) scenarios

=head1 SYNOPSIS

This example shows how Promises, Future and Async::Defer modules
approach asynchronous routines in the four scenarios described in
"You're Missing the Point of Promises" (https://gist.github.com/3889970).
The additional fifth scenario, in which a thrown exception is not handled,
is also demonstrated.

=head1 AUTHOR

Toshio Ito (https://github.com/debug-ito)

=head1 SEE ALSO

=over

=item *

You're Missing the Point of Promises L<https://gist.github.com/3889970>

=item *

Promises/Future and Async::Defer L<http://d.hatena.ne.jp/debug-ito/20121123>

(Sorry, it's Japanese)

=back


=cut

use strict;
use warnings;

use constant WAIT_TIME => 0.5;
use Promises 0.01;
use Future 0.04;
use Async::Defer 0.9.3;
use AE;
use feature 'say';

############## Waiting routine for each framework

sub wait_promise {
    my $result = shift;
    my $d = Promises::Deferred->new();
    my $t; $t = AE::timer WAIT_TIME, 0, sub {
        undef $t;
        if($result eq "ok") {
            $d->resolve($result);
        }else {
            $d->reject($result);
        }
    };
    return $d->promise;
}

sub wait_future {
    my $result = shift;
    my $f = Future->new();
    my $t; $t = AE::timer WAIT_TIME, 0, sub {
        undef $t;
        if($result eq "ok") {
            $f->done($result);
        }else {
            $f->fail($result);
        }
    };
    return $f;
}

sub wait_callback {
    my ($result, $callback, $errback) = @_;
    my $t; $t = AE::timer WAIT_TIME, 0, sub {
        undef $t;
        if($result eq "ok") {
            $callback->($result);
        }else {
            $errback->($result);
        }
    };
}

my $cv;


say "----------- Promises";

$cv = AE::cv;
wait_promise("ok")->then(sub {
    say "@_";
    say "Scenario 1: fulfilled and accepted.";
    return "Result accepted";
}, sub {
    say "This is not executed";
    return @_;
})->then(sub {
    say "@_";
    $cv->send;
}, sub {
    say "This is not executed";
});
$cv->recv;

$cv = AE::cv;
wait_promise("ok")->then(sub {
    say "@_";
    say "Scenario 2: fulfilled but rejected.";
    return Promises::Deferred->new->reject('Result rejected')->promise;
}, sub {
    say "This is not executed";
    return @_;
})->then(sub {
    say "This is not executed";
}, sub {
    say "@_";
    $cv->send;
});
$cv->recv;

$cv = AE::cv;
wait_promise("ng")->then(sub {
    say "This is not executed";
}, sub {
    say "@_";
    say "Scenario 3: rejected but handled.";
    return Promises::Deferred->new->resolve("Exception handled")->promise;
})->then(sub {
    say "@_";
    $cv->send;
}, sub {
    say "This is not executed";
});
$cv->recv;

$cv = AE::cv;
wait_promise("ng")->then(sub {
    say "This is not executed";
}, sub {
    say "@_";
    say "Scenario 4: rejected and rethrown.";
    return Promises::Deferred->new->reject("Exception rethrown")->promise;
})->then(sub {
    say "This is not executed";
}, sub {
    say "@_";
    $cv->send;
});
$cv->recv;

$cv = AE::cv;
wait_promise("ng")->then(sub {
    say "This is not executed";
}, sub {
    @_; ## Exception goes through here
})->then(sub {
    say "This is not executed";
}, sub {
    say "@_";
    say "Scenario 5: rejected and not handled.";
    $cv->send;
});
$cv->recv;


say "----------- Future";

$cv = AE::cv;
wait_future("ok")->and_then(sub {
    my $f = shift;
    say $f->get;
    say "Scenario 1: fulfilled and accepted.";
    return Future->new->done("Result accepted.");
})->on_ready(sub {
    my $f = shift;
    say $f->get;
    $cv->send;
});
$cv->recv;

$cv = AE::cv;
wait_future("ok")->and_then(sub {
    my $f = shift;
    say $f->get;
    say "Scenario 2: fulfilled but rejected.";
    return Future->new->fail("Result rejected.");
})->on_ready(sub {
    my $f = shift;
    say $f->failure;
    $cv->send;
});
$cv->recv;

$cv = AE::cv;
wait_future("ng")->and_then(sub {
    say "This is not executed.";
    return @_;
})->or_else(sub {
    my $f = shift;
    say $f->failure;
    say "Scenario 3: rejected but handled.";
    return Future->new->done("Exception handled.");
})->on_ready(sub {
    my $f = shift;
    say $f->get;
    $cv->send;
});
$cv->recv;

$cv = AE::cv;
wait_future("ng")->and_then(sub {
    say "This is not executed.";
    return @_;
})->or_else(sub {
    my $f = shift;
    say $f->failure;
    say "Scenario 4: rejected and rethrown.";
    return Future->new->fail("Exception rethrown.");
})->on_ready(sub {
    my $f = shift;
    say $f->failure;
    $cv->send;
});
$cv->recv;

$cv = AE::cv;
wait_future("ng")->and_then(sub {
    say "This is not executed.";
    return @_;
})->on_ready(sub {
    my $f = shift;
    say $f->failure;
    say "Scenario 5: rejected and not handled.";
    $cv->send;
});
$cv->recv;

say "----------- Async::Defer";

$cv = AE::cv;
Async::Defer->new->do(sub {
    my $d = shift;
    wait_callback("ok", sub { $d->done(@_) }, sub { $d->throw(@_) });
})->do(sub {
    my ($d, @results) = @_;
    say "@results";
    say "Scenario 1: fulfilled and accepted.";
    $d->done("Result accepted.");
})->do(sub {
    my ($d, @results) = @_;
    say "@results";
    $cv->send;
    $d->done;
})->run;
$cv->recv;

$cv = AE::cv;
Async::Defer->new->do(sub {
    my $d = shift;
    wait_callback("ok", sub { $d->done(@_) }, sub { $d->throw(@_) });
})->try->do(sub {
    my ($d, @result) = @_;
    say "@result";
    say "Scenario 2: fulfilled but rejected.";
    $d->throw("Result rejected.");
})->catch( qr/.?/ => sub {
    my ($d, @result) = @_;
    say "@result";
    $cv->send;
    $d->done;
})->run;
$cv->recv;

$cv = AE::cv;
Async::Defer->new->try->do(sub {
    my $d = shift;
    wait_callback("ng", sub { $d->done(@_) }, sub { $d->throw(@_) });
})->do(sub {
    my $d = shift;
    say "This is not executed.";
    $d->done;
})->catch( qr/.?/ => sub {
    my ($d, @result) = @_;
    say "@result";
    say "Scenario 3: rejected but handled.";
    $d->done("Exception handled.");
})->do(sub {
    my ($d, @result) = @_;
    say "@result";
    $cv->send;
    $d->done;
})->run;
$cv->recv;

$cv = AE::cv;
Async::Defer->new->try->try->do(sub {
    my $d = shift;
    wait_callback("ng", sub { $d->done(@_) }, sub { $d->throw(@_) });
})->do(sub {
    my $d = shift;
    say "This is not executed.";
    $d->done;
})->catch( qr/.?/ => sub {
    my ($d, @result) = @_;
    say "@result";
    say "Scenario 4: rejected and rethrown.";
    $d->throw("Exception rethrown.");
})->catch( qr/.?/ => sub {
    my ($d, @result) = @_;
    say "@result";
    $cv->send;
    $d->done;
})->run;
$cv->recv;

$cv = AE::cv;
Async::Defer->new->try->do(sub {
    my $d = shift;
    wait_callback("ng", sub { $d->done(@_) }, sub { $d->throw(@_) });
})->do(sub {
    my $d = shift;
    say "This is not executed.";
    $d->done;
})->catch( qr/.?/ => sub {
    my ($d, @result) = @_;
    say "@result";
    say "Scenario 5: rejected and not handled.";
    $cv->send;
    $d->done;
})->run;
$cv->recv;


{
    say "---------------- use wait_callback with Promises";
    $cv = AE::cv;
    my $d = Promises::Deferred->new();
    wait_callback("ok", sub { $d->resolve(@_) }, sub { $d->reject(@_) });
    $d->then(sub {
        say "@_";
        my $d = Promises::Deferred->new();
        wait_callback("ng", sub { $d->resolve(@_) }, sub { $d->reject(@_) });
        return $d->promise;
    }, sub {
        @_;
    })->then(sub {
        say "Success: @_";
    }, sub {
        say "Failure: @_";
        $cv->send;
    });
    $cv->recv;
}

{
    say "---------------- use wait_promise with Async::Defer";
    $cv = AE::cv;
    Async::Defer->new->try->do(sub {
        my $d = shift;
        wait_promise("ok")->then(sub { $d->done(@_) }, sub { $d->throw(@_) });
    })->do(sub {
        my ($d, @result) = @_;
        say "@result";
        wait_promise("ng")->then(sub { $d->done(@_) }, sub { $d->throw(@_) });
    })->do(sub {
        my ($d, @result) = @_;
        say "Success: @result";
        $d->done;
    })->catch(qr/.?/ => sub {
        my ($d, @result) = @_;
        say "Failure: @result";
        $d->done;
        $cv->send;
    })->run;
    $cv->recv;
}