6

我的 Perl 脚本需要同时运行多个线程...

use threads ('yield', 'exit' => 'threads_only');
use threads::shared;
use strict;
use warnings;
 no warnings 'threads';
use LWP::UserAgent;
use HTTP::Request;
use HTTP::Async;
use ...

...并且此类线程需要从网络获取一些信息，因此HTTP::Async使用。

my $request = HTTP::Request->new;
   $request->protocol('HTTP/1.1');
   $request->method('GET');
   $request->header('User-Agent' => '...');

my $async = HTTP::Async->new( slots            => 100,
                              timeout          => REQUEST_TIMEOUT,
                              max_request_time => REQUEST_TIMEOUT );

但是只有当其他线程这样说时，某些线程才需要访问网络。

my $start = [Time::HiRes::gettimeofday()];
my @threads = ();
foreach ... {
  $thread = threads->create(
    sub {
           local $SIG{KILL} = sub { threads->exit };
           my $url = shift;
           if ($url ... ) {
             # wait for "go" signal from other threads
           }
           my ($response, $data);
           $request->url($url);
           $data = '';
           $async->add($request);
           while ($response = $async->wait_for_next_response) {
             threads->yield();
             $data .= $response->as_string;
           }
           if ($data ... ) {
             # send "go" signal to waiting threads
           }
         }
       }, $_);

  if (defined $thread) {
    $thread->detach;
    push (@threads, $thread);
  }
}

可能有一个或多个线程在等待“go”信号，并且可能有一个或多个线程可以发送这样的“go”信号。信号量一开始的状态是“ wait ”，一旦变成“ go ”，就一直这样。

最后，应用程序检查最大运行时间。如果线程运行时间过长，则会发送自终止信号。

my $running;
do {
  $running = 0;
  foreach my $thread (@threads) {
    $running++ if $thread->is_running();
  }
  threads->yield();
} until (($running == 0) || 
         (Time::HiRes::tv_interval($start) > MAX_RUN_TIME));
$running = 0;
foreach my $thread (@threads) {
  if ($thread->is_running()) {
    $thread->kill('KILL');
    $running++;
  }
}
threads->yield();

现在说到重点。我的问题是：

  1. 我怎样才能最有效地在脚本中编写等待“信号量”的代码（参见上面脚本中的注释）。我应该只使用带有一些虚拟 sleep 循环的共享变量吗？

  2. 我是否需要 sleep 在应用程序末尾添加一些循环以给线程时间进行自毁？

4

2 回答 2

3

您可能会查看Thread::Queue来执行这项工作。您可以设置一个队列来处理等待“开始”信号的线程和发送“开始”信号的线程之间的信号。这是一个我没有测试过的快速模型：

...
use Thread::Queue;
...
# In main body
my $q = Thread::Queue->new();
...
$thread = threads->create(
    sub {
           local $SIG{KILL} = sub { threads->exit };
           my $url = shift;
           if ($url ... ) {
             # wait for "go" signal from other threads
             my $mesg = $q->dequeue();
             # you could put in some termination code if the $mesg isn't 'go'
             if ($mesg ne 'go') { ... }
           }
           ...
           if ($data ... ) {
             # send "go" signal to waiting threads
             $q->enqueue('go');
           }
         }
       }, $_);
...

需要等待“go”信号的线程将在 dequeue 方法上等待，直到有东西进入队列。一旦消息进入队列，一个线程并且只有一个线程会抓取消息并处理它。

如果您希望停止线程以便它们不会运行，您可以在队列的头部插入一条停止消息。

$q->insert(0, 'stop') foreach (@threads);

Thread::Queue 和线程CPAN 分布中的示例更详细地显示了这一点。

在回答您的第二个问题时，不幸的是，答案是视情况而定。当您继续终止线程时，干净关闭需要什么样的清理？如果地毯从线下被拉出，可能发生的最坏情况是什么？您可能希望随时计划进行清理。您可以做的另一个选择是等待每个线程实际完成。

我的评论询问您是否可以删除detach调用的原因是因为此方法允许主线程退出而不关心任何子线程发生了什么。相反，如果您删除此调用，并添加：

$_->join() foreach threads->list();

到主块的末尾，这将要求主应用程序等待每个线程实际完成。

如果您保留该detach方法，那么如果您需要线程执行任何类型的清理，您将需要在代码末尾休眠。当你调用detach一个线程时，你告诉 Perl 的是当你的主线程退出时你不关心线程在做什么。如果主线程退出并且有线程仍在运行且已分离，则程序将在没有警告的情况下完成。但是，如果您不需要任何清理，并且仍然调用detach，请随时退出。

于 2012-05-08T14:58:05.913 回答
-1

试试这样的东西......

#!/usr/bin/perl

use threads;
use threads::shared;

$|=1;

my ($global):shared;
my (@threads);

push(@threads, threads->new(\&mySub,1));
push(@threads, threads->new(\&mySub,2));
push(@threads, threads->new(\&mySub,3));

$i = 0;

foreach my $myThread(@threads)

{
    my @ReturnData = $myTread->join ;
    print "Thread $i returned: @ReturnData\n";
    $i++;
}

sub mySub
{
    my ($threadID) = @_;

    for(0..1000)
    {
        $global++;
        print "Thread ID: $threadID >> $_ >> GLB: $global\n";
        sleep(1);
    }   
    return( $id );
}
于 2012-05-16T05:05:14.407 回答