1use warnings; 2use strict; 3 4package Munin::Common::Timeout; 5use base qw(Exporter); 6 7use Carp; 8use English qw(-no_match_vars); 9 10 11BEGIN { 12 our @EXPORT = qw( 13 &do_with_timeout 14 ); 15} 16 17# This represents the current ALRM signal setting 18my $current_timeout_epoch; 19 20# This sub always uses absolute epoch time reference. 21# This is in order to cope with eventual stealed time... 22# ... and to avoid complex timing computations 23# 24# $timeout is relative seconds, $timeout_epoch is absolute. 25sub do_with_timeout { 26 my ($timeout, $block) = @_; 27 28 croak 'Argument exception: $timeout' 29 unless $timeout && $timeout =~ /^\d+$/; 30 croak 'Argument exception: $block' 31 unless ref $block eq 'CODE'; 32 33 my $new_timeout_epoch = time + $timeout; 34 35 # Nested timeouts cannot extend the global timeout, 36 # and we always leave 5s for outer loop to finish itself 37 if ($current_timeout_epoch && $new_timeout_epoch > $current_timeout_epoch - 5) { 38 $new_timeout_epoch = $current_timeout_epoch - 5; 39 } 40 41 if ($new_timeout_epoch <= time) { 42 # Yey ! Time's up already, don't do anything, just : "farewell !" 43 return undef; 44 } 45 46 # Ok, going under new timeout setting 47 my $old_current_timeout_epoch = $current_timeout_epoch; 48 $current_timeout_epoch = $new_timeout_epoch; 49 50 my $ret_value; 51 eval { 52 local $SIG{ALRM} = sub { die "alarm\n" }; # NB: \n required 53 alarm ($new_timeout_epoch - time); 54 $ret_value = $block->(); 55 }; 56 my $err = $EVAL_ERROR; 57 58 # Restore the old $current_timeout_epoch... 59 $current_timeout_epoch = $old_current_timeout_epoch; 60 61 # ... and restart the old alarm if needed 62 if ($current_timeout_epoch) { 63 my $timeleft = $current_timeout_epoch - time; 64 if ($timeleft <= 0) { 65 # no timeleft : directly raise alarm 66 die "alarm\n"; 67 } 68 69 alarm ($timeleft); 70 } else { 71 # Remove the alarm 72 alarm (0); 73 } 74 75 # And handle the return code 76 if ($err) { 77 return undef if $err eq "alarm\n"; 78 die $err; # Propagate any other exceptions 79 } 80 81 return $ret_value; 82} 83 841; 85__END__ 86 87 88=head1 NAME 89 90Munin::Common::Timeout - Run code with a timeout. May nest. 91 92 93=head1 SYNOPSIS 94 95 use Munin::Common::Timeout; 96 97 do_with_timeout(50, sub { 98 # ... 99 do_with_timeout(5, sub { 100 # ... 101 # ... 102 }); 103 # ... 104 }); 105 106 107=head1 DESCRIPTION 108 109See also L<Time::Out>, L<Sys::AlarmCall> 110 111=head1 SUBROUTINES 112 113=over 114 115=item B<do_with_timeout> 116 117 my $finished_with_no_timeout = do_with_timeout($seconds, $code_ref) 118 or die "Timed out!"; 119 120Executes $block with a timeout of $seconds. Returns the return value of the $block 121if it completed within the timeout. If the timeout is reached and the code is still 122running, it halts it and returns undef. 123 124NB: every $code_ref should return something defined, otherwise the caller doesn't know 125if a timeout occurred. 126 127Calls to do_with_timeout() can be nested. Any exceptions raised 128by $block are propagated. 129 130=back 131 132=cut 133# vim: ts=4 : sw=4 : et 134