#!/usr/bin/perl -w
#
# $Id: timeout.pl,v 1.9 2002/12/10 02:53:38 jmates Exp $
#
# Copyright (c) 2002, Jeremy A. Mates.  This script is free software;
# you can redistribute it and/or modify it under the same terms as
# Perl itself.
#
# Run perldoc(1) on this file for additional documentation.
#
######################################################################
#
# REQUIREMENTS

require 5;

use strict;

######################################################################
#
# MODULES

use Carp;         # better error reporting
use Getopt::Std;  # command line option processing

######################################################################
#
# VARIABLES

my $VERSION;
($VERSION = '$Revision: 1.9 $ ') =~ s/[^0-9.]//g;

my (%opts, %features, $t0);

# how to convert short human durations into seconds  
my %factor = (
  'w' => 604800,
  'd' => 86400,
  'h' => 3600,
  'm' => 60,
  's' => 1,
);

######################################################################
#
# MAIN

# optional high resolution timers
eval { require Time::HiRes; };
unless ($@) {
  require Time::HiRes;
  $features{'Time::HiRes'} = 1;
}

# parse command-line options
getopts('h?v', \%opts);

help() if exists $opts{'h'} or exists $opts{'?'};

if (exists $opts{'v'}) {
  $features{'verbose'} = 1;
}

# regular program arguments
my $duration = shift;
help() unless @ARGV;

# figure out duration, start timer, and fork/exec to run program
my $timeout = duration2seconds($duration);
$duration = seconds2duration($timeout);

$t0 = [Time::HiRes::gettimeofday()] if $features{'Time::HiRes'} and $features{'verbose'};

my $pid = open WATCH, "-|";

if ($pid) {  # parent
  eval {
    local $SIG{ALRM} = sub { die "alarm\n" };

    alarm $timeout;

    # ergh, need STDERR output pass through... Expect??
    while (<WATCH>) {

      # keep track of output frequency?
      print;
    }
    close WATCH or warn "Warning: kid exited $?\n";

    # so one knows how long positive runs take
    warn "Info: program ran for ",
     sprintf("%.1f", Time::HiRes::tv_interval($t0)), " seconds\n"
     if $features{'Time::HiRes'} and $features{'verbose'};

    alarm 0;
  };
  if ($@) {
    die unless $@ eq "alarm\n";

    warn "Error: timeout ($duration) exceeded: killing pid $pid\n";

    for my $signal (qw(TERM INT HUP KILL)) {
      last if kill $signal, $pid;
      sleep 2;
      warn "Warning: kill of $pid (via $signal) failed...\n";
    }

  }
} else {  # child
  exec @ARGV or die "Error: could not exec: $!\n";
}

######################################################################
#
# SUBROUTINES

# takes duration such as "2m3s" and returns number of seconds.
sub duration2seconds {
  my $tmpdur = shift;
  my $timeout;

  # assume raw seconds for plain number
  if ($tmpdur =~ m/^\d+$/) {
    $timeout = $tmpdur * 60;

  } elsif ($tmpdur =~ m/^[wdhms\d\s]+$/) {

    # match "2m 5s" style input and convert to seconds
    while ($tmpdur =~ m/(\d+)\s*([wdhms])/g) {
      $timeout += $1 * $factor{$2};
    }
  } else {
    die "Error: unknown characters in duration.\n";
  }

  unless (defined $timeout and $timeout =~ m/^\d+$/) {
    die "Error: unable to parse duration.\n";
  }

  return $timeout;
}

# takes seconds and returns a shorthand duration format.
sub seconds2duration {
  my $tmpsec = shift;

  unless (defined $tmpsec and $tmpsec =~ m/^\d+$/) {
    die "Error: argument not an integer";
  }

  my $seconds = $tmpsec % 60;
  $tmpsec = ($tmpsec - $seconds) / 60;
  my $minutes = $tmpsec % 60;
  $tmpsec = ($tmpsec - $minutes) / 60;

  #  my $hours = $tmpsec;
  my $hours = $tmpsec % 24;
  $tmpsec = ($tmpsec - $hours) / 24;
  my $days  = $tmpsec % 7;
  my $weeks = ($tmpsec - $days) / 7;

  # TODO better way to do this?
  my $temp = ($weeks) ? "${weeks}w" : '';
  $temp .= ($days)    ? "${days}d"    : '';
  $temp .= ($hours)   ? "${hours}h"   : '';
  $temp .= ($minutes) ? "${minutes}m" : '';
  $temp .= ($seconds) ? "${seconds}s"  : '';
  return $temp;
}

# a generic help blarb
sub help {
  print <<"HELP";
Usage: $0 duration program [program args]

Stops operation of long running programs.  Duration is either seconds,
or a shorthand format of "2m3s" for 123 seconds.

Options for version $VERSION:
  -h/-?  Display this message

  -v     Verbose.  Prints program run time unless timeout is hit.

Run perldoc(1) on this script for additional documentation.

HELP
  exit;
}

######################################################################
#
# DOCUMENTATION

=head1 NAME

timeout.pl - stop operation of long running programs

=head1 SYNOPSIS

Break out of sleep program after five seconds:

  $ timeout.pl 5s sleep 60

=head1 DESCRIPTION

=head2 Overview

This script allows programs to be stopped after a specified period of
time.  Practical uses for this script include escape from buggy
programs that stall from Makefile, where a SIGINT to stop the program
will also stop make.

=head2 Normal Usage

  $ timeout.pl duration program [program args]

See L<"OPTIONS"> for details on the command line switches supported.

The duration can either be a number (raw seconds), or a shorthand
format of the form "2m3s" for 120 seconds.  The following factors are
recognized:

  w - weeks
  d - days
  h - hours
  m - minutes
  s - seconds

Multiple factors will be added together, allowing easy addition of
time values to existing timeouts:

  $ timeout.pl 3s3s sleep 60

Would only allow the sleep to run for six seconds.

An error will occur if the script is unable to parse the supplied
duration.

=head1 OPTIONS

This script currently supports the following command line switches:

=over 4

=item B<-h>, B<-?>

Prints a brief usage note about the script.

=item B<-v>

Verbose mode.  Currently prints program run time unless the timeout is
reached.

=back

=head1 BUGS

=head2 Reporting Bugs

Newer versions of this script may be available from:

http://sial.org/code/perl/

If the bug is in the latest version, send a report to the author.
Patches that fix problems or add new features are welcome.

=head2 Known Issues

No known bugs.

=head1 TODO

Currently, a hard upper time limit must be specified.  In theory, one
could watch the output from the program and stop the program if it
remains idle for some period of time.

Since using a piped read from a program, likely cannot supply STDIN to
the program in question.

Make sure signals are properly passed back from command being run and
reported on?

=head1 SEE ALSO

perl(1), perlipc(1)

=head1 AUTHOR

Jeremy A. Mates, http://sial.org/contact/

=head1 COPYRIGHT

Copyright (c) 2002, Jeremy A. Mates.  This script is free software;
you can redistribute it and/or modify it under the same terms as Perl
itself.

=head1 VERSION

  $Id: timeout.pl,v 1.9 2002/12/10 02:53:38 jmates Exp $

=cut