El Módulo Parallel::Simple

El módulo Parallel::Simple escrito por Ofer Nave nos proporciona un buen ejemplo de como se debe organizar la gestión de procesos mediante 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 foo

Si 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 foo

Es 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 globals

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

Ejercicio 3.9.1   Lea en avance la sección 3.3. Use el debugger de perl para estudiar la conducta de un programa con forks de manera que le ayude a comprender el código de prun.