lhp@nereida:~/Lperl/src/perl_networking/ch2$ cat -n fullpipe4.pl 1 #!/usr/bin/perl -w 2 use strict; 3 use IO::Handle; 4 5 { # closure for the pipe channels 6 7 my (@R, @W); # pipe channels 8 9 sub init_pipes { 10 my $lp = shift; # last process index 11 foreach (0..$lp) { 12 pipe($R[$_], $W[$_]); 13 $W[$_]->autoflush(); 14 } 15 } 16 17 sub create_child { 18 my ($id, $task, $args) = @_; 19 my $pid; 20 21 return $pid if $pid = fork(); 22 die "Cannot fork $!" unless defined $pid; 23 close($W[$id]); 24 $task->($id, $R[$id], \@W, @{$args->[$id]}); # do something 25 exit; 26 } 27 28 sub parfor { 29 my $last = shift; 30 my $task = shift; 31 my $args = shift; 32 my @pid; 33 34 $pid[0] = $$; 35 $pid[$_] = create_child($_, $task, $args) for 1..$last; 36 close($W[0]); 37 $task->(0, $R[0], \@W, @{$args->[0]}); 38 my $child; 39 do { $child = waitpid( -1, 0 ) } while ( $child > 0 ); 40 } 41 } # end closure 42 43 sub task { 44 my ($id, $r, $w, @args) = @_; 45 if ($id % 2) { # odd: send 46 my $chan = $w->[$id ^ 1]; 47 print $chan "Hello from $id($$), my arg is @args\n"; 48 } 49 else { # even: receive 50 my $line = <$r>; chomp $line; 51 print "$id ($$): Received <$line>\n"; 52 } 53 } 54 55 #main 56 my $lp = (shift || 3); # last processor id 57 die "Provide an odd number as argument\n" unless ($lp % 2); 58 59 &init_pipes($lp); 60 my @args = map { [1+$_*$_] } 0..$lp; 61 my @pids = &parfor($lp, \&task, \@args);
En la subrutina init_pipes
(líneas 9-15)
se construyen tantas parejas de canales
como procesos haya (contando al padre que será utilizado
durante el trabajo). Como siempre, los canales de escritura
se ponen en modo de escritura sin buffer (línea 13).
Los canales son usados por los restantes procesos para enviar mensajes al proceso . Así pues, una vez el ésimo proceso es creado, se cierra su canal . Dicho de otro modo el proceso no necesita envíar mensajes a si mismo.
Sigue el resultado de una ejecución:
lhp@nereida:~/Lperl/src/perl_networking/ch2$ ./fullpipe3.pl 7 2 (5838): Received <Hello from 3(5839), my arg is 10> 0 (5836): Received <Hello from 1(5837), my arg is 2> 4 (5840): Received <Hello from 5(5841), my arg is 26> 6 (5842): Received <Hello from 7(5843), my arg is 50> lhp@nereida:~/Lperl/src/perl_networking/ch2$
Casiano Rodríguez León