view release on metacpan or  search on metacpan

bin/run-stop-run  view on Meta::CPAN

#!perl
use strict;
use warnings;

use App::RunStopRun;
use Config;
use File::Spec;
use Getopt::Long qw(:config bundling no_ignore_case require_order);
use IO::Pty;
use List::Util qw(first uniq);
use POSIX qw(:unistd_h :sys_wait_h);
use Pod::Usage;
use Proc::ProcessTable;
use Time::HiRes qw(sleep);

# NOTE: docs claim getpgrp($PID) isn't portable. Also, the POSIX module
# doesn't provide a separate interface for getpgid, though it's part of the
# standard and used internally.
use constant HAS_PORTABLE_GETPGRP =>
    !! grep defined, @Config{qw( d_getpgid d_bsdgetpgrp d_getpgrp2 )};

my $filename = (File::Spec->splitpath(__FILE__))[-1];
my @option = (
    'verbose|v' => \my $verbose,
    'dry-run|n' => \my $dryrun,

    'limit|l=f'          => \my $limit,
    'pid|p=s'            => \my @pid,
    'run|r=f'            => \my $run,
    'stop|s=f'           => \my $stop,
    'group|g'            => \my $group,
    'nogroup|no-group|G' => \my $nogroup,
    'children|c'         => \my $children,
    'notty|no-tty|T'     => \my $notty,
    'tty|t+'             => \my $tty,

    'version|V' => \my $version,
    'help|h'    => \my $help,
    'man|H'     => \my $man,
);
my @getopt_msg;
eval {
    local @SIG{qw(__DIE__ __WARN__)} = (sub { push @getopt_msg, $_[0] }) x 2;
    GetOptions(@option);
} or usage(@getopt_msg);
@pid = uniq split /,/, join ',', @pid;

usage() if $help;
exit printf "$filename $App::RunStopRun::VERSION\n" if $version;
pod2usage(-exitval => 0, -verbose => 2) if $man;
usage('Missing command or PIDs') unless @pid or @ARGV;
usage("Can't use both command and PIDs") if @pid and @ARGV;
if (my @bad = grep { ! /^-?\d+$/ or 1 >= abs or ! kill 0, $_ } @pid) {
    usage(sprintf "Bad PID%s: %s", 1 < @bad ? 's' : '', join ',', @bad);
}
usage('--run must be >0') if defined $run and 0 >= $run;
usage('--stop must be >0') if defined $stop and 0 >= $stop;
usage("Can't use --limit with both --run and --stop")
    if defined $limit and defined $run and defined $stop;
if (defined $limit) {
    $limit *= 100 if $limit and 1 > $limit;
    usage('--limit must be between 1..99') if 1 > $limit or 99 < $limit;
}

$limit ||= 50;
$run   ||= 1;
$stop  ||= 100 * $run / $limit - $run;

my $status = 0;
my @kill;
my $isfg = (getpgrp == tcgetpgrp STDIN_FILENO);
if ($verbose) {
    warn "Controller PID: $$\n";
    warn "Controller is in the foreground\n" if $isfg;
}

my $sigint;
$SIG{INT} = $SIG{TERM} = sub {
    $sigint = shift;
    warn "Received SIG$sigint\n" if $verbose;