#!/usr/bin/perl

use strict;
use warnings;

use File::Basename;
use Getopt::Long;

my %opt = (
    discipline => '',
    timeout => 10,
    );
GetOptions (\%opt, qw{discipline=s timeout=i}) && @ARGV == 1 or die <<eod;

Test effect of I/O discipline on signal handling.

usage: perl @{[basename $0]} [options] command

where the options are zero or more of:

  -discipline string
    specifies the I/O discipline to use (default: none)

  -timeout number
    specifies the command timeout in seconds (default: 10)

Note that I have found no way to set $ENV{PERL_SIGNALS} in Perl and
have it affect anything. Even a BEGIN block doesn't help. So there's
no -unsafe option.

eod

$| = 1;
my $cmd = shift @ARGV;
my $tmot = $opt{timeout} || 10;
my $pipe;
my $toerr = 0;
my $access = "-|$opt{discipline}";
my $start = time ();
my $pid = open ($pipe, $access, $cmd) or die;
local $SIG{ALRM} = sub {
    $toerr++;
    kill KILL => $pid;
    };
alarm ($tmot);
while (<$pipe>) {print}
alarm (0);
my @bool = qw{No Yes};
print <<eod;
     Command: '$cmd'
      Access: '$access'
     Timeout: $tmot
Elapsed time: @{[time () - $start]} seconds.
   Timed out? $bool[$toerr]
eod
