Question

我有一个线程应用程序，并希望为线程设置超时。 Peldoc for alarm建议使用eval - die对并捕获ALRM信号。但是，这会导致线程产生错误Alarm clock：

use strict; use warnings;                                                                                                                                                                                                                                             
require threads;                                                                                                                                                                                                                                                      
require threads::shared;                                                                                                                                                                                                                                              

my $t = threads->create( sub {                                                                                                                                                                                                                                        

    eval {                                                                                                                                                                                                                                                            
        $SIG{ALRM} = sub { die "alarm\n" };                                                                                                                                                                                                                           
        alarm 2;                                                                                                                                                                                                                                                      
        main();                                                                                                                                                                                                                                                       
        alarm 0;                                                                                                                                                                                                                                                      
    };                                                                                                                                                                                                                                                                
    if ($@){                                                                                                                                                                                                                                                          
        die $@ unless $@ eq "alarm\n";                                                                                                                                                                                                                                
        print "timed out\n";                                                                                                                                                                                                                                          
    }                                                                                                                                                                                                                                                                 
                 }                                                                                                                                                                                                                                                    
    );                                                                                                                                                                                                                                                                

my @r = $t->join;                                                                                                                                                                                                                                                     
print "done\n";                                                                                                                                                                                                                                                       

sub main {                                                                                                                                                                                                                                                            
    sleep 3;                                                                                                                                                                                                                                                          
}

This post表示在alarm库中调用threads时没有信号处理程序。 Another post是关于此问题的，答案建议使用fork和waitpid，但我真的想使用threads。 Another post声称提出了一个解决方案，但这仍然给我Alarm clock错误。我试图抓住Alarm clock中的if ($@)，但没有成功。知道我怎么能做这个工作吗？

Answer 1

在线程中使用警报的整个想法是有问题的。

信号被发送到进程，而不是线程。
如果两个线程想要使用alarm怎么办？

您必须实施自己的系统。以下是对一般解决方案的尝试：

package Threads::Alarm;

use strict;
use warnings;

use threads;
use threads::shared;

use Exporter qw( import );


our @EXPORT_OK = qw( alarm thread_alarm );


# A list of "$time:$tid" strings sorted by ascending time.
my @alarms :shared;

sub thread_alarm {
   my ($wait) = @_;

   my $tid  = threads->tid();

   lock @alarms;

   # Cancel existing alarm for this thread, if any.
   for my $i (0..$#alarms) {
      if ((split(/:/, $alarms[$i]))[1] == $tid) {
         splice(@alarms, $i, 1);
         last;
      }
   }

   # Create an alarm
   if ($wait) {
      my $when = time() + $wait;

      # A binary search would be better.
      my $i;
      for ($i=0; $i<@alarms; ++$i) {
         last if $when < (split(/:/, $alarms[$i]))[0];
      }

      splice(@alarms, $i, 0, "$when:$tid");
   }

   # Notify others of change to @alarms.
   cond_broadcast(@alarms);
}


{
   no warnings 'once';
   *alarm = \&thread_alarm;
}


threads->create(sub {
   while (1) {
      my $thread;

      {
         lock @alarms;

         while (1) {
            # Wait for an alarm request to come in.
            cond_wait(@alarms) while !@alarms;

            # Grab the soonest alarm.
            my ($when, $tid) = split(/:/, $alarms[0]);
            # Check if the thread still exists.
            my $thread = threads->object($tid)
               or last;

            # Wait for the @alarms to change or for the alarm time.    
            last if !cond_timedwait(@alarms, $when);
         }

         # Before releasing the lock, remove the alarm we're about to raise.
         shift(@alarms);

         # Notify others of change to @alarms.
         # Doesn't actually do anything at this time.
         cond_broadcast(@alarms);
      }

      $thread->kill('ALRM') if $thread;
   }
})->detach();


1;

完全未经测试。嗯，我确保它编译，但就是这样。

请注意，threads->kill不发送实际信号（因为它们被发送到进程，而不是线程），因此操作系统不会中断任何操作（例如sleep，{{1} }）。简单的解决方案：在调用wait后立即向处理程序发送一个真正的信号。也许我应该编写一个基于实际threads->kill。

线程内的Perl设置超时失败：'闹钟'

1 个答案: