Acme-Sort-Sleep

 view release on metacpan or  search on metacpan

local/lib/perl5/IO/Async/Loop.pm  view on Meta::CPAN

=cut

# Internal constructor used by subclasses
sub __new
{
   my $class = shift;

   # 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;

   # It's possible this is a specific subclass constructor. We still want the
   # magic IO::Async::Loop->new constructor to yield this if it's the first
   # one
   our $ONE_TRUE_LOOP ||= $self;

   # Legacy support - temporary until all CPAN classes are updated; bump NEEDAPI version at that point
   my $old_timer = $self->can( "enqueue_timer" ) != \&enqueue_timer;
   if( $old_timer != ( $self->can( "cancel_timer" ) != \&cancel_timer ) ) {
      die "$class should overload both ->enqueue_timer and ->cancel_timer, or neither";
   }

   if( $old_timer ) {
      warnings::warnif( deprecated => "Enabling old_timer workaround for old loop class " . $class );
   }

   $self->{old_timer} = $old_timer;

   return $self;
}

=head1 MAGIC CONSTRUCTOR

=head2 new

   $loop = IO::Async::Loop->new

This function attempts to find a good subclass to use, then calls its
constructor. It works by making a list of likely candidate classes, then
trying each one in turn, C<require>ing the module then calling its C<new>
method. If either of these operations fails, the next subclass is tried. If
no class was successful, then an exception is thrown.

The constructed object is cached, and will be returned again by a subsequent
call. The cache will also be set by a constructor on a specific subclass. This
behaviour makes it possible to simply use the normal constructor in a module
that wishes to interract with the main program's Loop, such as an integration
module for another event system.

For example, the following two C<$loop> variables will refer to the same
object:

 use IO::Async::Loop;
 use IO::Async::Loop::Poll;

 my $loop_poll = IO::Async::Loop::Poll->new;

 my $loop = IO::Async::Loop->new;

While it is not advised to do so under normal circumstances, if the program
really wishes to construct more than one Loop object, it can call the
constructor C<really_new>, or invoke one of the subclass-specific constructors
directly.

The list of candidates is formed from the following choices, in this order:

=over 4

=item * $ENV{IO_ASYNC_LOOP}

If this environment variable is set, it should contain a comma-separated list
of subclass names. These names may or may not be fully-qualified; if a name
does not contain C<::> then it will have C<IO::Async::Loop::> prepended to it.
This allows the end-user to specify a particular choice to fit the needs of
his use of a program using L<IO::Async>.

=item * $IO::Async::Loop::LOOP

If this scalar is set, it should contain a comma-separated list of subclass
names. These may or may not be fully-qualified, as with the above case. This
allows a program author to suggest a loop module to use.

In cases where the module subclass is a hard requirement, such as GTK programs
using C<Glib>, it would be better to use the module specifically and invoke
its constructor directly.

=item * IO::Async::OS->LOOP_PREFER_CLASSES

The L<IO::Async::OS> hints module for the given OS is then consulted to see if
it suggests any other module classes specific to the given operating system.

=item * $^O

The module called C<IO::Async::Loop::$^O> is tried next. This allows specific
OSes, such as the ever-tricky C<MSWin32>, to provide an implementation that
might be more efficient than the generic ones, or even work at all.

This option is now discouraged in favour of the L<IO::Async::OS> hint instead.
At some future point it may be removed entirely, given as currently only
C<linux> uses it.

=item * Poll and Select

Finally, if no other choice has been made by now, the built-in C<Poll> module
is chosen. This should always work, but in case it doesn't, the C<Select>
module will be chosen afterwards as a last-case attempt. If this also fails,
then the magic constructor itself will throw an exception.

=back

If any of the explicitly-requested loop types (C<$ENV{IO_ASYNC_LOOP}> or
C<$IO::Async::Loop::LOOP>) fails to load then a warning is printed detailing
the error.

Implementors of new C<IO::Async::Loop> subclasses should see the notes about
C<API_VERSION> below.

=cut

sub __try_new
{
   my ( $class ) = @_;

   ( my $file = "$class.pm" ) =~ s{::}{/}g;

   eval {
      local $SIG{__WARN__} = sub {};
      require $file;
   } or return;

   my $self;
   $self = eval { $class->new } and return $self;

   # Oh dear. We've loaded the code OK but for some reason the constructor
   # wasn't happy. Being polite we ought really to unload the file again,
   # but perl doesn't actually provide us a way to do this.

   return undef;
}

sub new
{
   return our $ONE_TRUE_LOOP ||= shift->really_new;
}

# Ensure that the loop is DESTROYed recursively at exit time, before GD happens
END {
   undef our $ONE_TRUE_LOOP;
}

