Acme-Sort-Sleep
view release on metacpan or search on metacpan
local/lib/perl5/Future.pm view on Meta::CPAN
CB_SEQ_ONDONE => 1<<5, # Sequencing on success (->then)
CB_SEQ_ONFAIL => 1<<6, # Sequencing on failure (->else)
CB_SEQ_IMDONE => 1<<7, # $code is in fact immediate ->done result
CB_SEQ_IMFAIL => 1<<8, # $code is in fact immediate ->fail result
};
use constant CB_ALWAYS => CB_DONE|CB_FAIL|CB_CANCEL;
# Useful for identifying CODE references
sub CvNAME_FILE_LINE
{
my ( $code ) = @_;
my $cv = svref_2object( $code );
my $name = join "::", $cv->STASH->NAME, $cv->GV->NAME;
return $name unless $cv->GV->NAME eq "__ANON__";
# $cv->GV->LINE isn't reliable, as outside of perl -d mode all anon CODE
# in the same file actually shares the same GV. :(
# Walk the optree looking for the first COP
my $cop = $cv->START;
$cop = $cop->next while $cop and ref $cop ne "B::COP";
sprintf "%s(%s line %d)", $cv->GV->NAME, $cop->file, $cop->line;
}
sub _callable
{
my ( $cb ) = @_;
defined $cb and ( reftype($cb) eq 'CODE' || overload::Method($cb, '&{}') );
}
sub new
{
my $proto = shift;
return bless {
ready => 0,
callbacks => [], # [] = [$type, ...]
( DEBUG ?
( do { my $at = Carp::shortmess( "constructed" );
chomp $at; $at =~ s/\.$//;
constructed_at => $at } )
: () ),
( $TIMES ?
( btime => [ gettimeofday ] )
: () ),
}, ( ref $proto || $proto );
}
my $GLOBAL_END;
END { $GLOBAL_END = 1; }
sub DESTROY_debug {
my $self = shift;
return if $GLOBAL_END;
return if $self->{ready} and ( $self->{reported} or !$self->{failure} );
my $lost_at = join " line ", (caller)[1,2];
# We can't actually know the real line where the last reference was lost;
# a variable set to 'undef' or close of scope, because caller can't see it;
# the current op has already been updated. The best we can do is indicate
# 'near'.
if( $self->{ready} and $self->{failure} ) {
warn "${\$self->__selfstr} was $self->{constructed_at} and was lost near $lost_at with an unreported failure of: " .
$self->{failure}[0] . "\n";
}
elsif( !$self->{ready} ) {
warn "${\$self->__selfstr} was $self->{constructed_at} and was lost near $lost_at before it was ready.\n";
}
}
*DESTROY = \&DESTROY_debug if DEBUG;
=head2 done I<(class method)>
=head2 fail I<(class method)>
$future = Future->done( @values )
$future = Future->fail( $exception, @details )
I<Since version 0.26.>
Shortcut wrappers around creating a new C<Future> then immediately marking it
as done or failed.
=head2 wrap
$future = Future->wrap( @values )
I<Since version 0.14.>
If given a single argument which is already a C<Future> reference, this will
be returned unmodified. Otherwise, returns a new C<Future> instance that is
already complete, and will yield the given values.
This will ensure that an incoming argument is definitely a C<Future>, and may
be useful in such cases as adapting synchronous code to fit asynchronous
libraries driven by C<Future>.
=cut
sub wrap
{
my $class = shift;
my @values = @_;
if( @values == 1 and blessed $values[0] and $values[0]->isa( __PACKAGE__ ) ) {
return $values[0];
}
else {
return $class->done( @values );
}
}
=head2 call
$future = Future->call( \&code, @args )
I<Since version 0.15.>
local/lib/perl5/Future.pm view on Meta::CPAN
fact.
=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 : () ),
);
}
}
}
local/lib/perl5/Future.pm view on Meta::CPAN
is ready, if it completes successfully. If the future completed successfully,
invokes it immediately. If it failed or was cancelled, it is not invoked at
all.
The callback will be passed the result passed to the C<done> method.
$on_done->( @result )
If passed another C<Future> instance, the passed instance will have its
C<done> method invoked when the original future completes successfully.
Returns the C<$future>.
=cut
sub on_done
{
my $self = shift;
my ( $code ) = @_;
my $is_future = blessed( $code ) && $code->isa( "Future" );
$is_future or _callable( $code ) or
Carp::croak "Expected \$code to be callable or a Future in ->on_done";
if( $self->{ready} ) {
return $self if $self->{failure} or $self->{cancelled};
$is_future ? $code->done( $self->get )
: $code->( $self->get );
}
else {
push @{ $self->{callbacks} }, [ CB_DONE|CB_RESULT, $self->wrap_cb( on_done => $code ) ];
}
return $self;
}
=head2 is_failed
$failed = $future->is_failed
I<Since version 0.26.>
Returns true on a future if it is ready and it failed. Returns false if it is
still pending, completed successfully, or was cancelled.
=cut
sub is_failed
{
my $self = shift;
return $self->{ready} && !!$self->{failure}; # boolify
}
=head2 failure
$exception = $future->failure
$exception, @details = $future->failure
Returns the exception passed to the C<fail> method, C<undef> if the future
completed successfully via the C<done> method, or raises an exception if
called on a future that is not yet ready.
If called in list context, will additionally yield a list of the details
provided to the C<fail> method.
Because the exception value must be true, this can be used in a simple C<if>
statement:
if( my $exception = $future->failure ) {
...
}
else {
my @result = $future->get;
...
}
=cut
sub failure
{
my $self = shift;
$self->await until $self->{ready};
return unless $self->{failure};
$self->{reported} = 1;
return $self->{failure}->[0] if !wantarray;
return @{ $self->{failure} };
}
=head2 on_fail
$future->on_fail( $code )
If the future is not yet ready, adds a callback to be invoked when the future
is ready, if it fails. If the future has already failed, invokes it
immediately. If it completed successfully or was cancelled, it is not invoked
at all.
The callback will be passed the exception and details passed to the C<fail>
method.
$on_fail->( $exception, @details )
If passed another C<Future> instance, the passed instance will have its
C<fail> method invoked when the original future fails.
To invoke a C<done> method on a future when another one fails, use a CODE
reference:
$future->on_fail( sub { $f->done( @_ ) } );
Returns the C<$future>.
=cut
sub on_fail
{
my $self = shift;
my ( $code ) = @_;
local/lib/perl5/Future.pm view on Meta::CPAN
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"
for keys %catch_handlers;
sub {
my $self = shift;
my @maybe_self = $with_f ? ( $self ) : ();
if( !$self->{failure} ) {
return $self unless $done_code;
return $done_code->( @maybe_self, $self->get );
}
else {
my $name = $self->{failure}[1];
if( defined $name and $catch_handlers{$name} ) {
return $catch_handlers{$name}->( @maybe_self, $self->failure );
}
return $self unless $fail_code;
return $fail_code->( @maybe_self, $self->failure );
}
};
};
sub then
{
my $self = shift;
my $done_code = shift;
my $fail_code = ( @_ % 2 ) ? pop : undef;
my @catch_list = @_;
if( $done_code and !@catch_list and !$fail_code ) {
return $self->_sequence( $done_code, CB_SEQ_ONDONE|CB_RESULT );
}
# Complex
return $self->_sequence( $make_donecatchfail_sub->(
0, $done_code, $fail_code, @catch_list,
), CB_SEQ_ONDONE|CB_SEQ_ONFAIL|CB_SELF );
}
sub else
{
my $self = shift;
my ( $fail_code ) = @_;
return $self->_sequence( $fail_code, CB_SEQ_ONFAIL|CB_RESULT );
}
=head2 catch
$future = $f1->catch(
name => \&code,
name => \&code, ...
)
I<Since version 0.33.>
Returns a new sequencing C<Future> that behaves like an C<else> call which
dispatches to a choice of several alternative handling functions depending on
the kind of failure that occurred. If C<$f1> fails with a category name (i.e.
the second argument to the C<fail> call) which exactly matches one of the
string names given, then the corresponding code is invoked, being passed the
same arguments as a plain C<else> call would take, and is expected to return a
C<Future> in the same way.
$f2 = $code->( $exception, $name, @other_details )
If C<$f1> does not fail, fails without a category name at all, or fails with a
category name that does not match any given to the C<catch> method, then the
returned sequence future immediately completes with the same result, and no
block of code is invoked.
If passed an odd-sized list, the final argument gives a function to invoke on
failure if no other handler matches.
$future = $f1->catch(
name => \&code, ...
\&fail_code,
)
This feature is currently still a work-in-progress. It currently can only cope
with category names that are literal strings, which are all distinct. A later
version may define other kinds of match (e.g. regexp), may specify some sort
of ordering on the arguments, or any of several other semantic extensions. For
more detail on the ongoing design, see
L<https://rt.cpan.org/Ticket/Display.html?id=103545>.
=head2 then I<(multiple arguments)>
$future = $f1->then( \&done_code, @catch_list, \&fail_code )
I<Since version 0.33.>
The C<then> method can be passed an even-sized list inbetween the
C<$done_code> and the C<$fail_code>, with the same meaning as the C<catch>
method.
=cut
sub catch
{
my $self = shift;
my $fail_code = ( @_ % 2 ) ? pop : undef;
my @catch_list = @_;
return $self->_sequence( $make_donecatchfail_sub->(
0, undef, $fail_code, @catch_list,
), CB_SEQ_ONDONE|CB_SEQ_ONFAIL|CB_SELF );
}
=head2 transform
$future = $f1->transform( %args )
Returns a new sequencing C<Future> that wraps the one given as C<$f1>. With no
arguments this will be a trivial wrapper; C<$future> will complete or fail
when C<$f1> does, and C<$f1> will be cancelled when C<$future> is.
By passing the following named arguments, the returned C<$future> can be made
to behave differently to C<$f1>:
=over 8
=item done => CODE
Provides a function to use to modify the result of a successful completion.
When C<$f1> completes successfully, the result of its C<get> method is passed
into this function, and whatever it returns is passed to the C<done> method of
C<$future>
=item fail => CODE
Provides a function to use to modify the result of a failure. When C<$f1>
fails, the result of its C<failure> method is passed into this function, and
whatever it returns is passed to the C<fail> method of C<$future>.
=back
=cut
sub transform
{
my $self = shift;
my %args = @_;
my $xfrm_done = $args{done};
my $xfrm_fail = $args{fail};
return $self->_sequence( sub {
my $self = shift;
if( !$self->{failure} ) {
return $self unless $xfrm_done;
my @result = $xfrm_done->( $self->get );
return $self->new->done( @result );
}
else {
return $self unless $xfrm_fail;
my @failure = $xfrm_fail->( $self->failure );
return $self->new->fail( @failure );
}
}, CB_SEQ_ONDONE|CB_SEQ_ONFAIL|CB_SELF );
}
=head2 then_with_f
$future = $f1->then_with_f( ... )
I<Since version 0.21.>
Returns a new sequencing C<Future> that behaves like C<then>, but also passes
the original future, C<$f1>, to any functions it invokes.
$f2 = $done_code->( $f1, @result )
$f2 = $catch_code->( $f1, $name, @other_details )
$f2 = $fail_code->( $f1, @details )
This is useful for conditional execution cases where the code block may just
return the same result of the original future. In this case it is more
efficient to return the original future itself.
=cut
sub then_with_f
{
my $self = shift;
my $done_code = shift;
my $fail_code = ( @_ % 2 ) ? pop : undef;
my @catch_list = @_;
if( $done_code and !@catch_list and !$fail_code ) {
return $self->_sequence( $done_code, CB_SEQ_ONDONE|CB_SELF|CB_RESULT );
}
return $self->_sequence( $make_donecatchfail_sub->(
1, $done_code, $fail_code, @catch_list,
), CB_SEQ_ONDONE|CB_SEQ_ONFAIL|CB_SELF );
}
=head2 then_done
=head2 then_fail
$future = $f->then_done( @result )
$future = $f->then_fail( $exception, @details )
I<Since version 0.22.>
Convenient shortcuts to returning an immediate future from a C<then> block,
when the result is already known.
=cut
sub then_done
{
my $self = shift;
my ( @result ) = @_;
return $self->_sequence( \@result, CB_SEQ_ONDONE|CB_SEQ_IMDONE );
}
sub then_fail
{
my $self = shift;
my ( @failure ) = @_;
return $self->_sequence( \@failure, CB_SEQ_ONDONE|CB_SEQ_IMFAIL );
}
=head2 else_with_f
$future = $f1->else_with_f( \&code )
I<Since version 0.21.>
Returns a new sequencing C<Future> that runs the code if the first fails.
Identical to C<else>, except that the code reference will be passed both the
original future, C<$f1>, and its exception and details.
$f2 = $code->( $f1, $exception, @details )
This is useful for conditional execution cases where the code block may just
return the same result of the original future. In this case it is more
efficient to return the original future itself.
=cut
sub else_with_f
{
my $self = shift;
my ( $fail_code ) = @_;
return $self->_sequence( $fail_code, CB_SEQ_ONFAIL|CB_SELF|CB_RESULT );
}
=head2 else_done
=head2 else_fail
$future = $f->else_done( @result )
$future = $f->else_fail( $exception, @details )
I<Since version 0.22.>
Convenient shortcuts to returning an immediate future from a C<else> block,
when the result is already known.
=cut
sub else_done
{
my $self = shift;
my ( @result ) = @_;
return $self->_sequence( \@result, CB_SEQ_ONFAIL|CB_SEQ_IMDONE );
}
sub else_fail
{
my $self = shift;
my ( @failure ) = @_;
return $self->_sequence( \@failure, CB_SEQ_ONFAIL|CB_SEQ_IMFAIL );
}
=head2 catch_with_f
$future = $f1->catch_with_f( ... )
I<Since version 0.33.>
Returns a new sequencing C<Future> that behaves like C<catch>, but also passes
the original future, C<$f1>, to any functions it invokes.
=cut
sub catch_with_f
{
my $self = shift;
my $fail_code = ( @_ % 2 ) ? pop : undef;
my @catch_list = @_;
return $self->_sequence( $make_donecatchfail_sub->(
1, undef, $fail_code, @catch_list,
), CB_SEQ_ONDONE|CB_SEQ_ONFAIL|CB_SELF );
}
=head2 followed_by
$future = $f1->followed_by( \&code )
Returns a new sequencing C<Future> that runs the code regardless of success or
failure. Once C<$f1> is ready the code reference will be invoked and is passed
one argument, C<$f1>. 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.
$f2 = $code->( $f1 )
=cut
sub followed_by
{
my $self = shift;
my ( $code ) = @_;
return $self->_sequence( $code, CB_SEQ_ONDONE|CB_SEQ_ONFAIL|CB_SELF );
}
=head2 without_cancel
$future = $f1->without_cancel
I<Since version 0.30.>
Returns a new sequencing C<Future> that will complete with the success or
failure of the original future, but if cancelled, will not cancel the
original. This may be useful if the original future represents an operation
that is being shared among multiple sequences; cancelling one should not
prevent the others from running too.
=cut
sub without_cancel
{
my $self = shift;
my $new = $self->new;
$self->on_ready( sub {
my $self = shift;
if( $self->failure ) {
$new->fail( $self->failure );
}
else {
$new->done( $self->get );
}
});
return $new;
}
=head1 CONVERGENT FUTURES
The following constructors all take a list of component futures, and return a
local/lib/perl5/Future.pm view on Meta::CPAN
( $self->{label} ) = @_;
return $self;
}
sub label
{
my $self = shift;
return $self->{label};
}
sub __selfstr
{
my $self = shift;
return "$self" unless defined $self->{label};
return "$self (\"$self->{label}\")";
}
=head2 btime
=head2 rtime
[ $sec, $usec ] = $future->btime
[ $sec, $usec ] = $future->rtime
I<Since version 0.28.>
Accessors that return the tracing timestamps from the instance. These give the
time the instance was contructed ("birth" time, C<btime>) and the time the
result was determined (the "ready" time, C<rtime>). Each result is returned as
a two-element ARRAY ref, containing the epoch time in seconds and
microseconds, as given by C<Time::HiRes::gettimeofday>.
In order for these times to be captured, they have to be enabled by setting
C<$Future::TIMES> to a true value. This is initialised true at the time the
module is loaded if either C<PERL_FUTURE_DEBUG> or C<PERL_FUTURE_TIMES> are
set in the environment.
=cut
sub btime
{
my $self = shift;
return $self->{btime};
}
sub rtime
{
my $self = shift;
return $self->{rtime};
}
=head2 elapsed
$sec = $future->elapsed
I<Since version 0.28.>
If both tracing timestamps are defined, returns the number of seconds of
elapsed time between them as a floating-point number. If not, returns
C<undef>.
=cut
sub elapsed
{
my $self = shift;
return undef unless defined $self->{btime} and defined $self->{rtime};
return $self->{elapsed} ||= tv_interval( $self->{btime}, $self->{rtime} );
}
=head2 wrap_cb
$cb = $future->wrap_cb( $operation_name, $cb )
I<Since version 0.31.>
I<Note: This method is experimental and may be changed or removed in a later
version.>
This method is invoked internally by various methods that are about to save a
callback CODE reference supplied by the user, to be invoked later. The default
implementation simply returns the callback agument as-is; the method is
provided to allow users to provide extra behaviour. This can be done by
applying a method modifier of the C<around> kind, so in effect add a chain of
wrappers. Each wrapper can then perform its own wrapping logic of the
callback. C<$operation_name> is a string giving the reason for which the
callback is being saved; currently one of C<on_ready>, C<on_done>, C<on_fail>
or C<sequence>; the latter being used for all the sequence-returning methods.
This method is intentionally invoked only for CODE references that are being
saved on a pending C<Future> instance to be invoked at some later point. It
does not run for callbacks to be invoked on an already-complete instance. This
is for performance reasons, where the intended behaviour is that the wrapper
can provide some amount of context save and restore, to return the operating
environment for the callback back to what it was at the time it was saved.
For example, the following wrapper saves the value of a package variable at
the time the callback was saved, and restores that value at invocation time
later on. This could be useful for preserving context during logging in a
Future-based program.
our $LOGGING_CTX;
no warnings 'redefine';
my $orig = Future->can( "wrap_cb" );
*Future::wrap_cb = sub {
my $cb = $orig->( @_ );
my $saved_logging_ctx = $LOGGING_CTX;
return sub {
local $LOGGING_CTX = $saved_logging_ctx;
$cb->( @_ );
};
};
At this point, any code deferred into a C<Future> by any of its callbacks will
observe the C<$LOGGING_CTX> variable as having the value it held at the time
the callback was saved, even if it is invoked later on when that value is
different.
Remember when writing such a wrapper, that it still needs to invoke the
previous version of the method, so that it plays nicely in combination with
others (see the C<< $orig->( @_ ) >> part).
=cut
( run in 3.365 seconds using v1.01-cache-2.11-cpan-d80b1682f3f )