Perlでセマフォースレッド通信を実装する方法は？

Question

私の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); 

しかし、いくつかのスレッドが他のスレッド（s）はそう言う場合にのみ、ウェブにアクセスする必要があります。

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); 
    } 
} 

は「行く」信号のためのを待っ一つ以上のスレッドがあるかもしれませんし、そのような「行く」信号がを送ることができます一つ以上ののスレッドがあるかもしれません。最初にセマフォーのステータスは "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ループを追加する必要がありますか？

Answer 1

あなたは、この作業を実行するためにThread::Queueに見えるかもしれません。 'go'シグナルを待っているスレッドと 'go'シグナルを送信しているスレッドの間のシグナリングを処理するキューをセットアップできます。ここで私がテストしていない迅速なモックアップだ：

... 
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」信号を待つ必要があるスレッドは。メッセージがキューに入ると、スレッドは1つだけになり、1つのスレッドだけがメッセージを取得して処理します。

実行されないようにスレッドを停止したい場合は、キューの先頭に停止メッセージを挿入することができます。

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

これをより詳細に示しスレッド::キューとthreads CPAN分布の例があります。

あなたの2番目の質問に答えて、答えは、残念ながら、それは異なります。あなたのスレッドを終了させる場合、クリーンシャットダウンにはどのようなクリーンアップが必要ですか？敷物が糸の下から引き出された場合に起こりうる最悪のシナリオは何ですか？クリーンアップが発生するようにいつでも計画したいと思うでしょう。もう1つのオプションは、実際に完了するために各スレッドで待機することです。

detach呼び出しを削除できるかどうかを尋ねる私のコメントの理由は、このメソッドによってメインスレッドが終了し、子スレッドに何が起きているか気にしないためです。あなたはこの呼び出しを削除し、追加した場合代わりに、：

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

をあなたのメインブロックの最後に、これは実際には完全に各スレッドを待つために、メインアプリケーションが必要になります。

detachメソッドをそのまま残しておけば、スレッドで何らかのクリーンアップを実行する必要がある場合は、コードの最後にスリープ状態にする必要があります。スレッドでdetachを呼び出すと、Perlに伝えていることは、メインスレッドが終了したときにスレッドが何をしているか気にしないということです。メインスレッドが終了し、まだ実行中のスレッドが切り離されている場合、プログラムは警告なしで終了します。ただし、クリーンアップが不要で、まだdetachに電話をしている場合は、いつでも自由に終了することができます。

Answer 2

#!/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); 
}