¿Cómo implementar la comunicación de subprocesos de semáforos en Perl?

Question

script de Perl Mi necesita para ejecutar múltiples hilos simultáneamente ...

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 ... 

... y tales hilos tienen que obtener alguna información de la web, por lo que se utiliza 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); 

Sin embargo, algunos temas necesitan acceder a la web sólo cuando otro hilo (s) lo dice.

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

Puede haber uno o más hilos esperando para señal "ir" y puede haber uno o más hilos que dicha señal de "ir" puede enviar . Al principio, el estado del semáforo es "wait" y una vez que pase a "vaya", se mantendrá así.

Finalmente, la aplicación comprueba el tiempo máximo de funcionamiento. Si los hilos se están ejecutando demasiado tiempo, se envía una señal de auto-terminación.

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

---

Ahora al grano. Mis preguntas son:

1. Cómo puedo más eficaz código de espera "semáforo" en la secuencia de comandos (ver comentarios en la escritura anterior). ¿Debería simplemente usar solo la variable compartida con algún dummysleeploop?

2. ¿Es necesario añadir un poco desleeplazo en el extremo de aplicación para dar tiempo a las discusiones para la autodestrucción?

Answer 1

lo podría hacer en Thread::Queue para llevar a cabo este trabajo. Puede configurar una cola que controle la señalización entre los hilos que esperan la señal de "marcha" y los hilos que envían la señal de "marcha". He aquí una rápida maqueta que no he probado:

... 
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'); 
      } 
     } 
     }, $_); 
... 

Los hilos que hay que esperar a una señal de 'ir' va a esperar en el método de quitar de la cola hasta que algo entra en la cola. Una vez que un mensaje ingresa a la cola, un hilo y solo un hilo captará el mensaje y lo procesará.

Si desea detener los hilos para que no se ejecuten, puede insertar un mensaje de detención en el encabezado de la cola.

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

Hay ejemplos en Hilo :: cola y threads distribuciones CPAN que muestran esto con más detalle.

En respuesta a su segunda pregunta, la respuesta es, lamentablemente, depende. Cuando proceda a terminar sus hilos, ¿qué tipo de limpieza se requiere para un cierre limpio? ¿Cuál es el peor escenario que podría ocurrir si la alfombra fuera arrancada de debajo del hilo? Debería planear en cualquier momento para que se realice la limpieza. La otra opción que puede hacer es esperar en cada hilo para completar realmente.

El motivo de mi comentario que pregunta si puede eliminar la llamada detach es que este método permite que el subproceso principal salga y no importa lo que sucedía con los subprocesos secundarios. En cambio, si se quita esta llamada, y agrega:

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

hasta el final de su bloque principal, esto requerirá la aplicación principal que esperar a que cada hilo de realidad completa.

Si deja el método detach en su lugar, necesitará dormir al final de su código si necesita que sus hilos hagan cualquier tipo de limpieza. Cuando llamas al detach en un hilo, lo que le estás diciendo a Perl es que no te importa qué está haciendo el hilo cuando sale el hilo principal. Si el hilo principal sale y hay hilos que aún se están ejecutando que se han desprendido, entonces el programa terminará sin advertencias. Sin embargo, si no necesita ninguna limpieza y todavía llama al detach, siéntase libre de salir cuando lo desee.

Answer 2

Pruebe algo como esto ....

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