El Módulo IO::Pipe

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