How can I limit the time spent in a specific section of a Perl script?

Question

Is there any way to build some time counter that enable parts of a script to run as long it ticks? For example, I have the following code:

for my $i (0 .. $QUOTA-1) {
    build_dyna_file($i);
    comp_simu_exe;
    bin2txt2errormap($i);
}

Theoretically I want to run this loop for 3 minutes, even if the loop instructions haven't finished yet, it should still break out of the loop after exactly 3 minutes.

Actually the program opens a time counter window that works in parallel to part of the script (each time I call it).

Additionally, the sub call 'comp_simu_exe' run an outside simulator (in the shell) that when time out ends - this process must also killed (not suppose to return after a while).

sub comp_simu_exe{

system("simulator --shell");
}

Is there any connection between the dead coming problem to the system function call ?

Answer 1

You can set an alarm that will break out of your code after a specified amount of seconds:

eval {
    local $SIG{ ALRM } = sub { die "TIMEOUT" };
    alarm 3 * 60;
    for (my $i = 0 ; $i <$QUOTA ; $i++) {
        build_dyna_file($i);
        comp_simu_exe;
        bin2txt2errormap($i);
    }
    alarm 0;
};

if ( $@ && $@ =~ m/TIMEOUT/ ) {
    warn "operation timed out";
}
else {
    # somebody else died
    alarm 0;
    die $@;
}

Or, if you really need the loop to run at least three times, no matter how long this might take:

eval {
    my $t0 = time;
    local $SIG{ ALRM } = sub { die "TIMEOUT" };

    for (my $i = 0 ; $i <$QUOTA ; $i++) {
        build_dyna_file($i);
        comp_simu_exe;
        bin2txt2errormap($i);
        if ( $i == 3 ) {
            my $time_remaining = 3 * 60 - time - $t0;
            alarm $time_remaining if $time_remaining > 0;
        }
    }
    alarm 0;
};

Answer 2

The way you deal with timeouts like this in Perl is the alarm function. It will send the signal ALRM to your process after the number of seconds you pass into it. Be careful if the code you are trying to setup the timeout for calls sleep, as they do not mix well on many platforms. The basic structure looks like this:

#start a block eval to stop the die below from ending the program
eval {
    #set the signal handler for the ALRM signal to die if it is run
    #note, the local makes this signal handler local to this block
    #eval only
    local $SIG{ALRM} = sub { die "timeout\n" };

    alarm $wait; #wait $wait seconds and then send the ALRM signal

    #thing that could take a long time

    alarm 0; #turn off the alarm (don't send the signal)

    #any true value will do, if this line is reached the or do below won't run
    1; 
} or do {
    #if we are in this block something bad happened, so we need to find out
    #what it was by looking at the $@ variable which holds the reason the
    #the code above died
    if ($@ eq "timeout\n") {
        #if $@ is the timeout message then we timed out, take the
        #proper clean up steps here
    } else {
        #we died for some other reason, possibly a syntax error or the code
        #issued its own die.  We should look at $@ more carefully and determine
        #the right course of action.  For the purposes of this example I will
        #assume that a message of "resource not available\n" is being sent by
        #the thing that takes a long time and it is safe to continue the program.
        #Any other message is unexpected.

        #since we didn't timeout, but the code died, alarm 0 was never called
        #so we need to call it now to prevent the default ALRM signal handler
        #from running when the timeout is up
        alarm 0;

        if ($@ eq "resource not available\n") {
            warn $@;
        } else {
            die $@;
        }
 }

or written more compactly:

eval {
    local $SIG{ALRM} = sub { die "timeout\n" };

    alarm $wait; #wait $wait seconds and then send the ALRM signal

    #thing that could take a long time

    alarm 0;

    1;
} or do {
    die $@ unless $@ eq "timeout\n" or $@ eq "resource not available\n";
    alarm 0;
    warn $@;
}

Answer 3

Here's a second answer that deals with the case of timing-out a second process. Use this case to start your external program and make sure that it doesn't take too long:

my $timeout = 180;
my $pid = fork;

if ( defined $pid ) {
    if ( $pid ) {
        # this is the parent process
        local $SIG{ALRM} = sub { die "TIMEOUT" };
        alarm 180;
        # wait until child returns or timeout occurs
        eval {
            waitpid( $pid, 0 );
        };
        alarm 0;

        if ( $@ && $@ =~ m/TIMEOUT/ ) {
            # timeout, kill the child process
            kill 9, $pid;
        }
    }
    else {
        # this is the child process
        # this call will never return. Note the use of exec instead of system
        exec "simulator --shell";
    }
}
else {
    die "Could not fork.";
}