Sys::RunUntil - make sure script only runs for the given time

 use Sys::RunUntil '30mW';
 # code which may only take 30 minutes to run

 use Sys::RunUntil '30sC';
 # code which may only take 30 seconds of CPU time

 - S seconds
 - M minutes
 - H hours
 - D days

 (none)

 Elizabeth Mattijsen

package Sys::RunUntil;

# Set version
# Make sure we're strict

$VERSION = '0.02';
use strict;

# Satisfy -require-

1;

#---------------------------------------------------------------------------
#
# Standard Perl functionality
#
#---------------------------------------------------------------------------
# import
#
# Called during execution of "use"
#
#  IN: 1 class
#      2 runtime of script

sub import {

# Obtain the initial run time
# Die now if nothing to check

    my $runtime = $_[1];
    die "Must specify a time until which the script should run\n"
     unless defined $runtime;

# Initialize CPU time flag if wallclock identifier given
# Set CPU flag if so specified
# Die now if invalid characters found

    my $cpu = ($runtime =~ s#[cC]##);
    $cpu = undef if $runtime =~ s#[wW]##;
    die "Unrecognizable runtime specified: $runtime\n"
     unless $runtime =~ m#^[sSmMhHdD\d]+$#;

# Convert seconds into seconds
# Convert minutes into seconds
# Convert hours into seconds
# Convert days into seconds

    my $seconds = 0;
    $seconds += $1           if $runtime =~ m#(\d+)[sS]?#;
    $seconds += (60 * $1)    if $runtime =~ m#(\d+)[mM]#;
    $seconds += (3600 * $1)  if $runtime =~ m#(\+?\d+)[hH]#;
    $seconds += (86400 * $1) if $runtime =~ m#(\+?\d+)[dD]#;

# If we're only allowing so much CPU
#  Create a single pipe (from child to parent)
#  Perform the fork
#  Die now if the fork failed

    if ($cpu) {
        pipe my $child,my $parent;
        my $pid = fork();
        die "Could not fork: $!\n" unless defined $pid;

#  If we're in the child process
#   Close the reading part on this end
#   Make sure we can autoflush
#   Make sure the pipe to the parent flushes
        
        unless ($pid) {
            close $child;
            require IO::Handle;
            $parent->autoflush;

#   Install a signal handler which
#    Obtain the CPU time info
#    Calculate the total
#    Send that to the parent, rounded
#   Return now to let the child do its thing

            $SIG{INFO} = sub {
                my @time = times;
                my $time = $time[0] + $time[1] + $time[2] + $time[3];
                printf $parent "%.0f\n",$time;
            };
            return;
        }        

#  Install a signal handler that will exit parent process if child exits

        $SIG{CHLD} = sub { exit };

#  Close the writing part of the pipe on this end
#  Initialize CPU time burnt so far
#  While we have a child process and not all CPU time burnt
#   Sleep for the minimum time until CPU cycles burnt
#   Signal the child to tell its CPU usage
#   Until we received word from the child
#    Check if the child still runs, exit if child no longer there
#   Obtain time spent from child, exit if child no longer there

        close $parent;
        my $rbits; vec( $rbits,fileno( $child ),1 ) = 1;
        my $burnt = 0;
        while ($burnt < $seconds) {
            sleep $seconds - $burnt;
            kill 29,$pid;
            until (select $rbits,undef,undef,1) {
                exit unless kill 0,$pid;
            }
            exit unless defined( $burnt = <$child> );
        }

#  Kill the child process
#  And exit

        kill 15,$pid;
        exit;

# Else (only interested in wallclock)
#  Perform the fork
#  Die now if the fork failed
#  Return now if we're in the child process

    } else {
        my $pid = fork();
        die "Could not fork: $!\n" unless defined $pid;
        return unless $pid;  

#  Set the alarm handler which
#   Kills the child process
#   And does an exit, indicating a problem

        $SIG{ALRM} = sub {
            kill 15,$pid;
            exit 1;
        };

#  Set the alarm
#  Wait for the child process to return
#  Exit now, we're done okidoki

        alarm $seconds;
        wait;
        exit;
    }
} #import

#---------------------------------------------------------------------------

__END__