File Coverage

blib/lib/Acme/Fork/Lazy.pm
Criterion Covered Total %
statement 37 37 100.0
branch 2 2 100.0
condition n/a
subroutine 10 10 100.0
pod 2 2 100.0
total 51 51 100.0


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2 7     7   204092 use strict; use warnings;
  7     7   14  
  7         10010  
  7         77  
  7         14  
  7         728  
3              
4             package Acme::Fork::Lazy;
5              
6             =head1 NAME
7              
8             Acme::Fork::Lazy - abstract forking with lazy variables
9              
10             =head1 SYNOPSIS
11              
12             use Acme::Fork::Lazy qw/:all/;
13             use feature 'say';
14              
15             ###
16             # Single parallel calculation
17              
18             my $foo = forked { expensive_calculation_to_do_in_parallel() };
19             # ...then (sooner or later...)
20             say $foo;
21              
22             ###
23             # Parallel map
24              
25             my @list = map forked { sleep $_; $_*2 }, 1..10;
26             sleep 5; # gives enough time for first 5 elements to be calculated
27             say $_ for @list;
28              
29             ###
30              
31             END {
32             wait_kids; # make sure we're not leaving behind any zombies
33             }
34              
35             =head1 DESCRIPTION
36              
37             We often want to fork a process with an expensive calculation. This involves making the child
38             write the answer back to the parent, who will then have to poll the child occasionally to check
39             if it answered back. There are abstractions, like L (lovely if you're already
40             using L). This is another one, using lazy variables:
41              
42             =head2 C
43              
44             my $foo = forked { do_calculation() };
45             print "The answer was $foo\n";
46              
47             C returns a lazy calculation that will wait on the child process and return its
48             result as a Perl data structure. If the child process isn't ready, then it will wait for it.
49             This means that you could just as easily do:
50              
51             my $foo = forked { do_calculation() };
52             do_some_stuff_that_might_take_about_the_same_time_as_calculation();
53             print "The answer was $foo\n";
54              
55             without having to worry about polling etc. if the work in the main process didn't quite take
56             long enough.
57              
58             Note that the forked result must be a scalar.
59              
60             =head2 C
61              
62             END {
63             wait_kids();
64             }
65              
66             Place this anywhere that you'd like to stop and wait for the children to catch up,
67             and in particular in an END block to avoid producing zombies.
68              
69             =head1 BUGS and TODO
70              
71             Lots. Once those are resolved, we could upgrade this from C to C.
72              
73             =over 4
74              
75             =item *
76              
77             The Lazy modules (see L) are all currently broken in various
78             exciting ways. So you may find that certain uses (like using L
79             to output the result) won't trigger forcing the lazy result, and so on.
80              
81             =item *
82              
83             Only scalar values may be returned by a C block.
84              
85             =item *
86              
87             No attempt is made to handle failure: timeouts/retry/error etc.
88              
89             =item *
90              
91             The client has to manually call C in END to make sure all kids
92             exited cleanly.
93              
94             =back
95              
96             Suggestions and patches for any of the above are very welcome (as well as new
97             bug reports!)
98              
99             =head1 SEE ALSO
100              
101             =over 4
102              
103             =item *
104              
105             The lazy semantics are provided by one of the following:
106              
107             =over 8
108              
109             =item L
110              
111             The original, by Audrey Tang
112              
113             =item L
114              
115             An ambitious and complex implementation by Nothingmuch.
116              
117             =item L
118              
119             A much simpler implementation.
120              
121             =back
122              
123             =item *
124              
125             The result is currently sent back from the child process coded in L.
126              
127             =item *
128              
129             If you can stomach POE, look at L
130              
131             =item *
132              
133             Various IPC modules wrap C in more or less palatable ways: L, L, etc.
134              
135             =back
136              
137             =head1 AUTHOR and LICENSE
138              
139             (C) 2008 osfameron@cpan.org
140              
141             This module is distributed under the same conditions as Perl itself.
142              
143             =cut
144              
145             our $VERSION = 0.03;
146              
147 7     7   8470 use IO::Pipe;
  7         95298  
  7         245  
148 7     7   8841 use YAML;
  7         99169  
  7         511  
149             # use Data::Thunk;
150             # use Scalar::Lazy;
151 7     7   8204 use Scalar::Defer;
  7         163436  
  7         63  
152             # all need a kludge for reference example
153              
154 7     7   588 use base 'Exporter';
  7         7  
  7         1981  
155             our %EXPORT_TAGS = (
156             all => [ qw/ forked wait_kids / ],
157             );
158             Exporter::export_ok_tags('all');
159              
160             sub forked (&) {
161 27     27 1 346088 my $sub = shift;
162 27         623 my $p = IO::Pipe->new();
163              
164 27 100       56736 if (my $child = fork) {
165 21         2533 $p->reader;
166             return lazy {
167 15     15   11519312 waitpid $child, 0;
168 15         289 local $/ = undef;
169 15         832 my $result = <$p>;
170 15         315 Load($result);
171 21         11301 };
172             } else {
173 6         1142 $p->writer;
174 6         2444 my @result = $sub->();
175 6         10001208 print $p Dump(@result);
176 6         151776 exit;
177             }
178             }
179             sub wait_kids {
180             # Wait on all kids, possibly getting rid of zombies etc.
181 7     7   8855 use POSIX ":sys_wait_h";
  7         73031  
  7         56  
182 1     1 1 3503 my $kid;
183 1         9 do {
184 1         18 $kid = waitpid(-1, 0);
185             } while $kid > 0;
186             }
187              
188             1;