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