Acme-Sort-Sleep
view release on metacpan or search on metacpan
local/lib/perl5/Future.pm view on Meta::CPAN
By the time a C<Future> object is destroyed, it ought to have been completed
or cancelled. By enabling debug tracing of objects, this fact can be checked.
If a future object is destroyed without having been completed or cancelled, a
warning message is printed.
$ PERL_FUTURE_DEBUG=1 perl -MFuture -E 'my $f = Future->new'
Future=HASH(0xaa61f8) was constructed at -e line 1 and was lost near -e line 0 before it was ready.
Note that due to a limitation of perl's C<caller> function within a C<DESTROY>
destructor method, the exact location of the leak cannot be accurately
determined. Often the leak will occur due to falling out of scope by returning
from a function; in this case the leak location may be reported as being the
line following the line calling that function.
$ PERL_FUTURE_DEBUG=1 perl -MFuture
sub foo {
my $f = Future->new;
}
foo();
print "Finished\n";
Future=HASH(0x14a2220) was constructed at - line 2 and was lost near - line 6 before it was ready.
Finished
A warning is also printed in debug mode if a C<Future> object is destroyed
that completed with a failure, but the object believes that failure has not
been reported anywhere.
$ PERL_FUTURE_DEBUG=1 perl -Mblib -MFuture -E 'my $f = Future->fail("Oops")'
Future=HASH(0xac98f8) was constructed at -e line 1 and was lost near -e line 0 with an unreported failure of: Oops
Such a failure is considered reported if the C<get> or C<failure> methods are
called on it, or it had at least one C<on_ready> or C<on_fail> callback, or
its failure is propagated to another C<Future> instance (by a sequencing or
converging method).
=cut
=head1 CONSTRUCTORS
=cut
=head2 new
$future = Future->new
$future = $orig->new
Returns a new C<Future> instance to represent a leaf future. It will be marked
as ready by any of the C<done>, C<fail>, or C<cancel> methods. It can be
called either as a class method, or as an instance method. Called on an
instance it will construct another in the same class, and is useful for
subclassing.
This constructor would primarily be used by implementations of asynchronous
interfaces.
=cut
# Callback flags
use constant {
CB_DONE => 1<<0, # Execute callback on done
CB_FAIL => 1<<1, # Execute callback on fail
CB_CANCEL => 1<<2, # Execute callback on cancellation
CB_SELF => 1<<3, # Pass $self as first argument
CB_RESULT => 1<<4, # Pass result/failure as a list
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; }
local/lib/perl5/Future.pm view on Meta::CPAN
=head2 call
$future = Future->call( \&code, @args )
I<Since version 0.15.>
A convenient wrapper for calling a C<CODE> reference that is expected to
return a future. In normal circumstances is equivalent to
$future = $code->( @args )
except that if the code throws an exception, it is wrapped in a new immediate
fail future. If the return value from the code is not a blessed C<Future>
reference, an immediate fail future is returned instead to complain about this
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 : () ),
);
}
}
}
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;
}
sub done_cb
{
my $self = shift;
return sub { $self->done( @_ ) };
local/lib/perl5/Future.pm view on Meta::CPAN
Requests that the future be cancelled, immediately marking it as ready. This
will invoke all of the code blocks registered by C<on_cancel>, in the reverse
order. When called on a convergent future, all its component futures are also
cancelled. It is not an error to attempt to cancel a future that is already
complete or cancelled; it simply has no effect.
Returns the C<$future>.
=cut
sub cancel
{
my $self = shift;
return $self if $self->{ready};
$self->{cancelled}++;
foreach my $code ( reverse @{ $self->{on_cancel} || [] } ) {
my $is_future = blessed( $code ) && $code->isa( "Future" );
$is_future ? $code->cancel
: $code->( $self );
}
$self->_mark_ready( "cancel" );
return $self;
}
sub cancel_cb
{
my $self = shift;
return sub { $self->cancel };
}
=head1 SEQUENCING METHODS
The following methods all return a new future to represent the combination of
its invocant followed by another action given by a code reference. The
combined activity waits for the first future to be ready, then may invoke the
code depending on the success or failure of the first, or may run it
regardless. The returned sequence future represents the entire combination of
activity.
In some cases the code should return a future; in some it should return an
immediate result. If a future is returned, the combined future will then wait
for the result of this second one. If the combinined future is cancelled, it
will cancel either the first future or the second, depending whether the first
had completed. If the code block throws an exception instead of returning a
value, the sequence future will fail with that exception as its message and no
further values.
As it is always a mistake to call these sequencing methods in void context and lose the
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
( run in 2.537 seconds using v1.01-cache-2.11-cpan-140bd7fdf52 )