Как реализовать семафорную потоковую связь в Perl?

мой скрипт 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 ...

...и такие потоки должны получать некоторую информацию из интернета, поэтому есть.

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 " может отправить. В начале семафор имеет статус"ждать "и как только он превращается в" 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. как я могу больше всего эффективно код ждет "семафор" в скрипте (см. комментарии в скрипте выше). Должен ли я просто использовать только общую переменную с некоторым dummy sleep петли?

  2. мне нужно добавить sleep цикл в конце приложения, чтобы дать время потокам для самоуничтожения?

6
multiprocessing multithreading perl process semaphore

2 ответов

на 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", будут ждать метода dequeue, пока что-то не войдет в очередь. Как только сообщение войдет в очередь, один поток и только один поток захватит сообщение и обработать его.

если вы хотите остановить потоки, чтобы они не запускались, вы можете вставить сообщение остановки в начало очереди.

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

есть примеры в Thread::Queue и темы распределения CPAN, которые показывают это более подробно.

в ответ на ваш второй вопрос, то ответ, К сожалению, это зависит. Когда вы приступаете к завершению своих потоков, какая очистка требуется для чистого завершения работы? Какой худший сценарий может произойти, если ковер выдернут из-под нити? Вы хотели бы планировать в любое время для подчистки. Другой вариант, который вы можете сделать, - это дождаться завершения каждого потока.

причина моего комментария, спрашивающего, можете ли вы удалить detach вызов потому, что этот метод позволяет основному потоку выйти и не заботиться о том, что происходит с любыми дочерними потоками. Вместо этого, если вы удалите этот вызов, и добавить:

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

до конца вашего основного блока это потребует, чтобы основное приложение дождалось завершения каждого потока.

если вы оставите detach способ, то вам придется спать в конце вашего кода, если вы желаете темы для выполнения какой-либо очистки. Когда вы звоните detach в потоке вы говорите Perl, что вам все равно, что делает поток, когда ваш основной поток выходит. Если основной поток выходит и там это потоки, которые все еще работают, которые были отсоединены, тогда программа завершится без предупреждений. Однако, если вам не требуется никакой очистки, и вы все равно позвоните detach, не стесняйтесь выходить, когда захотите.

3

попробуйте что-то вроде этого....

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