Beefy Boxes and Bandwidth Generously Provided by pair Networks
P is for Practical
 
PerlMonks  

Perl syntax for enforcing time limits

by ncw (Friar)
on Apr 21, 2001 at 19:39 UTC ( #74429=perlcraft: print w/replies, xml ) Need Help??

   1: =head1 NAME
   2: 
   3: TimeLimit - limit execution time
   4: 
   5: =head1 SYNOPSIS
   6: 
   7:   use TimeLimit
   8:   time_limit {
   9:       # Some code which might take a long time
  10:   } or warn "Timeout";
  11: 
  12: =head1 DESCRIPTION
  13: 
  14: Provides time_limit for adding easy to use timeouts to your programs.
  15: 
  16: =head1 FUNCTIONS
  17: 
  18: =cut
  19: 
  20: ############################################################
  21: 
  22: package TimeLimit;
  23: 
  24: use strict;
  25: use Carp;
  26: use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
  27: 
  28: require Exporter;
  29: 
  30: @ISA = qw(Exporter);
  31: @EXPORT_OK = ( );
  32: @EXPORT = qw(
  33:     time_limit
  34: );
  35: $VERSION = '1.00';
  36: 
  37: ############################################################
  38: 
  39: =head2 time_limit
  40: 
  41: Time out the subroutine or subroutine block using alarm, being careful
  42: to save and restore the alarm properly.
  43: 
  44: You may nest this function inside other time_limits or alarm calls.
  45: Inside a nested time_limit the outer time_limit is turned off for the
  46: duration of the inner timeout, and restored when the inner time_limit
  47: exits.
  48: 
  49: Input:
  50: 
  51:     { subroutine block }
  52:     timeout - optional defaults to 30 seconds
  53: 
  54: Output:
  55: 
  56:     $ok  - returns 1 for OK or undef for false
  57: 
  58: Use like this
  59: 
  60:     time_limit
  61:     {
  62:         long_function();
  63:         more_stuff();
  64:     } 60
  65:     or die "Stuff timedout after 60 seconds";
  66: 
  67: Or this where the 'or do { }' block acts like an 'else' block.
  68: 
  69:     time_limit
  70:     {
  71:         long_function(1);
  72:         long_function(2);
  73:     } or do
  74:     {
  75:         something_on_timeout();
  76:     };
  77: 
  78: =cut
  79: 
  80: ############################################################
  81: 
  82: my $time_limit_invocation = 0;
  83: 
  84: sub time_limit (&;$)
  85: {
  86:     my ($sub, $timeout) = @_;
  87:     my $die_text = "time_limit: " . $time_limit_invocation++ . "\n";
  88:     $timeout ||= 30;
  89:     my $old_alarm = alarm(0);        # turn alarm off and read old value
  90:     {
  91:         local $SIG{ALRM} = 'IGNORE'; # ignore alarms in this scope
  92: 
  93:         eval
  94:         {
  95:             local $SIG{__DIE__};     # turn die handler off in eval block
  96:             local $SIG{ALRM} = sub { die $die_text };
  97:             alarm($timeout);         # set alarm
  98:             $sub->();                # do the user's code
  99:         };
 100: 
 101:         # Note the alarm is still active here - however we assume that
 102:         # if we got here without an alarm the user's code succeeded -
 103:         # hence the IGNOREing of alarms in this scope
 104: 
 105:         alarm 0;                     # kill off alarm
 106:     }
 107: 
 108:     alarm $old_alarm;                # restore alarm
 109: 
 110:     if ($@)
 111:     {
 112:         # the eval returned an error
 113:         return 0 if $@ eq $die_text; # show we timed out ($@ is set)
 114:         die $@;                      # propagate error
 115:     }
 116: 
 117:     return 1;                        # all ok
 118: }
 119:     
 120: ############################################################
 121: 
 122: =head1 EXPORT
 123: 
 124:     time_limit
 125: 
 126: =head1 AUTHOR
 127: 
 128: Nick Craig-Wood
 129: 
 130: =head1 CHANGES
 131: 
 132: =head2 2001-04-21 ncw
 133: 
 134: Release 1.00
 135: 
 136: Created
 137: 
 138: =head1 SEE ALSO
 139: 
 140: perl(1).
 141: 
 142: =cut
 143: 
 144: ############################################################
 145: 1;
 146: __END__

Replies are listed 'Best First'.
Re: Perl syntax for enforcing time limits
by Starky (Chaplain) on Apr 22, 2001 at 01:59 UTC
    Very useful!

    I have a suggestion: I would mention in the PODs that the sigalrm is used to establish the timeout. Almost every module that has a timeout uses a sigalrm to accomplish the task, and when they're used in combination, strange things happen. (Usually, the last assignment to $SIG{ALRM} overriders any former assignments.)

    This would pose problems to those who use Net::Ping, for example, and less seasoned coders may not be aware of what is happening.

    I'm going to keep this in my toolkit. I think it will see good use.

      Glad you like it!

      Yes I should make the fact that it uses $SIG{ALRM} explicit in the documentation. However note that TimeLimit always uses local $SIG{ALRM} which means that it gets reset to its previous value when it goes out of scope.

      The answer to Net::Ping of course is that it should use TimeLimit too if it uses alarm(), or if you have some code that you think might be using alarm() &or $SIG{ALRM} and not resetting it then bracket it in a time_limit { } block and that will reset the alarm() & $SIG{ALRM} properly.

      Ideally I should submit TimeLimit so CPAN so everyone who uses alarm() anywhere should use it instead!

(bbfu) (nested limits) Re: Perl syntax for enforcing time limits
by bbfu (Curate) on Apr 30, 2001 at 07:34 UTC

    An interesting module, and implemented well. As constructive critisim, there's two things I'd like to mention.

    First, and simplest, you document a return value of undef on timeout but you actually return 0. This can trip people up so you might want to fix it.

    Second, I think that, perhaps, you're handling nested time_limit()'s incorrectly (not that I really know what I mean by "correct"). Consider:

    #!/usr/bin/perl -w use TimeLimit; $outter1 = time; time_limit { $inner1 = time; time_limit { sleep 7 } 5; $inner2 = time; } 3; $outter2 = time; $elapsed_outter = $outter2-$outter1; $elapsed_inner = $inner2-$inner1; print "Seconds elapsed for outter limit: $elapsed_outter\n"; print "Seconds elapsed for inner limit: $elapsed_inner\n";

    The output of this test program is:

    Seconds elapsed for outter limit: 5 Seconds elapsed for inner limit: 5

    Whereas anyone looking at the outter time_limit() would think that it should return no more than 3s later. (Imagine the inner time_limit() call being burried in a called subroutine...)

    Further, what if the code you expected to cause a timeout was after the inner time_limit() call? Because your code actually resets the alarm(), it could take even longer.

    Of course, for most applications where you would want to time_limit() some code, you wouldn't really care if it takes a little bit longer to time out than you expected, so it shouldn't matter much. Also, I can't think of a very elegant solution that would handle such cases. I never did understand why they limited it to one alarm per process...

    Well, I hope that at least gives you some ideas to work with. In fact, I think I might just have to look into writing a module that would offer a more robust replacement for alarm. :-) And again, congrats on a good module.

    Happy coding.

    bbfu
    Seasons don't fear The Reaper.
    Nor do the wind, the sun, and the rain.
    We can be like they are.

