/usr/share/perl5/Time/Out.pm is in libtime-out-perl 0.11-1.
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 | package Time::Out ;
@ISA = qw(Exporter) ;
@EXPORT_OK = qw(timeout) ;
use strict ;
use Exporter ;
use Carp ;
BEGIN {
if (Time::HiRes->can('alarm')){
Time::HiRes->import('alarm') ;
}
if (Time::HiRes->can('time')){
Time::HiRes->import('time') ;
}
}
$Time::Out::VERSION = '0.11' ;
sub timeout($@){
my $secs = shift ;
carp("Timeout value evaluates to 0: no timeout will be set") if ! $secs ;
my $code = pop ;
usage() unless ((defined($code))&&(UNIVERSAL::isa($code, 'CODE'))) ;
my @other_args = @_ ;
# Disable any pending alarms.
my $prev_alarm = alarm(0) ;
my $prev_time = time() ;
my $dollar_at = undef ;
my @ret = () ;
{
# Disable alarm to prevent possible race condition between end of eval and execution of alarm(0) after eval.
local $SIG{ALRM} = sub {} ;
@ret = eval {
local $SIG{ALRM} = sub { die $code } ;
if (($prev_alarm)&&($prev_alarm < $secs)){
# A shorter alarm was pending, let's use it instead.
alarm($prev_alarm) ;
}
else {
alarm($secs) ;
}
my @ret = $code->(@other_args) ;
alarm(0) ;
@ret ;
} ;
alarm(0) ;
$dollar_at = $@ ;
}
my $new_time = time() ;
my $new_alarm = $prev_alarm - ($new_time - $prev_time) ;
if ($new_alarm > 0){
# Rearm old alarm with remaining time.
alarm($new_alarm) ;
}
elsif ($prev_alarm){
# Old alarm has already expired.
kill 'ALRM', $$ ;
}
if ($dollar_at){
if ((ref($dollar_at))&&($dollar_at eq $code)){
$@ = "timeout" ;
}
else {
if (! ref($dollar_at)){
chomp($dollar_at) ;
die("$dollar_at\n") ;
}
else {
croak $dollar_at ;
}
}
}
return wantarray ? @ret : $ret[0] ;
}
sub usage {
croak("Usage: timeout \$nb_secs => sub {\n #code\n} ;\n") ;
}
1 ;
|