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