view release on metacpan or  search on metacpan

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

our $VERSION = '0.70';

# When editing this value don't forget to update the docs below
use constant NEED_API_VERSION => '0.33';

# Base value but some classes might override
use constant _CAN_ON_HANGUP => 0;

# Most Loop implementations do not accurately handle sub-second timers.
# This only matters for unit tests
use constant _CAN_SUBSECOND_ACCURATELY => 0;

# Does the loop implementation support IO_ASYNC_WATCHDOG?
use constant _CAN_WATCHDOG => 0;

# 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.
# There is a race condition in perl involving signals interacting with XS code
# that implements blocking syscalls. There is a slight chance a signal will
# arrive in the XS function, before the blocking itself. Perl will not run our
# (safe) deferred signal handler in this case. To mitigate this, if we have a
# signal proxy, we'll adjust the maximal timeout. The signal handler will be 
# run when the XS function returns. 
our $MAX_SIGWAIT_TIME = 1;

# Also, never sleep for more than 1 second if the OS does not support signals
# and we have child watches registered (so we must use waitpid() polling)
our $MAX_CHILDWAIT_TIME = 1;

# Maybe our calling program will have a suggested hint of a specific Loop
# class or list of classes to use
our $LOOP;

# Undocumented; used only by the test scripts.
# Setting this value true will avoid the IO::Async::Loop::$^O candidate in the
# magic constructor
our $LOOP_NO_OS;

# SIGALRM handler for watchdog
$SIG{ALRM} = sub {
   # There are two extra frames here; this one and the signal handler itself
   local $Carp::CarpLevel = $Carp::CarpLevel + 2;
   if( WATCHDOG_SIGABRT ) {
      print STDERR Carp::longmess( "Watchdog timeout" );
      kill ABRT => $$;
   }
   else {
      Carp::confess( "Watchdog timeout" );
   }
} if WATCHDOG_ENABLE;

$SIG{PIPE} = "IGNORE" if ( $SIG{PIPE} || "" ) eq "DEFAULT";

=head1 NAME

C<IO::Async::Loop> - core loop of the C<IO::Async> framework

=head1 SYNOPSIS

 use IO::Async::Stream;
 use IO::Async::Timer::Countdown;

 use IO::Async::Loop;

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

 $loop->add( IO::Async::Timer::Countdown->new(
    delay => 10,
    on_expire => sub { print "10 seconds have passed\n" },
 )->start );

 $loop->add( IO::Async::Stream->new_for_stdin(
    on_read => sub {
       my ( $self, $buffref, $eof ) = @_;

       while( $$buffref =~ s/^(.*)\n// ) {
          print "You typed a line $1\n";
       }

       return 0;
    },
 ) );

 $loop->run;

=head1 DESCRIPTION

This module provides an abstract class which implements the core loop of the
L<IO::Async> framework. Its primary purpose is to store a set of
L<IO::Async::Notifier> objects or subclasses of them. It handles all of the
lower-level set manipulation actions, and leaves the actual IO readiness 
testing/notification to the concrete class that implements it. It also
provides other functionality such as signal handling, child process managing,
and timers.

See also the two bundled Loop subclasses:

=over 4

=item L<IO::Async::Loop::Select>

=item L<IO::Async::Loop::Poll>

=back

Or other subclasses that may appear on CPAN which are not part of the core
L<IO::Async> distribution.

=head2 Ignoring SIGPIPE

Since version I<0.66> loading this module automatically ignores C<SIGPIPE>, as
it is highly unlikely that the default-terminate action is the best course of
action for an L<IO::Async>-based program to take. If at load time the handler
disposition is still set as C<DEFAULT>, it is set to ignore. If already
another handler has been placed there by the program code, it will be left
undisturbed.

=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