File Coverage

blib/lib/Proc/Terminator.pm

Criterion	Covered	Total	%
statement	108	135	80.0
branch	28	50	56.0
condition	7	14	50.0
subroutine	20	20	100.0
pod	1	4	25.0
total	164	223	73.5

package Proc::Terminator::Ctx;
use strict;
use warnings;
use POSIX qw(errno_h);
my $DEBUG = $ENV{PROC_TERMINATOR_DEBUG};

use Moo;
has pid => (
    is =>'ro',
    required => 1,
    isa => sub {
        ($_[0] && $_[0] > 0) or die "PID must be a positive number!"
    },
);

has siglist => (
    is => 'rw',
    required => 0,
    isa => sub { ref $_[0] eq 'ARRAY' or die "Siglist must be an array reference" },
    default => sub  { [] }
);

has last_sent => (
    is => 'rw',
    default => sub { 0 }
);

has error => (
    is => 'rw',
    default => sub { "" }
);

sub try_kill {
    my ($self,$do_kill) = @_;

    if (kill(0, $self->pid) == 0) {
        my $errno_save = $!;
        $DEBUG and warn "Kill with signal=0 returned 0 (dead!)";
        if ($errno_save != ESRCH) {
            $self->error($errno_save);
            warn $errno_save;
            return -1;
        }
        # else, == ESRCH
        return 1;
    }

    if (!$do_kill) {
        $DEBUG and warn "We were not requested to proceed with signal. Returning";
        return 0;
    }
    my $sig = shift @{$self->siglist};

    if (!defined $sig) {
        $DEBUG and warn "Cannot kill ${\$self->pid} because no signals remain";
        return -1;
    }
    $DEBUG and warn "Using signal $sig for ${\$self->pid}";

    if (kill($sig, $self->pid) == 1) {
        return 0;
    }

    if ($! == ESRCH) {
        return 1;
    } else {
        warn $!;
        return -1;
    }
}

# This class represents a single 'batch' of PIDs each withe
package Proc::Terminator::Batch;
use strict;
use warnings;
use POSIX qw(:errno_h);
use Time::HiRes qw(sleep time);
use Moo;

has procs => (
    is => 'rw',
    isa => sub { ref $_[0] eq 'HASH' or die "Expected hash reference!" },
    default => sub { { } },
);

has grace_period => ( is => 'rw', default => sub { 0.75 });
has max_wait => ( is => 'rw', default => sub  { 10 });
has interval => (is => 'rw', default => sub { 0.25 });
has badprocs => (is => 'rw',
                 isa => sub { ref $_[0] eq 'ARRAY' or die "Expected arrayref!" },
                 default => sub {  [ ] } );
has begin_time => (is => 'rw', default => sub { 0 });

sub with_pids {
    my ($cls,$pids,%options) = @_;
    $pids = ref $pids ? $pids : [ $pids ];

    my $siglist = delete $options{siglist} ||
        [ @Proc::Terminator::DefaultSignalOrder ];

    my %procs;
    foreach my $pid (@$pids) {
        $procs{$pid} = Proc::Terminator::Ctx->new(
            pid => $pid,
            siglist => [ @$siglist ],
            last_sent => 0);
    }

    my $self = $cls->new(
        procs => \%procs,
        max_wait => delete $options{max_wait} || 10,
        interval => delete $options{interval} || 0.25,
        grace_period => delete $options{grace_period} || 0.75,
    );
    return $self;
}

sub _check_one_proc {
    my ($self,$ctx,$now) = @_;

    my $do_send_kill = $now - $ctx->last_sent > $self->grace_period;

    if ($do_send_kill) {
        $ctx->last_sent($now);
        $DEBUG and warn("Will send signal to ${\$ctx->pid}");
    }

    my $ret = $ctx->try_kill($do_send_kill);

    if ($ret) {
        delete $self->procs->{$ctx->pid};
        if ($ret == -1) {
            push @{ $self->badprocs }, $ctx;
        }
    }

    return $ret;
}

# The point of abstracting this is so that this module may be integrated
# within event loops, where this method is called by a timer, or something.
sub loop_once {
    my $self = shift;
    my @ctxs = values %{ $self->procs };

    if (!scalar @ctxs) {
        $DEBUG and warn "Nothing left to check..";
        if (@{$self->badprocs}) {
            return undef;
        }
        return 0; #nothing left to do
    }

    my $now = time();

    if ($self->max_wait &&
        ($now - $self->begin_time > $self->max_wait)) {
        # do one last sweep?
        while (my ($pid,$ctx) = each %{$self->procs}) {
            if (kill(0, $pid) == 0 && $! == ESRCH) {
                delete $self->procs->{$pid};
            } else {
                push @{$self->badprocs}, $ctx;
            }
        }
        if (@{$self->badprocs}) {
            return undef;
        }
        return 0;
    }
    $self->_check_one_proc($_, $now) foreach (@ctxs);
    if (keys %{$self->procs}) {
        return scalar keys %{$self->procs};
    } else {
        if (@{$self->badprocs}) {
            return undef;
        }
        return 0;
    }
}



package Proc::Terminator;
use warnings;
use strict;
use Time::HiRes qw(time sleep);
use POSIX qw(:signal_h :sys_wait_h :errno_h);
use base qw(Exporter);

our $VERSION = 0.05;

our @DefaultSignalOrder = (
    SIGINT,
    SIGQUIT,
    SIGTERM,
    SIGKILL
);

our @EXPORT = qw(proc_terminate);
use Data::Dumper;
# Kill a bunch of processes
sub proc_terminate {
    my ($pids, %options) = @_;

    my $batch = Proc::Terminator::Batch->with_pids($pids, %options);

    $batch->begin_time(time());
    #print Dumper($batch);
    while ($batch->loop_once) {
        $DEBUG and warn "Sleeping for ${\$batch->interval} seconds";
        sleep($batch->interval);
    }

    my @badprocs = map { $_->pid } @{$batch->badprocs};

    if (wantarray) {
        return @badprocs;
    } else {
        return !@badprocs;
    }
}

__END__