Acme-Sort-Sleep
view release on metacpan or search on metacpan
local/lib/perl5/Future.pm view on Meta::CPAN
package Future;
use strict;
use warnings;
no warnings 'recursion'; # Disable the "deep recursion" warning
our $VERSION = '0.34';
use Carp qw(); # don't import croak
use Scalar::Util qw( weaken blessed reftype );
use B qw( svref_2object );
use Time::HiRes qw( gettimeofday tv_interval );
# we are not overloaded, but we want to check if other objects are
require overload;
our @CARP_NOT = qw( Future::Utils );
use constant DEBUG => $ENV{PERL_FUTURE_DEBUG};
local/lib/perl5/Future.pm view on Meta::CPAN
$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
local/lib/perl5/Future.pm view on Meta::CPAN
}
else {
$f2 = $self;
}
if( $f2->is_ready ) {
$f2->on_ready( $fseq ) if !$f2->{cancelled};
}
else {
push @{ $f2->{callbacks} }, [ CB_DONE|CB_FAIL, $fseq ];
weaken( $f2->{callbacks}[-1][1] );
}
}
else {
$code->(
( $flags & CB_SELF ? $self : () ),
( $flags & CB_RESULT ? @result : () ),
);
}
}
}
local/lib/perl5/Future.pm view on Meta::CPAN
}
my $fseq = $f1->new;
$fseq->on_cancel( $f1 );
# TODO: if anyone cares about the op name, we might have to synthesize it
# from $flags
$code = $f1->wrap_cb( sequence => $code ) unless $flags & (CB_SEQ_IMDONE|CB_SEQ_IMFAIL);
push @{ $f1->{callbacks} }, [ CB_DONE|CB_FAIL|$flags, $code, $fseq ];
weaken( $f1->{callbacks}[-1][2] );
return $fseq;
}
=head2 then
$future = $f1->then( \&done_code )
I<Since version 0.13.>
local/lib/perl5/Future.pm view on Meta::CPAN
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" );
};
local/lib/perl5/Future.pm view on Meta::CPAN
}
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} ) {
local/lib/perl5/Future.pm view on Meta::CPAN
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" );
local/lib/perl5/Future.pm view on Meta::CPAN
}
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" );
}
local/lib/perl5/IO/Async/ChildManager.pm view on Meta::CPAN
our $VERSION = '0.70';
# Not a notifier
use IO::Async::Stream;
use IO::Async::OS;
use Carp;
use Scalar::Util qw( weaken );
use POSIX qw( _exit dup dup2 nice );
use constant LENGTH_OF_I => length( pack( "I", 0 ) );
=head1 NAME
C<IO::Async::ChildManager> - facilitates the execution of child processes
=head1 SYNOPSIS
local/lib/perl5/IO/Async/ChildManager.pm view on Meta::CPAN
{
my $class = shift;
my ( %params ) = @_;
my $loop = delete $params{loop} or croak "Expected a 'loop'";
my $self = bless {
loop => $loop,
}, $class;
weaken( $self->{loop} );
return $self;
}
=head1 METHODS
When active, the following methods are available on the containing C<Loop>
object.
=cut
local/lib/perl5/IO/Async/Internals/Connector.pm view on Meta::CPAN
# (C) Paul Evans, 2008-2013 -- leonerd@leonerd.org.uk
package # hide from CPAN
IO::Async::Internals::Connector;
use strict;
use warnings;
our $VERSION = '0.70';
use Scalar::Util qw( weaken );
use POSIX qw( EINPROGRESS );
use Socket qw( SOL_SOCKET SO_ERROR );
use Future 0.21;
use Future::Utils 0.18 qw( try_repeat_until_success );
use IO::Async::OS;
use Carp;
local/lib/perl5/IO/Async/Internals/Connector.pm view on Meta::CPAN
# Internal constructor
sub new
{
my $class = shift;
my ( %params ) = @_;
my $loop = delete $params{loop} or croak "Expected a 'loop'";
my $self = bless {}, $class;
weaken( $self->{loop} = $loop );
return $self;
}
## Utility function
sub _get_sock_err
{
my ( $sock ) = @_;
my $err = $sock->getsockopt( SOL_SOCKET, SO_ERROR );
local/lib/perl5/IO/Async/Loop.pm view on Meta::CPAN
# Watchdog configuration constants
use constant WATCHDOG_ENABLE => $ENV{IO_ASYNC_WATCHDOG};
use constant WATCHDOG_INTERVAL => $ENV{IO_ASYNC_WATCHDOG_INTERVAL} || 10;
use constant WATCHDOG_SIGABRT => $ENV{IO_ASYNC_WATCHDOG_SIGABRT};
use Carp;
use IO::Socket (); # empty import
use Time::HiRes qw(); # empty import
use POSIX qw( WNOHANG );
use Scalar::Util qw( refaddr weaken );
use Socket qw( SO_REUSEADDR AF_INET6 IPPROTO_IPV6 IPV6_V6ONLY );
use IO::Async::OS;
use constant HAVE_SIGNALS => IO::Async::OS->HAVE_SIGNALS;
use constant HAVE_POSIX_FORK => IO::Async::OS->HAVE_POSIX_FORK;
use constant HAVE_THREADS => IO::Async::OS->HAVE_THREADS;
# Never sleep for more than 1 second if a signal proxy is registered, to avoid
# a borderline race condition.
local/lib/perl5/IO/Async/Loop.pm view on Meta::CPAN
} or $died = $@;
$wr->syswrite( pack "N", threads->tid );
return died => $died if $died;
return return => @ret;
}
);
$threadwatches->{$thread->tid} = [ $thread, $on_joined ];
weaken( $threads_to_detach{$thread->tid} = $thread );
return $thread->tid;
}
=head1 LOW-LEVEL METHODS
As C<IO::Async::Loop> is an abstract base class, specific subclasses of it are
required to implement certain methods that form the base level of
functionality. They are not recommended for applications to use; see instead
the various event objects or higher level methods listed above.
local/lib/perl5/IO/Async/Notifier.pm view on Meta::CPAN
# (C) Paul Evans, 2006-2015 -- leonerd@leonerd.org.uk
package IO::Async::Notifier;
use strict;
use warnings;
our $VERSION = '0.70';
use Carp;
use Scalar::Util qw( weaken );
use Future 0.26; # ->is_failed
use IO::Async::Debug;
# Perl 5.8.4 cannot do trampolines by modiying @_ then goto &$code
use constant HAS_BROKEN_TRAMPOLINES => ( $] == "5.008004" );
=head1 NAME
local/lib/perl5/IO/Async/Notifier.pm view on Meta::CPAN
my $self = shift;
my ( $loop ) = @_;
# early exit if no change
return if !$loop and !$self->loop or
$loop and $self->loop and $loop == $self->loop;
$self->_remove_from_loop( $self->loop ) if $self->loop;
$self->{IO_Async_Notifier__loop} = $loop;
weaken( $self->{IO_Async_Notifier__loop} ); # To avoid a cycle
$self->_add_to_loop( $self->loop ) if $self->loop;
}
=head2 notifier_name
$name = $notifier->notifier_name
Returns the name to identify this Notifier. If a has not been set, it will
return the empty string. Subclasses may wish to override this behaviour to
local/lib/perl5/IO/Async/Notifier.pm view on Meta::CPAN
croak "Cannot add a child that already has a parent" if defined $child->{IO_Async_Notifier__parent};
croak "Cannot add a child that is already a member of a loop" if defined $child->loop;
if( defined( my $loop = $self->loop ) ) {
$loop->add( $child );
}
push @{ $self->{IO_Async_Notifier__children} }, $child;
$child->{IO_Async_Notifier__parent} = $self;
weaken( $child->{IO_Async_Notifier__parent} );
return;
}
=head2 remove_child
$notifier->remove_child( $child )
Removes a child notifier. The child will be removed from the containing loop,
if the parent has one. If the child itself has grandchildren, these will be
local/lib/perl5/IO/Async/Notifier.pm view on Meta::CPAN
if( !ref $code ) {
my $class = ref $self;
# Don't save this coderef, or it will break dynamic method dispatch,
# which means code reloading, dynamic replacement, or other funky
# techniques stop working
$self->can( $code ) or
croak qq(Can't locate object method "$code" via package "$class");
}
weaken $self;
return sub {
my $cv = ref( $code ) ? $code : $self->can( $code );
if( HAS_BROKEN_TRAMPOLINES ) {
return $cv->( $self, @_ );
}
else {
unshift @_, $self;
goto &$cv;
local/lib/perl5/IO/Async/Notifier.pm view on Meta::CPAN
my $self = shift;
my ( $code ) = @_; # actually bare method names work too
if( !ref $code ) {
# Don't save this coderef, see _capture_weakself for why
my $class = ref $self;
$self->can( $code ) or
croak qq(Can't locate object method "$code" via package "$class");
}
weaken $self;
return sub {
my $cv = ref( $code ) ? $code : $self->can( $code );
if( HAS_BROKEN_TRAMPOLINES ) {
return $cv->( $self, @_[1..$#_] );
}
else {
# Don't assign to $_[0] directly or we will change caller's first argument
shift @_;
( run in 0.260 second using v1.01-cache-2.11-cpan-65fba6d93b7 )