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, 2010-2011 -- leonerd@leonerd.org.uk 5 6package IO::Async::PID; 7 8use strict; 9use warnings; 10use base qw( IO::Async::Notifier ); 11 12our $VERSION = '0.800'; 13 14use Carp; 15 16=head1 NAME 17 18C<IO::Async::PID> - event callback on exit of a child process 19 20=head1 SYNOPSIS 21 22 use IO::Async::PID; 23 use POSIX qw( WEXITSTATUS ); 24 25 use IO::Async::Loop; 26 my $loop = IO::Async::Loop->new; 27 28 my $kid = $loop->fork( 29 code => sub { 30 print "Child sleeping..\n"; 31 sleep 10; 32 print "Child exiting\n"; 33 return 20; 34 }, 35 ); 36 37 print "Child process $kid started\n"; 38 39 my $pid = IO::Async::PID->new( 40 pid => $kid, 41 42 on_exit => sub { 43 my ( $self, $exitcode ) = @_; 44 printf "Child process %d exited with status %d\n", 45 $self->pid, WEXITSTATUS($exitcode); 46 }, 47 ); 48 49 $loop->add( $pid ); 50 51 $loop->run; 52 53=head1 DESCRIPTION 54 55This subclass of L<IO::Async::Notifier> invokes its callback when a process 56exits. 57 58For most use cases, a L<IO::Async::Process> object provides more control of 59setting up the process, connecting filehandles to it, sending data to and 60receiving data from it. 61 62=cut 63 64=head1 EVENTS 65 66The following events are invoked, either using subclass methods or CODE 67references in parameters: 68 69=head2 on_exit $exitcode 70 71Invoked when the watched process exits. 72 73=cut 74 75=head1 PARAMETERS 76 77The following named parameters may be passed to C<new> or C<configure>: 78 79=head2 pid => INT 80 81The process ID to watch. Must be given before the object has been added to the 82containing L<IO::Async::Loop> object. 83 84=head2 on_exit => CODE 85 86CODE reference for the C<on_exit> event. 87 88Once the C<on_exit> continuation has been invoked, the C<IO::Async::PID> 89object is removed from the containing L<IO::Async::Loop> object. 90 91=cut 92 93sub configure 94{ 95 my $self = shift; 96 my %params = @_; 97 98 if( exists $params{pid} ) { 99 $self->loop and croak "Cannot configure 'pid' after adding to Loop"; 100 $self->{pid} = delete $params{pid}; 101 } 102 103 if( exists $params{on_exit} ) { 104 $self->{on_exit} = delete $params{on_exit}; 105 106 undef $self->{cb}; 107 108 if( my $loop = $self->loop ) { 109 $self->_remove_from_loop( $loop ); 110 $self->_add_to_loop( $loop ); 111 } 112 } 113 114 $self->SUPER::configure( %params ); 115} 116 117sub _add_to_loop 118{ 119 my $self = shift; 120 my ( $loop ) = @_; 121 122 $self->pid or croak "Require a 'pid' in $self"; 123 124 $self->SUPER::_add_to_loop( @_ ); 125 126 # on_exit continuation gets passed PID value; need to replace that with 127 # $self 128 $self->{cb} ||= $self->_replace_weakself( sub { 129 my $self = shift or return; 130 my ( $exitcode ) = @_; 131 132 $self->invoke_event( on_exit => $exitcode ); 133 134 # Since this is a oneshot, we'll have to remove it from the loop or 135 # parent Notifier 136 $self->remove_from_parent; 137 } ); 138 139 $loop->watch_process( $self->pid, $self->{cb} ); 140} 141 142sub _remove_from_loop 143{ 144 my $self = shift; 145 my ( $loop ) = @_; 146 147 $loop->unwatch_process( $self->pid ); 148} 149 150sub notifier_name 151{ 152 my $self = shift; 153 if( length( my $name = $self->SUPER::notifier_name ) ) { 154 return $name; 155 } 156 157 return $self->{pid}; 158} 159 160=head1 METHODS 161 162=cut 163 164=head2 pid 165 166 $process_id = $pid->pid 167 168Returns the underlying process ID 169 170=cut 171 172sub pid 173{ 174 my $self = shift; 175 return $self->{pid}; 176} 177 178=head2 kill 179 180 $pid->kill( $signal ) 181 182Sends a signal to the process 183 184=cut 185 186sub kill 187{ 188 my $self = shift; 189 my ( $signal ) = @_; 190 191 kill $signal, $self->pid or croak "Cannot kill() - $!"; 192} 193 194=head1 AUTHOR 195 196Paul Evans <leonerd@leonerd.org.uk> 197 198=cut 199 2000x55AA; 201