Perl线程和不安全信号

Question

所以我最近想要通过一个Perl程序来提高速度。考虑到网站列表，我想为每个网址开始一个线索并获取每个网站的内容，然后在页面上查找公司描述。一旦一个线程找到了结果，或者所有线程都没有，我想退出，写下我的结果，然后阅读我的下一个公司的URL。

我看到的问题是我在创建线程时调用的函数内部使用了Perl :: Unsafe :: Signals模块。我需要不安全的信号来中断正在被卡住的正则表达式。但是，这似乎会导致各种各样的问题，主要是程序崩溃，并显示错误消息“闹钟”。

因此，有没有一种方法可以安全地使用Perl :: Unsafe :: Signals和线程？有没有办法通过向函数发送信号以另一种方式超时正则表达式（例如，我在下面发送'KILL'信号？）谢谢。

注：我将代码分解到所有相关部分，让我知道你是否需要更多。

use threads ('exit' => 'threads_only'); 
use threads::shared; 
my @descrip; 
share(@descrip); 

my $lock; 
share($lock); 

URL:foreach my $url(@unique_urls) { 
     #skip blank urls 
     if(!$url) { next URL; }#if 

     #find description 
     my $thread = threads->create(\&findCompanyDescription, $PREV_COMPANY, $PREV_BASE_URL, $url); 

#while a description has not been found and there are still active threads, keep looking 
#there may be a better way to do this, but this seems to work for me 
while(!@descrip && threads->list() != 0) {;} 

#kill all threads, write output, read in next batch of urls 
my @threads = threads->list(); 
foreach(@threads) { print("detaching\n"); $_->kill('KILL')->detach(); }#foreach 

####### SUBROUTINE CALLED BY THREAD CREATE

sub findCompanyDescription { 
    my($company_full, $base_url, $url) = @_; 
    my($descrip, $raw_meta, $raw) = ''; 
    my @company; 

    $SIG{'KILL'} = sub { alarm(0); threads->exit(); }; 

    eval { 
     local $SIG{ALRM} = sub { die("alarm\n") }; # NB: \n required 
     alarm(5); 

     use Perl::Unsafe::Signals; 
     UNSAFE_SIGNALS { 

      while($company) { 
      my @matches = ($content =~ m!.*<([\w\d]+).*?>\s*about\s+$company[\w\s\-_]*<.*?>(?:<.*?>|\s)*(.*?)</\1.*?>!sig); 

      MATCH:for(my $ndx=1; $ndx<@matches; $ndx+=2) { 
      ($raw, $descrip) = &filterResult($matches[$ndx], $company_full); 

      if($descrip) { 
       $company = undef; 
       last(MATCH); 
      }#if 
     }#for 

     #reduce the company name and try again 
     $company = &reduceCompanyName($company); 

     }#while 

     alarm(0); 
     };#unsafe_signals 
    };#eval 

    if($@) { 
     if($@ eq "alarm\n" && $DEBUG) { print("\nWebpage Timeout [].\n"); }#if 
    }#if 

    if($descrip) { lock($lock); { 
     @descrip = ($PREV_ID, $company_full, $base_url, $url, 1, $raw, $descrip); } 
    }#if 

Answer 1

一般而言， “不安全” 的信号是不安全的两个单线程和多线程。您只会通过使用线程和不安全的信号增加了您的危险。 Perl的通常的安全信号处理程序设置标志signal_pending而没有有意义的中断执行。 VM在操作码之间检查该标志。

您的正则表达式执行是一个单一的“原子”操作码。当然，正则表达式本身是另一个具有自己的操作码的虚拟机，但是我们目前对perl信号处理程序没有可见性。

坦率地说，我不知道如何中断正则表达式引擎。它有一些全球C状态，在过去的perl-5.10之前，它阻止了它的重入。像您正在尝试的那样，通用中断性可能并不安全。如果你真的希望它是完全可中断的，你可能想要分叉并让你的子进程执行正则表达式，并通过管道传回结果。

require JSON; 
require IO::Select; 

my $TIMEOUT_SECONDS = 2.5; # seconds 

my ($read, $write); 
pipe $read, $write; 

my @matches; 
my $pid = fork; 
if ($pid) { 

    my $select = IO::Select->new($read); 
    if ($select->can_read($TIMEOUT_SECONDS)) { 
     local $/; 
     my $json = <$read>; 
     if ($json) { 
      my $matches_ref = JSON::from_json($json); 
      if ($matches_ref) { 
       @matches = @$matches_ref; 
      } 
     } 
    } 
    waitpid $pid, 0; 
} 
else { 
    my @r = $content =~ m!.*<([\w\d]+).*?>\s*about\s+$company[\w\s\-_]*<.*?>(?:<.*?>|\s)*(.*?)</\1.*?>!sig; 
    my $json = JSON::to_json(\ @r); 
    print { $write } $json; 
    close $write; 
    exit; 
} 

Answer 2

恕我直言，混合信号和线程本身是一项具有挑战性的任务（即没有特定的东西）。 请记住，即使在单线程程序中，您也可以安全地仅从信号处理程序调用异步信号安全函数，因为程序可能会在任何时候中断。 Perl增加了另一层抽象层，所以我不知道在信号不安全的情况下从信号处理器调用“死”的安全性。

如果我没记错，SIGALRM是异步信号，所以必须同步处理。多线程程序中处理它的方式通常不正确。

此外，恕我直言perl线程不会像大多数人所期望的那样工作。 只需避免使用它们并使用进程。

P.S.

以下行没有任何意义：

$SIG{'KILL'} = sub { alarm(0); threads->exit(); };

SIGKILL（以及SIGSTOP）不能被捕获。

Answer 3

我并不是真正的Perl-MT专家，但是你显然缺少的一件事是信号在整个过程中是全局性的 - 它们不是线程特定的。在POSIX系统上，您不能为线程设置信号处理程序：信号传递到整个进程。调用影响整个过程，而不仅仅是调用它的线程。即使在MT环境中的local %SIG也不会做人们可能会认为它的做法 - 因为local是语法问题。