File Coverage

blib/lib/IO/Async/Loop.pm
Criterion Covered Total %
statement 573 675 84.8
branch 223 346 64.4
condition 75 143 52.4
subroutine 101 115 87.8
pod 43 49 87.7
total 1015 1328 76.4


line stmt bran cond sub pod time code
1             # You may distribute under the terms of either the GNU General Public License
2             # or the Artistic License (the same terms as Perl itself)
3             #
4             # (C) Paul Evans, 2007-2021 -- leonerd@leonerd.org.uk
5              
6             package IO::Async::Loop;
7              
8 100     100   3535687 use strict;
  100         308  
  100         3162  
9 100     100   561 use warnings;
  100         208  
  100         4588  
10              
11             our $VERSION = '0.79';
12              
13             # When editing this value don't forget to update the docs below
14 100     100   570 use constant NEED_API_VERSION => '0.33';
  100         226  
  100         6664  
15              
16             # Base value but some classes might override
17 100     100   626 use constant _CAN_ON_HANGUP => 0;
  100         216  
  100         5062  
18              
19             # Most Loop implementations do not accurately handle sub-second timers.
20             # This only matters for unit tests
21 100     100   610 use constant _CAN_SUBSECOND_ACCURATELY => 0;
  100         202  
  100         5362  
22              
23             # Does the loop implementation support IO_ASYNC_WATCHDOG?
24 100     100   622 use constant _CAN_WATCHDOG => 0;
  100         198  
  100         5689  
25              
26             # Does the loop support ->watch_process on PID 0 to observe all exits?
27 100     100   1424 use constant _CAN_WATCH_ALL_PIDS => 1;
  100         234  
  100         6271  
28              
29             # Watchdog configuration constants
30 100     100   701 use constant WATCHDOG_ENABLE => $ENV{IO_ASYNC_WATCHDOG};
  100         207  
  100         7202  
31 100   50 100   698 use constant WATCHDOG_INTERVAL => $ENV{IO_ASYNC_WATCHDOG_INTERVAL} || 10;
  100         234  
  100         7592  
32 100     100   703 use constant WATCHDOG_SIGABRT => $ENV{IO_ASYNC_WATCHDOG_SIGABRT};
  100         238  
  100         5839  
33              
34 100     100   692 use Carp;
  100         197  
  100         7108  
35              
36 100     100   27601 use Time::HiRes qw(); # empty import
  100         66852  
  100         2847  
37 100     100   14782 use POSIX qw( WNOHANG );
  100         172542  
  100         975  
38 100     100   51578 use Scalar::Util qw( refaddr weaken );
  100         239  
  100         6475  
39 100     100   30030 use Socket qw( SO_REUSEADDR AF_INET6 IPPROTO_IPV6 IPV6_V6ONLY );
  100         170264  
  100         11707  
40              
41 100     100   25218 use IO::Async::OS;
  100         255  
  100         3465  
42 100     100   42279 use IO::Async::Metrics '$METRICS';
  100         306  
  100         590  
43              
44 100     100   877 use constant HAVE_SIGNALS => IO::Async::OS->HAVE_SIGNALS;
  100         211  
  100         8743  
45 100     100   693 use constant HAVE_POSIX_FORK => IO::Async::OS->HAVE_POSIX_FORK;
  100         179  
  100         5824  
46 100     100   579 use constant HAVE_THREADS => IO::Async::OS->HAVE_THREADS;
  100         205  
  100         907288  
47              
48             # Never sleep for more than 1 second if a signal proxy is registered, to avoid
49             # a borderline race condition.
50             # There is a race condition in perl involving signals interacting with XS code
51             # that implements blocking syscalls. There is a slight chance a signal will
52             # arrive in the XS function, before the blocking itself. Perl will not run our
53             # (safe) deferred signal handler in this case. To mitigate this, if we have a
54             # signal proxy, we'll adjust the maximal timeout. The signal handler will be
55             # run when the XS function returns.
56             our $MAX_SIGWAIT_TIME = 1;
57              
58             # Also, never sleep for more than 1 second if the OS does not support signals
59             # and we have child watches registered (so we must use waitpid() polling)
60             our $MAX_CHILDWAIT_TIME = 1;
61              
62             # Maybe our calling program will have a suggested hint of a specific Loop
63             # class or list of classes to use
64             our $LOOP;
65              
66             # Undocumented; used only by the test scripts.
67             # Setting this value true will avoid the IO::Async::Loop::$^O candidate in the
68             # magic constructor
69             our $LOOP_NO_OS;
70              
71             # SIGALRM handler for watchdog
72             $SIG{ALRM} = sub {
73             # There are two extra frames here; this one and the signal handler itself
74             local $Carp::CarpLevel = $Carp::CarpLevel + 2;
75             if( WATCHDOG_SIGABRT ) {
76             print STDERR Carp::longmess( "Watchdog timeout" );
77             kill ABRT => $$;
78             }
79             else {
80             Carp::confess( "Watchdog timeout" );
81             }
82             } if WATCHDOG_ENABLE;
83              
84             # There are two default values that might apply; undef or "DEFAULT"
85             $SIG{PIPE} = "IGNORE" if ( $SIG{PIPE} || "DEFAULT" ) eq "DEFAULT";
86              
87             =head1 NAME
88              
89             C - core loop of the C framework
90              
91             =head1 SYNOPSIS
92              
93             use IO::Async::Stream;
94             use IO::Async::Timer::Countdown;
95              
96             use IO::Async::Loop;
97              
98             my $loop = IO::Async::Loop->new;
99              
100             $loop->add( IO::Async::Timer::Countdown->new(
101             delay => 10,
102             on_expire => sub { print "10 seconds have passed\n" },
103             )->start );
104              
105             $loop->add( IO::Async::Stream->new_for_stdin(
106             on_read => sub {
107             my ( $self, $buffref, $eof ) = @_;
108              
109             while( $$buffref =~ s/^(.*)\n// ) {
110             print "You typed a line $1\n";
111             }
112              
113             return 0;
114             },
115             ) );
116              
117             $loop->run;
118              
119             =head1 DESCRIPTION
120              
121             This module provides an abstract class which implements the core loop of the
122             L framework. Its primary purpose is to store a set of
123             L objects or subclasses of them. It handles all of the
124             lower-level set manipulation actions, and leaves the actual IO readiness
125             testing/notification to the concrete class that implements it. It also
126             provides other functionality such as signal handling, child process managing,
127             and timers.
128              
129             See also the two bundled Loop subclasses:
130              
131             =over 4
132              
133             =item L
134              
135             =item L
136              
137             =back
138              
139             Or other subclasses that may appear on CPAN which are not part of the core
140             L distribution.
141              
142             =head2 Ignoring SIGPIPE
143              
144             Since version I<0.66> loading this module automatically ignores C, as
145             it is highly unlikely that the default-terminate action is the best course of
146             action for an L-based program to take. If at load time the handler
147             disposition is still set as C, it is set to ignore. If already
148             another handler has been placed there by the program code, it will be left
149             undisturbed.
150              
151             =cut
152              
153             # Internal constructor used by subclasses
154             sub __new
155             {
156 98     98   270 my $class = shift;
157              
158             # Detect if the API version provided by the subclass is sufficient
159 98 50       1567 $class->can( "API_VERSION" ) or
160             die "$class is too old for IO::Async $VERSION; it does not provide \->API_VERSION\n";
161              
162 98 50       1114 $class->API_VERSION >= NEED_API_VERSION or
163             die "$class is too old for IO::Async $VERSION; we need API version >= ".NEED_API_VERSION.", it provides ".$class->API_VERSION."\n";
164              
165 98         279 WATCHDOG_ENABLE and !$class->_CAN_WATCHDOG and
166             warn "$class cannot implement IO_ASYNC_WATCHDOG\n";
167              
168 98         1063 my $self = bless {
169             notifiers => {}, # {nkey} = notifier
170             iowatches => {}, # {fd} = [ $on_read_ready, $on_write_ready, $on_hangup ]
171             sigattaches => {}, # {sig} => \@callbacks
172             childmanager => undef,
173             childwatches => {}, # {pid} => $code
174             threadwatches => {}, # {tid} => $code
175             timequeue => undef,
176             deferrals => [],
177             os => {}, # A generic scratchpad for IO::Async::OS to store whatever it wants
178             }, $class;
179              
180 98 100       3273 $METRICS and $METRICS->inc_gauge( loops => [ class => ref $self ] );
181              
182             # It's possible this is a specific subclass constructor. We still want the
183             # magic IO::Async::Loop->new constructor to yield this if it's the first
184             # one
185 98   33     82788 our $ONE_TRUE_LOOP ||= $self;
186              
187             # Legacy support - temporary until all CPAN classes are updated; bump NEEDAPI version at that point
188 98         955 my $old_timer = $self->can( "enqueue_timer" ) != \&enqueue_timer;
189 98 50       934 if( $old_timer != ( $self->can( "cancel_timer" ) != \&cancel_timer ) ) {
190 0         0 die "$class should overload both ->enqueue_timer and ->cancel_timer, or neither";
191             }
192              
193 98 50       370 if( $old_timer ) {
194 0         0 warnings::warnif( deprecated => "Enabling old_timer workaround for old loop class " . $class );
195             }
196              
197 98         333 $self->{old_timer} = $old_timer;
198              
199 98         320 return $self;
200             }
201              
202             sub DESTROY
203             {
204 63     63   481 my $self = shift;
205              
206 63 100       1135 $METRICS and $METRICS->dec_gauge( loops => [ class => ref $self ] );
207             }
208              
209             =head1 MAGIC CONSTRUCTOR
210              
211             =head2 new
212              
213             $loop = IO::Async::Loop->new
214              
215             This function attempts to find a good subclass to use, then calls its
216             constructor. It works by making a list of likely candidate classes, then
217             trying each one in turn, Cing the module then calling its C
218             method. If either of these operations fails, the next subclass is tried. If
219             no class was successful, then an exception is thrown.
220              
221             The constructed object is cached, and will be returned again by a subsequent
222             call. The cache will also be set by a constructor on a specific subclass. This
223             behaviour makes it possible to simply use the normal constructor in a module
224             that wishes to interact with the main program's Loop, such as an integration
225             module for another event system.
226              
227             For example, the following two C<$loop> variables will refer to the same
228             object:
229              
230             use IO::Async::Loop;
231             use IO::Async::Loop::Poll;
232              
233             my $loop_poll = IO::Async::Loop::Poll->new;
234              
235             my $loop = IO::Async::Loop->new;
236              
237             While it is not advised to do so under normal circumstances, if the program
238             really wishes to construct more than one Loop object, it can call the
239             constructor C, or invoke one of the subclass-specific constructors
240             directly.
241              
242             The list of candidates is formed from the following choices, in this order:
243              
244             =over 4
245              
246             =item * $ENV{IO_ASYNC_LOOP}
247              
248             If this environment variable is set, it should contain a comma-separated list
249             of subclass names. These names may or may not be fully-qualified; if a name
250             does not contain C<::> then it will have C prepended to it.
251             This allows the end-user to specify a particular choice to fit the needs of
252             his use of a program using L.
253              
254             =item * $IO::Async::Loop::LOOP
255              
256             If this scalar is set, it should contain a comma-separated list of subclass
257             names. These may or may not be fully-qualified, as with the above case. This
258             allows a program author to suggest a loop module to use.
259              
260             In cases where the module subclass is a hard requirement, such as GTK programs
261             using C, it would be better to use the module specifically and invoke
262             its constructor directly.
263              
264             =item * IO::Async::OS->LOOP_PREFER_CLASSES
265              
266             The L hints module for the given OS is then consulted to see if
267             it suggests any other module classes specific to the given operating system.
268              
269             =item * $^O
270              
271             The module called C is tried next. This allows specific
272             OSes, such as the ever-tricky C, to provide an implementation that
273             might be more efficient than the generic ones, or even work at all.
274              
275             This option is now discouraged in favour of the L hint instead.
276             At some future point it may be removed entirely, given as currently only
277             C uses it.
278              
279             =item * Poll and Select
280              
281             Finally, if no other choice has been made by now, the built-in C module
282             is chosen. This should always work, but in case it doesn't, the C
283             module will be chosen afterwards as a last-case attempt. If this also fails,
284             then the magic constructor itself will throw an exception.
285              
286             =back
287              
288             If any of the explicitly-requested loop types (C<$ENV{IO_ASYNC_LOOP}> or
289             C<$IO::Async::Loop::LOOP>) fails to load then a warning is printed detailing
290             the error.
291              
292             Implementors of new C subclasses should see the notes about
293             C below.
294              
295             =cut
296              
297             sub __try_new
298             {
299 80     80   264 my ( $class ) = @_;
300              
301 80         538 ( my $file = "$class.pm" ) =~ s{::}{/}g;
302              
303 80 100       216 eval {
304 80     0   637 local $SIG{__WARN__} = sub {};
305 80         49927 require $file;
306             } or return;
307              
308 74         391 my $self;
309 74 50       185 $self = eval { $class->new } and return $self;
  74         411  
310              
311             # Oh dear. We've loaded the code OK but for some reason the constructor
312             # wasn't happy. Being polite we ought really to unload the file again,
313             # but perl doesn't actually provide us a way to do this.
314              
315 0         0 return undef;
316             }
317              
318             sub new
319             {
320 31   66 31 1 2070 return our $ONE_TRUE_LOOP ||= shift->really_new;
321             }
322              
323             # Ensure that the loop is DESTROYed recursively at exit time, before GD happens
324             END {
325 72     72   3607 undef our $ONE_TRUE_LOOP;
326             }
327              
328             sub really_new
329             {
330 6     6 0 13 shift; # We're going to ignore the class name actually given
331 6         10 my $self;
332              
333             my @candidates;
334              
335 6 100       26 push @candidates, split( m/,/, $ENV{IO_ASYNC_LOOP} ) if defined $ENV{IO_ASYNC_LOOP};
336              
337 6 100       23 push @candidates, split( m/,/, $LOOP ) if defined $LOOP;
338              
339 6         19 foreach my $class ( @candidates ) {
340 3 100       15 $class =~ m/::/ or $class = "IO::Async::Loop::$class";
341 3 50       7 $self = __try_new( $class ) and return $self;
342              
343 0         0 my ( $topline ) = split m/\n/, $@; # Ignore all the other lines; they'll be require's verbose output
344 0         0 warn "Unable to use $class - $topline\n";
345             }
346              
347 3 100       11 unless( $LOOP_NO_OS ) {
348 2         32 foreach my $class ( IO::Async::OS->LOOP_PREFER_CLASSES, "IO::Async::Loop::$^O" ) {
349 6 100       31 $class =~ m/::/ or $class = "IO::Async::Loop::$class";
350 6 50       20 $self = __try_new( $class ) and return $self;
351              
352             # Don't complain about these ones
353             }
354             }
355              
356 3         17 return IO::Async::Loop->new_builtin;
357             }
358              
359             sub new_builtin
360             {
361 71     71 0 10578 shift;
362 71         168 my $self;
363              
364 71         924 foreach my $class ( IO::Async::OS->LOOP_BUILTIN_CLASSES ) {
365 71 50       460 $self = __try_new( "IO::Async::Loop::$class" ) and return $self;
366             }
367              
368 0         0 croak "Cannot find a suitable candidate class";
369             }
370              
371             #######################
372             # Notifier management #
373             #######################
374              
375             =head1 NOTIFIER MANAGEMENT
376              
377             The following methods manage the collection of L objects.
378              
379             =cut
380              
381             =head2 add
382              
383             $loop->add( $notifier )
384              
385             This method adds another notifier object to the stored collection. The object
386             may be a L, or any subclass of it.
387              
388             When a notifier is added, any children it has are also added, recursively. In
389             this way, entire sections of a program may be written within a tree of
390             notifier objects, and added or removed on one piece.
391              
392             =cut
393              
394             sub add
395             {
396 1368     1368 1 47532 my $self = shift;
397 1368         2804 my ( $notifier ) = @_;
398              
399 1368 100       7527 if( defined $notifier->parent ) {
400 1         94 croak "Cannot add a child notifier directly - add its parent";
401             }
402              
403 1367 100       3905 if( defined $notifier->loop ) {
404 1         184 croak "Cannot add a notifier that is already a member of a loop";
405             }
406              
407 1366         6089 $self->_add_noparentcheck( $notifier );
408             }
409              
410             sub _add_noparentcheck
411             {
412 1952     1952   3594 my $self = shift;
413 1952         3520 my ( $notifier ) = @_;
414              
415 1952         5313 my $nkey = refaddr $notifier;
416              
417 1952         14945 $self->{notifiers}->{$nkey} = $notifier;
418 1952 100       8551 $METRICS and $METRICS->inc_gauge( notifiers => );
419              
420 1952         29517 $notifier->__set_loop( $self );
421              
422 1918         26947 $self->_add_noparentcheck( $_ ) for $notifier->children;
423              
424 1918         5132 return;
425             }
426              
427             =head2 remove
428              
429             $loop->remove( $notifier )
430              
431             This method removes a notifier object from the stored collection, and
432             recursively and children notifiers it contains.
433              
434             =cut
435              
436             sub remove
437             {
438 878     878 1 115631 my $self = shift;
439 878         1855 my ( $notifier ) = @_;
440              
441 878 100       2646 if( defined $notifier->parent ) {
442 1         80 croak "Cannot remove a child notifier directly - remove its parent";
443             }
444              
445 877         3127 $self->_remove_noparentcheck( $notifier );
446             }
447              
448             sub _remove_noparentcheck
449             {
450 1169     1169   1957 my $self = shift;
451 1169         2255 my ( $notifier ) = @_;
452              
453 1169         3302 my $nkey = refaddr $notifier;
454              
455 1169 50       3709 exists $self->{notifiers}->{$nkey} or croak "Notifier does not exist in collection";
456              
457 1169         6128 delete $self->{notifiers}->{$nkey};
458 1169 100       5459 $METRICS and $METRICS->dec_gauge( notifiers => );
459              
460 1169         15074 $notifier->__set_loop( undef );
461              
462 1169         3347 $self->_remove_noparentcheck( $_ ) for $notifier->children;
463              
464 1169         8530 return;
465             }
466              
467             =head2 notifiers
468              
469             @notifiers = $loop->notifiers
470              
471             Returns a list of all the notifier objects currently stored in the Loop.
472              
473             =cut
474              
475             sub notifiers
476             {
477 3     3 1 21 my $self = shift;
478             # Sort so the order remains stable under additions/removals
479 3         5 return map { $self->{notifiers}->{$_} } sort keys %{ $self->{notifiers} };
  1         9  
  3         21  
480             }
481              
482             ###################
483             # Looping support #
484             ###################
485              
486             =head1 LOOPING CONTROL
487              
488             The following methods control the actual run cycle of the loop, and hence the
489             program.
490              
491             =cut
492              
493             =head2 loop_once
494              
495             $count = $loop->loop_once( $timeout )
496              
497             This method performs a single wait loop using the specific subclass's
498             underlying mechanism. If C<$timeout> is undef, then no timeout is applied, and
499             it will wait until an event occurs. The intention of the return value is to
500             indicate the number of callbacks that this loop executed, though different
501             subclasses vary in how accurately they can report this. See the documentation
502             for this method in the specific subclass for more information.
503              
504             =cut
505              
506             sub loop_once
507             {
508 0     0 1 0 my $self = shift;
509 0         0 my ( $timeout ) = @_;
510              
511 0         0 croak "Expected that $self overrides ->loop_once";
512             }
513              
514             =head2 run
515              
516             @result = $loop->run
517              
518             $result = $loop->run
519              
520             Runs the actual IO event loop. This method blocks until the C method is
521             called, and returns the result that was passed to C. In scalar context
522             only the first result is returned; the others will be discarded if more than
523             one value was provided. This method may be called recursively.
524              
525             This method is a recent addition and may not be supported by all the
526             C subclasses currently available on CPAN.
527              
528             =cut
529              
530             sub run
531             {
532 10     10 1 35 my $self = shift;
533              
534 10         51 local $self->{running} = 1;
535 10         44 local $self->{result} = [];
536              
537 10         38 while( $self->{running} ) {
538 10         81 $self->loop_once( undef );
539             }
540              
541 10 100       97 return wantarray ? @{ $self->{result} } : $self->{result}[0];
  6         58  
542             }
543              
544             =head2 stop
545              
546             $loop->stop( @result )
547              
548             Stops the inner-most C method currently in progress, causing it to return
549             the given C<@result>.
550              
551             This method is a recent addition and may not be supported by all the
552             C subclasses currently available on CPAN.
553              
554             =cut
555              
556             sub stop
557             {
558 10     10 1 39 my $self = shift;
559              
560 10         29 @{ $self->{result} } = @_;
  10         78  
561 10         49 undef $self->{running};
562             }
563              
564             =head2 loop_forever
565              
566             $loop->loop_forever
567              
568             A synonym for C, though this method does not return a result.
569              
570             =cut
571              
572             sub loop_forever
573             {
574 2     2 1 10 my $self = shift;
575 2         43 $self->run;
576 2         12 return;
577             }
578              
579             =head2 loop_stop
580              
581             $loop->loop_stop
582              
583             A synonym for C, though this method does not pass any results.
584              
585             =cut
586              
587             sub loop_stop
588             {
589 2     2 1 9 my $self = shift;
590 2         16 $self->stop;
591             }
592              
593             =head2 post_fork
594              
595             $loop->post_fork
596              
597             The base implementation of this method does nothing. It is provided in case
598             some Loop subclasses should take special measures after a C system
599             call if the main body of the program should survive in both running processes.
600              
601             This may be required, for example, in a long-running server daemon that forks
602             multiple copies on startup after opening initial listening sockets. A loop
603             implementation that uses some in-kernel resource that becomes shared after
604             forking (for example, a Linux C or a BSD C filehandle) would
605             need recreating in the new child process before the program can continue.
606              
607             =cut
608              
609             sub post_fork
610             {
611 2     2 1 5 my $self = shift;
612              
613 2         16 IO::Async::OS->post_fork( $self );
614             }
615              
616             ###########
617             # Futures #
618             ###########
619              
620             =head1 FUTURE SUPPORT
621              
622             The following methods relate to L objects.
623              
624             =cut
625              
626             =head2 new_future
627              
628             $future = $loop->new_future
629              
630             Returns a new L instance with a reference to the Loop.
631              
632             =cut
633              
634             sub new_future
635             {
636 1022     1022 1 6031 my $self = shift;
637 1022         43277 require IO::Async::Future;
638 1022         11661 return IO::Async::Future->new( $self );
639             }
640              
641             =head2 await
642              
643             $loop->await( $future )
644              
645             Blocks until the given future is ready, as indicated by its C method.
646             As a convenience it returns the future, to simplify code:
647              
648             my @result = $loop->await( $future )->get;
649              
650             =cut
651              
652             sub await
653             {
654 44     44 1 431 my $self = shift;
655 44         123 my ( $future ) = @_;
656              
657 44         823 $self->loop_once until $future->is_ready;
658              
659 44         333 return $future;
660             }
661              
662             =head2 await_all
663              
664             $loop->await_all( @futures )
665              
666             Blocks until all the given futures are ready, as indicated by the C
667             method. Equivalent to calling C on a C<< Future->wait_all >> except
668             that it doesn't create the surrounding future object.
669              
670             =cut
671              
672 2   100 2   7 sub _all_ready { $_->is_ready or return 0 for @_; return 1 }
  1         14  
