El módulo IO::Pipe proporciona una alternativa orientada a objetos para el uso de pipes:
lhp@nereida:~/Lperl/src/perl_networking/ch2$ cat -n parwithpipes.pl 1 #!/usr/bin/perl 2 use strict; 3 use IO::Pipe; 4 5 local $SIG{CHLD} = sub { 6 while (my $kid = waitpid(-1, 1) > 0) {} # WNOHANG = 1 7 }; 8 9 sub create_child { 10 my ($id, $pipe, $task) = splice @_, 0, 3; 11 my $pid; 12 13 return $pid if $pid = fork(); 14 die "Cannot fork $!" unless defined $pid; 15 16 $pipe->writer; # Set child as writer 17 $task->($id, $pipe, @_); # do something 18 exit; 19 } 20 21 sub parfor { 22 my $LAST = shift; 23 24 my @proc; 25 26 $proc[0] = $$; 27 my $pipe = IO::Pipe->new; 28 for (1..$LAST) { 29 my $task = shift @_; 30 my $sub = shift @$task; 31 $proc[$_] = create_child($_, $pipe, $sub, @$task); 32 } 33 $pipe->reader; 34 return ($pipe, @proc); 35 } 36 37 sub factorial { 38 my ($id, $pipe, $target) = @_; 39 40 my $result; 41 for ( $result = 1,my $i = 1; $i <= $target; $i++) { 42 $result *= $i; 43 } 44 45 # Return $result 46 syswrite $pipe, "$id:$result\n"; 47 } 48 49 sub fibonacci { 50 my ($id, $pipe, $target) = @_; 51 52 my $result; 53 for ($result = 1,my $i = 1; $i <= $target; $i++) { 54 $result += $i; 55 } 56 57 syswrite $pipe, "$id:$result\n"; 58 } 59 60 sub main { 61 my $n = shift @ARGV || 5; 62 my $m = shift @ARGV || $n; 63 64 my ($pipe, @procs) = parfor(2, [\&factorial, $n], [\&fibonacci, $m]); 65 66 for (1..2) { 67 my $result = <$pipe>; 68 print "Father has received:\n$result"; 69 } 70 do {} while wait > 0; 71 } 72 73 main();
Al ejecutar este programa obtenemos una salida como:
lhp@nereida:~/Lperl/src/perl_networking/ch2$ parwithpipes.pl 20 10 Father has received: 2:56 Father has received: 1:2.43290200817664e+18
Casiano Rodríguez León