File Coverage

blib/lib/IO/Async/PID.pm

Criterion	Covered	Total	%
statement	43	46	93.4
branch	8	16	50.0
condition	1	3	33.3
subroutine	11	11	100.0
pod	4	4	100.0
total	67	80	83.7

#  You may distribute under the terms of either the GNU General Public License
#  or the Artistic License (the same terms as Perl itself)
#
#  (C) Paul Evans, 2010-2011 -- [e-mail]

package IO::Async::PID;

use strict;
use warnings;
use base qw( IO::Async::Notifier );

our $VERSION = '0.801';

use Carp;

=head1 NAME

C - event callback on exit of a child process

=head1 SYNOPSIS

   use IO::Async::PID;
   use POSIX qw( WEXITSTATUS );

   use IO::Async::Loop;
   my $loop = IO::Async::Loop->new;

   my $kid = $loop->fork(
      code => sub {
         print "Child sleeping..\n";
         sleep 10;
         print "Child exiting\n";
         return 20;
      },
   );

   print "Child process $kid started\n";

   my $pid = IO::Async::PID->new(
      pid => $kid,

      on_exit => sub {
         my ( $self, $exitcode ) = @_;
         printf "Child process %d exited with status %d\n",
            $self->pid, WEXITSTATUS($exitcode);
      },
   );

   $loop->add( $pid );

   $loop->run;

=head1 DESCRIPTION

This subclass of L invokes its callback when a process
exits.

For most use cases, a L object provides more control of
setting up the process, connecting filehandles to it, sending data to and
receiving data from it.

=cut

=head1 EVENTS

The following events are invoked, either using subclass methods or CODE
references in parameters:

=head2 on_exit $exitcode

Invoked when the watched process exits.

=cut

=head1 PARAMETERS

The following named parameters may be passed to C or C:

=head2 pid => INT

The process ID to watch. Must be given before the object has been added to the
containing L object.

=head2 on_exit => CODE

CODE reference for the C event.

Once the C continuation has been invoked, the C
object is removed from the containing L object.

=cut

sub configure
{
   my $self = shift;
   my %params = @_;

   if( exists $params{pid} ) {
      $self->loop and croak "Cannot configure 'pid' after adding to Loop";
      $self->{pid} = delete $params{pid};
   }

   if( exists $params{on_exit} ) {
      $self->{on_exit} = delete $params{on_exit};

      undef $self->{cb};

      if( my $loop = $self->loop ) {
         $self->_remove_from_loop( $loop );
         $self->_add_to_loop( $loop );
      }
   }

   $self->SUPER::configure( %params );
}

sub _add_to_loop
{
   my $self = shift;
   my ( $loop ) = @_;

   $self->pid or croak "Require a 'pid' in $self";

   $self->SUPER::_add_to_loop( @_ );

   # on_exit continuation gets passed PID value; need to replace that with
   # $self
   $self->{cb} ||= $self->_replace_weakself( sub {
      my $self = shift or return;
      my ( $exitcode ) = @_;

      $self->invoke_event( on_exit => $exitcode );

      # Since this is a oneshot, we'll have to remove it from the loop or
      # parent Notifier
      $self->remove_from_parent;
   } );

   $loop->watch_process( $self->pid, $self->{cb} );
}

sub _remove_from_loop
{
   my $self = shift;
   my ( $loop ) = @_;

   $loop->unwatch_process( $self->pid );
}

sub notifier_name
{
   my $self = shift;
   if( length( my $name = $self->SUPER::notifier_name ) ) {
      return $name;
   }

   return $self->{pid};
}

=head1 METHODS

=cut

=head2 pid

   $process_id = $pid->pid

Returns the underlying process ID

=cut

sub pid
{
   my $self = shift;
   return $self->{pid};
}

=head2 kill

   $pid->kill( $signal )

Sends a signal to the process

=cut

sub kill
{
   my $self = shift;
   my ( $signal ) = @_;

   kill $signal, $self->pid or croak "Cannot kill() - $!";
}

=head1 AUTHOR

Paul Evans

=cut

0x55AA;