fork
. Puede descargar el módulo
desde CPAN
http://search.cpan.org/~odigity/
o bien desde
Parallel-Simple-0.01.tar.gz.
El módulo
provee la función prun la cual recibe una lista de
referencias a subrutinas que son ejecutadas concurrentemente:
hp@nereida:~/Lperl/src/perl_networking/ch2$ cat -n prun1.pl 1 #!/usr/bin/perl -w 2 use Parallel::Simple qw( prun ); 3 4 # style 1: simple list of code blocks 5 prun( 6 sub { print "$$ foo\n" }, 7 sub { print "$$ bar\n" } 8 ) or die( Parallel::Simple::errplus() ); 9 lhp@nereida:~/Lperl/src/perl_networking/ch2$ prun1.pl 10789 bar 10790 fooSi se desea, es posible usar el formato de llamada con nombre, asignándoles nombres a los procesos:
lhp@nereida:~/Lperl/src/perl_networking/ch2$ cat -n prun3.pl 1 #!/usr/bin/perl -w 2 use Parallel::Simple qw( prun ); 3 4 # style 2: named code blocks (like the Benchmark module) 5 prun( 6 foo => sub { print "$$ foo\n" }, 7 bar => sub { print "$$ bar\n" }, 8 ) or die( Parallel::Simple::errplus() ); lhp@nereida:~/Lperl/src/perl_networking/ch2$ prun3.pl 10797 bar 10798 fooEs posible también especificar argumentos para cada una de las subrutinas:
lhp@nereida:~/Lperl/src/perl_networking/ch2$ cat -n prun4.pl 1 #!/usr/bin/perl -w 2 use Parallel::Simple qw( prun ); 3 4 # getting fancy with arg binding 5 prun( 6 [ sub { print "$$ bar @_\n" }, 1..4 ], 7 [ sub { print "$$ bar @_\n" }, 'a'..'c' ], 8 ) or die( Parallel::Simple::errplus() ); lhp@nereida:~/Lperl/src/perl_networking/ch2$ prun4.pl 10801 bar a b c 10802 bar 1 2 3 4
Es posible pasar opciones a prun
como último argumento una referencia a
un hash conteniendo las parejas opción-valor:
lhp@nereida:~/Lperl/src/perl_networking/ch2$ cat -n prun2.pl 1 #!/usr/bin/perl -w 2 use Parallel::Simple qw( prun ); 3 4 # style 1 with options 5 prun( 6 sub { print "$$ foo\n"; 0 }, 7 sub { print "$$ bar\n" }, 8 { use_return => 1 }, 9 ) or die( Parallel::Simple::errplus() ); 10 lhp@nereida:~/Lperl/src/perl_networking/ch2$ prun2.pl 10859 bar 10860 foo only 1 of 2 blocks completed successfully 0 => 0 1 => 256
La opción use_return
hace que el valor retornado por
el bloque se utilice como valor de retorno del proceso. La
función prun
devuelve 1 si ningún proceso falló y cero en otro caso.
Esa es la razón por la que en el ejemplo se ejecuta el die
de la línea
9. (La función print
retorna un 1 si la escritura pudo hacerse).
La otra opción permitida es abort_on_error
la cual hace
que prun
aborte la ejecución si alguno de los procesos devuelve
un valor distinto de cero.
Nótese que en tal caso se le asigna al proceso asesinado un código
de retorno de -1 (véase la línea 42 del fuente de prun
mas abajo).
El código del módulo es un ejemplo de como combinar simplicidad y eficiencia:
1 sub prun { 2 ( $error, $return_values ) = ( undef, undef ); # reset globalsEl módulo tiene dos funciones
err
y rv
cuyos códigos
se limitan a retornar dos variables léxicas $error
y
$return_values
. La variable de error contiene
un mensaje informativo sobre el tipo de error que se ha producido.
Se puede obtener mas información sobre los errores consultando
la variable $return_values
. Si se ha usado una llamada con nombres
esta variable es una referencia a un hash
con claves los nombres de los procesos y valores los valores de retorno de
los mismos. En otro caso es un array conteniendo los valores de
retorno.
3 return 1 unless ( @_ ); # return true if 0 args passed 4 my %options = %{pop @_} if ( ref($_[-1]) =~ /HASH/ ); # grab options, if specified 5 return 1 unless ( @_ ); # return true if 0 code blocks passed
El último argumento contiene las opciones si es una referencia a un hash. La línea 4 da cuenta de ello.
8 my $named = ref($_[0]) ? 0 : 1; # if first element is a subref, they're not named 9 my $i = 0; # used to turn array into hash with array-like keys 10 my %blocks = $named ? @_ : map { $i++ => $_ } @_;
Si la llamada fué ''sin nombres'' se reconvierte la lista de argumentos para producir una aparente llamada con nombres: los nombres son los índices de posición.
13 my %child_registry; # pid => { name => $name, return_value => $return_value } 14 while ( my ( $name, $block ) = each %blocks ) { 15 my $child = fork(); 16 unless ( defined $child ) { 17 $error = "$!"; 18 last; # something's wrong; stop trying to fork 19 } 20 if ( $child == 0 ) { # child 21 my ( $subref, @args ) = ref($block) =~ /ARRAY/ ? @$block : ( $block ); 22 my $return_value = eval { $subref->( @args ) }; 23 warn( $@ ) if ( $@ ); # print death message, because eval doesn't 24 exit( $@ ? 255 : $options{use_return} ? $return_value : 0 ); 25 } 26 $child_registry{$child} = { name => $name, return_value => undef }; 27 }El hash
%child_registry
tiene por claves los PID
. Su valor es un
hash anónimo con claves name
y return_value
.
La variable $block
es una de dos:
Una referencia a una lista ( $subref, @args )
o bien
simplemente una referencia a la subrutina a ejecutar (línea 21).
La subrutina se ejecuta en la línea 22. El código de error
se examina en las líneas 23 y 24.
A las alturas de la línea
26 (ejecutada sólo por el padre)
no se conoce aún el valor de retorno y por eso se pone a undef
.
30 my $successes = 0; 31 my $child; 32 do { 33 $child = waitpid( -1, 0 );La espera por la finalización de un hijo en la línea 33 es síncrona.
34 if ( $child > 0 and exists $child_registry{$child} ) { 35 $child_registry{$child}{return_value} = $? 36 unless ( defined $child_registry{$child}{return_value} ); 37 $successes++ if ( $? == 0 ); 38 if ( $? > 0 and $options{abort_on_error} ) { 39 while ( my ( $pid, $child ) = each %child_registry ) { 40 unless ( defined $child->{return_value} ) { 41 kill( 9, $pid ); 42 $child->{return_value} = -1; 43 } 44 } 45 } 46 } 47 } while ( $child > 0 );Si la opción
abort_on_error
está activada y un proceso termina
con un código de error se eliminan
todos los procesos arrancados y que no
hayan finalizado.
Para ello se comprueba el estatus de retorno
del proceso almacenado en $?
. Si es distinto de cero se procede a abortar
los procesos hijo envíandoles mediante la
llamada kill (9, $pid )
.
La función kill permite el envío de señales a otros procesos. Su modo de uso es:
$count = kill($signal, @processes);
La llamada envía la señal $signal
a los procesos cuyos PID están en la lista
@processes
. El resultado devuelve el número de procesos
a los que la señal llegó con éxito.
Las señales serán estudiadas en mas detalle
en la sección
3.4.
Nótese que pudiera ocurrir que un proceso p1
terminará con éxito al mismo tiempo
o poco después que otro proceso p2
lo hace con error. En tal caso
la llamada a kill
de la línea 41 sobre p1
fracasa en matar el zombi p1
ya que este ''ha muerto''. Sin embargo
se establece la entrada $child->{return_value}
a -1
.
En este caso el waitpid
de la línea 33 cosecha posteriormente
al zombi resultante de p1
. Observe que bajo estas circunstancias
la condición
de la línea 36 'defined $child_registry{$child}{return_value}
'
es cierta.
Por último se calcula el valor de retorno.
La variable $return_values
contendrá un hash anónimo con las parejas
formadas por el nombre lógico del proceso y su valor de retorno si la llamada
a prun
usó el formato con nombres. En otro caso
$return_values
contiene una referencia a un array
con los valores de retorno. Para ordenar los valores de retorno
(líneas 52 y 53) es necesario usar el criterio de comparación
numérica ($a->{name} <=> $b->{name}
).
49 # store return values using appropriate data type 50 $return_values = $named 51 ? { map { $_->{name} => $_->{return_value} } values %child_registry } 52 : [ map { $_->{return_value} } sort { $a->{name} <=> $b->{name} } 53 values %child_registry 54 ]; 55 56 my $num_blocks = keys %blocks; 57 return 1 if ( $successes == $num_blocks ); # all good! 58 59 $error = "only $successes of $num_blocks blocks completed successfully"; 60 return 0; # sorry... better luck next time 61 }El número de claves en
%blocks
es el número total de procesos.
fork
s de manera que le ayude a comprender
el código de prun
.Casiano Rodríguez León