Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine
 
PerlMonks  

brutally stop a perl program if it runs too long

by water (Chaplain)
on Sep 13, 2005 at 01:36 UTC ( #491431=perlquestion: print w/ replies, xml ) Need Help??
water has asked for the wisdom of the Perl Monks concerning the following question:

I have some perl code that needs to be stopped if it runs for more than N seconds. The stop can be brutal; no need to clean up.

The alarm docs warn against mixing alarm and sleep in the same program.

I also want to place the stop-me-if-run-for-more-than-N-secs in a module; the module doesn't know anything about the code that will use it.

Given that, what's the best way to zap a process if it runs too long? Need I spawn another process to kill the parent after a time limit? Is there a system linux flag that accomplish this on the command line? Or is SIGALARM my best bet?

Thanks

waterwaterwater

Comment on brutally stop a perl program if it runs too long
Download Code
Re: brutally stop a perl program if it runs too long
by Zaxo (Archbishop) on Sep 13, 2005 at 02:10 UTC

    There are several ways to do it.

    Since you want something standalone, without ties to the caller, a seperate process seems best. That allows the parent to use any timers and alarms it likes.

    Lets call the thing "Timelimit", and abuse import to set the limit and fork, per Errto.

    package Timelimit; use warnings; use strict; =head1 NAME Timelimit - fork off a watchdog timer =cut =head1 SYNOPSIS use Timelimit $seconds; use Timelimit; # default 120 seconds =cut use vars qw/$N/; sub import { my $class = shift; $N = 0+$_[0] || 120; # default two minutes my $ppid = $$; defined(my $pid = fork) or die $!; return $pid if $pid; local $SIG{HUP} = sub { exit 0 }; while ($N > 0) { $N -= sleep $N; } kill INT, $ppid; # or, for maximum brutality, # kill KILL, $ppid; sleep 1 while kill 0, $ppid; exit 0; } 1; __END__ =head1 AUTHOR Zaxo, Sept 2005 =cut
    The initial $Timelimit::N setting is visible to the user who wants to see it.

    Update ++Errto's suggestion gratefully adopted.

    After Compline,
    Zaxo

      Cool idea, but I don't think it works as is (at least not for me) because the import routine is called after the module is required, so the forking block would never see the correct value of $N. The solution is simply to make it all part of the import subroutine, and use return instead of last.
Re: brutally stop a perl program if it runs too long
by sgifford (Prior) on Sep 13, 2005 at 06:41 UTC
    You can do something similar to what you want with ulimit; you can limit your script to 30 seconds of CPU time (not wall-clock time) by running ulimit -t 30 before you start your script.
Re: brutally stop a perl program if it runs too long
by zentara (Archbishop) on Sep 13, 2005 at 11:06 UTC
    It wouldn't be an "exact timer" , but you could run the timer in a thread, and just have the thread kill off everything when time is up.

    I'm not really a human, but I play one on earth. flash japh
Re: brutally stop a perl program if it runs too long
by radiantmatrix (Parson) on Sep 13, 2005 at 14:30 UTC

    Depending on how time-sensitive your operation is, and its nature, something like this might work:

    my $n_secs = 30; #seconds after which we die. my $start = time; ## each iteration of this loop is short, but the whole ## thing is long while ( $some_condition ) { die 'We ran too long!' if time-$start >= $n_secs; ## do stuff ## }

    Of course, this will fail miserably if you can't check time regularly; since I don't know what your implementation looks like, I can't say if it will work for you or not. As for putting it in a module:

    package RunKiller; sub new { my $self = shift; my $obj = { timer => time(), length => shift }; bless $obj, $self; return $self; } sub check { my $self = shift; die 'Ran too long!' if time-($self->{timer}) >= $self->{length}; } 1;

    Called like:

    require RunKiller; my $runtimer = RunKiller->new(30); #30s run length. while (1) { $runtimer->check(); ## do something ## }
    <-radiant.matrix->
    Larry Wall is Yoda: there is no try{} (ok, except in Perl6; way to ruin a joke, Larry! ;P)
    The Code that can be seen is not the true Code
    "In any sufficiently large group of people, most are idiots" - Kaa's Law

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://491431]
Approved by BrowserUk
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others imbibing at the Monastery: (11)
As of 2014-07-28 18:50 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite superfluous repetitious redundant duplicative phrase is:









    Results (206 votes), past polls