sub really_new
{
   shift;  # We're going to ignore the class name actually given
   my $self;

   my @candidates;

   push @candidates, split( m/,/, $ENV{IO_ASYNC_LOOP} ) if defined $ENV{IO_ASYNC_LOOP};

   push @candidates, split( m/,/, $LOOP ) if defined $LOOP;

   foreach my $class ( @candidates ) {
      $class =~ m/::/ or $class = "IO::Async::Loop::$class";
      $self = __try_new( $class ) and return $self;

      my ( $topline ) = split m/\n/, $@; # Ignore all the other lines; they'll be require's verbose output
      warn "Unable to use $class - $topline\n";

local/lib/perl5/IO/Async/Loop.pm  view on Meta::CPAN

{
   my $self = shift;
   my ( $code ) = @_;

   return $self->watch_idle( when => 'later', code => $code );
}

=head2 spawn_child

   $loop->spawn_child( %params )

This method creates a new child process to run a given code block or command.
For more detail, see the C<spawn_child> method on the
L<IO::Async::ChildManager> class.

=cut

sub spawn_child
{
   my $self = shift;
   my %params = @_;

   my $childmanager = $self->{childmanager} ||=
      $self->__new_feature( "IO::Async::ChildManager" );

   $childmanager->spawn_child( %params );
}

=head2 open_child

   $pid = $loop->open_child( %params )

This creates a new child process to run the given code block or command, and
attaches filehandles to it that the parent will watch. This method is a light
wrapper around constructing a new L<IO::Async::Process> object, provided
largely for backward compatibility. New code ought to construct such an object
directly, as it may provide more features than are available here.

The C<%params> hash takes the following keys:

=over 8

=item command => ARRAY or STRING

=item code => CODE

The command or code to run in the child process (as per the C<spawn> method)

=item on_finish => CODE

A continuation to be called when the child process exits and has closed all of
the filehandles that were set up for it. It will be invoked in the following
way:

 $on_finish->( $pid, $exitcode )

The second argument is passed the plain perl C<$?> value.

=item on_error => CODE

Optional continuation to be called when the child code block throws an
exception, or the command could not be C<exec(2)>ed. It will be invoked in the
following way (as per C<spawn>)

 $on_error->( $pid, $exitcode, $dollarbang, $dollarat )

If this continuation is not supplied, then C<on_finish> is used instead. The
value of C<$!> and C<$@> will not be reported.

=item setup => ARRAY

Optional reference to an array to pass to the underlying C<spawn> method.

=back

In addition, the hash takes keys that define how to set up file descriptors in
the child process. (If the C<setup> array is also given, these operations will
be performed after those specified by C<setup>.)

=over 8

=item fdI<n> => HASH

A hash describing how to set up file descriptor I<n>. The hash may contain one
of the following sets of keys:

=over 4

=item on_read => CODE

The child will be given the writing end of a pipe. The reading end will be
wrapped by an L<IO::Async::Stream> using this C<on_read> callback function.

=item from => STRING

The child will be given the reading end of a pipe. The string given by the
C<from> parameter will be written to the child. When all of the data has been
written the pipe will be closed.

=back

=item stdin => ...

=item stdout => ...

=item stderr => ...

Shortcuts for C<fd0>, C<fd1> and C<fd2> respectively.

=back

=cut

sub open_child
{
   my $self = shift;
   my %params = @_;

   my $on_finish = delete $params{on_finish};
   ref $on_finish or croak "Expected 'on_finish' to be a reference";
   $params{on_finish} = sub {

local/lib/perl5/IO/Async/Loop.pm  view on Meta::CPAN

=cut

sub fork
{
   my $self = shift;
   my %params = @_;

   HAVE_POSIX_FORK or croak "POSIX fork() is not available";

   my $code = $params{code} or croak "Expected 'code' as a CODE reference";

   my $kid = fork;
   defined $kid or croak "Cannot fork() - $!";

   if( $kid == 0 ) {
      unless( $params{keep_signals} ) {
         foreach( keys %SIG ) {
            next if m/^__(WARN|DIE)__$/;
            $SIG{$_} = "DEFAULT" if ref $SIG{$_} eq "CODE";
         }
      }

      my $exitvalue = eval { $code->() };

      defined $exitvalue or $exitvalue = -1;

      POSIX::_exit( $exitvalue );
   }

   if( defined $params{on_exit} ) {
      $self->watch_child( $kid => $params{on_exit} );
   }

   return $kid;
}

=head2 create_thread

   $tid = $loop->create_thread( %params )

This method creates a new (non-detached) thread to run the given code block,
returning its thread ID.

=over 8

=item code => CODE

A block of code to execute in the thread. It is called in the context given by
the C<context> argument, and its return value will be available to the
C<on_joined> callback. It is called inside an C<eval> block; if it fails the
exception will be caught.

=item context => "scalar" | "list" | "void"

Optional. Gives the calling context that C<code> is invoked in. Defaults to
C<scalar> if not supplied.

=item on_joined => CODE

Callback to invoke when the thread function returns or throws an exception.
If it returned, this callback will be invoked with its result

 $on_joined->( return => @result )

If it threw an exception the callback is invoked with the value of C<$@>

 $on_joined->( died => $! )

=back

=cut

# It is basically impossible to have any semblance of order on global
# destruction, and even harder again to rely on when threads are going to be
# terminated and joined. Instead of ensuring we join them all, just detach any
# we no longer care about at END time
my %threads_to_detach; # {$tid} = $thread_weakly
END {
   $_ and $_->detach for values %threads_to_detach;
}

sub create_thread
{
   my $self = shift;
   my %params = @_;

   HAVE_THREADS or croak "Threads are not available";

   eval { require threads } or croak "This Perl does not support threads";

   my $code = $params{code} or croak "Expected 'code' as a CODE reference";
   my $on_joined = $params{on_joined} or croak "Expected 'on_joined' as a CODE reference";

   my $threadwatches = $self->{threadwatches};

   unless( $self->{thread_join_pipe} ) {
      ( my $rd, $self->{thread_join_pipe} ) = IO::Async::OS->pipepair or
         croak "Cannot pipepair - $!";
      $self->{thread_join_pipe}->autoflush(1);

      $self->watch_io(
         handle => $rd,
         on_read_ready => sub {
            sysread $rd, my $buffer, 8192 or return;

            # There's a race condition here in that we might have read from
            # the pipe after the returning thread has written to it but before
            # it has returned. We'll grab the actual $thread object and
            # forcibly ->join it here to ensure we wait for its result.

            foreach my $tid ( unpack "N*", $buffer ) {
               my ( $thread, $on_joined ) = @{ delete $threadwatches->{$tid} }
                  or die "ARGH: Can't find threadwatch for tid $tid\n";
               $on_joined->( $thread->join );
               delete $threads_to_detach{$tid};
            }
         }
      );
   }

local/lib/perl5/IO/Async/Loop.pm  view on Meta::CPAN

will become

 $loop->FOO_connect(
    extensions => [qw( BAR )],
    %args
 )

This is provided so that extension modules, such as L<IO::Async::SSL> can
easily be invoked indirectly, by passing extra arguments to C<connect> methods
or similar, without needing every module to be aware of the C<SSL> extension.
This functionality is generic and not limited to C<SSL>; other extensions may
also use it.

The following methods take an C<extensions> parameter:

 $loop->connect
 $loop->listen

If an extension C<listen> method is invoked, it will be passed a C<listener>
parameter even if one was not provided to the original C<< $loop->listen >>
call, and it will not receive any of the C<on_*> event callbacks. It should
use the C<acceptor> parameter on the C<listener> object.

=cut

=head1 STALL WATCHDOG

A well-behaved L<IO::Async> program should spend almost all of its time
blocked on input using the underlying C<IO::Async::Loop> instance. The stall
watchdog is an optional debugging feature to help detect CPU spinlocks and
other bugs, where control is not returned to the loop every so often.

If the watchdog is enabled and an event handler consumes more than a given
amount of real time before returning to the event loop, it will be interrupted
by printing a stack trace and terminating the program. The watchdog is only in
effect while the loop itself is not blocking; it won't fail simply because the
loop instance is waiting for input or timers.

It is implemented using C<SIGALRM>, so if enabled, this signal will no longer
be available to user code. (Though in any case, most uses of C<alarm()> and
C<SIGALRM> are better served by one of the L<IO::Async::Timer> subclasses).

The following environment variables control its behaviour.

=over 4

=item IO_ASYNC_WATCHDOG => BOOL

Enables the stall watchdog if set to a non-zero value.

=item IO_ASYNC_WATCHDOG_INTERVAL => INT

Watchdog interval, in seconds, to pass to the C<alarm(2)> call. Defaults to 10
seconds.

=item IO_ASYNC_WATCHDOG_SIGABRT => BOOL

If enabled, the watchdog signal handler will raise a C<SIGABRT>, which usually
has the effect of breaking out of a running program in debuggers such as
F<gdb>. If not set then the process is terminated by throwing an exception with
C<die>.

=back

=cut

=head1 AUTHOR

Paul Evans <leonerd@leonerd.org.uk>

=cut

0x55AA;