如何在Perl函數調用上超時

Question

如何在Perl子例程調用上設置時間限制（應用超時處理）？如果運行時間太長，我想取消子程序。子程序可以調用C庫（例如，基於C的數據庫驅動程序），這意味着需要特殊處理。此外，SIGALRM可能已經在使用，所以我們不能直接使用alarm（）。

Answer 1

下面是一些工作的代碼我從幾年前已經對處理這個問題：

our $signal_after_delay= "/path/to/signal_after_delay.pl"; # could be merged into code below 

# execute a function call, but abort it if it takes too long to complete 
# if a signal other than the default ALRM is given, assume that the function being called uses 
# ALRMitself and use the given signal instead; for this case, we fork a child to give us the alternate 
# signal at the time of the timeout 

sub call_with_timeout { 
    my($desc,$fn,$args,$timeout,$verbosity,$sigtouse)= @_; 
    return undef unless defined($fn); 
    $timeout= 60 unless defined $timeout; 
    $verbosity= 1 unless defined $verbosity; 
    $sigtouse= 'ALRM' unless defined $sigtouse; 
    print "call_with_timeout(",join(',',$desc,$fn,'['.join(',',@{$args}).']',$timeout,$verbosity,$sigtouse),")\n" if $verbosity > 3; 

    my @res=(); 
    my $start= time(); 
    my $timeoutpid= undef; 
    eval { 
     my $sighandler= sub {0 && print "$$: in signal handler for $_[0]\n"; die "$$: $desc timed out with $_[0] after $timeout seconds" }; 
     if ($sigtouse eq 'ALRM') { 
      alarm($timeout); 
     } else { 
      my $fncallingpid= $$; 
      $timeoutpid=fork(); 
      if ($timeoutpid == 0) { # child 
       exec($signal_after_delay,$sigtouse,$fncallingpid,$timeout,$verbosity); 
       die "could not exec $signal_after_delay\n"; 
      } 
      # parent 
     } 
     $SIG{$sigtouse}= $sighandler; 

     # on timeout, alarm handler above will execute and we'll fall out of this eval 
     # on normal exit, we'll fall out of the bottom of the eval with no error 
     print "$desc: starting call\n" if $verbosity > 1; 
     UNSAFE_SIGNALS { 
      # get signals immediately during this call rather than when Perl thinks it is a good time; this allows us to interrupt C routines such as VMware VIX 
      @res= &{$fn}(@{$args}); 
     }; 
     print "$desc exited normally: ",join(',',@res),"\n" if $verbosity > 2; 
     $SIG{$sigtouse}= 'IGNORE'; 
     if ($sigtouse eq 'ALRM') { 
      alarm(0); 
     } else { 
      print "$$: canceling signal_after_delay.pl ($timeoutpid)\n" if $verbosity > 2; 
      kill 'KILL', $timeoutpid; 
     } 
    }; 
    my $elapsed= time()-$start; 
    #print "waitpid($timeoutpid)\n" if defined($timeoutpid); 
    waitpid($timeoutpid,0) if defined($timeoutpid); 
    if ($@) { 
     if ($@ =~ /timed out with/) { # we timed out 
      print "$@\n"; 
      return (0); 
     } else { # the method call did a die 
      # propagate 
      $SIG{$sigtouse}= 'IGNORE'; 
      if ($sigtouse eq 'ALRM') { 
       alarm(0); 
      } else { 
       kill $timeoutpid;  
      } 
      die; 
     } 
    } 
    print qq{$desc exited normally [elapsed=$elapsed]\n} if $verbosity; 
    return (1,@res); 
} 

signal_after_delay.pl很簡單：

#!/usr/bin/perl -w 

# send a given signal to a given PID after a given delay 

use FileHandle; 
STDOUT->autoflush(1); 

my($sig,$targetpid,$wait,$verbosity)= @ARGV; 
$wait= 60 unless defined($wait); 
$verbosity= 1 unless defined($verbosity); 

print "$0 ($$): will send SIG$sig to $targetpid after $wait seconds\n" if $verbosity > 1; 

my $now= time(); 
my $end=$now+$wait; 
do { 
    print "$$: will sleep for ",$end-$now,"\n" if $verbosity > 2; 
    sleep($end-$now); 
    $now= time(); 
} while ($now < $end); 

print "$$: sending SIG$sig to $targetpid\n" if $verbosity; 
kill $sig, $targetpid; 

exit(0); 

Answer 2

最簡單的答案是 - 用alarm :) 。 但是，因爲這不是一種選擇，我提供的替代方案是使用線程來運行您可能想要殺死的代碼。

例如爲：

#!/usr/bin/perl 

use strict; 
use warnings; 

use threads; 

sub my_subroutine_to_timeout { 
    $SIG{'USR1'} = sub { print "Got USR1, dying\n"; die }; 

    my $timeout = rand (30); 
    sleep ($timeout) ; 
    return $timeout; 
} 

my $thr = threads -> create (\&my_subroutine_to_timeout); 

sleep 10; 
if ($thr -> is_joinable()) { 
    my $result = $thr -> join(); 
    print "Thread returned before timeout, with $result\n"; 
} 
else { 
    print "Timeout: Killing\n"; 
    $thr -> kill ('SIGUSR1'); #can trap with a signal handler. 
    $thr -> detach(); 
} 

print "Main program continues, but may not have a result from the thread\n"; 

以上就是說明的 - 它是保證等待10秒的命令來完成，哪怕1秒後結束。但是有這方面的方法。