—

              
package Child::Link::Proc;
use strict;
use warnings;
use Carp;
use Carp;
use Child::Util;
use base 'Child::Link';
add_accessors qw/exit/;
sub is_complete {
    my $self = shift;
    $self->_wait();
    return defined($self->exit);
}
sub wait {
    my $self = shift;
    return unless $self->_wait(1);
    return !$self->exit;
}
sub exit_status {
    my $self = shift;
    return unless $self->is_complete;
    return ($self->exit >> 8);
}
sub unix_exit {
    my $self = shift;
    return unless $self->is_complete;
    return $self->exit;
}
sub _wait {
    my $self = shift;
    my ( $block ) = @_;
    #non-blocking to check if process was terminated
    #blocking to wait until it finishes
    unless ( defined $self->exit ) {
        my @flags;
        require POSIX unless $block;
        my $ret;
        my $x = 1;
        do {
            sleep(1) if defined $ret;
            $ret = waitpid( $self->pid, $block ? 0 : &POSIX::WNOHANG );
        } while ( $block && !$ret );
        return 0 unless $ret;
        if ($^O eq 'MSWin32') {
            croak( "wait returned $ret: No such process " . $self->pid )
                if $ret == -1; #forked threads on Win32 have negative pids
        } else {
            croak( "wait returned $ret: No such process " . $self->pid )
                if $ret < 0;
        }
        Child->_clean_proc($self);
        $self->_exit( $? );
    }
    return defined($self->exit);
}
sub kill {
    my $self = shift;
    my ( $sig ) = @_;
    kill( $sig, $self->pid );
}
1;
HideShow 93 lines of Pod
=head1 NAME
Child::Link::Proc - Proc object used by L<Child>.
=head1 SEE ALSO
This class inherits from:
=over 4
=item L<Child::Link>
=back
=head1 METHODS
=over 4
=item $bool = $proc->is_complete()
Check if the child is finished (non-blocking)
=item $proc->wait()
Wait until child terminates, destroy remaining zombie process (blocking)
=item $proc->kill($SIG)
Send the $SIG signal to the child process.
B<NOTE>: kill() is unpredictable on windows, strawberry perl sends the kill
signal to the parent as well as the child.
=item $proc->pid()
Returns the process PID.
=item $proc->exit_status()
Will be undef unless the process has exited, otherwise it will have the exit
status.
B<Note>: When you call exit($N) the actual unix exit status will be bit shifted
with extra information added. exit_status() will shift the value back for you.
That means exit_status() will return 2 when your child calls exit(2) see
unix_exit() if you want the actual value wait() assigned to $?.
=item $proc->unix_exit()
When you call exit($N) the actual unix exit status will be bit shifted
with extra information added. See exit_status() if you want the actual value
used in exit() in the child.
=back
=head1 HISTORY
Most of this was part of L<Parallel::Runner> intended for use in the L<Fennec>
project. Fennec is being broken into multiple parts, this is one such part.
=head1 FENNEC PROJECT
This module is part of the Fennec project. See L<Fennec> for more details.
Fennec is a project to develop an extendable and powerful testing framework.
Together the tools that make up the Fennec framework provide a potent testing
environment.
The tools provided by Fennec are also useful on their own. Sometimes a tool
created for Fennec is useful outside the greater framework. Such tools are
turned into their own projects. This is one such project.
=over 2
=item L<Fennec> - The core framework
The primary Fennec project that ties them all together.
=back
=head1 AUTHORS
Chad Granum L<exodist7@gmail.com>
=head1 COPYRIGHT
Copyright (C) 2010 Chad Granum
Child is free software; Standard perl licence.
Child is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
FOR A PARTICULAR PURPOSE.  See the license for more details.