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
