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
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 ] )
: () ),
local/lib/perl5/Future.pm view on Meta::CPAN
be useful in such cases as adapting synchronous code to fit asynchronous
libraries driven by C<Future>.
=cut
sub wrap
{
my $class = shift;
my @values = @_;
if( @values == 1 and blessed $values[0] and $values[0]->isa( __PACKAGE__ ) ) {
return $values[0];
}
else {
return $class->done( @values );
}
}
=head2 call
$future = Future->call( \&code, @args )
I<Since version 0.15.>
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;
}
local/lib/perl5/Future.pm view on Meta::CPAN
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 ) :
local/lib/perl5/Future.pm view on Meta::CPAN
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;
}
local/lib/perl5/Future.pm view on Meta::CPAN
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;
}
local/lib/perl5/Future.pm view on Meta::CPAN
Returns the C<$future>.
=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 ) :
local/lib/perl5/Future.pm view on Meta::CPAN
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 on_done
local/lib/perl5/Future.pm view on Meta::CPAN
Returns the C<$future>.
=cut
sub on_done
{
my $self = shift;
my ( $code ) = @_;
my $is_future = blessed( $code ) && $code->isa( "Future" );
$is_future or _callable( $code ) or
Carp::croak "Expected \$code to be callable or a Future in ->on_done";
if( $self->{ready} ) {
return $self if $self->{failure} or $self->{cancelled};
$is_future ? $code->done( $self->get )
: $code->( $self->get );
}
else {
local/lib/perl5/Future.pm view on Meta::CPAN
Returns the C<$future>.
=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 );
}
local/lib/perl5/Future.pm view on Meta::CPAN
=cut
sub cancel
{
my $self = shift;
return $self if $self->{ready};
$self->{cancelled}++;
foreach my $code ( reverse @{ $self->{on_cancel} || [] } ) {
my $is_future = blessed( $code ) && $code->isa( "Future" );
$is_future ? $code->cancel
: $code->( $self );
}
$self->_mark_ready( "cancel" );
return $self;
}
sub cancel_cb
{
local/lib/perl5/Future.pm view on Meta::CPAN
( $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
local/lib/perl5/Future.pm view on Meta::CPAN
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;
local/lib/perl5/Future/Mutex.pm view on Meta::CPAN
$mutex = Future::Mutex->new
Returns a new C<Future::Mutex> instance. It is initially unlocked.
=cut
sub new
{
my $class = shift;
return bless {
f => Future->done,
}, $class;
}
=head1 METHODS
=cut
=head2 enter
local/lib/perl5/IO/Async/ChildManager.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 {
loop => $loop,
}, $class;
weaken( $self->{loop} );
return $self;
}
=head1 METHODS
local/lib/perl5/IO/Async/Debug.pm view on Meta::CPAN
Debugging support is enabled by an environment variable called
C<IO_ASYNC_DEBUG> having a true value.
When debugging is enabled, the C<make_event_cb> and C<invoke_event> methods
on L<IO::Async::Notifier> (and their C<maybe_> variants) are altered such that
when the event is fired, a debugging line is printed, using the C<debug_printf>
method. This identifes the name of the event.
By default, the line is only printed if the caller of one of these methods is
the same package as the object is blessed into, allowing it to print the
events of the most-derived class, without the extra verbosity of the
lower-level events of its parent class used to create it. All calls regardless
of caller can be printed by setting a number greater than 1 as the value of
C<IO_ASYNC_DEBUG>.
By default the debugging log goes to C<STDERR>, but two other environment
variables can redirect it. If C<IO_ASYNC_DEBUG_FILE> is set, it names a file
which will be opened for writing, and logging written into it. Otherwise, if
C<IO_ASYNC_DEBUG_FD> is set, it gives a file descriptor number that logging
should be written to. If opening the named file or file descriptor fails then
local/lib/perl5/IO/Async/Function.pm view on Meta::CPAN
=item args => ARRAY
A reference to the array of arguments to pass to the code.
=back
If the function body returns normally the list of results are provided as the
(successful) result of returned future. If the function throws an exception
this results in a failed future. In the special case that the exception is in
fact an unblessed C<ARRAY> reference, this array is unpacked and used as-is
for the C<fail> result. If the exception is not such a reference, it is used
as the first argument to C<fail>, in the category of C<error>.
$f->done( @result )
$f->fail( @{ $exception } )
$f->fail( $exception, error => )
=head2 call (void)
local/lib/perl5/IO/Async/Internals/Connector.pm view on Meta::CPAN
use constant CONNECT_EWOULDLBOCK => IO::Async::OS->HAVE_CONNECT_EWOULDBLOCK;
# 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 ) = @_;
local/lib/perl5/IO/Async/Internals/TimeQueue.pm view on Meta::CPAN
# Implementation using a Perl array
use constant {
TIME => 0,
CODE => 1,
};
sub ARRAY_new
{
my $class = shift;
return bless [], $class;
}
sub ARRAY_next_time
{
my $self = shift;
return @$self ? $self->[0]->[TIME] : undef;
}
sub ARRAY__enqueue
{
local/lib/perl5/IO/Async/Listener.pm view on Meta::CPAN
# Sanity check it - it may be a bare GLOB ref, not an IO::Socket-derived handle
defined getsockname( $handle ) or croak "IO handle $handle does not have a sockname";
# So now we know it's at least some kind of socket. Is it listening?
# SO_ACCEPTCONN would tell us, but not all OSes implement it. Since it's
# only a best-effort sanity check, we won't mind if the OS doesn't.
my $acceptconn = getsockopt( $handle, SOL_SOCKET, SO_ACCEPTCONN );
!defined $acceptconn or unpack( "I", $acceptconn ) or croak "Socket is not accepting connections";
# This is a bit naughty but hopefully nobody will mind...
bless $handle, "IO::Socket" if ref( $handle ) eq "GLOB";
$self->SUPER::configure( read_handle => $handle );
}
elsif( exists $params{handle} ) {
delete $params{handle};
$self->SUPER::configure( read_handle => undef );
}
unless( grep $self->can_event( $_ ), @acceptor_events ) {
local/lib/perl5/IO/Async/Loop.pm view on Meta::CPAN
# Detect if the API version provided by the subclass is sufficient
$class->can( "API_VERSION" ) or
die "$class is too old for IO::Async $VERSION; it does not provide \->API_VERSION\n";
$class->API_VERSION >= NEED_API_VERSION or
die "$class is too old for IO::Async $VERSION; we need API version >= ".NEED_API_VERSION.", it provides ".$class->API_VERSION."\n";
WATCHDOG_ENABLE and !$class->_CAN_WATCHDOG and
warn "$class cannot implement IO_ASYNC_WATCHDOG\n";
my $self = bless {
notifiers => {}, # {nkey} = notifier
iowatches => {}, # {fd} = [ $on_read_ready, $on_write_ready, $on_hangup ]
sigattaches => {}, # {sig} => \@callbacks
childmanager => undef,
childwatches => {}, # {pid} => $code
threadwatches => {}, # {tid} => $code
timequeue => undef,
deferrals => [],
os => {}, # A generic scratchpad for IO::Async::OS to store whatever it wants
}, $class;
local/lib/perl5/IO/Async/Notifier.pm view on Meta::CPAN
it.
=cut
=head1 AS A MIXIN
Rather than being used as a subclass this package also supports being used as
a non-principle superclass for an object, as a mix-in. It still provides
methods and satisfies an C<isa> test, even though the constructor is not
directly called. This simply requires that the object be based on a normal
blessed hash reference and include C<IO::Async::Notifier> somewhere in its
C<@ISA> list.
The methods in this class all use only keys in the hash prefixed by
C<"IO_Async_Notifier__"> for namespace purposes.
This is intended mainly for defining a subclass of some other object that is
also an C<IO::Async::Notifier>, suitable to be added to an L<IO::Async::Loop>.
package SomeEventSource::Async;
use base qw( SomeEventSource IO::Async::Notifier );
local/lib/perl5/IO/Async/Notifier.pm view on Meta::CPAN
needs to use any of C<handle>, C<read_handle>, C<write_handle>,
C<on_read_ready> or C<on_write_ready> should use L<IO::Async::Handle> instead.
=cut
sub new
{
my $class = shift;
my %params = @_;
my $self = bless {}, $class;
$self->_init( \%params );
$self->configure( %params );
return $self;
}
=head1 METHODS
local/lib/perl5/IO/Async/Stream.pm view on Meta::CPAN
our $VERSION = '0.70';
use base qw( IO::Async::Handle );
use Errno qw( EAGAIN EWOULDBLOCK EINTR EPIPE );
use Carp;
use Encode 2.11 qw( find_encoding STOP_AT_PARTIAL );
use Scalar::Util qw( blessed );
use IO::Async::Debug;
# Tuneable from outside
# Not yet documented
our $READLEN = 8192;
our $WRITELEN = 8192;
use Struct::Dumb;
local/lib/perl5/IO/Async/Stream.pm view on Meta::CPAN
return 1;
}
if( !ref $data and my $encoding = $self->{encoding} ) {
$data = $encoding->encode( $data );
}
unshift @$writequeue, my $new = Writer(
$data, $head->writelen, $head->on_write, undef, undef, 0
);
next;
}
elsif( blessed $head->data and $head->data->isa( "Future" ) ) {
my $f = $head->data;
if( !$f->is_ready ) {
return 0 if $head->watching;
$f->on_ready( sub { $self->_flush_one_write } );
$head->watching++;
return 0;
}
my $data = $f->get;
if( !ref $data and my $encoding = $self->{encoding} ) {
$data = $encoding->encode( $data );
local/lib/perl5/Module/Build.pm view on Meta::CPAN
=back
For years, these things have been a barrier to people getting the
build/install process to do what they want.
=item *
There are several architectural decisions in C<MakeMaker> that make it
very difficult to customize its behavior. For instance, when using
C<MakeMaker> you do C<use ExtUtils::MakeMaker>, but the object created in
C<WriteMakefile()> is actually blessed into a package name that's
created on the fly, so you can't simply subclass
C<ExtUtils::MakeMaker>. There is a workaround C<MY> package that lets
you override certain C<MakeMaker> methods, but only certain explicitly
preselected (by C<MakeMaker>) methods can be overridden. Also, the method
of customization is very crude: you have to modify a string containing
the Makefile text for the particular target. Since these strings
aren't documented, and I<can't> be documented (they take on different
values depending on the platform, version of perl, version of
C<MakeMaker>, etc.), you have no guarantee that your modifications will
work on someone else's machine or after an upgrade of C<MakeMaker> or
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
local @ARGV;
return shift()->resume;
}
sub _construct {
my ($package, %input) = @_;
my $args = delete $input{args} || {};
my $config = delete $input{config} || {};
my $self = bless {
args => {%$args},
config => Module::Build::Config->new(values => $config),
properties => {
base_dir => $package->cwd,
mb_version => $Module::Build::VERSION,
%input,
},
phash => {},
stash => {}, # temporary caching, not stored in _build
}, $package;
local/lib/perl5/Module/Build/Config.pm view on Meta::CPAN
package Module::Build::Config;
use strict;
use warnings;
our $VERSION = '0.4220';
$VERSION = eval $VERSION;
use Config;
sub new {
my ($pack, %args) = @_;
return bless {
stack => {},
values => $args{values} || {},
}, $pack;
}
sub get {
my ($self, $key) = @_;
return $self->{values}{$key} if ref($self) && exists $self->{values}{$key};
return $Config{$key};
}
local/lib/perl5/Module/Build/Notes.pm view on Meta::CPAN
use strict;
use warnings;
our $VERSION = '0.4220';
$VERSION = eval $VERSION;
use Data::Dumper;
use Module::Build::Dumper;
sub new {
my ($class, %args) = @_;
my $file = delete $args{file} or die "Missing required parameter 'file' to new()";
my $self = bless {
disk => {},
new => {},
file => $file,
%args,
}, $class;
}
sub restore {
my $self = shift;
local/lib/perl5/Module/Build/PPMMaker.pm view on Meta::CPAN
$VERSION = eval $VERSION;
# This code is mostly borrowed from ExtUtils::MM_Unix 6.10_03, with a
# few tweaks based on the PPD spec at
# http://www.xav.com/perl/site/lib/XML/PPD.html
# The PPD spec is based on <http://www.w3.org/TR/NOTE-OSD>
sub new {
my $package = shift;
return bless {@_}, $package;
}
sub make_ppd {
my ($self, %args) = @_;
my $build = delete $args{build};
my @codebase;
if (exists $args{codebase}) {
@codebase = ref $args{codebase} ? @{$args{codebase}} : ($args{codebase});
} else {
local/lib/perl5/Module/Build/PodParser.pm view on Meta::CPAN
use strict;
use warnings;
our $VERSION = '0.4220';
$VERSION = eval $VERSION;
sub new {
# Perl is so fun.
my $package = shift;
my $self;
$self = bless {have_pod_parser => 0, @_}, $package;
unless ($self->{fh}) {
die "No 'file' or 'fh' parameter given" unless $self->{file};
open($self->{fh}, '<', $self->{file}) or die "Couldn't open $self->{file}: $!";
}
return $self;
}
sub parse_from_filehandle {
local/lib/perl5/Struct/Dumb.pm view on Meta::CPAN
$constructor = sub {
my %values = @_;
my @values;
foreach ( @$fields ) {
exists $values{$_} or croak "usage: $pkg requires '$_'";
push @values, delete $values{$_};
}
if( my ( $extrakey ) = keys %values ) {
croak "usage: $pkg does not recognise '$extrakey'";
}
bless \@values, $pkg;
};
}
else {
my $fieldcount = @$fields;
my $argnames = join ", ", map "\$$_", @$fields;
$constructor = sub {
@_ == $fieldcount or croak "usage: $pkg($argnames)";
bless [ @_ ], $pkg;
};
}
no strict 'refs';
*{"${pkg}::$_"} = $subs{$_} for keys %subs;
*{"${caller}::$name"} = $constructor;
if( my $predicate = $opts{predicate} ) {
*{"${caller}::$predicate"} = sub { ( ref($_[0]) || "" ) eq $pkg };
}
( run in 2.186 seconds using v1.01-cache-2.11-cpan-de7293f3b23 )