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