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; |