Acme-Sort-Sleep
view release on metacpan or search on metacpan
local/lib/perl5/Future.pm view on Meta::CPAN
# You may distribute under the terms of either the GNU General Public License
# or the Artistic License (the same terms as Perl itself)
#
# (C) Paul Evans, 2011-2016 -- leonerd@leonerd.org.uk
package Future;
use strict;
use warnings;
no warnings 'recursion'; # Disable the "deep recursion" warning
our $VERSION = '0.34';
use Carp qw(); # don't import croak
use Scalar::Util qw( weaken blessed reftype );
use B qw( svref_2object );
use Time::HiRes qw( gettimeofday tv_interval );
# we are not overloaded, but we want to check if other objects are
require overload;
our @CARP_NOT = qw( Future::Utils );
use constant DEBUG => $ENV{PERL_FUTURE_DEBUG};
our $TIMES = DEBUG || $ENV{PERL_FUTURE_TIMES};
=head1 NAME
C<Future> - represent an operation awaiting completion
=head1 SYNOPSIS
my $future = Future->new;
perform_some_operation(
on_complete => sub {
$future->done( @_ );
}
);
$future->on_ready( sub {
say "The operation is complete";
} );
=head1 DESCRIPTION
A C<Future> object represents an operation that is currently in progress, or
has recently completed. It can be used in a variety of ways to manage the flow
of control, and data, through an asynchronous program.
Some futures represent a single operation and are explicitly marked as ready
by calling the C<done> or C<fail> methods. These are called "leaf" futures
here, and are returned by the C<new> constructor.
Other futures represent a collection of sub-tasks, and are implicitly marked
as ready depending on the readiness of their component futures as required.
These are called "convergent" futures here as they converge control and
data-flow back into one place. These are the ones returned by the various
C<wait_*> and C<need_*> constructors.
It is intended that library functions that perform asynchronous operations
would use future objects to represent outstanding operations, and allow their
calling programs to control or wait for these operations to complete. The
implementation and the user of such an interface would typically make use of
different methods on the class. The methods below are documented in two
sections; those of interest to each side of the interface.
It should be noted however, that this module does not in any way provide an
actual mechanism for performing this asynchronous activity; it merely provides
a way to create objects that can be used for control and data flow around
those operations. It allows such code to be written in a neater,
forward-reading manner, and simplifies many common patterns that are often
involved in such situations.
local/lib/perl5/Future.pm view on Meta::CPAN
=cut
sub call
{
my $class = shift;
my ( $code, @args ) = @_;
my $f;
eval { $f = $code->( @args ); 1 } or $f = $class->fail( $@ );
blessed $f and $f->isa( "Future" ) or $f = $class->fail( "Expected " . CvNAME_FILE_LINE($code) . " to return a Future" );
return $f;
}
sub _shortmess
{
my $at = Carp::shortmess( $_[0] );
chomp $at; $at =~ s/\.$//;
return $at;
}
sub _mark_ready
{
my $self = shift;
$self->{ready} = 1;
$self->{ready_at} = _shortmess $_[0] if DEBUG;
if( $TIMES ) {
$self->{rtime} = [ gettimeofday ];
}
delete $self->{on_cancel};
my $callbacks = delete $self->{callbacks} or return;
my $cancelled = $self->{cancelled};
my $fail = defined $self->{failure};
my $done = !$fail && !$cancelled;
my @result = $done ? $self->get :
$fail ? $self->failure :
();
foreach my $cb ( @$callbacks ) {
my ( $flags, $code ) = @$cb;
my $is_future = blessed( $code ) && $code->isa( "Future" );
next if $done and not( $flags & CB_DONE );
next if $fail and not( $flags & CB_FAIL );
next if $cancelled and not( $flags & CB_CANCEL );
$self->{reported} = 1 if $fail;
if( $is_future ) {
$done ? $code->done( @result ) :
$fail ? $code->fail( @result ) :
$code->cancel;
}
elsif( $flags & (CB_SEQ_ONDONE|CB_SEQ_ONFAIL) ) {
my ( undef, undef, $fseq ) = @$cb;
if( !$fseq ) { # weaken()ed; it might be gone now
# This warning should always be printed, even not in DEBUG mode.
# It's always an indication of a bug
Carp::carp +(DEBUG ? "${\$self->__selfstr} ($self->{constructed_at})"
: "${\$self->__selfstr} $self" ) .
" lost a sequence Future";
next;
}
my $f2;
if( $done and $flags & CB_SEQ_ONDONE or
$fail and $flags & CB_SEQ_ONFAIL ) {
if( $flags & CB_SEQ_IMDONE ) {
$fseq->done( @$code );
next;
}
elsif( $flags & CB_SEQ_IMFAIL ) {
$fseq->fail( @$code );
next;
}
my @args = (
( $flags & CB_SELF ? $self : () ),
( $flags & CB_RESULT ? @result : () ),
);
unless( eval { $f2 = $code->( @args ); 1 } ) {
$fseq->fail( $@ );
next;
}
unless( blessed $f2 and $f2->isa( "Future" ) ) {
$fseq->fail( "Expected " . CvNAME_FILE_LINE($code) . " to return a Future" );
next;
}
$fseq->on_cancel( $f2 );
}
else {
$f2 = $self;
}
if( $f2->is_ready ) {
$f2->on_ready( $fseq ) if !$f2->{cancelled};
}
else {
push @{ $f2->{callbacks} }, [ CB_DONE|CB_FAIL, $fseq ];
weaken( $f2->{callbacks}[-1][1] );
}
}
else {
$code->(
( $flags & CB_SELF ? $self : () ),
( $flags & CB_RESULT ? @result : () ),
);
}
}
}
sub _state
{
my $self = shift;
return !$self->{ready} ? "pending" :
DEBUG ? $self->{ready_at} :
$self->{failure} ? "failed" :
$self->{cancelled} ? "cancelled" :
"done";
}
=head1 IMPLEMENTATION METHODS
These methods would primarily be used by implementations of asynchronous
interfaces.
=cut
=head2 done
$future->done( @result )
Marks that the leaf future is now ready, and provides a list of values as a
result. (The empty list is allowed, and still indicates the future as ready).
Cannot be called on a convergent future.
If the future is already cancelled, this request is ignored. If the future is
already complete with a result or a failure, an exception is thrown.
=cut
sub done
{
my $self = shift;
if( ref $self ) {
$self->{cancelled} and return $self;
$self->{ready} and Carp::croak "${\$self->__selfstr} is already ".$self->_state." and cannot be ->done";
$self->{subs} and Carp::croak "${\$self->__selfstr} is not a leaf Future, cannot be ->done";
$self->{result} = [ @_ ];
$self->_mark_ready( "done" );
}
else {
$self = $self->new;
$self->{ready} = 1;
$self->{ready_at} = _shortmess "done" if DEBUG;
$self->{result} = [ @_ ];
}
return $self;
local/lib/perl5/Future.pm view on Meta::CPAN
reference to the returned future (because exception/error handling would be
silently dropped), this method warns in void context.
=cut
sub _sequence
{
my $f1 = shift;
my ( $code, $flags ) = @_;
# For later, we might want to know where we were called from
my $func = (caller 1)[3];
$func =~ s/^.*:://;
$flags & (CB_SEQ_IMDONE|CB_SEQ_IMFAIL) or _callable( $code ) or
Carp::croak "Expected \$code to be callable in ->$func";
if( !defined wantarray ) {
Carp::carp "Calling ->$func in void context";
}
if( $f1->is_ready ) {
# Take a shortcut
return $f1 if $f1->is_done and not( $flags & CB_SEQ_ONDONE ) or
$f1->failure and not( $flags & CB_SEQ_ONFAIL );
if( $flags & CB_SEQ_IMDONE ) {
return Future->done( @$code );
}
elsif( $flags & CB_SEQ_IMFAIL ) {
return Future->fail( @$code );
}
my @args = (
( $flags & CB_SELF ? $f1 : () ),
( $flags & CB_RESULT ? $f1->is_done ? $f1->get :
$f1->failure ? $f1->failure :
() : () ),
);
my $fseq;
unless( eval { $fseq = $code->( @args ); 1 } ) {
return Future->fail( $@ );
}
unless( blessed $fseq and $fseq->isa( "Future" ) ) {
return Future->fail( "Expected " . CvNAME_FILE_LINE($code) . " to return a Future" );
}
return $fseq;
}
my $fseq = $f1->new;
$fseq->on_cancel( $f1 );
# TODO: if anyone cares about the op name, we might have to synthesize it
# from $flags
$code = $f1->wrap_cb( sequence => $code ) unless $flags & (CB_SEQ_IMDONE|CB_SEQ_IMFAIL);
push @{ $f1->{callbacks} }, [ CB_DONE|CB_FAIL|$flags, $code, $fseq ];
weaken( $f1->{callbacks}[-1][2] );
return $fseq;
}
=head2 then
$future = $f1->then( \&done_code )
I<Since version 0.13.>
Returns a new sequencing C<Future> that runs the code if the first succeeds.
Once C<$f1> succeeds the code reference will be invoked and is passed the list
of results. It should return a future, C<$f2>. Once C<$f2> completes the
sequence future will then be marked as complete with whatever result C<$f2>
gave. If C<$f1> fails then the sequence future will immediately fail with the
same failure and the code will not be invoked.
$f2 = $done_code->( @result )
=head2 else
$future = $f1->else( \&fail_code )
I<Since version 0.13.>
Returns a new sequencing C<Future> that runs the code if the first fails. Once
C<$f1> fails the code reference will be invoked and is passed the failure and
details. It should return a future, C<$f2>. Once C<$f2> completes the sequence
future will then be marked as complete with whatever result C<$f2> gave. If
C<$f1> succeeds then the sequence future will immediately succeed with the
same result and the code will not be invoked.
$f2 = $fail_code->( $exception, @details )
=head2 then I<(2 arguments)>
$future = $f1->then( \&done_code, \&fail_code )
The C<then> method can also be passed the C<$fail_code> block as well, giving
a combination of C<then> and C<else> behaviour.
This operation is designed to be compatible with the semantics of other future
systems, such as Javascript's Q or Promises/A libraries.
=cut
my $make_donecatchfail_sub = sub {
my ( $with_f, $done_code, $fail_code, @catch_list ) = @_;
my $func = (caller 1)[3];
$func =~ s/^.*:://;
!$done_code or _callable( $done_code ) or
Carp::croak "Expected \$done_code to be callable in ->$func";
!$fail_code or _callable( $fail_code ) or
Carp::croak "Expected \$fail_code to be callable in ->$func";
my %catch_handlers = @catch_list;
_callable( $catch_handlers{$_} ) or
Carp::croak "Expected catch handler for '$_' to be callable in ->$func"
local/lib/perl5/Future.pm view on Meta::CPAN
# Find the best prototype. Ideally anything derived if we can find one.
my $self;
ref($_) eq "Future" or $self = $_->new, last for @$subs;
# No derived ones; just have to be a basic class then
$self ||= Future->new;
$self->{subs} = $subs;
# This might be called by a DESTROY during global destruction so it should
# be as defensive as possible (see RT88967)
$self->on_cancel( sub {
foreach my $sub ( @$subs ) {
$sub->cancel if $sub and !$sub->{ready};
}
} );
return $self;
}
=head2 wait_all
$future = Future->wait_all( @subfutures )
Returns a new C<Future> instance that will indicate it is ready once all of
the sub future objects given to it indicate that they are ready, either by
success, failure or cancellation. Its result will be a list of its component
futures.
When given an empty list this constructor returns a new immediately-done
future.
This constructor would primarily be used by users of asynchronous interfaces.
=cut
sub wait_all
{
my $class = shift;
my @subs = @_;
unless( @subs ) {
my $self = $class->done;
$self->{subs} = [];
return $self;
}
my $self = Future->_new_convergent( \@subs );
my $pending = 0;
$_->{ready} or $pending++ for @subs;
# Look for immediate ready
if( !$pending ) {
$self->{result} = [ @subs ];
$self->_mark_ready( "wait_all" );
return $self;
}
weaken( my $weakself = $self );
my $sub_on_ready = sub {
return unless $weakself;
$pending--;
$pending and return;
$weakself->{result} = [ @subs ];
$weakself->_mark_ready( "wait_all" );
};
foreach my $sub ( @subs ) {
$sub->{ready} or $sub->on_ready( $sub_on_ready );
}
return $self;
}
=head2 wait_any
$future = Future->wait_any( @subfutures )
Returns a new C<Future> instance that will indicate it is ready once any of
the sub future objects given to it indicate that they are ready, either by
success or failure. Any remaining component futures that are not yet ready
will be cancelled. Its result will be the result of the first component future
that was ready; either success or failure. Any component futures that are
cancelled are ignored, apart from the final component left; at which point the
result will be a failure.
When given an empty list this constructor returns an immediately-failed
future.
This constructor would primarily be used by users of asynchronous interfaces.
=cut
sub wait_any
{
my $class = shift;
my @subs = @_;
unless( @subs ) {
my $self = $class->fail( "Cannot ->wait_any with no subfutures" );
$self->{subs} = [];
return $self;
}
my $self = Future->_new_convergent( \@subs );
# Look for immediate ready
my $immediate_ready;
foreach my $sub ( @subs ) {
$sub->{ready} and $immediate_ready = $sub, last;
}
if( $immediate_ready ) {
foreach my $sub ( @subs ) {
$sub->{ready} or $sub->cancel;
}
if( $immediate_ready->{failure} ) {
$self->{failure} = [ $immediate_ready->failure ];
}
else {
$self->{result} = [ $immediate_ready->get ];
}
$self->_mark_ready( "wait_any" );
return $self;
}
my $pending = 0;
weaken( my $weakself = $self );
my $sub_on_ready = sub {
return unless $weakself;
return if $weakself->{result} or $weakself->{failure}; # don't recurse on child ->cancel
return if --$pending and $_[0]->{cancelled};
if( $_[0]->{cancelled} ) {
$weakself->{failure} = [ "All component futures were cancelled" ];
}
elsif( $_[0]->{failure} ) {
$weakself->{failure} = [ $_[0]->failure ];
}
else {
$weakself->{result} = [ $_[0]->get ];
}
foreach my $sub ( @subs ) {
$sub->{ready} or $sub->cancel;
}
$weakself->_mark_ready( "wait_any" );
};
foreach my $sub ( @subs ) {
# No need to test $sub->{ready} since we know none of them are
$sub->on_ready( $sub_on_ready );
$pending++;
}
return $self;
}
=head2 needs_all
$future = Future->needs_all( @subfutures )
Returns a new C<Future> instance that will indicate it is ready once all of the
sub future objects given to it indicate that they have completed successfully,
or when any of them indicates that they have failed. If any sub future fails,
then this will fail immediately, and the remaining subs not yet ready will be
cancelled. Any component futures that are cancelled will cause an immediate
failure of the result.
If successful, its result will be a concatenated list of the results of all
its component futures, in corresponding order. If it fails, its failure will
be that of the first component future that failed. To access each component
future's results individually, use C<done_futures>.
When given an empty list this constructor returns a new immediately-done
future.
This constructor would primarily be used by users of asynchronous interfaces.
=cut
sub needs_all
{
my $class = shift;
my @subs = @_;
unless( @subs ) {
my $self = $class->done;
$self->{subs} = [];
return $self;
}
my $self = Future->_new_convergent( \@subs );
# Look for immediate fail
my $immediate_fail;
foreach my $sub ( @subs ) {
$sub->{ready} and $sub->{failure} and $immediate_fail = $sub, last;
}
if( $immediate_fail ) {
foreach my $sub ( @subs ) {
$sub->{ready} or $sub->cancel;
}
$self->{failure} = [ $immediate_fail->failure ];
$self->_mark_ready( "needs_all" );
return $self;
}
my $pending = 0;
$_->{ready} or $pending++ for @subs;
# Look for immediate done
if( !$pending ) {
$self->{result} = [ map { $_->get } @subs ];
$self->_mark_ready( "needs_all" );
return $self;
}
weaken( my $weakself = $self );
my $sub_on_ready = sub {
return unless $weakself;
return if $weakself->{result} or $weakself->{failure}; # don't recurse on child ->cancel
if( $_[0]->{cancelled} ) {
$weakself->{failure} = [ "A component future was cancelled" ];
foreach my $sub ( @subs ) {
$sub->cancel if !$sub->{ready};
}
$weakself->_mark_ready( "needs_all" );
}
elsif( my @failure = $_[0]->failure ) {
$weakself->{failure} = \@failure;
foreach my $sub ( @subs ) {
$sub->cancel if !$sub->{ready};
}
$weakself->_mark_ready( "needs_all" );
}
else {
$pending--;
$pending and return;
$weakself->{result} = [ map { $_->get } @subs ];
$weakself->_mark_ready( "needs_all" );
}
};
foreach my $sub ( @subs ) {
$sub->{ready} or $sub->on_ready( $sub_on_ready );
}
return $self;
}
=head2 needs_any
$future = Future->needs_any( @subfutures )
Returns a new C<Future> instance that will indicate it is ready once any of
the sub future objects given to it indicate that they have completed
successfully, or when all of them indicate that they have failed. If any sub
future succeeds, then this will succeed immediately, and the remaining subs
not yet ready will be cancelled. Any component futures that are cancelled are
ignored, apart from the final component left; at which point the result will
be a failure.
If successful, its result will be that of the first component future that
succeeded. If it fails, its failure will be that of the last component future
to fail. To access the other failures, use C<failed_futures>.
Normally when this future completes successfully, only one of its component
futures will be done. If it is constructed with multiple that are already done
however, then all of these will be returned from C<done_futures>. Users should
be careful to still check all the results from C<done_futures> in that case.
When given an empty list this constructor returns an immediately-failed
future.
This constructor would primarily be used by users of asynchronous interfaces.
=cut
sub needs_any
{
my $class = shift;
my @subs = @_;
unless( @subs ) {
my $self = $class->fail( "Cannot ->needs_any with no subfutures" );
$self->{subs} = [];
return $self;
}
my $self = Future->_new_convergent( \@subs );
# Look for immediate done
my $immediate_done;
my $pending = 0;
foreach my $sub ( @subs ) {
$sub->{ready} and !$sub->{failure} and $immediate_done = $sub, last;
$sub->{ready} or $pending++;
}
if( $immediate_done ) {
foreach my $sub ( @subs ) {
$sub->{ready} ? $sub->{reported} = 1 : $sub->cancel;
}
$self->{result} = [ $immediate_done->get ];
$self->_mark_ready( "needs_any" );
return $self;
}
# Look for immediate fail
my $immediate_fail = 1;
foreach my $sub ( @subs ) {
$sub->{ready} or $immediate_fail = 0, last;
}
if( $immediate_fail ) {
$_->{reported} = 1 for @subs;
# For consistency we'll pick the last one for the failure
$self->{failure} = [ $subs[-1]->{failure} ];
$self->_mark_ready( "needs_any" );
return $self;
}
weaken( my $weakself = $self );
my $sub_on_ready = sub {
return unless $weakself;
return if $weakself->{result} or $weakself->{failure}; # don't recurse on child ->cancel
return if --$pending and $_[0]->{cancelled};
if( $_[0]->{cancelled} ) {
$weakself->{failure} = [ "All component futures were cancelled" ];
$weakself->_mark_ready( "needs_any" );
}
elsif( my @failure = $_[0]->failure ) {
$pending and return;
$weakself->{failure} = \@failure;
$weakself->_mark_ready( "needs_any" );
}
else {
$weakself->{result} = [ $_[0]->get ];
foreach my $sub ( @subs ) {
$sub->cancel if !$sub->{ready};
}
$weakself->_mark_ready( "needs_any" );
}
};
foreach my $sub ( @subs ) {
$sub->{ready} or $sub->on_ready( $sub_on_ready );
}
return $self;
}
=head1 METHODS ON CONVERGENT FUTURES
The following methods apply to convergent (i.e. non-leaf) futures, to access
the component futures stored by it.
=cut
=head2 pending_futures
@f = $future->pending_futures
=head2 ready_futures
@f = $future->ready_futures
=head2 done_futures
@f = $future->done_futures
=head2 failed_futures
@f = $future->failed_futures
=head2 cancelled_futures
@f = $future->cancelled_futures
Return a list of all the pending, ready, done, failed, or cancelled
( run in 1.859 second using v1.01-cache-2.11-cpan-df04353d9ac )