File Coverage

blib/lib/System/Command/Reaper.pm

Criterion	Covered	Total	%
statement	74	78	94.8
branch	21	22	95.4
condition	27	37	72.9
subroutine	16	18	88.8
pod	3	3	100.0
total	141	158	89.2

package System::Command::Reaper;
$System::Command::Reaper::VERSION = '1.121';
use strict;
use warnings;
use 5.006;

use Carp;
use Scalar::Util qw( weaken reftype );

use POSIX ":sys_wait_h";

use constant MSWin32 => $^O eq 'MSWin32';
use constant HANDLES => qw( stdin stdout stderr );
use constant STATUS  => qw( exit signal core );

for my $attr ( HANDLES ) {
    no strict 'refs';
    *$attr = sub { return $_[0]{$attr} };
}
for my $attr ( STATUS ) {
    no strict 'refs';
    *$attr = sub { $_[0]->is_terminated(); return $_[0]{$attr} };
}

sub new {
    my ($class, $command, $o) = @_;
    $o ||= {};
    my $self = bless { %$o, command => $command }, $class;

    # copy/weaken the important keys
    @{$self}{ pid => HANDLES } = @{$command}{ pid => HANDLES };
    weaken $self->{$_} for ( command => HANDLES );

    return $self;
}

# this is necessary, because kill(0,pid) is misimplemented in perl core
my $_is_alive = MSWin32
    ? sub { return `tasklist /FO CSV /NH /fi "PID eq $_[0]"` =~ /^"/ }
    : sub { return kill 0, $_[0]; };

sub is_terminated {
    my ($self) = @_;
    my $pid = $self->{pid};

    # Zed's dead, baby. Zed's dead.
    return $pid if !$_is_alive->($pid) and exists $self->{exit};

    # If that is a re-animated body, we're gonna have to kill it.
    return $self->_reap(WNOHANG);
}

sub _reap {
    my ( $self, $flags ) = @_;

    $flags = 0 if ! defined $flags;

    my $pid = $self->{pid};

    # REPENT/THE END IS/EXTREMELY/FUCKING/NIGH
    if ( !exists $self->{exit} and my $reaped = waitpid( $pid, $flags ) ) {

        # Well, it's a puzzle because, technically, you're not alive.
        my $zed = $reaped == $pid;
        carp "Child process already reaped, check for a SIGCHLD handler"
            if !$zed && !$System::Command::QUIET && !MSWin32;

        # What do you think? "Zombie Kill of the Week"?
        @{$self}{ STATUS() }
            = $zed
            ? ( $? >> 8, $? & 127, $? & 128 )
            : ( -1, -1, -1 );

        # Who died and made you fucking king of the zombies?
        if ( defined( my $cmd = $self->{command} ) ) {
            @{$cmd}{ STATUS() } = @{$self}{ STATUS() };

            # I know you're here, because I can smell your brains.
            my $o = $cmd->{options};
            defined reftype( $o->{$_} )
              and reftype( $o->{$_} ) eq 'SCALAR'
              and ${ $o->{$_} } = $self->{$_}
              for STATUS();
        }

        # I think it's safe to assume it isn't a zombie.
        print { $self->{th} } "System::Command xit[$pid]: ",
          join( ', ', map "$_: $self->{$_}", STATUS() ), "\n"
          if $self->{trace};

        return $reaped;    # It's dead, Jim!
    }

    # Look! It's moving. It's alive. It's alive...
    return;
}

sub close {
    my ($self) = @_;

    # close all pipes
    my ( $in, $out, $err ) = @{$self}{qw( stdin stdout stderr )};
    $in  and $in->opened  and $in->close  || carp "error closing stdin: $!";
    $out and $out->opened and $out->close || carp "error closing stdout: $!";
    $err and $err->opened and $err->close || carp "error closing stderr: $!";

    # and wait for the child (if any)
    $self->_reap();

    return $self;
}

sub DESTROY {
    my ($self) = @_;
    local $?;
    local $!;
    $self->close if !exists $self->{exit};
}

1;

__END__