673              
674             sub await_all
675             {
676 1     1 1 9 my $self = shift;
677 1         5 my @futures = @_;
678              
679 1         4 $self->loop_once until _all_ready @futures;
680             }
681              
682             =head2 delay_future
683              
684             $loop->delay_future( %args )->get
685              
686             Returns a new L instance which will become done at a given
687             point in time. The C<%args> should contain an C or C key as per the
688             C method. The returned future may be cancelled to cancel the
689             timer. At the alloted time the future will succeed with an empty result list.
690              
691             =cut
692              
693             sub delay_future
694             {
695 2     2 1 2920 my $self = shift;
696 2         9 my %args = @_;
697              
698 2         9 my $future = $self->new_future;
699             my $id = $self->watch_time( %args,
700 1     1   14 code => sub { $future->done },
701 2         22 );
702              
703 2     1   26 $future->on_cancel( sub { shift->loop->unwatch_time( $id ) } );
  1         21  
704              
705 2         65 return $future;
706             }
707              
708             =head2 timeout_future
709              
710             $loop->timeout_future( %args )->get
711              
712             Returns a new L instance which will fail at a given point
713             in time. The C<%args> should contain an C or C key as per the
714             C method. The returned future may be cancelled to cancel the
715             timer. At the alloted time, the future will fail with the string C<"Timeout">.
716              
717             =cut
718              
719             sub timeout_future
720             {
721 2     2 1 3095 my $self = shift;
722 2         9 my %args = @_;
723              
724 2         9 my $future = $self->new_future;
725             my $id = $self->watch_time( %args,
726 1     1   24 code => sub { $future->fail( "Timeout" ) },
727 2         18 );
728              
729 2     1   18 $future->on_cancel( sub { shift->loop->unwatch_time( $id ) } );
  1         29  
730              
731 2         63 return $future;
732             }
733              
734             ############
735             # Features #
736             ############
737              
738             =head1 FEATURES
739              
740             Most of the following methods are higher-level wrappers around base
741             functionality provided by the low-level API documented below. They may be
742             used by L subclasses or called directly by the program.
743              
744             The following methods documented with a trailing call to C<< ->get >> return
745             L instances.
746              
747             =cut
748              
749             sub __new_feature
750             {
751 120     120   438 my $self = shift;
752 120         420 my ( $classname ) = @_;
753              
754 120         1608 ( my $filename = "$classname.pm" ) =~ s{::}{/}g;
755 120         97759 require $filename;
756              
757             # These features aren't supposed to be "user visible", so if methods called
758             # on it carp or croak, the shortmess line ought to skip IO::Async::Loop and
759             # go on report its caller. To make this work, add the feature class to our
760             # @CARP_NOT list.
761 120         629 push our(@CARP_NOT), $classname;
762              
763 120         1035 return $classname->new( loop => $self );
764             }
765              
766             =head2 attach_signal
767              
768             $id = $loop->attach_signal( $signal, $code )
769              
770             This method adds a new signal handler to watch the given signal. The same
771             signal can be attached to multiple times; its callback functions will all be
772             invoked, in no particular order.
773              
774             The returned C<$id> value can be used to identify the signal handler in case
775             it needs to be removed by the C method. Note that this value
776             may be an object reference, so if it is stored, it should be released after it
777             is cancelled, so the object itself can be freed.
778              
779             =over 8
780              
781             =item $signal
782              
783             The name of the signal to attach to. This should be a bare name like C.
784              
785             =item $code
786              
787             A CODE reference to the handling callback.
788              
789             =back
790              
791             Attaching to C is not recommended because of the way all child
792             processes use it to report their termination. Instead, the C
793             method should be used to watch for termination of a given child process. A
794             warning will be printed if C is passed here, but in future versions
795             of L this behaviour may be disallowed altogether.
796              
797             See also L for the C> constants.
798              
799             For a more flexible way to use signals from within Notifiers, see instead the
800             L object.
801              
802             =cut
803              
804             sub attach_signal
805             {
806 68     68 1 425 my $self = shift;
807 68         476 my ( $signal, $code ) = @_;
808              
809 68         393 HAVE_SIGNALS or croak "This OS cannot ->attach_signal";
810              
811 68 100       500 if( $signal eq "CHLD" ) {
812             # We make special exception to allow $self->watch_process to do this
813 55 50       780 caller eq "IO::Async::Loop" or
814             carp "Attaching to SIGCHLD is not advised - use ->watch_process instead";
815             }
816              
817 68 100       371 if( not $self->{sigattaches}->{$signal} ) {
818 65         277 my @attaches;
819             $self->watch_signal( $signal, sub {
820 306     306   2711 foreach my $attachment ( @attaches ) {
821 309         1597 $attachment->();
822             }
823 65         1887 } );
824 62         316 $self->{sigattaches}->{$signal} = \@attaches;
825             }
826              
827 65         142 push @{ $self->{sigattaches}->{$signal} }, $code;
  65         366  
828              
829 65         545 return \$self->{sigattaches}->{$signal}->[-1];
830             }
831              
832             =head2 detach_signal
833              
834             $loop->detach_signal( $signal, $id )
835              
836             Removes a previously-attached signal handler.
837              
838             =over 8
839              
840             =item $signal
841              
842             The name of the signal to remove from. This should be a bare name like
843             C.
844              
845             =item $id
846              
847             The value returned by the C method.
848              
849             =back
850              
851             =cut
852              
853             sub detach_signal
854             {
855 9     9 1 19 my $self = shift;
856 9         30 my ( $signal, $id ) = @_;
857              
858 9         17 HAVE_SIGNALS or croak "This OS cannot ->detach_signal";
859              
860             # Can't use grep because we have to preserve the addresses
861 9 50       37 my $attaches = $self->{sigattaches}->{$signal} or return;
862              
863 9         35 for (my $i = 0; $i < @$attaches; ) {
864 12 100       51 $i++, next unless \$attaches->[$i] == $id;
865              
866 9         32 splice @$attaches, $i, 1, ();
867             }
868              
869 9 100       34 if( !@$attaches ) {
870 6         38 $self->unwatch_signal( $signal );
871 6         30 delete $self->{sigattaches}->{$signal};
872             }
873             }
874              
875             =head2 later
876              
877             $loop->later( $code )
878              
879             $f = $loop->later
880              
881             Schedules a code reference to be invoked as soon as the current round of IO
882             operations is complete.
883              
884             The code reference is never invoked immediately, though the loop will not
885             perform any blocking operations between when it is installed and when it is
886             invoked. It may call C
887             timeout, and process any currently-pending IO conditions before the code is
888             invoked, but it will not block for a non-zero amount of time.
889              
890             This method is implemented using the C method, with the C
891             parameter set to C. It will return an ID value that can be passed to
892             C if required.
893              
894             I: If no C<$code> value is passed, a L will be
895             returned instead. This allows for constructs such as:
896              
897             await $loop->later;
898              
899             =cut
900              
901             sub later
902             {
903 49     49 1 2206 my $self = shift;
904 49         220 my ( $code ) = @_;
905              
906 49 100       747 return $self->watch_idle( when => 'later', code => $code )
907             if $code;
908              
909 2         10 my $f = $self->new_future;
910             my $id = $self->watch_idle( when => 'later', code => sub {
911 1 50   1   4 $f->done unless $f->is_ready;
912 2         23 } );
913             $f->on_cancel( sub {
914 1     1   716 $self->unwatch_idle( $id );
915 2         17 } );
916 2         46 return $f;
917             }
918              
919             =head2 spawn_child
920              
921             $loop->spawn_child( %params )
922              
923             This method creates a new child process to run a given code block or command.
924             The C<%params> hash takes the following keys:
925              
926             =over 8
927              
928             =item command => ARRAY or STRING
929              
930             Either a reference to an array containing the command and its arguments, or a
931             plain string containing the command. This value is passed into perl's
932             C function.
933              
934             =item code => CODE
935              
936             A block of code to execute in the child process. It will be called in scalar
937             context inside an C block.
938              
939             =item setup => ARRAY
940              
941             A reference to an array which gives file descriptors to set up in the child
942             process before running the code or command. See below.
943              
944             =item on_exit => CODE
945              
946             A continuation to be called when the child processes exits. It will be invoked
947             in the following way:
948              
949             $on_exit->( $pid, $exitcode, $dollarbang, $dollarat )
950              
951             The second argument is passed the plain perl C<$?> value.
952              
953             =back
954              
955             Exactly one of the C or C keys must be specified.
956              
957             If the C key is used, the given array or string is executed using the
958             C function.
959              
960             If the C key is used, the return value will be used as the C
961             code from the child if it returns (or 255 if it returned C or thows an
962             exception).
963              
964             Case | ($exitcode >> 8) | $dollarbang | $dollarat
965             --------------+------------------------+-------------+----------
966             exec succeeds | exit code from program | 0 | ""
967             exec fails | 255 | $! | ""
968             $code returns | return value | $! | ""
969             $code dies | 255 | $! | $@
970              
971             It is usually more convenient to use the C method in simple
972             cases where an external program is being started in order to interact with it
973             via file IO, or even C when only the final result is required,
974             rather than interaction while it is running.
975              
976             =head3 C array
977              
978             This array gives a list of file descriptor operations to perform in the child
979             process after it has been Ced from the parent, before running the code
980             or command. It consists of name/value pairs which are ordered; the operations
981             are performed in the order given.
982              
983             =over 8
984              
985             =item fdI => ARRAY
986              
987             Gives an operation on file descriptor I. The first element of the array
988             defines the operation to be performed:
989              
990             =over 4
991              
992             =item [ 'close' ]
993              
994             The file descriptor will be closed.
995              
996             =item [ 'dup', $io ]
997              
998             The file descriptor will be Ced from the given IO handle.
999              
1000             =item [ 'open', $mode, $file ]
1001              
1002             The file descriptor will be opened from the named file in the given mode. The
1003             C<$mode> string should be in the form usually given to the C function;
1004             such as '<' or '>>'.
1005              
1006             =item [ 'keep' ]
1007              
1008             The file descriptor will not be closed; it will be left as-is.
1009              
1010             =back
1011              
1012             A non-reference value may be passed as a shortcut, where it would contain the
1013             name of the operation with no arguments (i.e. for the C and C
1014             operations).
1015              
1016             =item IO => ARRAY
1017              
1018             Shortcut for passing C>, where I is the fileno of the IO
1019             reference. In this case, the key must be a reference that implements the
1020             C method. This is mostly useful for
1021              
1022             $handle => 'keep'
1023              
1024             =item fdI => IO
1025              
1026             A shortcut for the C case given above.
1027              
1028             =item stdin => ...
1029              
1030             =item stdout => ...
1031              
1032             =item stderr => ...
1033              
1034             Shortcuts for C, C and C respectively.
1035              
1036             =item env => HASH
1037              
1038             A reference to a hash to set as the child process's environment.
1039              
1040             Note that this will entirely set a new environment, completely replacing the
1041             existing one. If you want to simply add new keys or change the values of some
1042             keys without removing the other existing ones, you can simply copy C<%ENV>
1043             into the hash before setting new keys:
1044              
1045             env => {
1046             %ENV,
1047             ANOTHER => "key here",
1048             }
1049              
1050             =item nice => INT
1051              
1052             Change the child process's scheduling priority using C.
1053              
1054             =item chdir => STRING
1055              
1056             Change the child process's working directory using C.
1057              
1058             =item setuid => INT
1059              
1060             =item setgid => INT
1061              
1062             Change the child process's effective UID or GID.
1063              
1064             =item setgroups => ARRAY
1065              
1066             Change the child process's groups list, to those groups whose numbers are
1067             given in the ARRAY reference.
1068              
1069             On most systems, only the privileged superuser change user or group IDs.
1070             L will B check before detaching the child process whether
1071             this is the case.
1072              
1073             If setting both the primary GID and the supplementary groups list, it is
1074             suggested to set the primary GID first. Moreover, some operating systems may
1075             require that the supplementary groups list contains the primary GID.
1076              
1077             =back
1078              
1079             If no directions for what to do with C, C and C are
1080             given, a default of C is implied. All other file descriptors will be
1081             closed, unless a C operation is given for them.
1082              
1083             If C is used, be sure to place it after any other operations that
1084             might require superuser privileges, such as C or opening special
1085             files.
1086              
1087             Z<>
1088              
1089             my ( $pipeRd, $pipeWr ) = IO::Async::OS->pipepair;
1090             $loop->spawn_child(
1091             command => "/usr/bin/my-command",
1092              
1093             setup => [
1094             stdin => [ "open", "<", "/dev/null" ],
1095             stdout => $pipeWr,
1096             stderr => [ "open", ">>", "/var/log/mycmd.log" ],
1097             chdir => "/",
1098             ]
1099              
1100             on_exit => sub {
1101             my ( $pid, $exitcode ) = @_;
1102             my $status = ( $exitcode >> 8 );
1103             print "Command exited with status $status\n";
1104             },
1105             );
1106              
1107             $loop->spawn_child(
1108             code => sub {
1109             do_something; # executes in a child process
1110             return 1;
1111             },
1112              
1113             on_exit => sub {
1114             my ( $pid, $exitcode, $dollarbang, $dollarat ) = @_;
1115             my $status = ( $exitcode >> 8 );
1116             print "Child process exited with status $status\n";
1117             print " OS error was $dollarbang, exception was $dollarat\n";
1118             },
1119             );
1120              
1121             =cut
1122              
1123             sub spawn_child
1124             {
1125 338     338 1 142606 my $self = shift;
1126 338         1923 my %params = @_;
1127              
1128             my $childmanager = $self->{childmanager} ||=
1129 338   66     1949 $self->__new_feature( "IO::Async::Internals::ChildManager" );
1130              
1131 338         2446 $childmanager->spawn_child( %params );
1132             }
1133              
1134             =head2 open_process
1135              
1136             $process = $loop->open_process( %params )
1137              
1138             I
1139              
1140             This creates a new child process to run the given code block or command, and
1141             attaches filehandles to it that the parent will watch. This method is a light
1142             wrapper around constructing a new L object, adding it to
1143             the loop, and returning it.
1144              
1145             The C<%params> hash is passed directly to the L
1146             constructor.
1147              
1148             =cut
1149              
1150             sub open_process
1151             {
1152 4     4 1 2193 my $self = shift;
1153 4         14 my %params = @_;
1154              
1155 4 100       125 $params{on_exit} and croak "Cannot pass 'on_exit' parameter through ->open_process";
1156              
1157 3         592 require IO::Async::Process;
1158 3         23 my $process = IO::Async::Process->new( %params );
1159              
1160 3         28 $self->add( $process );
1161              
1162 2         38 return $process;
1163             }
1164              
1165             =head2 open_child
1166              
1167             $pid = $loop->open_child( %params )
1168              
1169             A back-compatibility wrapper to calling L and returning the PID
1170             of the newly-constructed L instance. The C
1171             continuation likewise will be invoked with the PID rather than the process
1172             instance.
1173              
1174             $on_finish->( $pid, $exitcode )
1175              
1176             Similarly, a C continuation is accepted, though note its arguments
1177             come in a different order to those of the Process's C:
1178              
1179             $on_error->( $pid, $exitcode, $errno, $exception )
1180              
1181             This method should not be used in new code; instead use L
1182             directly.
1183              
1184             =cut
1185              
1186             sub open_child
1187             {
1188 2     2 1 1536 my $self = shift;
1189 2         8 my %params = @_;
1190              
1191 2         7 my $on_finish = delete $params{on_finish};
1192 2 100       303 ref $on_finish or croak "Expected 'on_finish' to be a reference";
1193             $params{on_finish} = sub {
1194 1     1   9 my ( $process, $exitcode ) = @_;
1195 1         5 $on_finish->( $process->pid, $exitcode );
1196 1         13 };
1197              
1198 1 50       6 if( my $on_error = delete $params{on_error} ) {
1199 0 0       0 ref $on_error or croak "Expected 'on_error' to be a reference";
1200              
1201             $params{on_exception} = sub {
1202 0     0   0 my ( $process, $exception, $errno, $exitcode ) = @_;
1203             # Swap order
1204 0         0 $on_error->( $process->pid, $exitcode, $errno, $exception );
1205 0         0 };
1206             }
1207              
1208 1         6 return $self->open_process( %params )->pid;
1209             }
1210              
1211             =head2 run_process
1212              
1213             @results = $loop->run_process( %params )->get
1214              
1215             ( $exitcode, $stdout ) = $loop->run_process( ... )->get # by default
1216              
1217             I
1218              
1219             Creates a new child process to run the given code block or command, optionally
1220             capturing its STDOUT and STDERR streams. By default the returned future will
1221             yield the exit code and content of the STDOUT stream, but the C
1222             argument can be used to alter what is requested and returned.
1223              
1224             =over 8
1225              
1226             =item command => ARRAY or STRING
1227              
1228             =item code => CODE
1229              
1230             The command or code to run in the child process (as per the C
1231             method)
1232              
1233             =item stdin => STRING
1234              
1235             Optional. String to pass in to the child process's STDIN stream.
1236              
1237             =item setup => ARRAY
1238              
1239             Optional reference to an array to pass to the underlying C method.
1240              
1241             =item capture => ARRAY
1242              
1243             Optional reference to an array giving a list of names of values which should
1244             be returned by resolving future. Values will be returned in the same order as
1245             in the list. Valid choices are: C, C, C.
1246              
1247             =item cancel_signal => STRING
1248              
1249             Optional. Name (or number) of the signal to send to the process if the
1250             returned future is cancelled. Defaults to C. Use empty string or zero
1251             disable sending a signal on cancellation.
1252              
1253             =item fail_on_nonzero => BOOL
1254              
1255             Optional. If true, the returned future will fail if the process exits with a
1256             nonzero status. The failure will contain a message, the C category
1257             name, and the capture values that were requested.
1258              
1259             Future->fail( $message, process => @captures )
1260              
1261             =back
1262              
1263             This method is intended mainly as an IO::Async-compatible replacement for the
1264             perl C function (`backticks`), allowing it to replace
1265              
1266             my $output = `command here`;
1267              
1268             with
1269              
1270             my ( $exitcode, $output ) = $loop->run_process(
1271             command => "command here",
1272             )->get;
1273              
1274             Z<>
1275              
1276             my ( $exitcode, $stdout ) = $loop->run_process(
1277             command => "/bin/ps",
1278             )->get;
1279              
1280             my $status = ( $exitcode >> 8 );
1281             print "ps exited with status $status\n";
1282              
1283             =cut
1284              
1285             sub _run_process
1286             {
1287 85     85   249 my $self = shift;
1288 85         498 my %params = @_;
1289              
1290 85 100       493 $params{on_finish} and croak "Unrecognised parameter on_finish";
1291              
1292 84   100     455 my $capture = delete $params{capture} // [qw(exitcode stdout)];
1293 84 100       788 ref $capture eq "ARRAY" or croak "Expected 'capture' to be an array reference";
1294              
1295 83         260 my %subparams;
1296             my %results;
1297              
1298 83 100       357 if( my $child_stdin = delete $params{stdin} ) {
1299 6 50       114 ref $child_stdin and croak "Expected 'stdin' not to be a reference";
1300 6         118 $subparams{stdin} = { from => $child_stdin };
1301             }
1302              
1303 83         288 foreach (qw( code command setup notifier_name )) {
1304 332         789 $subparams{$_} = delete $params{$_};
1305             }
1306              
1307 83         251 foreach my $name ( @$capture ) {
1308 175 100       356 grep { $_ eq $name } qw( exitcode stdout stderr ) or croak "Unexpected capture $name";
  525         1361  
1309              
1310 174 100       700 $subparams{stdout} = { into => \$results{stdout} } if $name eq "stdout";
1311 174 100       582 $subparams{stderr} = { into => \$results{stderr} } if $name eq "stderr";
1312             }
1313              
1314 82   100     823 my $cancel_signal = delete $params{cancel_signal} // "TERM";
1315              
1316 82         206 my $fail_on_nonzero = delete $params{fail_on_nonzero};
1317              
1318 82 100       915 croak "Unrecognised parameters " . join( ", ", keys %params ) if keys %params;
1319              
1320 79         369 my $future = $self->new_future;
1321              
1322 79         9262 require IO::Async::Process;
1323             my $process = IO::Async::Process->new(
1324             %subparams,
1325             on_finish => sub {
1326 68     68   476 ( undef, $results{exitcode} ) = @_;
1327              
1328 68 100 66     325 if( $fail_on_nonzero and $results{exitcode} > 0 ) {
1329             $future->fail( "Process failed with exit code $results{exitcode}\n",
1330 1         24 process => @results{ @$capture }
1331             );
1332             }
1333             else {
1334 67         537 $future->done( @results{ @$capture } );
1335             }
1336             },
1337 79         1474 );
1338              
1339             $future->on_cancel(sub {
1340 1     1   50 $process->kill( $cancel_signal );
1341 79 50       819 }) if $cancel_signal;
1342              
1343 79         2558 $self->add( $process );
1344              
1345 68         3704 return ( $future, $process );
1346             }
1347              
1348             sub run_process
1349             {
1350 46     46 1 65903 my $self = shift;
1351 46         529 return ( $self->_run_process( @_ ) )[0];
1352             }
1353              
1354             =head2 run_child
1355              
1356             $pid = $loop->run_child( %params )
1357              
1358             A back-compatibility wrapper for L, returning the PID and taking
1359             an C continuation instead of returning a Future.
1360              
1361             This creates a new child process to run the given code block or command,
1362             capturing its STDOUT and STDERR streams. When the process exits, a
1363             continuation is invoked being passed the exitcode, and content of the streams.
1364              
1365             Takes the following named arguments in addition to those taken by
1366             C:
1367              
1368             =over 8
1369              
1370             =item on_finish => CODE
1371              
1372             A continuation to be called when the child process exits and closed its STDOUT
1373             and STDERR streams. It will be invoked in the following way:
1374              
1375             $on_finish->( $pid, $exitcode, $stdout, $stderr )
1376              
1377             The second argument is passed the plain perl C<$?> value.
1378              
1379             =back
1380              
1381             This method should not be used in new code; instead use L
1382             directly.
1383              
1384             =cut
1385              
1386             sub run_child
1387             {
1388 41     41 1 100357 my $self = shift;
1389 41         207 my %params = @_;
1390              
1391 41         120 my $on_finish = delete $params{on_finish};
1392 41 100       901 ref $on_finish or croak "Expected 'on_finish' to be a reference";
1393              
1394 39         487 my ( $f, $process ) = $self->_run_process(
1395             %params,
1396             capture => [qw( exitcode stdout stderr )],
1397             );
1398 32         270 my $pid = $process->pid;
1399              
1400             $f->on_done( sub {
1401 32     32   2307 undef $f; # capture cycle
1402 32         263 $on_finish->( $pid, @_ );
1403 32         934 });
1404              
1405 32         1230 return $pid;
1406             }
1407              
1408             =head2 resolver
1409              
1410             $loop->resolver
1411              
1412             Returns the internally-stored L object, used for name
1413             resolution operations by the C, C and C methods.
1414              
1415             =cut
1416              
1417             sub resolver
1418             {
1419 12     12 1 42 my $self = shift;
1420              
1421 12   66     82 return $self->{resolver} ||= do {
1422 6         3822 require IO::Async::Resolver;
1423 6         91 my $resolver = IO::Async::Resolver->new;
1424 6         54 $self->add( $resolver );
1425 6         59 $resolver;
1426             }
1427             }
1428              
1429             =head2 set_resolver
1430              
1431             $loop->set_resolver( $resolver )
1432              
1433             Sets the internally-stored L object. In most cases this
1434             method should not be required, but it may be used to provide an alternative
1435             resolver for special use-cases.
1436              
1437             =cut
1438              
1439             sub set_resolver
1440             {
1441 1     1 1 1017 my $self = shift;
1442 1         4 my ( $resolver ) = @_;
1443              
1444             $resolver->can( $_ ) or croak "Resolver is unsuitable as it does not implement $_"
1445 1   33     30 for qw( resolve getaddrinfo getnameinfo );
1446              
1447 1         6 $self->{resolver} = $resolver;
1448              
1449 1         6 $self->add( $resolver );
1450             }
1451              
1452             =head2 resolve
1453              
1454             @result = $loop->resolve( %params )->get
1455              
1456             This method performs a single name resolution operation. It uses an
1457             internally-stored L object. For more detail, see the
1458             C method on the L class.
1459              
1460             =cut
1461              
1462             sub resolve
1463             {
1464 2     2 1 815 my $self = shift;
1465 2         19 my ( %params ) = @_;
1466              
1467 2         19 $self->resolver->resolve( %params );
1468             }
1469              
1470             =head2 connect
1471              
1472             $handle|$socket = $loop->connect( %params )->get
1473              
1474             This method performs a non-blocking connection to a given address or set of
1475             addresses, returning a L which represents the operation. On
1476             completion, the future will yield the connected socket handle, or the given
1477             L object.
1478              
1479             There are two modes of operation. Firstly, a list of addresses can be provided
1480             which will be tried in turn. Alternatively as a convenience, if a host and
1481             service name are provided instead of a list of addresses, these will be
1482             resolved using the underlying loop's C method into the list of
1483             addresses.
1484              
1485             When attempting to connect to any among a list of addresses, there may be
1486             failures among the first attempts, before a valid connection is made. For
1487             example, the resolver may have returned some IPv6 addresses, but only IPv4
1488             routes are valid on the system. In this case, the first C syscall
1489             will fail. This isn't yet a fatal error, if there are more addresses to try,
1490             perhaps some IPv4 ones.
1491              
1492             For this reason, it is possible that the operation eventually succeeds even
1493             though some system calls initially fail. To be aware of individual failures,
1494             the optional C callback can be used. This will be invoked on each
1495             individual C or C failure, which may be useful for
1496             debugging or logging.
1497              
1498             Because this module simply uses the C resolver, it will be fully
1499             IPv6-aware if the underlying platform's resolver is. This allows programs to
1500             be fully IPv6-capable.
1501              
1502             In plain address mode, the C<%params> hash takes the following keys:
1503              
1504             =over 8
1505              
1506             =item addrs => ARRAY
1507              
1508             Reference to an array of (possibly-multiple) address structures to attempt to
1509             connect to. Each should be in the layout described for C. Such a layout
1510             is returned by the C named resolver.
1511              
1512             =item addr => HASH or ARRAY
1513              
1514             Shortcut for passing a single address to connect to; it may be passed directly
1515             with this key, instead of in another array on its own. This should be in a
1516             format recognised by L's C method.
1517              
1518             This example shows how to use the C functions to construct one for TCP
1519             port 8001 on address 10.0.0.1:
1520              
1521             $loop->connect(
1522             addr => {
1523             family => "inet",
1524             socktype => "stream",
1525             port => 8001,
1526             ip => "10.0.0.1",
1527             },
1528             ...
1529             );
1530              
1531             This example shows another way to connect to a UNIX socket at F.
1532              
1533             $loop->connect(
1534             addr => {
1535             family => "unix",
1536             socktype => "stream",
1537             path => "echo.sock",
1538             },
1539             ...
1540             );
1541              
1542             =item peer => IO
1543              
1544             Shortcut for constructing an address to connect to the given IO handle, which
1545             must be a L or subclass, and is presumed to be a local listening
1546             socket (perhaps on C or C). This is convenient for
1547             connecting to a local filehandle, for example during a unit test or similar.
1548              
1549             =item local_addrs => ARRAY
1550              
1551             =item local_addr => HASH or ARRAY
1552              
1553             Optional. Similar to the C or C parameters, these specify a local
1554             address or set of addresses to C the socket to before
1555             Cing it.
1556              
1557             =back
1558              
1559             When performing the resolution step too, the C or C keys are
1560             ignored, and instead the following keys are taken:
1561              
1562             =over 8
1563              
1564             =item host => STRING
1565              
1566             =item service => STRING
1567              
1568             The hostname and service name to connect to.
1569              
1570             =item local_host => STRING
1571              
1572             =item local_service => STRING
1573              
1574             Optional. The hostname and/or service name to C the socket to locally
1575             before connecting to the peer.
1576              
1577             =item family => INT
1578              
1579             =item socktype => INT
1580              
1581             =item protocol => INT
1582              
1583             =item flags => INT
1584              
1585             Optional. Other arguments to pass along with C and C to the
1586             C call.
1587              
1588             =item socktype => STRING
1589              
1590             Optionally may instead be one of the values C<'stream'>, C<'dgram'> or
1591             C<'raw'> to stand for C, C or C. This
1592             utility is provided to allow the caller to avoid a separate C only
1593             for importing these constants.
1594              
1595             =back
1596              
1597             It is necessary to pass the C hint to the resolver when resolving
1598             the host/service names into an address, as some OS's C functions
1599             require this hint. A warning is emitted if neither C nor C
1600             hint is defined when performing a C lookup. To avoid this warning
1601             while still specifying no particular C hint (perhaps to invoke some
1602             OS-specific behaviour), pass C<0> as the C value.
1603              
1604             In either case, it also accepts the following arguments:
1605              
1606             =over 8
1607              
1608             =item handle => IO::Async::Handle
1609              
1610             Optional. If given a L object or a subclass (such as
1611             L or L its handle will be set to the
1612             newly-connected socket on success, and that handle used as the result of the
1613             future instead.
1614              
1615             =item on_fail => CODE
1616              
1617             Optional. After an individual C or C syscall has failed,
1618             this callback is invoked to inform of the error. It is passed the name of the
1619             syscall that failed, the arguments that were passed to it, and the error it
1620             generated. I.e.
1621              
1622             $on_fail->( "socket", $family, $socktype, $protocol, $! );
1623              
1624             $on_fail->( "bind", $sock, $address, $! );
1625              
1626             $on_fail->( "connect", $sock, $address, $! );
1627              
1628             Because of the "try all" nature when given a list of multiple addresses, this
1629             callback may be invoked multiple times, even before an eventual success.
1630              
1631             =back
1632              
1633             This method accepts an C parameter; see the C section
1634             below.
1635              
1636             =head2 connect (void)
1637              
1638             $loop->connect( %params )
1639              
1640             When not returning a future, additional parameters can be given containing the
1641             continuations to invoke on success or failure.
1642              
1643             =over 8
1644              
1645             =item on_connected => CODE
1646              
1647             A continuation that is invoked on a successful C call to a valid
1648             socket. It will be passed the connected socket handle, as an C
1649             object.
1650              
1651             $on_connected->( $handle )
1652              
1653             =item on_stream => CODE
1654              
1655             An alternative to C, a continuation that is passed an instance
1656             of L when the socket is connected. This is provided as a
1657             convenience for the common case that a Stream object is required as the
1658             transport for a Protocol object.
1659              
1660             $on_stream->( $stream )
1661              
1662             =item on_socket => CODE
1663              
1664             Similar to C, but constructs an instance of L.
1665             This is most useful for C or C sockets.
1666              
1667             $on_socket->( $socket )
1668              
1669             =item on_connect_error => CODE
1670              
1671             A continuation that is invoked after all of the addresses have been tried, and
1672             none of them succeeded. It will be passed the most significant error that
1673             occurred, and the name of the operation it occurred in. Errors from the
1674             C syscall are considered most significant, then C, then
1675             finally C.
1676              
1677             $on_connect_error->( $syscall, $! )
1678              
1679             =item on_resolve_error => CODE
1680              
1681             A continuation that is invoked when the name resolution attempt fails. This is
1682             invoked in the same way as the C continuation for the C
1683             method.
1684              
1685             =back
1686              
1687             =cut
1688              
1689             sub connect
1690             {
1691 17     17 1 16315 my $self = shift;
1692 17         69 my ( %params ) = @_;
1693              
1694 17         35 my $extensions;
1695 17 100 66     79 if( $extensions = delete $params{extensions} and @$extensions ) {
1696 2         7 my ( $ext, @others ) = @$extensions;
1697              
1698 2         5 my $method = "${ext}_connect";
1699             # TODO: Try to 'require IO::Async::$ext'
1700              
1701 2 50       15 $self->can( $method ) or croak "Extension method '$method' is not available";
1702              
1703 2 100       14 return $self->$method(
1704             %params,
1705             ( @others ? ( extensions => \@others ) : () ),
1706             );
1707             }
1708              
1709 15         27 my $handle = $params{handle};
1710              
1711 15         28 my $on_done;
1712             # Legacy callbacks
1713 15 100       73 if( my $on_connected = delete $params{on_connected} ) {
    100          
    100          
    50          
1714 5         10 $on_done = $on_connected;
1715             }
1716             elsif( my $on_stream = delete $params{on_stream} ) {
1717 2 50       8 defined $handle and croak "Cannot pass 'on_stream' with a handle object as well";
1718              
1719 2         15 require IO::Async::Stream;
1720             # TODO: It doesn't make sense to put a SOCK_DGRAM in an
1721             # IO::Async::Stream but currently we don't detect this
1722 2         31 $handle = IO::Async::Stream->new;
1723 2         18 $on_done = $on_stream;
1724             }
1725             elsif( my $on_socket = delete $params{on_socket} ) {
1726 1 50       4 defined $handle and croak "Cannot pass 'on_socket' with a handle object as well";
1727              
1728 1         9 require IO::Async::Socket;
1729 1         7 $handle = IO::Async::Socket->new;
1730 1         3 $on_done = $on_socket;
1731             }
1732             elsif( !defined wantarray ) {
1733 0         0 croak "Expected 'on_connected' or 'on_stream' callback or to return a Future";
1734             }
1735              
1736 15         26 my $on_connect_error;
1737 15 100       125 if( $on_connect_error = $params{on_connect_error} ) {
    50          
1738             # OK
1739             }
1740             elsif( !defined wantarray ) {
1741 0         0 croak "Expected 'on_connect_error' callback";
1742             }
1743              
1744 15         28 my $on_resolve_error;
1745 15 100 33     73 if( $on_resolve_error = $params{on_resolve_error} ) {
    50 66        
1746             # OK
1747             }
1748             elsif( !defined wantarray and exists $params{host} || exists $params{local_host} ) {
1749 0         0 croak "Expected 'on_resolve_error' callback or to return a Future";
1750             }
1751              
1752 15   66     65 my $connector = $self->{connector} ||= $self->__new_feature( "IO::Async::Internals::Connector" );
1753              
1754 15         71 my $future = $connector->connect( %params );
1755              
1756             $future = $future->then( sub {
1757 7     7   1440 $handle->set_handle( shift );
1758 7         38 return Future->done( $handle )
1759 15 100       1169 }) if $handle;
1760              
1761 15 100       281 $future->on_done( $on_done ) if $on_done;
1762             $future->on_fail( sub {
1763 3 100 66 3   195 $on_connect_error->( @_[2,3] ) if $on_connect_error and $_[1] eq "connect";
1764 3 50 33     13 $on_resolve_error->( $_[2] ) if $on_resolve_error and $_[1] eq "resolve";
1765 15         259 } );
1766              
1767 15 100       338 return $future if defined wantarray;
1768              
1769             # Caller is not going to keep hold of the Future, so we have to ensure it
1770             # stays alive somehow
1771 8     8   50 $future->on_ready( sub { undef $future } ); # intentional cycle
  8         862  
1772             }
1773              
1774             =head2 listen
1775              
1776             $listener = $loop->listen( %params )->get
1777              
1778             This method sets up a listening socket and arranges for an acceptor callback
1779             to be invoked each time a new connection is accepted on the socket. Internally
1780             it creates an instance of L and adds it to the Loop if
1781             not given one in the arguments.
1782              
1783             Addresses may be given directly, or they may be looked up using the system's
1784             name resolver, or a socket handle may be given directly.
1785              
1786             If multiple addresses are given, or resolved from the service and hostname,
1787             then each will be attempted in turn until one succeeds.
1788              
1789             In named resolver mode, the C<%params> hash takes the following keys:
1790              
1791             =over 8
1792              
1793             =item service => STRING
1794              
1795             The service name to listen on.
1796              
1797             =item host => STRING
1798              
1799             The hostname to listen on. Optional. Will listen on all addresses if not
1800             supplied.
1801              
1802             =item family => INT
1803              
1804             =item socktype => INT
1805              
1806             =item protocol => INT
1807              
1808             =item flags => INT
1809              
1810             Optional. Other arguments to pass along with C and C to the
1811             C call.
1812              
1813             =item socktype => STRING
1814              
1815             Optionally may instead be one of the values C<'stream'>, C<'dgram'> or
1816             C<'raw'> to stand for C, C or C. This
1817             utility is provided to allow the caller to avoid a separate C only
1818             for importing these constants.
1819              
1820             =back
1821              
1822             It is necessary to pass the C hint to the resolver when resolving
1823             the host/service names into an address, as some OS's C functions
1824             require this hint. A warning is emitted if neither C nor C
1825             hint is defined when performing a C lookup. To avoid this warning
1826             while still specifying no particular C hint (perhaps to invoke some
1827             OS-specific behaviour), pass C<0> as the C value.
1828              
1829             In plain address mode, the C<%params> hash takes the following keys:
1830              
1831             =over 8
1832              
1833             =item addrs => ARRAY
1834              
1835             Reference to an array of (possibly-multiple) address structures to attempt to
1836             listen on. Each should be in the layout described for C. Such a layout
1837             is returned by the C named resolver.
1838              
1839             =item addr => ARRAY
1840              
1841             Shortcut for passing a single address to listen on; it may be passed directly
1842             with this key, instead of in another array of its own. This should be in a
1843             format recognised by L's C method. See also
1844             the C section.
1845              
1846             =back
1847              
1848             In direct socket handle mode, the following keys are taken:
1849              
1850             =over 8
1851              
1852             =item handle => IO
1853              
1854             The listening socket handle.
1855              
1856             =back
1857              
1858             In either case, the following keys are also taken:
1859              
1860             =over 8
1861              
1862             =item on_fail => CODE
1863              
1864             Optional. A callback that is invoked if a syscall fails while attempting to
1865             create a listening sockets. It is passed the name of the syscall that failed,
1866             the arguments that were passed to it, and the error generated. I.e.
1867              
1868             $on_fail->( "socket", $family, $socktype, $protocol, $! );
1869              
1870             $on_fail->( "sockopt", $sock, $optname, $optval, $! );
1871              
1872             $on_fail->( "bind", $sock, $address, $! );
1873              
1874             $on_fail->( "listen", $sock, $queuesize, $! );
1875              
1876             =item queuesize => INT
1877              
1878             Optional. The queue size to pass to the C calls. If not supplied,
1879             then 3 will be given instead.
1880              
1881             =item reuseaddr => BOOL
1882              
1883             Optional. If true or not supplied then the C socket option will
1884             be set. To prevent this, pass a false value such as 0.
1885              
1886             =item v6only => BOOL
1887              
1888             Optional. If defined, sets or clears the C socket option on
1889             C sockets. This option disables the ability of C socket to
1890             accept connections from C addresses. Not all operating systems allow
1891             this option to be disabled.
1892              
1893             =back
1894              
1895             An alternative which gives more control over the listener, is to create the
1896             L object directly and add it explicitly to the Loop.
1897              
1898             This method accepts an C parameter; see the C section
1899             below.
1900              
1901             =head2 listen (void)
1902              
1903             $loop->listen( %params )
1904              
1905             When not returning a future, additional parameters can be given containing the
1906             continuations to invoke on success or failure.
1907              
1908             =over 8
1909              
1910             =item on_notifier => CODE
1911              
1912             Optional. A callback that is invoked when the Listener object is ready to
1913             receive connections. The callback is passed the Listener object itself.
1914              
1915             $on_notifier->( $listener )
1916              
1917             If this callback is required, it may instead be better to construct the
1918             Listener object directly.
1919              
1920             =item on_listen => CODE
1921              
1922             Optional. A callback that is invoked when the listening socket is ready.
1923             Typically this would be used in the name resolver case, in order to inspect
1924             the socket's sockname address, or otherwise inspect the filehandle.
1925              
1926             $on_listen->( $socket )
1927              
1928             =item on_listen_error => CODE
1929              
1930             A continuation this is invoked after all of the addresses have been tried, and
1931             none of them succeeded. It will be passed the most significant error that
1932             occurred, and the name of the operation it occurred in. Errors from the
1933             C syscall are considered most significant, then C, then
1934             C, then finally C.
1935              
1936             =item on_resolve_error => CODE
1937              
1938             A continuation that is invoked when the name resolution attempt fails. This is
1939             invoked in the same way as the C continuation for the C
1940             method.
1941              
1942             =back
1943              
1944             =cut
1945              
1946             sub listen
1947             {
1948 5     5 1 3208 my $self = shift;
1949 5         22 my ( %params ) = @_;
1950              
1951 5         11 my $remove_on_error;
1952 5   66     25 my $listener = $params{listener} ||= do {
1953 4         8 $remove_on_error++;
1954              
1955 4         1140 require IO::Async::Listener;
1956              
1957             # Our wrappings of these don't want $listener
1958 4         11 my %listenerparams;
1959 4         11 for (qw( on_accept on_stream on_socket )) {
1960 12 100       34 next unless exists $params{$_};
1961 4 50       12 croak "Cannot ->listen with '$_' and 'listener'" if $params{listener};
1962              
1963 4         10 my $code = delete $params{$_};
1964             $listenerparams{$_} = sub {
1965 2     2   4 shift;
1966 2         17 goto &$code;
1967 4         24 };
1968             }
1969              
1970 4         35 my $listener = IO::Async::Listener->new( %listenerparams );
1971 4         28 $self->add( $listener );
1972 4         13 $listener
1973             };
1974              
1975 5         10 my $extensions;
1976 5 100 66     23 if( $extensions = delete $params{extensions} and @$extensions ) {
1977 2         22 my ( $ext, @others ) = @$extensions;
1978              
1979             # We happen to know we break older IO::Async::SSL
1980 2 50 33     17 if( $ext eq "SSL" and $IO::Async::SSL::VERSION < '0.12001' ) {
1981 0         0 croak "IO::Async::SSL version too old; need at least 0.12_001; found $IO::Async::SSL::VERSION";
1982             }
1983              
1984 2         7 my $method = "${ext}_listen";
1985             # TODO: Try to 'require IO::Async::$ext'
1986              
1987 2 50       11 $self->can( $method ) or croak "Extension method '$method' is not available";
1988              
1989 2 100       21 my $f = $self->$method(
1990             %params,
1991             ( @others ? ( extensions => \@others ) : () ),
1992             );
1993 2 50   0   26 $f->on_fail( sub { $self->remove( $listener ) } ) if $remove_on_error;
  0         0  
1994              
1995 2         57 return $f;
1996             }
1997              
1998 3         6 my $on_notifier = delete $params{on_notifier}; # optional
1999              
2000 3         7 my $on_listen_error = delete $params{on_listen_error};
2001 3         5 my $on_resolve_error = delete $params{on_resolve_error};
2002              
2003             # Shortcut
2004 3 100 66     12 if( $params{addr} and not $params{addrs} ) {
2005 1         96 $params{addrs} = [ delete $params{addr} ];
2006             }
2007              
2008 3         86 my $f;
2009 3 100       21 if( my $handle = delete $params{handle} ) {
    100          
    50          
2010 1         9 $f = $self->_listen_handle( $listener, $handle, %params );
2011             }
2012             elsif( my $addrs = delete $params{addrs} ) {
2013 1 50 33     5 $on_listen_error or defined wantarray or
2014             croak "Expected 'on_listen_error' or to return a Future";
2015 1         10 $f = $self->_listen_addrs( $listener, $addrs, %params );
2016             }
2017             elsif( defined $params{service} ) {
2018 1 50 33     7 $on_listen_error or defined wantarray or
2019             croak "Expected 'on_listen_error' or to return a Future";
2020 1 50 33     4 $on_resolve_error or defined wantarray or
2021             croak "Expected 'on_resolve_error' or to return a Future";
2022 1         853 $f = $self->_listen_hostservice( $listener, delete $params{host}, delete $params{service}, %params );
2023             }
2024             else {
2025 0         0 croak "Expected either 'service' or 'addrs' or 'addr' arguments";
2026             }
2027              
2028 3 50       174 $f->on_done( $on_notifier ) if $on_notifier;
2029 3 100       11 if( my $on_listen = $params{on_listen} ) {
2030 2     2   20 $f->on_done( sub { $on_listen->( shift->read_handle ) } );
  2         167  
2031             }
2032             $f->on_fail( sub {
2033 0     0   0 my ( $message, $how, @rest ) = @_;
2034 0 0 0     0 $on_listen_error->( @rest ) if $on_listen_error and $how eq "listen";
2035 0 0 0     0 $on_resolve_error->( @rest ) if $on_resolve_error and $how eq "resolve";
2036 3         81 });
2037 3 100   0   83 $f->on_fail( sub { $self->remove( $listener ) } ) if $remove_on_error;
  0         0  
2038              
2039 3 100       75 return $f if defined wantarray;
2040              
2041             # Caller is not going to keep hold of the Future, so we have to ensure it
2042             # stays alive somehow
2043 1     1   8 $f->on_ready( sub { undef $f } ); # intentional cycle
  1         22  
2044             }
2045              
2046             sub _listen_handle
2047             {
2048 3     3   7 my $self = shift;
2049 3         14 my ( $listener, $handle, %params ) = @_;
2050              
2051 3         22 $listener->configure( handle => $handle );
2052 3         15 return $self->new_future->done( $listener );
2053             }
2054              
2055             sub _listen_addrs
2056             {
2057 2     2   6 my $self = shift;
2058 2         11 my ( $listener, $addrs, %params ) = @_;
2059              
2060 2   50     22 my $queuesize = $params{queuesize} || 3;
2061              
2062 2         12 my $on_fail = $params{on_fail};
2063 2 50 33     9 !defined $on_fail or ref $on_fail or croak "Expected 'on_fail' to be a reference";
2064              
2065 2         4 my $reuseaddr = 1;
2066 2 50 33     8 $reuseaddr = 0 if defined $params{reuseaddr} and not $params{reuseaddr};
2067              
2068 2         4 my $v6only = $params{v6only};
2069              
2070 2         11 my ( $listenerr, $binderr, $sockopterr, $socketerr );
2071              
2072 2         14 foreach my $addr ( @$addrs ) {
2073 2         65 my ( $family, $socktype, $proto, $address ) = IO::Async::OS->extract_addrinfo( $addr );
2074              
2075 2         6 my $sock;
2076              
2077 2 50       41 unless( $sock = IO::Async::OS->socket( $family, $socktype, $proto ) ) {
2078 0         0 $socketerr = $!;
2079 0 0       0 $on_fail->( socket => $family, $socktype, $proto, $! ) if $on_fail;
2080 0         0 next;
2081             }
2082              
2083 2         576 $sock->blocking( 0 );
2084              
2085 2 50       43 if( $reuseaddr ) {
2086 2 50       24 unless( $sock->sockopt( SO_REUSEADDR, 1 ) ) {
2087 0         0 $sockopterr = $!;
2088 0 0       0 $on_fail->( sockopt => $sock, SO_REUSEADDR, 1, $! ) if $on_fail;
2089 0         0 next;
2090             }
2091             }
2092              
2093 2 50 33     89 if( defined $v6only and $family == AF_INET6 ) {
2094 0 0       0 unless( $sock->setsockopt( IPPROTO_IPV6, IPV6_V6ONLY, $v6only ) ) {
2095 0         0 $sockopterr = $!;
2096 0 0       0 $on_fail->( sockopt => $sock, IPV6_V6ONLY, $v6only, $! ) if $on_fail;
2097 0         0 next;
2098             }
2099             }
2100              
2101 2 50       22 unless( $sock->bind( $address ) ) {
2102 0         0 $binderr = $!;
2103 0 0       0 $on_fail->( bind => $sock, $address, $! ) if $on_fail;
2104 0         0 next;
2105             }
2106              
2107 2 50       62 unless( $sock->listen( $queuesize ) ) {
2108 0         0 $listenerr = $!;
2109 0 0       0 $on_fail->( listen => $sock, $queuesize, $! ) if $on_fail;
2110 0         0 next;
2111             }
2112              
2113 2         62 return $self->_listen_handle( $listener, $sock, %params );
2114             }
2115              
2116 0         0 my $f = $self->new_future;
2117 0 0       0 return $f->fail( "Cannot listen() - $listenerr", listen => listen => $listenerr ) if $listenerr;
2118 0 0       0 return $f->fail( "Cannot bind() - $binderr", listen => bind => $binderr ) if $binderr;
2119 0 0       0 return $f->fail( "Cannot setsockopt() - $sockopterr", listen => sockopt => $sockopterr ) if $sockopterr;
2120 0 0       0 return $f->fail( "Cannot socket() - $socketerr", listen => socket => $socketerr ) if $socketerr;
2121 0         0 die 'Oops; $loop->listen failed but no error cause was found';
2122             }
2123              
2124             sub _listen_hostservice
2125             {
2126 1     1   4 my $self = shift;
2127 1         6 my ( $listener, $host, $service, %params ) = @_;
2128              
2129 1   50     4 $host ||= "";
2130 1 50       4 defined $service or $service = ""; # might be 0
2131              
2132 1         1 my %gai_hints;
2133 1   66     10 exists $params{$_} and $gai_hints{$_} = $params{$_} for qw( family socktype protocol flags );
2134              
2135             defined $gai_hints{socktype} or defined $gai_hints{protocol} or
2136 1 50 33     5 carp "Attempting to ->listen without either 'socktype' or 'protocol' hint is not portable";
2137              
2138             $self->resolver->getaddrinfo(
2139             host => $host,
2140             service => $service,
2141             passive => 1,
2142             %gai_hints,
2143             )->then( sub {
2144 1     1   135 my @addrs = @_;
2145 1         35 $self->_listen_addrs( $listener, \@addrs, %params );
2146 1         8 });
2147             }
2148              
2149             =head1 OS ABSTRACTIONS
2150              
2151             Because the Magic Constructor searches for OS-specific subclasses of the Loop,
2152             several abstractions of OS services are provided, in case specific OSes need
2153             to give different implementations on that OS.
2154              
2155             =cut
2156              
2157             =head2 signame2num
2158              
2159             $signum = $loop->signame2num( $signame )
2160              
2161             Legacy wrappers around L functions.
2162              
2163             =cut
2164              
2165 0     0 1 0 sub signame2num { shift; IO::Async::OS->signame2num( @_ ) }
  0         0  
2166              
2167             =head2 time
2168              
2169             $time = $loop->time
2170              
2171             Returns the current UNIX time in fractional seconds. This is currently
2172             equivalent to C but provided here as a utility for
2173             programs to obtain the time current used by L for its own timing
2174             purposes.
2175              
2176             =cut
2177              
2178             sub time
2179             {
2180 1640     1640 1 3642 my $self = shift;
2181 1640         6091 return Time::HiRes::time;
2182             }
2183              
2184             =head2 fork
2185              
2186             $pid = $loop->fork( %params )
2187              
2188             This method creates a new child process to run a given code block, returning
2189             its process ID.
2190              
2191             =over 8
2192              
2193             =item code => CODE
2194              
2195             A block of code to execute in the child process. It will be called in scalar
2196             context inside an C block. The return value will be used as the
2197             C code from the child if it returns (or 255 if it returned C or
2198             thows an exception).
2199              
2200             =item on_exit => CODE
2201              
2202             A optional continuation to be called when the child processes exits. It will
2203             be invoked in the following way:
2204              
2205             $on_exit->( $pid, $exitcode )
2206              
2207             The second argument is passed the plain perl C<$?> value.
2208              
2209             This key is optional; if not supplied, the calling code should install a
2210             handler using the C method.
2211              
2212             =item keep_signals => BOOL
2213              
2214             Optional boolean. If missing or false, any CODE references in the C<%SIG> hash
2215             will be removed and restored back to C in the child process. If true,
2216             no adjustment of the C<%SIG> hash will be performed.
2217              
2218             =back
2219              
2220             =cut
2221              
2222             sub fork
2223             {
2224 334     334 1 14627 my $self = shift;
2225 334         1195 my %params = @_;
2226              
2227 334         627 HAVE_POSIX_FORK or croak "POSIX fork() is not available";
2228              
2229 334 50       1342 my $code = $params{code} or croak "Expected 'code' as a CODE reference";
2230              
2231 334         325029 my $kid = fork;
2232 334 50       11761 defined $kid or croak "Cannot fork() - $!";
2233              
2234 334 100       75015 if( $kid == 0 ) {
2235 30 100       3323 unless( $params{keep_signals} ) {
2236 29         5271 foreach( keys %SIG ) {
2237 1972 50       5607 next if m/^__(WARN|DIE)__$/;
2238 1972 100       17019 $SIG{$_} = "DEFAULT" if ref $SIG{$_} eq "CODE";
2239             }
2240             }
2241              
2242             # If the child process wants to use an IO::Async::Loop it needs to make
2243             # a new one, so this value is never useful
2244 30         989 undef our $ONE_TRUE_LOOP;
2245              
2246 30         553 my $exitvalue = eval { $code->() };
  30         1508  
2247              
2248 0 0       0 defined $exitvalue or $exitvalue = -1;
2249              
2250 0         0 POSIX::_exit( $exitvalue );
2251             }
2252              
2253 304 100       2238 if( defined $params{on_exit} ) {
2254 9         552 $self->watch_process( $kid => $params{on_exit} );
2255             }
2256              
2257 304 100       29591 $METRICS and $METRICS->inc_counter( forks => );
2258              
2259 304         40245 return $kid;
2260             }
2261              
2262             =head2 create_thread
2263              
2264             $tid = $loop->create_thread( %params )
2265              
2266             This method creates a new (non-detached) thread to run the given code block,
2267             returning its thread ID.
2268              
2269             =over 8
2270              
2271             =item code => CODE
2272              
2273             A block of code to execute in the thread. It is called in the context given by
2274             the C argument, and its return value will be available to the
2275             C callback. It is called inside an C block; if it fails the
2276             exception will be caught.
2277              
2278             =item context => "scalar" | "list" | "void"
2279              
2280             Optional. Gives the calling context that C is invoked in. Defaults to
2281             C if not supplied.
2282              
2283             =item on_joined => CODE
2284              
2285             Callback to invoke when the thread function returns or throws an exception.
2286             If it returned, this callback will be invoked with its result
2287              
2288             $on_joined->( return => @result )
2289              
2290             If it threw an exception the callback is invoked with the value of C<$@>
2291              
2292             $on_joined->( died => $! )
2293              
2294             =back
2295              
2296             =cut
2297              
2298             # It is basically impossible to have any semblance of order on global
2299             # destruction, and even harder again to rely on when threads are going to be
2300             # terminated and joined. Instead of ensuring we join them all, just detach any
2301             # we no longer care about at END time
2302             my %threads_to_detach; # {$tid} = $thread_weakly
2303             END {
2304 72   0 72   128190 $_ and $_->detach for values %threads_to_detach;
2305             }
2306              
2307             sub create_thread
2308             {
2309 0     0 1 0 my $self = shift;
2310 0         0 my %params = @_;
2311              
2312 0         0 HAVE_THREADS or croak "Threads are not available";
2313              
2314 0 0       0 eval { require threads } or croak "This Perl does not support threads";
  0         0  
2315              
2316 0 0       0 my $code = $params{code} or croak "Expected 'code' as a CODE reference";
2317 0 0       0 my $on_joined = $params{on_joined} or croak "Expected 'on_joined' as a CODE reference";
2318              
2319 0         0 my $threadwatches = $self->{threadwatches};
2320              
2321 0 0       0 unless( $self->{thread_join_pipe} ) {
2322 0 0       0 ( my $rd, $self->{thread_join_pipe} ) = IO::Async::OS->pipepair or
2323             croak "Cannot pipepair - $!";
2324 0         0 $rd->blocking( 0 );
2325 0         0 $self->{thread_join_pipe}->autoflush(1);
2326              
2327             $self->watch_io(
2328             handle => $rd,
2329             on_read_ready => sub {
2330 0 0   0   0 sysread $rd, my $buffer, 8192 or return;
2331              
2332             # There's a race condition here in that we might have read from
2333             # the pipe after the returning thread has written to it but before
2334             # it has returned. We'll grab the actual $thread object and
2335             # forcibly ->join it here to ensure we wait for its result.
2336              
2337 0         0 foreach my $tid ( unpack "N*", $buffer ) {
2338 0 0       0 my ( $thread, $on_joined ) = @{ delete $threadwatches->{$tid} }
  0         0  
2339             or die "ARGH: Can't find threadwatch for tid $tid\n";
2340 0         0 $on_joined->( $thread->join );
2341 0         0 delete $threads_to_detach{$tid};
2342             }
2343             }
2344 0         0 );
2345             }
2346              
2347 0         0 my $wr = $self->{thread_join_pipe};
2348              
2349 0   0     0 my $context = $params{context} || "scalar";
2350              
2351             my ( $thread ) = threads->create(
2352             sub {
2353 0     0   0 my ( @ret, $died );
2354 0 0       0 eval {
2355 0 0       0 $context eq "list" ? ( @ret = $code->() ) :
    0          
2356             $context eq "scalar" ? ( $ret[0] = $code->() ) :
2357             $code->();
2358 0         0 1;
2359             } or $died = $@;
2360              
2361 0         0 $wr->syswrite( pack "N", threads->tid );
2362              
2363 0 0       0 return died => $died if $died;
2364 0         0 return return => @ret;
2365             }
2366 0         0 );
2367              
2368 0         0 $threadwatches->{$thread->tid} = [ $thread, $on_joined ];
2369 0         0 weaken( $threads_to_detach{$thread->tid} = $thread );
2370              
2371 0         0 return $thread->tid;
2372             }
2373              
2374             =head1 LOW-LEVEL METHODS
2375              
2376             As C is an abstract base class, specific subclasses of it are
2377             required to implement certain methods that form the base level of
2378             functionality. They are not recommended for applications to use; see instead
2379             the various event objects or higher level methods listed above.
2380              
2381             These methods should be considered as part of the interface contract required
2382             to implement a C subclass.
2383              
2384             =cut
2385              
2386             =head2 API_VERSION
2387              
2388             IO::Async::Loop->API_VERSION
2389              
2390             This method will be called by the magic constructor on the class before it is
2391             constructed, to ensure that the specific implementation will support the
2392             required API. This method should return the API version that the loop
2393             implementation supports. The magic constructor will use that class, provided
2394             it declares a version at least as new as the version documented here.
2395              
2396             The current API version is C<0.49>.
2397              
2398             This method may be implemented using C; e.g
2399              
2400             use constant API_VERSION => '0.49';
2401              
2402             =cut
2403              
2404             sub pre_wait
2405             {
2406 1275     1275 0 2579 my $self = shift;
2407             $METRICS and $self->{processing_start} and
2408 1275 100 100     6280 $METRICS->report_timer( processing_time => Time::HiRes::tv_interval $self->{processing_start} );
2409             }
2410              
2411             sub post_wait
2412             {
2413 1275     1275 0 3329 my $self = shift;
2414 1275 100       8415 $METRICS and $self->{processing_start} = [ Time::HiRes::gettimeofday ];
2415             }
2416              
2417             =head2 watch_io
2418              
2419             $loop->watch_io( %params )
2420              
2421             This method installs callback functions which will be invoked when the given
2422             IO handle becomes read- or write-ready.
2423              
2424             The C<%params> hash takes the following keys:
2425              
2426             =over 8
2427              
2428             =item handle => IO
2429              
2430             The IO handle to watch.
2431              
2432             =item on_read_ready => CODE
2433              
2434             Optional. A CODE reference to call when the handle becomes read-ready.
2435              
2436             =item on_write_ready => CODE
2437              
2438             Optional. A CODE reference to call when the handle becomes write-ready.
2439              
2440             =back
2441              
2442             There can only be one filehandle of any given fileno registered at any one
2443             time. For any one filehandle, there can only be one read-readiness and/or one
2444             write-readiness callback at any one time. Registering a new one will remove an
2445             existing one of that type. It is not required that both are provided.
2446              
2447             Applications should use a L or L instead
2448             of using this method.
2449              
2450             If the filehandle does not yet have the C flag set, it will be
2451             enabled by this method. This will ensure that any subsequent C,
2452             C, or similar will not block on the filehandle.
2453              
2454             =cut
2455              
2456             # This class specifically does NOT implement this method, so that subclasses
2457             # are forced to. The constructor will be checking....
2458             sub __watch_io
2459             {
2460 791     791   1858 my $self = shift;
2461 791         4116 my %params = @_;
2462              
2463 791 50       3095 my $handle = delete $params{handle} or croak "Expected 'handle'";
2464 791 50       1644 defined eval { $handle->fileno } or croak "Expected that 'handle' has defined ->fileno";
  791         2686  
2465              
2466             # Silent "upgrade" to O_NONBLOCK
2467 791 100       11354 $handle->blocking and $handle->blocking(0);
2468              
2469 791   100     5368 my $watch = ( $self->{iowatches}->{$handle->fileno} ||= [] );
2470              
2471 791         16405 $watch->[0] = $handle;
2472              
2473 791 100       2325 if( exists $params{on_read_ready} ) {
2474 696         1688 $watch->[1] = delete $params{on_read_ready};
2475             }
2476              
2477 791 100       2088 if( exists $params{on_write_ready} ) {
2478 97         540 $watch->[2] = delete $params{on_write_ready};
2479             }
2480              
2481 791 100       1953 if( exists $params{on_hangup} ) {
2482 2 50       6 $self->_CAN_ON_HANGUP or croak "Cannot watch_io for 'on_hangup' in ".ref($self);
2483 2         5 $watch->[3] = delete $params{on_hangup};
2484             }
2485              
2486 791 50       3607 keys %params and croak "Unrecognised keys for ->watch_io - " . join( ", ", keys %params );
2487             }
2488              
2489             =head2 unwatch_io
2490              
2491             $loop->unwatch_io( %params )
2492              
2493             This method removes a watch on an IO handle which was previously installed by
2494             C.
2495              
2496             The C<%params> hash takes the following keys:
2497              
2498             =over 8
2499              
2500             =item handle => IO
2501              
2502             The IO handle to remove the watch for.
2503              
2504             =item on_read_ready => BOOL
2505              
2506             If true, remove the watch for read-readiness.
2507              
2508             =item on_write_ready => BOOL
2509              
2510             If true, remove the watch for write-readiness.
2511              
2512             =back
2513              
2514             Either or both callbacks may be removed at once. It is not an error to attempt
2515             to remove a callback that is not present. If both callbacks were provided to
2516             the C method and only one is removed by this method, the other shall
2517             remain.
2518              
2519             =cut
2520              
2521             sub __unwatch_io
2522             {
2523 714     714   1303 my $self = shift;
2524 714         3280 my %params = @_;
2525              
2526 714 50       2799 my $handle = delete $params{handle} or croak "Expected 'handle'";
2527              
2528 714 100       3528 my $watch = $self->{iowatches}->{$handle->fileno} or return;
2529              
2530 679 100       7272 if( delete $params{on_read_ready} ) {
2531 592         1399 undef $watch->[1];
2532             }
2533              
2534 679 100       1755 if( delete $params{on_write_ready} ) {
2535 89         265 undef $watch->[2];
2536             }
2537              
2538 679 100       1844 if( delete $params{on_hangup} ) {
2539 2 50       8 $self->_CAN_ON_HANGUP or croak "Cannot watch_io for 'on_hangup' in ".ref($self);
2540 2         9 undef $watch->[3];
2541             }
2542              
2543 679 50 100     6570 if( not $watch->[1] and not $watch->[2] and not $watch->[3] ) {
      66        
2544 666         2379 delete $self->{iowatches}->{$handle->fileno};
2545             }
2546              
2547 679 50       6083 keys %params and croak "Unrecognised keys for ->unwatch_io - " . join( ", ", keys %params );
2548             }
2549              
2550             =head2 watch_signal
2551              
2552             $loop->watch_signal( $signal, $code )
2553              
2554             This method adds a new signal handler to watch the given signal.
2555              
2556             =over 8
2557              
2558             =item $signal
2559              
2560             The name of the signal to watch to. This should be a bare name like C.
2561              
2562             =item $code
2563              
2564             A CODE reference to the handling callback.
2565              
2566             =back
2567              
2568             There can only be one callback per signal name. Registering a new one will
2569             remove an existing one.
2570              
2571             Applications should use a L object, or call
2572             C instead of using this method.
2573              
2574             This and C are optional; a subclass may implement neither, or
2575             both. If it implements neither then signal handling will be performed by the
2576             base class using a self-connected pipe to interrupt the main IO blocking.
2577              
2578             =cut
2579              
2580             sub watch_signal
2581             {
2582 68     68 1 255 my $self = shift;
2583 68         302 my ( $signal, $code ) = @_;
2584              
2585 68         199 HAVE_SIGNALS or croak "This OS cannot ->watch_signal";
2586              
2587 68         3741 IO::Async::OS->loop_watch_signal( $self, $signal, $code );
2588             }
2589              
2590             =head2 unwatch_signal
2591              
2592             $loop->unwatch_signal( $signal )
2593              
2594             This method removes the signal callback for the given signal.
2595              
2596             =over 8
2597              
2598             =item $signal
2599              
2600             The name of the signal to watch to. This should be a bare name like C.
2601              
2602             =back
2603              
2604             =cut
2605              
2606             sub unwatch_signal
2607             {
2608 9     9 1 29 my $self = shift;
2609 9         4473 my ( $signal ) = @_;
2610              
2611 9         22 HAVE_SIGNALS or croak "This OS cannot ->unwatch_signal";
2612              
2613 9         137 IO::Async::OS->loop_unwatch_signal( $self, $signal );
2614             }
2615              
2616             =head2 watch_time
2617              
2618             $id = $loop->watch_time( %args )
2619              
2620             This method installs a callback which will be called at the specified time.
2621             The time may either be specified as an absolute value (the C key), or
2622             as a delay from the time it is installed (the C key).
2623              
2624             The returned C<$id> value can be used to identify the timer in case it needs
2625             to be cancelled by the C method. Note that this value may be
2626             an object reference, so if it is stored, it should be released after it has
2627             been fired or cancelled, so the object itself can be freed.
2628              
2629             The C<%params> hash takes the following keys:
2630              
2631             =over 8
2632              
2633             =item at => NUM
2634              
2635             The absolute system timestamp to run the event.
2636              
2637             =item after => NUM
2638              
2639             The delay after now at which to run the event, if C is not supplied. A
2640             zero or negative delayed timer should be executed as soon as possible; the
2641             next time the C method is invoked.
2642              
2643             =item now => NUM
2644              
2645             The time to consider as now if calculating an absolute time based on C;
2646             defaults to C if not specified.
2647              
2648             =item code => CODE
2649              
2650             CODE reference to the continuation to run at the allotted time.
2651              
2652             =back
2653              
2654             Either one of C or C is required.
2655              
2656             For more powerful timer functionality as a L (so it can
2657             be used as a child within another Notifier), see instead the
2658             L object and its subclasses.
2659              
2660             These C<*_time> methods are optional; a subclass may implement neither or both
2661             of them. If it implements neither, then the base class will manage a queue of
2662             timer events. This queue should be handled by the C method
2663             implemented by the subclass, using the C<_adjust_timeout> and
2664             C<_manage_queues> methods.
2665              
2666             This is the newer version of the API, replacing C. It is
2667             unspecified how this method pair interacts with the older
2668             C triplet.
2669              
2670             =cut
2671              
2672             sub watch_time
2673             {
2674 593     593 1 2843 my $self = shift;
2675 593         5302 my %args = @_;
2676              
2677             # Renamed args
2678 593 100       2314 if( exists $args{after} ) {
    50          
2679 541         3205 $args{delay} = delete $args{after};
2680             }
2681             elsif( exists $args{at} ) {
2682 52         199 $args{time} = delete $args{at};
2683             }
2684             else {
2685 0         0 croak "Expected one of 'at' or 'after'";
2686             }
2687              
2688 593 50       2219 if( $self->{old_timer} ) {
2689 0         0 $self->enqueue_timer( %args );
2690             }
2691             else {
2692 593   66     4774 my $timequeue = $self->{timequeue} ||= $self->__new_feature( "IO::Async::Internals::TimeQueue" );
2693              
2694 593         7016 my $time = $self->_build_time( %args );
2695 593         1346 my $code = $args{code};
2696              
2697 593         8332 $timequeue->enqueue( time => $time, code => $code );
2698             }
2699             }
2700              
2701             =head2 unwatch_time
2702              
2703             $loop->unwatch_time( $id )
2704              
2705             Removes a timer callback previously created by C.
2706              
2707             This is the newer version of the API, replacing C. It is
2708             unspecified how this method pair interacts with the older
2709             C triplet.
2710              
2711             =cut
2712              
2713             sub unwatch_time
2714             {
2715 525     525 1 1218 my $self = shift;
2716 525         1280 my ( $id ) = @_;
2717              
2718 525 50       1633 if( $self->{old_timer} ) {
2719 0         0 $self->cancel_timer( $id );
2720             }
2721             else {
2722 525   33     1697 my $timequeue = $self->{timequeue} ||= $self->__new_feature( "IO::Async::Internals::TimeQueue" );
2723              
2724 525         2292 $timequeue->cancel( $id );
2725             }
2726             }
2727              
2728             sub _build_time
2729             {
2730 593     593   2412 my $self = shift;
2731 593         2260 my %params = @_;
2732              
2733 593         1114 my $time;
2734 593 100       2913 if( exists $params{time} ) {
    50          
2735 52         123 $time = $params{time};
2736             }
2737             elsif( exists $params{delay} ) {
2738 541 50       4683 my $now = exists $params{now} ? $params{now} : $self->time;
2739              
2740 541         1938 $time = $now + $params{delay};
2741             }
2742             else {
2743 0         0 croak "Expected either 'time' or 'delay' keys";
2744             }
2745              
2746 593         1658 return $time;
2747             }
2748              
2749             =head2 enqueue_timer
2750              
2751             $id = $loop->enqueue_timer( %params )
2752              
2753             An older version of C. This method should not be used in new code
2754             but is retained for legacy purposes. For simple watch/unwatch behaviour use
2755             instead the new C method; though note it has differently-named
2756             arguments. For requeueable timers, consider using an
2757             L or L instead.
2758              
2759             =cut
2760              
2761             sub enqueue_timer
2762             {
2763 0     0 1 0 my $self = shift;
2764 0         0 my ( %params ) = @_;
2765              
2766             # Renamed args
2767 0 0       0 $params{after} = delete $params{delay} if exists $params{delay};
2768 0 0       0 $params{at} = delete $params{time} if exists $params{time};
2769              
2770 0         0 my $code = $params{code};
2771 0         0 return [ $self->watch_time( %params ), $code ];
2772             }
2773              
2774             =head2 cancel_timer
2775              
2776             $loop->cancel_timer( $id )
2777              
2778             An older version of C. This method should not be used in new
2779             code but is retained for legacy purposes.
2780              
2781             =cut
2782              
2783             sub cancel_timer
2784             {
2785 0     0 1 0 my $self = shift;
2786 0         0 my ( $id ) = @_;
2787 0         0 $self->unwatch_time( $id->[0] );
2788             }
2789              
2790             =head2 requeue_timer
2791              
2792             $newid = $loop->requeue_timer( $id, %params )
2793              
2794             Reschedule an existing timer, moving it to a new time. The old timer is
2795             removed and will not be invoked.
2796              
2797             The C<%params> hash takes the same keys as C, except for the
2798             C argument.
2799              
2800             The requeue operation may be implemented as a cancel + enqueue, which may
2801             mean the ID changes. Be sure to store the returned C<$newid> value if it is
2802             required.
2803              
2804             This method should not be used in new code but is retained for legacy
2805             purposes. For requeueable, consider using an L or
2806             L instead.
2807              
2808             =cut
2809              
2810             sub requeue_timer
2811             {
2812 0     0 1 0 my $self = shift;
2813 0         0 my ( $id, %params ) = @_;
2814              
2815 0         0 $self->unwatch_time( $id->[0] );
2816 0         0 return $self->enqueue_timer( %params, code => $id->[1] );
2817             }
2818              
2819             =head2 watch_idle
2820              
2821             $id = $loop->watch_idle( %params )
2822              
2823             This method installs a callback which will be called at some point in the near
2824             future.
2825              
2826             The C<%params> hash takes the following keys:
2827              
2828             =over 8
2829              
2830             =item when => STRING
2831              
2832             Specifies the time at which the callback will be invoked. See below.
2833              
2834             =item code => CODE
2835              
2836             CODE reference to the continuation to run at the allotted time.
2837              
2838             =back
2839              
2840             The C parameter defines the time at which the callback will later be
2841             invoked. Must be one of the following values:
2842              
2843             =over 8
2844              
2845             =item later
2846              
2847             Callback is invoked after the current round of IO events have been processed
2848             by the loop's underlying C method.
2849              
2850             If a new idle watch is installed from within a C callback, the
2851             installed one will not be invoked during this round. It will be deferred for
2852             the next time C is called, after any IO events have been handled.
2853              
2854             =back
2855              
2856             If there are pending idle handlers, then the C method will use a
2857             zero timeout; it will return immediately, having processed any IO events and
2858             idle handlers.
2859              
2860             The returned C<$id> value can be used to identify the idle handler in case it
2861             needs to be removed, by calling the C method. Note this value
2862             may be a reference, so if it is stored it should be released after the
2863             callback has been invoked or cancled, so the referrant itself can be freed.
2864              
2865             This and C are optional; a subclass may implement neither, or
2866             both. If it implements neither then idle handling will be performed by the
2867             base class, using the C<_adjust_timeout> and C<_manage_queues> methods.
2868              
2869             =cut
2870              
2871             sub watch_idle
2872             {
2873 59     59 1 163 my $self = shift;
2874 59         408 my %params = @_;
2875              
2876 59         211 my $code = delete $params{code};
2877 59 50       363 ref $code or croak "Expected 'code' to be a reference";
2878              
2879 59 50       384 my $when = delete $params{when} or croak "Expected 'when'";
2880              
2881             # Future-proofing for other idle modes
2882 59 50       242 $when eq "later" or croak "Expected 'when' to be 'later'";
2883              
2884 59         147 my $deferrals = $self->{deferrals};
2885              
2886 59         138 push @$deferrals, $code;
2887 59         204 return \$deferrals->[-1];
2888             }
2889              
2890             =head2 unwatch_idle
2891              
2892             $loop->unwatch_idle( $id )
2893              
2894             Cancels a previously-installed idle handler.
2895              
2896             =cut
2897              
2898             sub unwatch_idle
2899             {
2900 3     3 1 7 my $self = shift;
2901 3         8 my ( $id ) = @_;
2902              
2903 3         7 my $deferrals = $self->{deferrals};
2904              
2905 3         6 my $idx;
2906 3   66     54 \$deferrals->[$_] == $id and ( $idx = $_ ), last for 0 .. $#$deferrals;
2907              
2908 3 50       52 splice @$deferrals, $idx, 1, () if defined $idx;
2909             }
2910              
2911             sub _reap_children
2912             {
2913 295     295   1376 my ( $childwatches ) = @_;
2914              
2915 295         725 while( 1 ) {
2916 590         17356 my $zid = waitpid( -1, WNOHANG );
2917              
2918             # PIDs on MSWin32 can be negative
2919 590 100 66     8651 last if !defined $zid or $zid == 0 or $zid == -1;
      100        
2920 295         3811 my $status = $?;
2921              
2922 295 100       1945 if( defined $childwatches->{$zid} ) {
2923 283         1930 $childwatches->{$zid}->( $zid, $status );
2924 283         12972 delete $childwatches->{$zid};
2925             }
2926              
2927 295 100       1547 if( defined $childwatches->{0} ) {
2928 14         92 $childwatches->{0}->( $zid, $status );
2929             # Don't delete it
2930             }
2931             }
2932             }
2933              
2934             =head2 watch_process
2935              
2936             $loop->watch_process( $pid, $code )
2937              
2938             This method adds a new handler for the termination of the given child process
2939             PID, or all child processes.
2940              
2941             =over 8
2942              
2943             =item $pid
2944              
2945             The PID to watch. Will report on all child processes if this is 0.
2946              
2947             =item $code
2948              
2949             A CODE reference to the exit handler. It will be invoked as
2950              
2951             $code->( $pid, $? )
2952              
2953             The second argument is passed the plain perl C<$?> value.
2954              
2955             =back
2956              
2957             After invocation, the handler for a PID-specific watch is automatically
2958             removed. The all-child watch will remain until it is removed by
2959             C.
2960              
2961             This and C are optional; a subclass may implement neither, or
2962             both. If it implements neither then child watching will be performed by using
2963             C to install a C handler, which will use C to
2964             look for exited child processes.
2965              
2966             If both a PID-specific and an all-process watch are installed, there is no
2967             ordering guarantee as to which will be called first.
2968              
2969             B that not all loop classes may be able to support the all-child watch.
2970             The basic Select and Poll-based classes provided by this distribution do, and
2971             those built on top of similar OS-specific mechanisms such as Linux's Epoll
2972             probably will, but typically those built on top of other event systems such
2973             as F or F may not be able, as the underlying event system may not
2974             provide the necessary hooks to support it.
2975              
2976             =cut
2977              
2978             sub watch_process
2979             {
2980 338     338 1 1339 my $self = shift;
2981 338         2603 my ( $pid, $code ) = @_;
2982              
2983 338 50 50     11920 if( $self->API_VERSION < 0.76 and
      33        
2984             ( $self->can( "watch_child" ) // 0 ) != \&watch_child ) {
2985             # Invoke legacy loop API
2986 0         0 return $self->watch_child( @_ );
2987             }
2988              
2989 338         1932 my $childwatches = $self->{childwatches};
2990              
2991 338 50       28662 croak "Already have a handler for $pid" if exists $childwatches->{$pid};
2992              
2993 338 100       2357 if( HAVE_SIGNALS and !$self->{childwatch_sigid} ) {
2994             $self->{childwatch_sigid} = $self->attach_signal(
2995 295     295   2373 CHLD => sub { _reap_children( $childwatches ) }
2996 55         2981 );
2997              
2998             # There's a chance the child has already exited
2999 55         1633 my $zid = waitpid( $pid, WNOHANG );
3000 55 100 66     969 if( defined $zid and $zid > 0 ) {
3001 36         469 my $exitstatus = $?;
3002 36     36   866 $self->later( sub { $code->( $pid, $exitstatus ) } );
  36         169  
3003 36         137 return;
3004             }
3005             }
3006              
3007 302         4790 $childwatches->{$pid} = $code;
3008             }
3009              
3010             # Old name
3011 2     2 0 56 sub watch_child { shift->watch_process( @_ ) }
3012              
3013             =head2 unwatch_process
3014              
3015             $loop->unwatch_process( $pid )
3016              
3017             This method removes a watch on an existing child process PID.
3018              
3019             =cut
3020              
3021             sub unwatch_process
3022             {
3023 2     2 1 4 my $self = shift;
3024 2         5 my ( $pid ) = @_;
3025              
3026 2 50 50     71 if( $self->API_VERSION < 0.76 and
      33        
3027             ( $self->can( "unwatch_child" ) // 0 ) != \&unwatch_child ) {
3028             # Invoke legacy loop API
3029 0         0 return $self->unwatch_child( @_ );
3030             }
3031              
3032 2         9 my $childwatches = $self->{childwatches};
3033              
3034 2         7 delete $childwatches->{$pid};
3035              
3036 2 50       8 if( HAVE_SIGNALS and !keys %$childwatches ) {
3037 2         12 $self->detach_signal( CHLD => delete $self->{childwatch_sigid} );
3038             }
3039             }
3040              
3041             # Old name
3042 0     0 0 0 sub unwatch_child { shift->unwatch_process( @_ ) }
3043              
3044             =head1 METHODS FOR SUBCLASSES
3045              
3046             The following methods are provided to access internal features which are
3047             required by specific subclasses to implement the loop functionality. The use
3048             cases of each will be documented in the above section.
3049              
3050             =cut
3051              
3052             =head2 _adjust_timeout
3053              
3054             $loop->_adjust_timeout( \$timeout )
3055              
3056             Shortens the timeout value passed in the scalar reference if it is longer in
3057             seconds than the time until the next queued event on the timer queue. If there
3058             are pending idle handlers, the timeout is reduced to zero.
3059              
3060             =cut
3061              
3062             sub _adjust_timeout
3063             {
3064 1281     1281   2726 my $self = shift;
3065 1281         2988 my ( $timeref, %params ) = @_;
3066              
3067 1281 100       2263 $$timeref = 0, return if @{ $self->{deferrals} };
  1281         5569  
3068              
3069 1228 50 33     5437 if( defined $self->{sigproxy} and !$params{no_sigwait} ) {
3070 0 0 0     0 $$timeref = $MAX_SIGWAIT_TIME if !defined $$timeref or $$timeref > $MAX_SIGWAIT_TIME;
3071             }
3072 1228         2320 if( !HAVE_SIGNALS and keys %{ $self->{childwatches} } ) {
3073             $$timeref = $MAX_CHILDWAIT_TIME if !defined $$timeref or $$timeref > $MAX_CHILDWAIT_TIME;
3074             }
3075              
3076 1228         3063 my $timequeue = $self->{timequeue};
3077 1228 100       4723 return unless defined $timequeue;
3078              
3079 1079         5591 my $nexttime = $timequeue->next_time;
3080 1079 100       7493 return unless defined $nexttime;
3081              
3082 1053 50       4517 my $now = exists $params{now} ? $params{now} : $self->time;
3083 1053         3130 my $timer_delay = $nexttime - $now;
3084              
3085 1053 100 100     11560 if( $timer_delay < 0 ) {
    100          
3086 3         10 $$timeref = 0;
3087             }
3088             elsif( !defined $$timeref or $timer_delay < $$timeref ) {
3089 67         235 $$timeref = $timer_delay;
3090             }
3091             }
3092              
3093             =head2 _manage_queues
3094              
3095             $loop->_manage_queues
3096              
3097             Checks the timer queue for callbacks that should have been invoked by now, and
3098             runs them all, removing them from the queue. It also invokes all of the
3099             pending idle handlers. Any new idle handlers installed by these are not
3100             invoked yet; they will wait for the next time this method is called.
3101              
3102             =cut
3103              
3104             sub _manage_queues
3105             {
3106 1281     1281   2763 my $self = shift;
3107              
3108 1281         2425 my $count = 0;
3109              
3110 1281         3066 my $timequeue = $self->{timequeue};
3111 1281 100       8119 $count += $timequeue->fire if $timequeue;
3112              
3113 1279         3237 my $deferrals = $self->{deferrals};
3114 1279         3200 $self->{deferrals} = [];
3115              
3116 1279         5946 foreach my $code ( @$deferrals ) {
3117 56         241 $code->();
3118 56         477 $count++;
3119             }
3120              
3121 1279         3135 my $childwatches = $self->{childwatches};
3122 1279         2121 if( !HAVE_SIGNALS and keys %$childwatches ) {
3123             _reap_children( $childwatches );
3124             }
3125              
3126 1279         3981 return $count;
3127             }
3128              
3129             =head1 EXTENSIONS
3130              
3131             An Extension is a Perl module that provides extra methods in the
3132             C or other packages. They are intended to provide extra
3133             functionality that easily integrates with the rest of the code.
3134              
3135             Certain base methods take an C parameter; an ARRAY reference
3136             containing a list of extension names. If such a list is passed to a method, it
3137             will immediately call a method whose name is that of the base method, prefixed
3138             by the first extension name in the list, separated by C<_>. If the
3139             C list contains more extension names, it will be passed the
3140             remaining ones in another C parameter.
3141              
3142             For example,
3143              
3144             $loop->connect(
3145             extensions => [qw( FOO BAR )],
3146             %args
3147             )
3148              
3149             will become
3150              
3151             $loop->FOO_connect(
3152             extensions => [qw( BAR )],
3153             %args
3154             )
3155              
3156             This is provided so that extension modules, such as L can
3157             easily be invoked indirectly, by passing extra arguments to C methods
3158             or similar, without needing every module to be aware of the C extension.
3159             This functionality is generic and not limited to C; other extensions may
3160             also use it.
3161              
3162             The following methods take an C parameter:
3163              
3164             $loop->connect
3165             $loop->listen
3166              
3167             If an extension C method is invoked, it will be passed a C
3168             parameter even if one was not provided to the original C<< $loop->listen >>
3169             call, and it will not receive any of the C event callbacks. It should
3170             use the C parameter on the C object.
3171              
3172             =cut
3173              
3174             =head1 STALL WATCHDOG
3175              
3176             A well-behaved L program should spend almost all of its time
3177             blocked on input using the underlying C instance. The stall
3178             watchdog is an optional debugging feature to help detect CPU spinlocks and
3179             other bugs, where control is not returned to the loop every so often.
3180              
3181             If the watchdog is enabled and an event handler consumes more than a given
3182             amount of real time before returning to the event loop, it will be interrupted
3183             by printing a stack trace and terminating the program. The watchdog is only in
3184             effect while the loop itself is not blocking; it won't fail simply because the
3185             loop instance is waiting for input or timers.
3186              
3187             It is implemented using C, so if enabled, this signal will no longer
3188             be available to user code. (Though in any case, most uses of C and
3189             C are better served by one of the L subclasses).
3190              
3191             The following environment variables control its behaviour.
3192              
3193             =over 4
3194              
3195             =item IO_ASYNC_WATCHDOG => BOOL
3196              
3197             Enables the stall watchdog if set to a non-zero value.
3198              
3199             =item IO_ASYNC_WATCHDOG_INTERVAL => INT
3200              
3201             Watchdog interval, in seconds, to pass to the C call. Defaults to 10
3202             seconds.
3203              
3204             =item IO_ASYNC_WATCHDOG_SIGABRT => BOOL
3205              
3206             If enabled, the watchdog signal handler will raise a C, which usually
3207             has the effect of breaking out of a running program in debuggers such as
3208             F. If not set then the process is terminated by throwing an exception with
3209             C.
3210              
3211             =back
3212              
3213             =cut
3214              
3215             =head1 AUTHOR
3216              
3217             Paul Evans
3218              
3219             =cut
3220              
3221             0x55AA;