Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked
 
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 musing on the Monastery: (4)
As of 2022-01-20 23:46 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    In 2022, my preferred method to securely store passwords is:












    Results (57 votes). Check out past polls.

    Notices?