File Coverage

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