#!/usr/bin/env perl
#
# impatiently - abort a command if it doesn't start to produce any output
#
# $Id$

use warnings;
use strict;

# try me with
#   $0 -i sh -c 'i=0; while sleep 4; do i=`expr $i + 1`; echo $i; done'
#   $0 -i sh -c 'i=0; while sleep 5; do i=`expr $i + 1`; echo $i; done'
#   $0 -i sh -c 'i=0; while sleep 4; do i=`expr $i + 1`; echo $i>&2; done'
# (first will continue, second and third will be killed)

# BUG: doesn't always produce the PING header with ping on FreeBSD
# I'll leave it for now, truss has no -f option there

use strict;

#$ENV{PATH} = '/bin:/usr/bin:/usr/ucb:' . $ENV{PATH};  # leftover from sh days?

# it works as follows: we plan to kill the command as long as $t exists
#
# a subprocess is started that times out after $sex seconds, if $t
# still exists, kills the other process, and removes $t
#
# then, the command is started; with -i, piping its output through a wrapper
# that will remove $t upon receiving the first line of output

# note: on a slow machine, the startup time may exceed one second

#--- config ---#
#

my $sex = 5;    # default interval to wait before interrupt

#--- error handling ---#
#

sub puke
{
  @_ && warn "fatal error: ", join( ' ', @_ ), "\n";
  print STDERR <<ZZ;

Usage:
  $0 [-i] [-s n] command line

  to start the given command and kill it after $sex seconds

  with -s n, kills it after n seconds
  with -i, kills it unless it has produced at least one line of output

ZZ
  exit(1);
}

#-- command line parse ---#
#

my $waitforinput = undef;

while (@ARGV)
{
  local ($_) = shift(@ARGV);

      /^-h/ and &puke
   or /^-i/ and $waitforinput = 1
   or /^-s/ and ( @ARGV ? $sex = shift : &puke("missing argument for '$_'") )
   or /^-/ and &puke("unrecognised option:'$_'")
   or unshift( @ARGV, $_ )
   and last;
}

$sex =~ /./ && $sex !~ /\D/ or &puke("invalid number of seconds '$sex'");

# go!
defined( my $childpid = open( PROGOUT, '-|' ) )
 or die "cannot fork()\n";

$childpid
 or exec { $ARGV[0] } @ARGV    # I'm the child, execute the command
 or die "cannot exec '$ARGV[0]'\n";

# I'm the parent, catch any output, and if -i, don't kill if any is found
my $pgrp = getpgrp() or die "cannot getpgrp()\n";

$SIG{ALRM} = sub { kill 2, $$; };    # no need for perlipc's eval/die here
alarm $sex;

$| = 1;

if ( defined( my $firstline = <PROGOUT> ) )
{
  !$waitforinput
   or alarm 0;
  print $firstline;
}
print while <PROGOUT>;