Acme-Sort-Sleep
view release on metacpan or search on metacpan
local/lib/perl5/IO/Async/Loop.pm view on Meta::CPAN
my $status = $?;
if( defined $childwatches->{$zid} ) {
$childwatches->{$zid}->( $zid, $status );
delete $childwatches->{$zid};
}
if( defined $childwatches->{0} ) {
$childwatches->{0}->( $zid, $status );
# Don't delete it
}
}
}
=head2 watch_child
$loop->watch_child( $pid, $code )
This method adds a new handler for the termination of the given child process
PID, or all child processes.
=over 8
=item $pid
The PID to watch. Will report on all child processes if this is 0.
=item $code
A CODE reference to the exit handler. It will be invoked as
$code->( $pid, $? )
The second argument is passed the plain perl C<$?> value.
=back
After invocation, the handler for a PID-specific watch is automatically
removed. The all-child watch will remain until it is removed by
C<unwatch_child>.
This and C<unwatch_child> are optional; a subclass may implement neither, or
both. If it implements neither then child watching will be performed by using
C<watch_signal> to install a C<SIGCHLD> handler, which will use C<waitpid> to
look for exited child processes.
If both a PID-specific and an all-process watch are installed, there is no
ordering guarantee as to which will be called first.
=cut
sub watch_child
{
my $self = shift;
my ( $pid, $code ) = @_;
my $childwatches = $self->{childwatches};
croak "Already have a handler for $pid" if exists $childwatches->{$pid};
if( HAVE_SIGNALS and !$self->{childwatch_sigid} ) {
$self->{childwatch_sigid} = $self->attach_signal(
CHLD => sub { _reap_children( $childwatches ) }
);
# There's a chance the child has already exited
my $zid = waitpid( $pid, WNOHANG );
if( defined $zid and $zid > 0 ) {
my $exitstatus = $?;
$self->later( sub { $code->( $pid, $exitstatus ) } );
return;
}
}
$childwatches->{$pid} = $code;
}
=head2 unwatch_child
$loop->unwatch_child( $pid )
This method removes a watch on an existing child process PID.
=cut
sub unwatch_child
{
my $self = shift;
my ( $pid ) = @_;
my $childwatches = $self->{childwatches};
delete $childwatches->{$pid};
if( HAVE_SIGNALS and !keys %$childwatches ) {
$self->detach_signal( CHLD => delete $self->{childwatch_sigid} );
}
}
=head1 METHODS FOR SUBCLASSES
The following methods are provided to access internal features which are
required by specific subclasses to implement the loop functionality. The use
cases of each will be documented in the above section.
=cut
=head2 _adjust_timeout
$loop->_adjust_timeout( \$timeout )
Shortens the timeout value passed in the scalar reference if it is longer in
seconds than the time until the next queued event on the timer queue. If there
are pending idle handlers, the timeout is reduced to zero.
=cut
sub _adjust_timeout
{
my $self = shift;
my ( $timeref, %params ) = @_;
$$timeref = 0, return if @{ $self->{deferrals} };
if( defined $self->{sigproxy} and !$params{no_sigwait} ) {
$$timeref = $MAX_SIGWAIT_TIME if !defined $$timeref or $$timeref > $MAX_SIGWAIT_TIME;
}
if( !HAVE_SIGNALS and keys %{ $self->{childwatches} } ) {
$$timeref = $MAX_CHILDWAIT_TIME if !defined $$timeref or $$timeref > $MAX_CHILDWAIT_TIME;
}
my $timequeue = $self->{timequeue};
return unless defined $timequeue;
my $nexttime = $timequeue->next_time;
return unless defined $nexttime;
my $now = exists $params{now} ? $params{now} : $self->time;
my $timer_delay = $nexttime - $now;
if( $timer_delay < 0 ) {
$$timeref = 0;
}
elsif( !defined $$timeref or $timer_delay < $$timeref ) {
$$timeref = $timer_delay;
}
}
=head2 _manage_queues
$loop->_manage_queues
Checks the timer queue for callbacks that should have been invoked by now, and
runs them all, removing them from the queue. It also invokes all of the
pending idle handlers. Any new idle handlers installed by these are not
invoked yet; they will wait for the next time this method is called.
( run in 0.790 second using v1.01-cache-2.11-cpan-5735350b133 )