view release on metacpan or  search on metacpan

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

#  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, 2007-2015 -- leonerd@leonerd.org.uk

package IO::Async::Loop;

use strict;
use warnings;

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" );