(bbfu) (nested-timeout fix) Re: Perl syntax for enforcing time limits
by bbfu (Curate) on May 16, 2001 at 05:00 UTC

    Okay, I did a simple rewrite using my Alarm::Concurrent module. You can add ':OVERRIDE' just after 'setalarm' in the use line (line # 3) to have it take over $SIG{ALRM} if you like.

    Let me know what you think. :-)

    #!/usr/bin/perl -w use Alarm::Concurrent qw( setalarm ); my $TIMELEVEL = 0; sub timeout(&;$) { my $code = shift; my $time = shift || 30; my $dietext = "Timeout " . ++$TIMELEVEL . "\n"; eval { local $SIG{__DIE__}; setalarm($time, sub { die $dietext }); $code->(); }; --$TIMELEVEL; if($@ eq $dietext) { return 0; # Timed out. } elsif($@ ne '') { die $@; # Propagate error upstream. } return 1; # Everything's ok. } timeout { timeout { sleep 10; } 3 or die "Inner timeout"; } 2 or die "Outter timeout"; print "Everything's ok.\n";

    And the output is:

    Outter timeout at ./testtimeout line 33.

    bbfu
    Seasons don't fear The Reaper.
    Nor do the wind, the sun, and the rain.
    We can be like they are.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlcraft [id://74429]
Approved by root
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others lurking in the Monastery: (4)
As of 2022-05-27 15:20 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Do you prefer to work remotely?



    Results (95 votes). Check out past polls.

    Notices?