diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/Future.pm | 2200 | ||||
| -rw-r--r-- | lib/Future/Phrasebook.pod | 500 | ||||
| -rw-r--r-- | lib/Future/Utils.pm | 687 | ||||
| -rw-r--r-- | lib/Test/Future.pm | 141 |
4 files changed, 3528 insertions, 0 deletions
diff --git a/lib/Future.pm b/lib/Future.pm new file mode 100644 index 0000000..07d7490 --- /dev/null +++ b/lib/Future.pm @@ -0,0 +1,2200 @@ +# 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-2015 -- leonerd@leonerd.org.uk + +package Future; + +use strict; +use warnings; +no warnings 'recursion'; # Disable the "deep recursion" warning + +our $VERSION = '0.32'; + +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. + +See also L<Future::Utils> which contains useful loop-constructing functions, +to run a future-returning function repeatedly in a loop. + +=head2 SUBCLASSING + +This class easily supports being subclassed to provide extra behavior, such as +giving the C<get> method the ability to block and wait for completion. This +may be useful to provide C<Future> subclasses with event systems, or similar. + +Each method that returns a new future object will use the invocant to +construct its return value. If the constructor needs to perform per-instance +setup it can override the C<new> method, and take context from the given +instance. + + sub new + { + my $proto = shift; + my $self = $proto->SUPER::new; + + if( ref $proto ) { + # Prototype was an instance + } + else { + # Prototype was a class + } + + return $self; + } + +If an instance provides a method called C<await>, this will be called by the +C<get> and C<failure> methods if the instance is pending. + + $f->await + +In most cases this should allow future-returning modules to be used as if they +were blocking call/return-style modules, by simply appending a C<get> call to +the function or method calls. + + my ( $results, $here ) = future_returning_function( @args )->get; + +The F<examples> directory in the distribution contains some examples of how +futures might be integrated with various event systems. + +=head2 MODULE DOCUMENTATION + +Modules that provide future-returning functions or methods may wish to adopt +the following styles in some way, to document the eventual return values from +these futures. + + func( ARGS, HERE... ) ==> ( RETURN, VALUES... ) + + OBJ->method( ARGS, HERE... ) ==> ( RETURN, VALUES... ) + +Code returning a future that yields no values on success can use empty +parentheses. + + func( ... ) ==> () + +=head2 DEBUGGING + +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 $future = Future->new + +=head2 $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; } + +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 $future = Future->done( @values ) + +=head2 $future = Future->fail( $exception, @details ) + +Shortcut wrappers around creating a new C<Future> then immediately marking it +as done or failed. + +=head2 $future = Future->wrap( @values ) + +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 $future = Future->call( \&code, @args ) + +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 $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. + +=head2 Future->done( @result ) + +May also be called as a class method, where it will construct a new Future and +immediately mark it as done. + +Returns the C<$future> to allow easy chaining to create an immediate future by + + return Future->done( ... ) + +=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; +} + +=head2 $code = $future->done_cb + +Returns a C<CODE> reference that, when invoked, calls the C<done> method. This +makes it simple to pass as a callback function to other code. + +As the same effect can be achieved using L<curry>, this method is deprecated +now and may be removed in a later version. + + $code = $future->curry::done; + +=cut + +sub done_cb +{ + my $self = shift; + return sub { $self->done( @_ ) }; +} + +=head2 $future->fail( $exception, @details ) + +Marks that the leaf future has failed, and provides an exception value. This +exception will be thrown by the C<get> method if called. + +The exception must evaluate as a true value; false exceptions are not allowed. +Further details may be provided that will be returned by the C<failure> method +in list context. These details will not be part of the exception string raised +by C<get>. + +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. + +=head2 Future->fail( $exception, @details ) + +May also be called as a class method, where it will construct a new Future and +immediately mark it as failed. + +Returns the C<$future> to allow easy chaining to create an immediate failed +future by + + return Future->fail( ... ) + +=cut + +sub fail +{ + my $self = shift; + my ( $exception, @details ) = @_; + + $_[0] or Carp::croak "$self ->fail requires an exception that is true"; + + if( ref $self ) { + $self->{cancelled} and return $self; + $self->{ready} and Carp::croak "${\$self->__selfstr} is already ".$self->_state." and cannot be ->fail'ed"; + $self->{subs} and Carp::croak "${\$self->__selfstr} is not a leaf Future, cannot be ->fail'ed"; + $self->{failure} = [ $exception, @details ]; + $self->_mark_ready( "fail" ); + } + else { + $self = $self->new; + $self->{ready} = 1; + $self->{ready_at} = _shortmess "fail" if DEBUG; + $self->{failure} = [ $exception, @details ]; + } + + if( DEBUG ) { + my $at = Carp::shortmess( "failed" ); + chomp $at; $at =~ s/\.$//; + $self->{ready_at} = $at; + } + + return $self; +} + +=head2 $code = $future->fail_cb + +Returns a C<CODE> reference that, when invoked, calls the C<fail> method. This +makes it simple to pass as a callback function to other code. + +As the same effect can be achieved using L<curry>, this method is deprecated +now and may be removed in a later version. + + $code = $future->curry::fail; + +=cut + +sub fail_cb +{ + my $self = shift; + return sub { $self->fail( @_ ) }; +} + +=head2 $future->die( $message, @details ) + +A convenient wrapper around C<fail>. If the exception is a non-reference that +does not end in a linefeed, its value will be extended by the file and line +number of the caller, similar to the logic that C<die> uses. + +Returns the C<$future>. + +=cut + +sub die :method +{ + my $self = shift; + my ( $exception, @details ) = @_; + + if( !ref $exception and $exception !~ m/\n$/ ) { + $exception .= sprintf " at %s line %d\n", (caller)[1,2]; + } + + $self->fail( $exception, @details ); +} + +=head2 $future->on_cancel( $code ) + +If the future is not yet ready, adds a callback to be invoked if the future is +cancelled by the C<cancel> method. If the future is already ready, throws an +exception. + +If the future is cancelled, the callbacks will be invoked in the reverse order +to that in which they were registered. + + $on_cancel->( $future ) + +=head2 $future->on_cancel( $f ) + +If passed another C<Future> instance, the passed instance will be cancelled +when the original future is cancelled. This method does nothing if the future +is already complete. + +=cut + +sub on_cancel +{ + 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_cancel"; + + $self->{ready} and return $self; + + push @{ $self->{on_cancel} }, $code; + + return $self; +} + +=head2 $cancelled = $future->is_cancelled + +Returns true if the future has been cancelled by C<cancel>. + +=cut + +sub is_cancelled +{ + my $self = shift; + return $self->{cancelled}; +} + +=head1 USER METHODS + +These methods would primarily be used by users of asynchronous interfaces, on +objects returned by such an interface. + +=cut + +=head2 $ready = $future->is_ready + +Returns true on a leaf future if a result has been provided to the C<done> +method, failed using the C<fail> method, or cancelled using the C<cancel> +method. + +Returns true on a convergent future if it is ready to yield a result, +depending on its component futures. + +=cut + +sub is_ready +{ + my $self = shift; + return $self->{ready}; +} + +=head2 $future->on_ready( $code ) + +If the future is not yet ready, adds a callback to be invoked when the future +is ready. If the future is already ready, invokes it immediately. + +In either case, the callback will be passed the future object itself. The +invoked code can then obtain the list of results by calling the C<get> method. + + $on_ready->( $future ) + +Returns the C<$future>. + +=head2 $future->on_ready( $f ) + +If passed another C<Future> instance, the passed instance will have its +C<done>, C<fail> or C<cancel> methods invoked when the original future +completes successfully, fails, or is cancelled respectively. + +=cut + +sub on_ready +{ + 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_ready"; + + if( $self->{ready} ) { + my $fail = defined $self->{failure}; + my $done = !$fail && !$self->{cancelled}; + + $self->{reported} = 1 if $fail; + + $is_future ? ( $done ? $code->done( $self->get ) : + $fail ? $code->fail( $self->failure ) : + $code->cancel ) + : $code->( $self ); + } + else { + push @{ $self->{callbacks} }, [ CB_ALWAYS|CB_SELF, $self->wrap_cb( on_ready => $code ) ]; + } + + return $self; +} + +=head2 $done = $future->is_done + +Returns true on a future if it is ready and completed successfully. Returns +false if it is still pending, failed, or was cancelled. + +=cut + +sub is_done +{ + my $self = shift; + return $self->{ready} && !$self->{failure} && !$self->{cancelled}; +} + +=head2 @result = $future->get + +=head2 $result = $future->get + +If the future is ready and completed successfully, returns the list of +results that had earlier been given to the C<done> method on a leaf future, +or the list of component futures it was waiting for on a convergent future. In +scalar context it returns just the first result value. + +If the future is ready but failed, this method raises as an exception the +failure string or object that was given to the C<fail> method. + +If the future was cancelled an exception is thrown. + +If it is not yet ready and is not of a subclass that provides an C<await> +method an exception is thrown. If it is subclassed to provide an C<await> +method then this is used to wait for the future to be ready, before returning +the result or propagating its failure exception. + +=cut + +sub await +{ + my $self = shift; + Carp::croak "$self is not yet complete and does not provide ->await"; +} + +sub get +{ + my $self = shift; + $self->await until $self->{ready}; + if( $self->{failure} ) { + $self->{reported} = 1; + my $exception = $self->{failure}->[0]; + !ref $exception && $exception =~ m/\n$/ ? CORE::die $exception : Carp::croak $exception; + } + $self->{cancelled} and Carp::croak "${\$self->__selfstr} was cancelled"; + return $self->{result}->[0] unless wantarray; + return @{ $self->{result} }; +} + +=head2 @values = Future->unwrap( @values ) + +If given a single argument which is a C<Future> reference, this method will +call C<get> on it and return the result. Otherwise, it returns the list of +values directly in list context, or the first value in scalar. Since it +involves an implicit C<await>, this method can only be used on immediate +futures or subclasses that implement C<await>. + +This will ensure that an outgoing argument is definitely not a C<Future>, and +may be useful in such cases as adapting synchronous code to fit asynchronous +libraries that return C<Future> instances. + +=cut + +sub unwrap +{ + shift; # $class + my @values = @_; + + if( @values == 1 and blessed $values[0] and $values[0]->isa( __PACKAGE__ ) ) { + return $values[0]->get; + } + else { + return $values[0] if !wantarray; + return @values; + } +} + +=head2 $future->on_done( $code ) + +If the future is not yet ready, adds a callback to be invoked when the future +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 ) + +Returns the C<$future>. + +=head2 $future->on_done( $f ) + +If passed another C<Future> instance, the passed instance will have its +C<done> method invoked when the original future completes successfully. + +=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 $failed = $future->is_failed + +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 $exception = $future->failure + +=head2 $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 $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 ) + +Returns the C<$future>. + +=head2 $future->on_fail( $f ) + +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( @_ ) } ); + +=cut + +sub on_fail +{ + 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_fail"; + + if( $self->{ready} ) { + return $self if not $self->{failure}; + $self->{reported} = 1; + + $is_future ? $code->fail( $self->failure ) + : $code->( $self->failure ); + } + else { + push @{ $self->{callbacks} }, [ CB_FAIL|CB_RESULT, $self->wrap_cb( on_fail => $code ) ]; + } + + return $self; +} + +=head2 $future->cancel + +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; +} + +=head2 $code = $future->cancel_cb + +Returns a C<CODE> reference that, when invoked, calls the C<cancel> method. +This makes it simple to pass as a callback function to other code. + +As the same effect can be achieved using L<curry>, this method is deprecated +now and may be removed in a later version. + + $code = $future->curry::cancel; + +=cut + +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 $future = $f1->then( \&done_code ) + +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 $future = $f1->else( \&fail_code ) + +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 $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 + +sub then +{ + my $self = shift; + my ( $done_code, $fail_code ) = @_; + + if( $done_code and !$fail_code ) { + return $self->_sequence( $done_code, CB_SEQ_ONDONE|CB_RESULT ); + } + + !$done_code or _callable( $done_code ) or + Carp::croak "Expected \$done_code to be callable in ->then"; + !$fail_code or _callable( $fail_code ) or + Carp::croak "Expected \$fail_code to be callable in ->then"; + + # Complex + return $self->_sequence( sub { + my $self = shift; + if( !$self->{failure} ) { + return $self unless $done_code; + return $done_code->( $self->get ); + } + else { + return $self unless $fail_code; + return $fail_code->( $self->failure ); + } + }, 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 $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 $future = $f1->then_with_f( \&code ) + +Returns a new sequencing C<Future> that runs the code if the first succeeds. +Identical to C<then>, except that the code reference will be passed both the +original future, C<$f1>, and its result. + + $f2 = $code->( $f1, @result ) + +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 ) = @_; + + return $self->_sequence( $done_code, CB_SEQ_ONDONE|CB_SELF|CB_RESULT ); +} + +=head2 $future = $f->then_done( @result ) + +=head2 $future = $f->then_fail( $exception, @details ) + +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 $future = $f1->else_with_f( \&code ) + +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 $future = $f->else_done( @result ) + +=head2 $future = $f->else_fail( $exception, @details ) + +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 $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 ); +} + +sub and_then +{ + Carp::croak "Future->and_then is now removed; use ->then_with_f instead"; +} + +sub or_else +{ + Carp::croak "Future->or_else is now removed; use ->else_with_f instead"; +} + +=head2 $future = $f1->without_cancel + +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 +new future whose readiness somehow depends on the readiness of those +components. The first derived class component future will be used as the +prototype for constructing the return value, so it respects subclassing +correctly, or failing that a plain C<Future>. + +=cut + +sub _new_convergent +{ + shift; # ignore this class + my ( $subs ) = @_; + + foreach my $sub ( @$subs ) { + blessed $sub and $sub->isa( "Future" ) or Carp::croak "Expected a Future, got $_"; + } + + # 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 $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 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 $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 $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 $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 @f = $future->pending_futures + +=head2 @f = $future->ready_futures + +=head2 @f = $future->done_futures + +=head2 @f = $future->failed_futures + +=head2 @f = $future->cancelled_futures + +Return a list of all the pending, ready, done, failed, or cancelled +component futures. In scalar context, each will yield the number of such +component futures. + +=cut + +sub pending_futures +{ + my $self = shift; + $self->{subs} or Carp::croak "Cannot call ->pending_futures on a non-convergent Future"; + return grep { not $_->{ready} } @{ $self->{subs} }; +} + +sub ready_futures +{ + my $self = shift; + $self->{subs} or Carp::croak "Cannot call ->ready_futures on a non-convergent Future"; + return grep { $_->{ready} } @{ $self->{subs} }; +} + +sub done_futures +{ + my $self = shift; + $self->{subs} or Carp::croak "Cannot call ->done_futures on a non-convergent Future"; + return grep { $_->{ready} and not $_->{failure} and not $_->{cancelled} } @{ $self->{subs} }; +} + +sub failed_futures +{ + my $self = shift; + $self->{subs} or Carp::croak "Cannot call ->failed_futures on a non-convergent Future"; + return grep { $_->{ready} and $_->{failure} } @{ $self->{subs} }; +} + +sub cancelled_futures +{ + my $self = shift; + $self->{subs} or Carp::croak "Cannot call ->cancelled_futures on a non-convergent Future"; + return grep { $_->{ready} and $_->{cancelled} } @{ $self->{subs} }; +} + +=head1 TRACING METHODS + +=head2 $future = $future->set_label( $label ) + +=head2 $label = $future->label + +Chaining mutator and accessor for the label of the C<Future>. This should be a +plain string value, whose value will be stored by the future instance for use +in debugging messages or other tooling, or similar purposes. + +=cut + +sub set_label +{ + my $self = shift; + ( $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 [ $sec, $usec ] = $future->btime + +=head2 [ $sec, $usec ] = $future->rtime + +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 $sec = $future->elapsed + +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 $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 + +sub wrap_cb +{ + my $self = shift; + my ( $op, $cb ) = @_; + return $cb; +} + +=head1 EXAMPLES + +The following examples all demonstrate possible uses of a C<Future> +object to provide a fictional asynchronous API. + +For more examples, comparing the use of C<Future> with regular call/return +style Perl code, see also L<Future::Phrasebook>. + +=head2 Providing Results + +By returning a new C<Future> object each time the asynchronous function is +called, it provides a placeholder for its eventual result, and a way to +indicate when it is complete. + + sub foperation + { + my %args = @_; + + my $future = Future->new; + + do_something_async( + foo => $args{foo}, + on_done => sub { $future->done( @_ ); }, + ); + + return $future; + } + +In most cases, the C<done> method will simply be invoked with the entire +result list as its arguments. In that case, it is simpler to use the +C<done_cb> wrapper method to create the C<CODE> reference. + + my $future = Future->new; + + do_something_async( + foo => $args{foo}, + on_done => $future->done_cb, + ); + +The caller may then use this future to wait for a result using the C<on_ready> +method, and obtain the result using C<get>. + + my $f = foperation( foo => "something" ); + + $f->on_ready( sub { + my $f = shift; + say "The operation returned: ", $f->get; + } ); + +=head2 Indicating Success or Failure + +Because the stored exception value of a failed future may not be false, the +C<failure> method can be used in a conditional statement to detect success or +failure. + + my $f = foperation( foo => "something" ); + + $f->on_ready( sub { + my $f = shift; + if( not my $e = $f->failure ) { + say "The operation succeeded with: ", $f->get; + } + else { + say "The operation failed with: ", $e; + } + } ); + +By using C<not> in the condition, the order of the C<if> blocks can be +arranged to put the successful case first, similar to a C<try>/C<catch> block. + +Because the C<get> method re-raises the passed exception if the future failed, +it can be used to control a C<try>/C<catch> block directly. (This is sometimes +called I<Exception Hoisting>). + + use Try::Tiny; + + $f->on_ready( sub { + my $f = shift; + try { + say "The operation succeeded with: ", $f->get; + } + catch { + say "The operation failed with: ", $_; + }; + } ); + +Even neater still may be the separate use of the C<on_done> and C<on_fail> +methods. + + $f->on_done( sub { + my @result = @_; + say "The operation succeeded with: ", @result; + } ); + $f->on_fail( sub { + my ( $failure ) = @_; + say "The operation failed with: $failure"; + } ); + +=head2 Immediate Futures + +Because the C<done> method returns the future object itself, it can be used to +generate a C<Future> that is immediately ready with a result. This can also be +used as a class method. + + my $f = Future->done( $value ); + +Similarly, the C<fail> and C<die> methods can be used to generate a C<Future> +that is immediately failed. + + my $f = Future->die( "This is never going to work" ); + +This could be considered similarly to a C<die> call. + +An C<eval{}> block can be used to turn a C<Future>-returning function that +might throw an exception, into a C<Future> that would indicate this failure. + + my $f = eval { function() } || Future->fail( $@ ); + +This is neater handled by the C<call> class method, which wraps the call in +an C<eval{}> block and tests the result: + + my $f = Future->call( \&function ); + +=head2 Sequencing + +The C<then> method can be used to create simple chains of dependent tasks, +each one executing and returning a C<Future> when the previous operation +succeeds. + + my $f = do_first() + ->then( sub { + return do_second(); + }) + ->then( sub { + return do_third(); + }); + +The result of the C<$f> future itself will be the result of the future +returned by the final function, if none of them failed. If any of them fails +it will fail with the same failure. This can be considered similar to normal +exception handling in synchronous code; the first time a function call throws +an exception, the subsequent calls are not made. + +=head2 Merging Control Flow + +A C<wait_all> future may be used to resynchronise control flow, while waiting +for multiple concurrent operations to finish. + + my $f1 = foperation( foo => "something" ); + my $f2 = foperation( bar => "something else" ); + + my $f = Future->wait_all( $f1, $f2 ); + + $f->on_ready( sub { + say "Operations are ready:"; + say " foo: ", $f1->get; + say " bar: ", $f2->get; + } ); + +This provides an ability somewhat similar to C<CPS::kpar()> or +L<Async::MergePoint>. + +=cut + +=head1 KNOWN ISSUES + +=head2 Cancellation of Non-Final Sequence Futures + +The behaviour of future cancellation still has some unanswered questions +regarding how to handle the situation where a future is cancelled that has a +sequence future constructed from it. + +In particular, it is unclear in each of the following examples what the +behaviour of C<$f2> should be, were C<$f1> to be cancelled: + + $f2 = $f1->then( sub { ... } ); # plus related ->then_with_f, ... + + $f2 = $f1->else( sub { ... } ); # plus related ->else_with_f, ... + + $f2 = $f1->followed_by( sub { ... } ); + +In the C<then>-style case it is likely that this situation should be treated +as if C<$f1> had failed, perhaps with some special message. The C<else>-style +case is more complex, because it may be that the entire operation should still +fail, or it may be that the cancellation of C<$f1> should again be treated +simply as a special kind of failure, and the C<else> logic run as normal. + +To be specific; in each case it is unclear what happens if the first future is +cancelled, while the second one is still waiting on it. The semantics for +"normal" top-down cancellation of C<$f2> and how it affects C<$f1> are already +clear and defined. + +=head2 Cancellation of Divergent Flow + +A further complication of cancellation comes from the case where a given +future is reused multiple times for multiple sequences or convergent trees. + +In particular, it is in clear in each of the following examples what the +behaviour of C<$f2> should be, were C<$f1> to be cancelled: + + my $f_initial = Future->new; ... + my $f1 = $f_initial->then( ... ); + my $f2 = $f_initial->then( ... ); + + my $f1 = Future->needs_all( $f_initial ); + my $f2 = Future->needs_all( $f_initial ); + +The point of cancellation propagation is to trace backwards through stages of +some larger sequence of operations that now no longer need to happen, because +the final result is no longer required. But in each of these cases, just +because C<$f1> has been cancelled, the initial future C<$f_initial> is still +required because there is another future (C<$f2>) that will still require its +result. + +Initially it would appear that some kind of reference-counting mechanism could +solve this question, though that itself is further complicated by the +C<on_ready> handler and its variants. + +It may simply be that a comprehensive useful set of cancellation semantics +can't be universally provided to cover all cases; and that some use-cases at +least would require the application logic to give extra information to its +C<Future> objects on how they should wire up the cancel propagation logic. + +Both of these cancellation issues are still under active design consideration; +see the discussion on RT96685 for more information +(L<https://rt.cpan.org/Ticket/Display.html?id=96685>). + +=cut + +=head1 SEE ALSO + +=over 4 + +=item * + +L<curry> - Create automatic curried method call closures for any class or +object + +=item * + +"The Past, The Present and The Future" - slides from a talk given at the +London Perl Workshop, 2012. + +L<https://docs.google.com/presentation/d/1UkV5oLcTOOXBXPh8foyxko4PR28_zU_aVx6gBms7uoo/edit> + +=item * + +"Futures advent calendar 2013" + +L<http://leonerds-code.blogspot.co.uk/2013/12/futures-advent-day-1.html> + +=back + +=cut + +=head1 TODO + +=over 4 + +=item * + +Consider the ability to pass the constructor an C<await> CODEref, instead of +needing to use a subclass. This might simplify async/etc.. implementations, +and allows the reuse of the idea of subclassing to extend the abilities of +C<Future> itself - for example to allow a kind of Future that can report +incremental progress. + +=back + +=cut + +=head1 AUTHOR + +Paul Evans <leonerd@leonerd.org.uk> + +=cut + +0x55AA; diff --git a/lib/Future/Phrasebook.pod b/lib/Future/Phrasebook.pod new file mode 100644 index 0000000..2798536 --- /dev/null +++ b/lib/Future/Phrasebook.pod @@ -0,0 +1,500 @@ +# 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, 2013-2014 -- leonerd@leonerd.org.uk + +=head1 NAME + +C<Future::Phrasebook> - coding examples for C<Future> and C<Future::Utils> + +This documentation-only module provides a phrasebook-like approach to giving +examples on how to use L<Future> and L<Future::Utils> to structure +Future-driven asynchronous or concurrent logic. As with any inter-dialect +phrasebook it is structured into pairs of examples; each given first in a +traditional call/return Perl style, and second in a style using Futures. In +each case, the generic function or functions in the example are named in +C<ALL_CAPITALS()> to make them stand out. + +In the examples showing use of Futures, any function that is expected to +return a C<Future> instance is named with a leading C<F_> prefix. Each example +is also constructed so as to yield an overall future in a variable called +C<$f>, which represents the entire operation. + +=head1 SEQUENCING + +The simplest example of a sequencing operation is simply running one piece of +code, then immediately running a second. In call/return code we can just place +one after the other. + + FIRST(); + SECOND(); + +Using a Future it is necessary to await the result of the first C<Future> +before calling the second. + + my $f = F_FIRST() + ->then( sub { F_SECOND(); } ); + +Here, the anonymous closure is invoked once the C<Future> returned by +C<F_FIRST()> succeeds. Because C<then> invokes the code block only if the +first Future succeeds, it shortcircuits around failures similar to the way that +C<die()> shortcircuits around thrown exceptions. A C<Future> representing the +entire combination is returned by the method. + +Because the C<then> method itself returns a C<Future> representing the +overall operation, it can itself be further chained. + + FIRST(); + SECOND(); + THIRD(); + +Z<> + + my $f = F_FIRST() + ->then( sub { F_SECOND(); } ) + ->then( sub { F_THIRD(); } ); + +See below for examples of ways to handle exceptions. + +=head2 Passing Results + +Often the result of one function can be passed as an argument to another +function. + + OUTER( INNER() ); + +The result of the first C<Future> is passed into the code block given to the +C<then> method. + + my $f = F_INNER() + ->then( sub { F_OUTER( @_ ) } ); + +=head1 CONDITIONALS + +It may be that the result of one function call is used to determine whether or +not another operation is taken. + + if( COND() == $value ) { + ACTION(); + } + +Because the C<then_with_f> code block is given the first future in addition to +its results it can decide whether to call the second function to return a new +future, or simply return the one it was given. + + my $f = F_COND() + ->then_with_f( sub { + my ( $f_cond, $result ) = @_; + if( $result == $value ) { + return F_ACTION(); + } + else { + return $f_cond; + } + }); + +=head1 EXCEPTION HANDLING + +In regular call/return style code, if any function throws an exception, the +remainder of the block is not executed, the containing C<try> or C<eval> is +aborted, and control is passed to the corresponding C<catch> or line after the +C<eval>. + + try { + FIRST(); + } + catch { + my $e = $_; + ERROR( $e ); + }; + +The C<else> method on a C<Future> can be used here. It behaves similar to +C<then>, but is only invoked if the initial C<Future> fails; not if it +succeeds. + + my $f = F_FIRST() + ->else( sub { F_ERROR( @_ ); } ); + +Alternatively, the second argument to the C<then> method can be applied, which +is invoked only on case of failure. + + my $f = F_FIRST() + ->then( undef, sub { F_ERROR( @_ ); } ); + +Often it may be the case that the failure-handling code is in fact immediate, +and doesn't return a C<Future>. In that case, the C<else> code block can +return an immediate C<Future> instance. + + my $f = F_FIRST() + ->else( sub { + ERROR( @_ ); + return Future->done; + }); + +Sometimes the failure handling code simply needs to be aware of the failure, +but rethrow it further up. + + try { + FIRST(); + } + catch { + my $e = $_; + ERROR( $e ); + die $e; + }; + +In this case, while the C<else> block could return a new C<Future> failed with +the same exception, the C<else_with_f> block is passed the failed C<Future> +itself in addition to the failure details so it can just return that. + + my $f = F_FIRST() + ->else_with_f( sub { + my ( $f1, @failure ) = @_; + ERROR( @failure ); + return $f1; + }); + +The C<followed_by> method is similar again, though it invokes the code block +regardless of the success or failure of the initial C<Future>. It can be used +to create C<finally> semantics. By returning the C<Future> instance that it +was passed, the C<followed_by> code ensures it doesn't affect the result of +the operation. + + try { + FIRST(); + } + catch { + ERROR( $_ ); + } + finally { + CLEANUP(); + }; + +Z<> + + my $f = F_FIRST() + ->else( sub { + ERROR( @_ ); + return Future->done; + }) + ->followed_by( sub { + CLEANUP(); + return shift; + }); + +=head1 ITERATION + +To repeat a single block of code multiple times, a C<while> block is often +used. + + while( COND() ) { + FUNC(); + } + +The C<Future::Utils::repeat> function can be used to repeatedly iterate a +given C<Future>-returning block of code until its ending condition is +satisfied. + + use Future::Utils qw( repeat ); + my $f = repeat { + F_FUNC(); + } while => sub { COND() }; + +Unlike the statement nature of perl's C<while> block, this C<repeat> C<Future> +can yield a value; the value returned by C<< $f->get >> is the result of the +final trial of the code block. + +Here, the condition function it expected to return its result immediately. If +the repeat condition function itself returns a C<Future>, it can be combined +along with the loop body. The trial C<Future> returned by the code block is +passed to the C<while> condition function. + + my $f = repeat { + F_FUNC() + ->followed_by( sub { F_COND(); } ); + } while => sub { shift->get }; + +The condition can be negated by using C<until> instead + + until( HALTING_COND() ) { + FUNC(); + } + +Z<> + + my $f = repeat { + F_FUNC(); + } until => sub { HALTING_COND() }; + +=head2 Iterating with Exceptions + +Technically, this loop isn't quite the same as the equivalent C<while> loop in +plain Perl, because the C<while> loop will also stop executing if the code +within it throws an exception. This can be handled in C<repeat> by testing for +a failed C<Future> in the C<until> condition. + + while(1) { + TRIAL(); + } + +Z<> + + my $f = repeat { + F_TRIAL(); + } until => sub { shift->failure }; + +When a repeat loop is required to retry a failure, the C<try_repeat> function +should be used. Currently this function behaves equivalently to C<repeat>, +except that it will not print a warning if it is asked to retry after a +failure, whereas this behaviour is now deprecated for the regular C<repeat> +function so that yields a warning. + + my $f = try_repeat { + F_TRIAL(); + } while => sub { shift->failure }; + +Another variation is the C<try_repeat_until_success> function, which provides +a convenient shortcut to calling C<try_repeat> with a condition that makes +another attempt each time the previous one fails; stopping once it achieves a +successful result. + + while(1) { + eval { TRIAL(); 1 } and last; + } + +Z<> + + my $f = try_repeat_until_success { + F_TRIAL(); + }; + +=head2 Iterating over a List + +A variation on the idea of the C<while> loop is the C<foreach> loop; a loop +that executes once for each item in a given list, with a variable set to one +value from that list each time. + + foreach my $thing ( @THINGS ) { + INSPECT( $thing ); + } + +This can be performed with C<Future> using the C<foreach> parameter to the +C<repeat> function. When this is in effect, the block of code is passed each +item of the given list as the first parameter. + + my $f = repeat { + my $thing = shift; + F_INSPECT( $thing ); + } foreach => \@THINGS; + +=head2 Recursing over a Tree + +A regular call/return function can use recursion to walk over a tree-shaped +structure, where each item yields a list of child items. + + sub WALK + { + my ( $item ) = @_; + ... + WALK($_) foreach CHILDREN($item); + } + +This recursive structure can be turned into a C<while()>-based repeat loop by +using an array to store the remaining items to walk into, instead of using the +perl stack directly: + + sub WALK + { + my @more = ( $root ); + while( @more ) { + my $item = shift @more; + ... + unshift @more, CHILDREN($item) + } + } + +This arrangement then allows us to use C<fmap_void> to walk this structure +using Futures, possibly concurrently. A lexical array variable is captured +that holds the stack of remaining items, which is captured by the item code so +it can C<unshift> more into it, while also being used as the actual C<fmap> +control array. + + my @more = ( $root ); + + my $f = fmap_void { + my $item = shift; + ...->on_done( sub { + unshift @more, @CHILDREN; + }) + } foreach => \@more; + +By choosing to either C<unshift> or C<push> more items onto this list, the +tree can be walked in either depth-first or breadth-first order. + +=head1 SHORT-CIRCUITING + +Sometimes a result is determined that should be returned through several +levels of control structure. Regular Perl code has such keywords as C<return> +to return a value from a function immediately, or C<last> for immediately +stopping execution of a loop. + + sub func { + foreach my $item ( @LIST ) { + if( COND($item) ) { + return $item; + } + } + return MAKE_NEW_ITEM(); + } + +The C<Future::Utils::call_with_escape> function allows this general form of +control flow, by calling a block of code that is expected to return a future, +and itself returning a future. Under normal circumstances the result of this +future propagates through to the one returned by C<call_with_escape>. + +However, the code is also passed in a future value, called here the "escape +future". If the code captures this future and completes it (either by calling +C<done> or C<fail>), then the overall returned future immediately completes +with that result instead, and the future returned by the code block is +cancelled. + + my $f = call_with_escape { + my $escape_f = shift; + + ( repeat { + my $item = shift; + COND($item)->then( sub { + my ( $result ) = @_; + if( $result ) { + $escape_f->done( $item ); + } + return Future->done; + }) + } foreach => \@ITEMS )->then( sub { + MAKE_NEW_ITEM(); + }); + }; + +Here, if C<$escape_f> is completed by the condition test, the future chain +returned by the code (that is, the C<then> chain of the C<repeat> block +followed by C<MAKE_NEW_ITEM()>) will be cancelled, and C<$f> itself will +receive this result. + +=head1 CONCURRENCY + +This final section of the phrasebook demonstrates a number of abilities that +are simple to do with C<Future> but can't easily be done with regular +call/return style programming, because they all involve an element of +concurrency. In these examples the comparison with regular call/return code +will be somewhat less accurate because of the inherent ability for the +C<Future>-using version to behave concurrently. + +=head2 Waiting on Multiple Functions + +The C<< Future->wait_all >> constructor creates a C<Future> that waits for all +of the component futures to complete. This can be used to form a sequence with +concurrency. + + { FIRST_A(); FIRST_B() } + SECOND(); + +Z<> + + my $f = Future->wait_all( FIRST_A(), FIRST_B() ) + ->then( sub { SECOND() } ); + +Unlike in the call/return case, this can perform the work of C<FIRST_A()> and +C<FIRST_B()> concurrently, only proceeding to C<SECOND()> when both are ready. + +The result of the C<wait_all> C<Future> is the list of its component +C<Future>s. This can be used to obtain the results. + + SECOND( FIRST_A(), FIRST_B() ); + +Z<> + + my $f = Future->wait_all( FIRST_A(), FIRST_B() ) + ->then( sub { + my ( $f_a, $f_b ) = @_ + SECOND( $f_a->get, $f_b->get ); + } ); + +Because the C<get> method will re-raise an exception caused by a failure of +either of the C<FIRST> functions, the second stage will fail if any of the +initial Futures failed. + +As this is likely to be the desired behaviour most of the time, this kind of +control flow can be written slightly neater using C<< Future->needs_all >> +instead. + + my $f = Future->needs_all( FIRST_A(), FIRST_B() ) + ->then( sub { SECOND( @_ ) } ); + +The C<get> method of a C<needs_all> convergent Future returns a concatenated +list of the results of all its component Futures, as the only way it will +succeed is if all the components do. + +=head2 Waiting on Multiple Calls of One Function + +Because the C<wait_all> and C<needs_all> constructors take an entire list of +C<Future> instances, they can be conveniently used with C<map> to wait on the +result of calling a function concurrently once per item in a list. + + my @RESULT = map { FUNC( $_ ) } @ITEMS; + PROCESS( @RESULT ); + +Again, the C<needs_all> version allows more convenient access to the list of +results. + + my $f = Future->needs_all( map { F_FUNC( $_ ) } @ITEMS ) + ->then( sub { + my @RESULT = @_; + F_PROCESS( @RESULT ) + } ); + +This form of the code starts every item's future concurrently, then waits for +all of them. If the list of C<@ITEMS> is potentially large, this may cause a +problem due to too many items running at once. Instead, the +C<Future::Utils::fmap> family of functions can be used to bound the +concurrency, keeping at most some given number of items running, starting new +ones as existing ones complete. + + my $f = fmap { + my $item = shift; + F_FUNC( $item ) + } foreach => \@ITEMS; + +By itself, this will not actually act concurrently as it will only keep one +Future outstanding at a time. The C<concurrent> flag lets it keep a larger +number "in flight" at any one time: + + my $f = fmap { + my $item = shift; + F_FUNC( $item ) + } foreach => \@ITEMS, concurrent => 10; + +The C<fmap> and C<fmap_scalar> functions return a Future that will eventually +give the collected results of the individual item futures, thus making them +similar to perl's C<map> operator. + +Sometimes, no result is required, and the items are run in a loop simply for +some side-effect of the body. + + foreach my $item ( @ITEMS ) { + FUNC( $item ); + } + +To avoid having to collect a potentially-large set of results only to throw +them away, the C<fmap_void> function variant of the C<fmap> family yields a +Future that completes with no result after all the items are complete. + + my $f = fmap_void { + my $item = shift; + F_FIRST( $item ) + } foreach => \@ITEMS, concurrent => 10; + +=head1 AUTHOR + +Paul Evans <leonerd@leonerd.org.uk> + +=cut diff --git a/lib/Future/Utils.pm b/lib/Future/Utils.pm new file mode 100644 index 0000000..563f327 --- /dev/null +++ b/lib/Future/Utils.pm @@ -0,0 +1,687 @@ +# 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, 2013-2015 -- leonerd@leonerd.org.uk + +package Future::Utils; + +use strict; +use warnings; + +our $VERSION = '0.32'; + +use Exporter 'import'; +# Can't import the one from Exporter as it relies on package inheritance +sub export_to_level +{ + my $pkg = shift; local $Exporter::ExportLevel = 1 + shift; $pkg->import(@_); +} + +our @EXPORT_OK = qw( + call + call_with_escape + + repeat + try_repeat try_repeat_until_success + repeat_until_success + + fmap fmap_concat + fmap1 fmap_scalar + fmap0 fmap_void +); + +use Carp; +our @CARP_NOT = qw( Future ); + +use Future; + +=head1 NAME + +C<Future::Utils> - utility functions for working with C<Future> objects + +=head1 SYNOPSIS + + use Future::Utils qw( call_with_escape ); + + my $result_f = call_with_escape { + my $escape_f = shift; + my $f = ... + $escape_f->done( "immediate result" ); + ... + }; + +Z<> + + use Future::Utils qw( repeat try_repeat try_repeat_until_success ); + + my $eventual_f = repeat { + my $trial_f = ... + return $trial_f; + } while => sub { my $f = shift; return want_more($f) }; + + my $eventual_f = repeat { + ... + return $trail_f; + } until => sub { my $f = shift; return acceptable($f) }; + + my $eventual_f = repeat { + my $item = shift; + ... + return $trial_f; + } foreach => \@items; + + my $eventual_f = try_repeat { + my $trial_f = ... + return $trial_f; + } while => sub { ... }; + + my $eventual_f = try_repeat_until_success { + ... + return $trial_f; + }; + + my $eventual_f = try_repeat_until_success { + my $item = shift; + ... + return $trial_f; + } foreach => \@items; + +Z<> + + use Future::Utils qw( fmap_concat fmap_scalar fmap_void ); + + my $result_f = fmap_concat { + my $item = shift; + ... + return $item_f; + } foreach => \@items, concurrent => 4; + + my $result_f = fmap_scalar { + my $item = shift; + ... + return $item_f; + } foreach => \@items, concurrent => 8; + + my $done_f = fmap_void { + my $item = shift; + ... + return $item_f; + } foreach => \@items, concurrent => 10; + +=cut + +=head1 INVOKING A BLOCK OF CODE + +=head2 $f = call { CODE } + +The C<call> function invokes a block of code that returns a future, and simply +returns the future it returned. The code is wrapped in an C<eval {}> block, so +that if it throws an exception this is turned into an immediate failed +C<Future>. If the code does not return a C<Future>, then an immediate failed +C<Future> instead. + +(This is equivalent to using C<< Future->call >>, but is duplicated here for +completeness). + +=cut + +sub call(&) +{ + my ( $code ) = @_; + return Future->call( $code ); +} + +=head2 $f = call_with_escape { CODE } + +The C<call_with_escape> function invokes a block of code that returns a +future, and passes in a separate future (called here an "escape future"). +Normally this is equivalent to the simple C<call> function. However, if the +code captures this future and completes it by calling C<done> or C<fail> on +it, the future returned by C<call_with_escape> immediately completes with this +result, and the future returned by the code itself is cancelled. + +This can be used to implement short-circuit return from an iterating loop or +complex sequence of code, or immediate fail that bypasses failure handling +logic in the code itself, or several other code patterns. + + $f = $code->( $escape_f ) + +(This can be considered similar to C<call-with-escape-continuation> as found +in some Scheme implementations). + +=cut + +sub call_with_escape(&) +{ + my ( $code ) = @_; + + my $escape_f = Future->new; + + return Future->wait_any( + Future->call( $code, $escape_f ), + $escape_f, + ); +} + +=head1 REPEATING A BLOCK OF CODE + +The C<repeat> function provides a way to repeatedly call a block of code that +returns a L<Future> (called here a "trial future") until some ending condition +is satisfied. The C<repeat> function itself returns a C<Future> to represent +running the repeating loop until that end condition (called here the "eventual +future"). The first time the code block is called, it is passed no arguments, +and each subsequent invocation is passed the previous trial future. + +The result of the eventual future is the result of the last trial future. + +If the eventual future is cancelled, the latest trial future will be +cancelled. + +If some specific subclass or instance of C<Future> is required as the return +value, it can be passed as the C<return> argument. Otherwise the return value +will be constructed by cloning the first non-immediate trial C<Future>. + +=head2 $future = repeat { CODE } while => CODE + +Repeatedly calls the C<CODE> block while the C<while> condition returns a true +value. Each time the trial future completes, the C<while> condition is passed +the trial future. + + $trial_f = $code->( $previous_trial_f ) + $again = $while->( $trial_f ) + +If the C<$code> block dies entirely and throws an exception, this will be +caught and considered as an immediately-failed C<Future> with the exception as +the future's failure. The exception will not be propagated to the caller. + +=head2 $future = repeat { CODE } until => CODE + +Repeatedly calls the C<CODE> block until the C<until> condition returns a true +value. Each time the trial future completes, the C<until> condition is passed +the trial future. + + $trial_f = $code->( $previous_trial_f ) + $accept = $until->( $trial_f ) + +=head2 $future = repeat { CODE } foreach => ARRAY, otherwise => CODE + +Calls the C<CODE> block once for each value obtained from the array, passing +in the value as the first argument (before the previous trial future). When +there are no more items left in the array, the C<otherwise> code is invoked +once and passed the last trial future, if there was one, or C<undef> if the +list was originally empty. The result of the eventual future will be the +result of the future returned from C<otherwise>. + +The referenced array may be modified by this operation. + + $trial_f = $code->( $item, $previous_trial_f ) + $final_f = $otherwise->( $last_trial_f ) + +The C<otherwise> code is optional; if not supplied then the result of the +eventual future will simply be that of the last trial. If there was no trial, +because the C<foreach> list was already empty, then an immediate successful +future with an empty result is returned. + +=head2 $future = repeat { CODE } foreach => ARRAY, while => CODE, ... + +=head2 $future = repeat { CODE } foreach => ARRAY, until => CODE, ... + +Combines the effects of C<foreach> with C<while> or C<until>. Calls the +C<CODE> block once for each value obtained from the array, until the array is +exhausted or the given ending condition is satisfied. + +If a C<while> or C<until> condition is combined with C<otherwise>, the +C<otherwise> code will only be run if the array was entirely exhausted. If the +operation is terminated early due to the C<while> or C<until> condition being +satisfied, the eventual result will simply be that of the last trial that was +executed. + +=head2 $future = repeat { CODE } generate => CODE, otherwise => CODE + +Calls the C<CODE> block once for each value obtained from the generator code, +passing in the value as the first argument (before the previous trial future). +When the generator returns an empty list, the C<otherwise> code is invoked and +passed the last trial future, if there was one, otherwise C<undef> if the +generator never returned a value. The result of the eventual future will be +the result of the future returned from C<otherwise>. + + $trial_f = $code->( $item, $previous_trial_f ) + $final_f = $otherwise->( $last_trial_f ) + + ( $item ) = $generate->() + +The generator is called in list context but should return only one item per +call. Subsequent values will be ignored. When it has no more items to return +it should return an empty list. + +For backward compatibility this function will allow a C<while> or C<until> +condition that requests a failure be repeated, but it will print a warning if +it has to do that. To apply repeating behaviour that can catch and retry +failures, use C<try_repeat> instead. This old behaviour is now deprecated and +will be removed in the next version. + +=cut + +sub _repeat +{ + my ( $code, $return, $trialp, $cond, $sense, $is_try ) = @_; + + my $prev = $$trialp; + + while(1) { + my $trial = $$trialp ||= Future->call( $code, $prev ); + $prev = $trial; + + if( !$trial->is_ready ) { + # defer + $return ||= $trial->new; + $trial->on_ready( sub { + return if $$trialp->is_cancelled; + _repeat( $code, $return, $trialp, $cond, $sense, $is_try ); + }); + return $return; + } + + my $stop; + if( not eval { $stop = !$cond->( $trial ) ^ $sense; 1 } ) { + $return ||= $trial->new; + $return->fail( $@ ); + return $return; + } + + if( $stop ) { + # Return result + $return ||= $trial->new; + $trial->on_done( $return ); + $trial->on_fail( $return ); + return $return; + } + + if( !$is_try and $trial->failure ) { + carp "Using Future::Utils::repeat to retry a failure is deprecated; use try_repeat instead"; + } + + # redo + undef $$trialp; + } +} + +sub repeat(&@) +{ + my $code = shift; + my %args = @_; + + # This makes it easier to account for other conditions + defined($args{while}) + defined($args{until}) == 1 + or defined($args{foreach}) + or defined($args{generate}) + or croak "Expected one of 'while', 'until', 'foreach' or 'generate'"; + + if( $args{foreach} ) { + $args{generate} and croak "Cannot use both 'foreach' and 'generate'"; + + my $array = delete $args{foreach}; + $args{generate} = sub { + @$array ? shift @$array : (); + }; + } + + if( $args{generate} ) { + my $generator = delete $args{generate}; + my $otherwise = delete $args{otherwise}; + + # TODO: This is slightly messy as this lexical is captured by both + # blocks of code. Can we do better somehow? + my $done; + + my $orig_code = $code; + $code = sub { + my ( $last_trial_f ) = @_; + my $again = my ( $value ) = $generator->( $last_trial_f ); + + if( $again ) { + unshift @_, $value; goto &$orig_code; + } + + $done++; + if( $otherwise ) { + goto &$otherwise; + } + else { + return $last_trial_f || Future->done; + } + }; + + if( my $orig_while = delete $args{while} ) { + $args{while} = sub { + $orig_while->( $_[0] ) and !$done; + }; + } + elsif( my $orig_until = delete $args{until} ) { + $args{while} = sub { + !$orig_until->( $_[0] ) and !$done; + }; + } + else { + $args{while} = sub { !$done }; + } + } + + my $future = $args{return}; + + my $trial; + $args{while} and $future = _repeat( $code, $future, \$trial, $args{while}, 0, $args{try} ); + $args{until} and $future = _repeat( $code, $future, \$trial, $args{until}, 1, $args{try} ); + + $future->on_cancel( sub { $trial->cancel } ); + + return $future; +} + +=head2 $future = try_repeat { CODE } ... + +A variant of C<repeat> that doesn't warn when the trial fails and the +condition code asks for it to be repeated. + +In some later version the C<repeat> function will be changed so that if a +trial future fails, then the eventual future will immediately fail as well, +making its semantics a little closer to that of a C<while {}> loop in Perl. +Code that specifically wishes to catch failures in trial futures and retry +the block should use C<try_repeat> specifically. + +=cut + +sub try_repeat(&@) +{ + # defeat prototype + &repeat( @_, try => 1 ); +} + +=head2 $future = try_repeat_until_success { CODE } ... + +A shortcut to calling C<try_repeat> with an ending condition that simply tests +for a successful result from a future. May be combined with C<foreach> or +C<generate>. + +This function used to be called C<repeat_until_success>, and is currently +aliased as this name as well. + +=cut + +sub try_repeat_until_success(&@) +{ + my $code = shift; + my %args = @_; + + # TODO: maybe merge while/until conditions one day... + defined($args{while}) or defined($args{until}) + and croak "Cannot pass 'while' or 'until' to try_repeat_until_success"; + + # defeat prototype + &try_repeat( $code, while => sub { shift->failure }, %args ); +} + +# Legacy name +*repeat_until_success = \&try_repeat_until_success; + +=head1 APPLYING A FUNCTION TO A LIST + +The C<fmap> family of functions provide a way to call a block of code that +returns a L<Future> (called here an "item future") once per item in a given +list, or returned by a generator function. The C<fmap*> functions themselves +return a C<Future> to represent the ongoing operation, which completes when +every item's future has completed. + +While this behaviour can also be implemented using C<repeat>, the main reason +to use an C<fmap> function is that the individual item operations are +considered as independent, and thus more than one can be outstanding +concurrently. An argument can be passed to the function to indicate how many +items to start initially, and thereafter it will keep that many of them +running concurrently until all of the items are done, or until any of them +fail. If an individual item future fails, the overall result future will be +marked as failing with the same failure, and any other pending item futures +that are outstanding at the time will be cancelled. + +The following named arguments are common to each C<fmap*> function: + +=over 8 + +=item foreach => ARRAY + +Provides the list of items to iterate over, as an C<ARRAY> reference. + +The referenced array will be modified by this operation, C<shift>ing one item +from it each time. The can C<push> more items to this array as it runs, and +they will be included in the iteration. + +=item generate => CODE + +Provides the list of items to iterate over, by calling the generator function +once for each required item. The function should return a single item, or an +empty list to indicate it has no more items. + + ( $item ) = $generate->() + +This function will be invoked each time any previous item future has completed +and may be called again even after it has returned empty. + +=item concurrent => INT + +Gives the number of item futures to keep outstanding. By default this value +will be 1 (i.e. no concurrency); larger values indicate that multiple item +futures will be started at once. + +=item return => Future + +Normally, a new instance is returned by cloning the first non-immediate future +returned as an item future. By passing a new instance as the C<return> +argument, the result will be put into the given instance. This can be used to +return subclasses, or specific instances. + +=back + +In each case, the main code block will be called once for each item in the +list, passing in the item as the only argument: + + $item_f = $code->( $item ) + +The expected return value from each item's future, and the value returned from +the result future will differ in each function's case; they are documented +below. + +=cut + +# This function is invoked in two circumstances: +# a) to create an item Future in a slot, +# b) once a non-immediate item Future is complete, to check its results +# It can tell which circumstance by whether the slot itself is defined or not +sub _fmap_slot +{ + my ( $slots, undef, $code, $generator, $collect, $results, $return ) = @_; + + SLOT: while(1) { + # Capture args each call because we mutate them + my ( undef, $idx ) = my @args = @_; + + unless( $slots->[$idx] ) { + # No item Future yet (case a), so create one + my $item; + unless( ( $item ) = $generator->() ) { + # All out of items, so now just wait for the slots to be finished + undef $slots->[$idx]; + defined and return $return for @$slots; + + # All the slots are done + $return ||= Future->new; + + $return->done( @$results ); + return $return; + } + + my $f = $slots->[$idx] = Future->call( $code, $item ); + + if( $collect eq "array" ) { + push @$results, my $r = []; + $f->on_done( sub { @$r = @_ }); + } + elsif( $collect eq "scalar" ) { + push @$results, undef; + my $r = \$results->[-1]; + $f->on_done( sub { $$r = $_[0] }); + } + } + + my $f = $slots->[$idx]; + + # Slot is non-immediate; arrange for us to be invoked again later when it's ready + if( !$f->is_ready ) { + $args[-1] = ( $return ||= $f->new ); + $f->on_done( sub { _fmap_slot( @args ) } ); + $f->on_fail( $return ); + + # Try looking for more that might be ready + my $i = $idx + 1; + while( $i != $idx ) { + $i++; + $i %= @$slots; + next if defined $slots->[$i]; + + $_[1] = $i; + redo SLOT; + } + return $return; + } + + # Either we've been invoked again (case b), or the immediate Future was + # already ready. + if( $f->failure ) { + $return ||= $f->new; + $return->fail( $f->failure ); + return $return; + } + + undef $slots->[$idx]; + # next + } +} + +sub _fmap +{ + my $code = shift; + my %args = @_; + + my $concurrent = $args{concurrent} || 1; + my @slots; + + my $results = []; + my $future = $args{return}; + + my $generator; + if( $generator = $args{generate} ) { + # OK + } + elsif( my $array = $args{foreach} ) { + $generator = sub { return unless @$array; shift @$array }; + } + else { + croak "Expected either 'generate' or 'foreach'"; + } + + # If any of these immediately fail, don't bother continuing + foreach my $idx ( 0 .. $concurrent-1 ) { + $future = _fmap_slot( \@slots, $idx, $code, $generator, $args{collect}, $results, $future ); + last if $future->is_ready; + } + + $future->on_fail( sub { + !defined $_ or $_->is_ready or $_->cancel for @slots; + }); + $future->on_cancel( sub { + $_->cancel for @slots; + }); + + return $future; +} + +=head2 $future = fmap_concat { CODE } ... + +This version of C<fmap> expects each item future to return a list of zero or +more values, and the overall result will be the concatenation of all these +results. It acts like a future-based equivalent to Perl's C<map> operator. + +The results are returned in the order of the original input values, not in the +order their futures complete in. Because of the intermediate storage of +C<ARRAY> references and final flattening operation used to implement this +behaviour, this function is slightly less efficient than C<fmap_scalar> or +C<fmap_void> in cases where item futures are expected only ever to return one, +or zero values, respectively. + +This function is also available under the name of simply C<fmap> to emphasise +its similarity to perl's C<map> keyword. + +=cut + +sub fmap_concat(&@) +{ + my $code = shift; + my %args = @_; + + _fmap( $code, %args, collect => "array" )->then( sub { + return Future->done( map { @$_ } @_ ); + }); +} +*fmap = \&fmap_concat; + +=head2 $future = fmap_scalar { CODE } ... + +This version of C<fmap> acts more like the C<map> functions found in Scheme or +Haskell; it expects that each item future returns only one value, and the +overall result will be a list containing these, in order of the original input +items. If an item future returns more than one value the others will be +discarded. If it returns no value, then C<undef> will be substituted in its +place so that the result list remains in correspondence with the input list. + +This function is also available under the shorter name of C<fmap1>. + +=cut + +sub fmap_scalar(&@) +{ + my $code = shift; + my %args = @_; + + _fmap( $code, %args, collect => "scalar" ) +} +*fmap1 = \&fmap_scalar; + +=head2 $future = fmap_void { CODE } ... + +This version of C<fmap> does not collect any results from its item futures, it +simply waits for them all to complete. Its result future will provide no +values. + +While not a map in the strictest sense, this variant is still useful as a way +to control concurrency of a function call iterating over a list of items, +obtaining its results by some other means (such as side-effects on captured +variables, or some external system). + +This function is also available under the shorter name of C<fmap0>. + +=cut + +sub fmap_void(&@) +{ + my $code = shift; + my %args = @_; + + _fmap( $code, %args, collect => "void" ) +} +*fmap0 = \&fmap_void; + +=head1 AUTHOR + +Paul Evans <leonerd@leonerd.org.uk> + +=cut + +0x55AA; diff --git a/lib/Test/Future.pm b/lib/Test/Future.pm new file mode 100644 index 0000000..f2a7d5f --- /dev/null +++ b/lib/Test/Future.pm @@ -0,0 +1,141 @@ +# 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, 2014 -- leonerd@leonerd.org.uk + +package Test::Future; + +use strict; +use warnings; +use base qw( Test::Builder::Module ); + +our $VERSION = '0.32'; + +our @EXPORT = qw( + no_pending_futures +); + +use Scalar::Util qw( refaddr ); + +use constant HAVE_DEVEL_MAT_DUMPER => defined eval { require Devel::MAT::Dumper }; + +=head1 NAME + +C<Test::Future> - unit test assertions for L<Future> instances + +=head1 SYNOPSIS + + use Test::More tests => 2; + use Test::Future; + + no_pending_futures { + my $f = some_function(); + + is( $f->get, "result", 'Result of the some_function()' ); + } 'some_function() leaves no pending Futures'; + +=head1 DESCRIPTION + +This module provides unit testing assertions that may be useful when testing +code based on, or using L<Future> instances or subclasses. + +=cut + +=head1 FUNCTIONS + +=cut + +=head2 no_pending_futures( \&code, $name ) + +Runs the given block of code, while keeping track of every C<Future> instance +constructed while doing so. After the code has returned, each of these +instances are inspected to check that they are not still pending. If they are +all either ready (by success or failure) or cancelled, the test will pass. If +any are still pending then the test fails. + +If L<Devel::MAT> is installed, it will be used to write a memory state dump +after a failure. It will create a F<.pmat> file named the same as the unit +test, but with the trailing F<.t> suffix replaced with F<-TEST.pmat> where +C<TEST> is the number of the test that failed (in case there was more than +one). A list of addresses of C<Future> instances that are still pending is +also printed to assist in debugging the issue. + +It is not an error if the code does not construct any C<Future> instances at +all. The block of code may contain other testing assertions; they will be run +before the assertion by C<no_pending_futures> itself. + +=cut + +sub no_pending_futures(&@) +{ + my ( $code, $name ) = @_; + + my @futures; + + no warnings 'redefine'; + + my $new = Future->can( "new" ); + local *Future::new = sub { + my $f = $new->(@_); + push @futures, $f; + $f->on_ready( sub { + my $f = shift; + for ( 0 .. $#futures ) { + refaddr( $futures[$_] ) == refaddr( $f ) or next; + + splice @futures, $_, 1, (); + return; + } + }); + return $f; + }; + + my $done = Future->can( "done" ); + local *Future::done = sub { + my $f = $done->(@_); + pop @futures if !ref $_[0]; # class method + return $f; + }; + + my $fail = Future->can( "fail" ); + local *Future::fail = sub { + my $f = $fail->(@_); + pop @futures if !ref $_[0]; # class method + return $f; + }; + + my $tb = __PACKAGE__->builder; + + $code->(); + + my @pending = grep { !$_->is_ready } @futures; + + return $tb->ok( 1, $name ) if !@pending; + + my $ok = $tb->ok( 0, $name ); + + $tb->diag( "The following Futures are still pending:" ); + $tb->diag( join ", ", map { sprintf "0x%x", refaddr $_ } @pending ); + + if( HAVE_DEVEL_MAT_DUMPER ) { + my $file = $0; + my $num = $tb->current_test; + + # Trim the .t off first then append -$num.pmat, in case $0 wasn't a .t file + $file =~ s/\.(?:t|pm|pl)$//; + $file .= "-$num.pmat"; + + $tb->diag( "Writing heap dump to $file" ); + Devel::MAT::Dumper::dump( $file ); + } + + return $ok; +} + +=head1 AUTHOR + +Paul Evans <leonerd@leonerd.org.uk> + +=cut + +0x55AA; |