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