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