Codebase list libparallel-forkmanager-perl / 465388a
Build results of b8189ed (on master) Yanick Champoux 8 years ago
22 changed file(s) with 1401 addition(s) and 91 deletion(s). Raw diff Collapse all Expand all
+0
-8
.gitignore less more
0 .build
1 /MYMETA.json
2 /MYMETA.yml
3 /Makefile
4 /README
5 /blib/
6 /pm_to_blib
7 /Parallel-ForkManager-*
+0
-13
.hgignore less more
0 \.DS_Store
1 Makefile
2 Makefile.old
3 .*.tar.gz
4 blib
5 MYMETA.*
6 META.yml
7 META.json
8 MANIFEST
9 MANIFEST.bak
10 .*.swp
11 cover_db
12 README
+0
-8
.mailmap less more
0 Yanick Champoux <yanick@cpan.org> <yanick@babyl.dyndns.org>
1 Gabor Szabo <gabor@szabgab.com> <szabgab@gmail.com>
2 Balazs Szabo (dLux) <dlux@dlux.hu> <devnull@localhost>
3 Balazs Szabo (dLux) <dlux@dlux.hu> <devnull@localhost>
4 Balazs Szabo (dLux) <dlux@dlux.hu> <dluxhu@users.noreply.github.com>
5
6
7
+0
-12
.travis.yml less more
0 branches:
1 except:
2 - gh-pages
3 language: perl
4 perl:
5 - "5.20"
6 - "5.18"
7 - "5.16"
8 - "5.14"
9 - "5.12"
10 - "5.10"
11
+12
-0
CONTRIBUTORS less more
0
1 # PARALLEL-FORKMANAGER CONTRIBUTORS #
2
3 This is the (likely incomplete) list of people who have helped
4 make this distribution what it is, either via code contributions,
5 patches, bug reports, help with troubleshooting, etc. A huge
6 'thank you' to all of them.
7
8 * Ninebit
9 * Shlomi Fish
10
11
+3
-12
Changes less more
00 Revision history for Perl extension Parallel::ForkManager.
11
2 {{$NEXT}}
2 1.17 2015-11-28
33 - Up Test::More's dependency version to v0.94 (because of 'subtest').
4 (GH#8, mauke)
5
6 [ API CHANGES ]
7
8 [ BUG FIXES ]
9
10 [ DOCUMENTATION ]
11
12 [ ENHANCEMENTS ]
13
14 [ NEW FEATURES ]
4 (GH#8, mauke)
155
166 [ STATISTICS ]
7 - code churn: 3 files changed, 88 insertions(+), 70 deletions(-)
178
189 1.16 2015-10-08
1910 - wait_one_child wasn't waiting at all. (RT#107634, Slaven Rezic, Yanick)
+43
-0
INSTALL less more
0 This is the Perl distribution Parallel-ForkManager.
1
2 Installing Parallel-ForkManager is straightforward.
3
4 ## Installation with cpanm
5
6 If you have cpanm, you only need one line:
7
8 % cpanm Parallel::ForkManager
9
10 If you are installing into a system-wide directory, you may need to pass the
11 "-S" flag to cpanm, which uses sudo to install the module:
12
13 % cpanm -S Parallel::ForkManager
14
15 ## Installing with the CPAN shell
16
17 Alternatively, if your CPAN shell is set up, you should just be able to do:
18
19 % cpan Parallel::ForkManager
20
21 ## Manual installation
22
23 As a last resort, you can manually install it. Download the tarball, untar it,
24 then build it:
25
26 % perl Makefile.PL
27 % make && make test
28
29 Then install it:
30
31 % make install
32
33 If you are installing into a system-wide directory, you may need to run:
34
35 % sudo make install
36
37 ## Documentation
38
39 Parallel-ForkManager documentation is available as POD.
40 You can run perldoc from a shell to read the documentation:
41
42 % perldoc Parallel::ForkManager
+0
-21
MANIFEST.SKIP less more
0 dist.ini
1 ^.travis.yml
2 ^.git
3 ^.cvsignore
4 ^.hg
5 ^Makefile(.old)?$
6 ^Build$
7 ^Clean$
8 ^RollingBuild$
9 ^blib/.*
10 ^pm_to_blib$
11 ^(.*/)?.cvsignore$
12 ^MANIFEST.bak$
13 ^make[-.]pm$
14 ^INFO.yaml$
15 ^_build/
16 ^MYMETA.*
17 \.gz$
18 ^cover_db/
19 MANIFEST.SKIP
20 Parallel-ForkManager-.*
+84
-0
META.json less more
0 {
1 "abstract" : "A simple parallel processing fork manager",
2 "author" : [
3 "dLux (Szabó, Balázs) <dlux@dlux.hu>",
4 "Yanick Champoux <yanick@cpan.org>",
5 "Gabor Szabo <gabor@szabgab.com>"
6 ],
7 "dynamic_config" : 0,
8 "generated_by" : "Dist::Zilla version 5.040, CPAN::Meta::Converter version 2.150001",
9 "license" : [
10 "perl_5"
11 ],
12 "meta-spec" : {
13 "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
14 "version" : "2"
15 },
16 "name" : "Parallel-ForkManager",
17 "prereqs" : {
18 "configure" : {
19 "requires" : {
20 "ExtUtils::MakeMaker" : "0"
21 }
22 },
23 "develop" : {
24 "requires" : {
25 "Test::More" : "0.96",
26 "Test::PAUSE::Permissions" : "0",
27 "Test::Vars" : "0",
28 "warnings" : "0"
29 }
30 },
31 "runtime" : {
32 "requires" : {
33 "Carp" : "0",
34 "File::Path" : "0",
35 "File::Spec" : "0",
36 "File::Temp" : "0",
37 "POSIX" : "0",
38 "Storable" : "0",
39 "strict" : "0"
40 }
41 },
42 "test" : {
43 "recommends" : {
44 "CPAN::Meta" : "2.120900"
45 },
46 "requires" : {
47 "ExtUtils::MakeMaker" : "0",
48 "File::Spec" : "0",
49 "IO::Handle" : "0",
50 "IPC::Open3" : "0",
51 "Test::More" : "0.94",
52 "Test::Warn" : "0",
53 "perl" : "5.006",
54 "warnings" : "0"
55 }
56 }
57 },
58 "provides" : {
59 "Parallel::ForkManager" : {
60 "file" : "lib/Parallel/ForkManager.pm",
61 "version" : "1.17"
62 }
63 },
64 "release_status" : "stable",
65 "resources" : {
66 "bugtracker" : {
67 "web" : "https://github.com/dluxhu/perl-parallel-forkmanager/issues"
68 },
69 "homepage" : "https://github.com/dluxhu/perl-parallel-forkmanager",
70 "repository" : {
71 "type" : "git",
72 "url" : "https://github.com/dluxhu/perl-parallel-forkmanager.git",
73 "web" : "https://github.com/dluxhu/perl-parallel-forkmanager"
74 }
75 },
76 "version" : "1.17",
77 "x_authority" : "cpan:DLUX",
78 "x_contributors" : [
79 "Ninebit <kevin@9b.io>",
80 "Shlomi Fish <shlomif@shlomifish.org>"
81 ]
82 }
83
+45
-0
META.yml less more
0 ---
1 abstract: 'A simple parallel processing fork manager'
2 author:
3 - 'dLux (Szabó, Balázs) <dlux@dlux.hu>'
4 - 'Yanick Champoux <yanick@cpan.org>'
5 - 'Gabor Szabo <gabor@szabgab.com>'
6 build_requires:
7 ExtUtils::MakeMaker: '0'
8 File::Spec: '0'
9 IO::Handle: '0'
10 IPC::Open3: '0'
11 Test::More: '0.94'
12 Test::Warn: '0'
13 perl: '5.006'
14 warnings: '0'
15 configure_requires:
16 ExtUtils::MakeMaker: '0'
17 dynamic_config: 0
18 generated_by: 'Dist::Zilla version 5.040, CPAN::Meta::Converter version 2.150001'
19 license: perl
20 meta-spec:
21 url: http://module-build.sourceforge.net/META-spec-v1.4.html
22 version: '1.4'
23 name: Parallel-ForkManager
24 provides:
25 Parallel::ForkManager:
26 file: lib/Parallel/ForkManager.pm
27 version: '1.17'
28 requires:
29 Carp: '0'
30 File::Path: '0'
31 File::Spec: '0'
32 File::Temp: '0'
33 POSIX: '0'
34 Storable: '0'
35 strict: '0'
36 resources:
37 bugtracker: https://github.com/dluxhu/perl-parallel-forkmanager/issues
38 homepage: https://github.com/dluxhu/perl-parallel-forkmanager
39 repository: https://github.com/dluxhu/perl-parallel-forkmanager.git
40 version: '1.17'
41 x_authority: cpan:DLUX
42 x_contributors:
43 - 'Ninebit <kevin@9b.io>'
44 - 'Shlomi Fish <shlomif@shlomifish.org>'
+70
-0
Makefile.PL less more
0 # This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v5.040.
1 use strict;
2 use warnings;
3
4 use 5.006;
5
6 use ExtUtils::MakeMaker;
7
8 my %WriteMakefileArgs = (
9 "ABSTRACT" => "A simple parallel processing fork manager",
10 "AUTHOR" => "dLux (Szab\x{f3}, Bal\x{e1}zs) <dlux\@dlux.hu>, Yanick Champoux <yanick\@cpan.org>, Gabor Szabo <gabor\@szabgab.com>",
11 "CONFIGURE_REQUIRES" => {
12 "ExtUtils::MakeMaker" => 0
13 },
14 "DISTNAME" => "Parallel-ForkManager",
15 "LICENSE" => "perl",
16 "MIN_PERL_VERSION" => "5.006",
17 "NAME" => "Parallel::ForkManager",
18 "PREREQ_PM" => {
19 "Carp" => 0,
20 "File::Path" => 0,
21 "File::Spec" => 0,
22 "File::Temp" => 0,
23 "POSIX" => 0,
24 "Storable" => 0,
25 "strict" => 0
26 },
27 "TEST_REQUIRES" => {
28 "ExtUtils::MakeMaker" => 0,
29 "File::Spec" => 0,
30 "IO::Handle" => 0,
31 "IPC::Open3" => 0,
32 "Test::More" => "0.94",
33 "Test::Warn" => 0,
34 "warnings" => 0
35 },
36 "VERSION" => "1.17",
37 "test" => {
38 "TESTS" => "t/*.t"
39 }
40 );
41
42
43 my %FallbackPrereqs = (
44 "Carp" => 0,
45 "ExtUtils::MakeMaker" => 0,
46 "File::Path" => 0,
47 "File::Spec" => 0,
48 "File::Temp" => 0,
49 "IO::Handle" => 0,
50 "IPC::Open3" => 0,
51 "POSIX" => 0,
52 "Storable" => 0,
53 "Test::More" => "0.94",
54 "Test::Warn" => 0,
55 "strict" => 0,
56 "warnings" => 0
57 );
58
59
60 unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) {
61 delete $WriteMakefileArgs{TEST_REQUIRES};
62 delete $WriteMakefileArgs{BUILD_REQUIRES};
63 $WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs;
64 }
65
66 delete $WriteMakefileArgs{CONFIGURE_REQUIRES}
67 unless eval { ExtUtils::MakeMaker->VERSION(6.52) };
68
69 WriteMakefile(%WriteMakefileArgs);
+537
-0
README.mkdn less more
0 # NAME
1
2 Parallel::ForkManager - A simple parallel processing fork manager
3
4 # VERSION
5
6 version 1.17
7
8 # SYNOPSIS
9
10 use Parallel::ForkManager;
11
12 my $pm = Parallel::ForkManager->new($MAX_PROCESSES);
13
14 DATA_LOOP:
15 foreach my $data (@all_data) {
16 # Forks and returns the pid for the child:
17 my $pid = $pm->start and next DATA_LOOP;
18
19 ... do some work with $data in the child process ...
20
21 $pm->finish; # Terminates the child process
22 }
23
24 # DESCRIPTION
25
26 This module is intended for use in operations that can be done in parallel
27 where the number of processes to be forked off should be limited. Typical
28 use is a downloader which will be retrieving hundreds/thousands of files.
29
30 The code for a downloader would look something like this:
31
32 use LWP::Simple;
33 use Parallel::ForkManager;
34
35 ...
36
37 my @links=(
38 ["http://www.foo.bar/rulez.data","rulez_data.txt"],
39 ["http://new.host/more_data.doc","more_data.doc"],
40 ...
41 );
42
43 ...
44
45 # Max 30 processes for parallel download
46 my $pm = Parallel::ForkManager->new(30);
47
48 LINKS:
49 foreach my $linkarray (@links) {
50 $pm->start and next LINKS; # do the fork
51
52 my ($link, $fn) = @$linkarray;
53 warn "Cannot get $fn from $link"
54 if getstore($link, $fn) != RC_OK;
55
56 $pm->finish; # do the exit in the child process
57 }
58 $pm->wait_all_children;
59
60 First you need to instantiate the ForkManager with the "new" constructor.
61 You must specify the maximum number of processes to be created. If you
62 specify 0, then NO fork will be done; this is good for debugging purposes.
63
64 Next, use $pm->start to do the fork. $pm returns 0 for the child process,
65 and child pid for the parent process (see also ["fork()" in perlfunc(1p)](http://man.he.net/man1p/perlfunc)).
66 The "and next" skips the internal loop in the parent process. NOTE:
67 $pm->start dies if the fork fails.
68
69 $pm->finish terminates the child process (assuming a fork was done in the
70 "start").
71
72 NOTE: You cannot use $pm->start if you are already in the child process.
73 If you want to manage another set of subprocesses in the child process,
74 you must instantiate another Parallel::ForkManager object!
75
76 # METHODS
77
78 The comment letter indicates where the method should be run. P for parent,
79 C for child.
80
81 - new $processes
82
83 Instantiate a new Parallel::ForkManager object. You must specify the maximum
84 number of children to fork off. If you specify 0 (zero), then no children
85 will be forked. This is intended for debugging purposes.
86
87 The optional second parameter, $tempdir, is only used if you want the
88 children to send back a reference to some data (see RETRIEVING DATASTRUCTURES
89 below). If not provided, it is set via a call to [File::Temp](https://metacpan.org/pod/File::Temp)::tempdir().
90
91 The new method will die if the temporary directory does not exist or it is not
92 a directory.
93
94 - start \[ $process\_identifier \]
95
96 This method does the fork. It returns the pid of the child process for
97 the parent, and 0 for the child process. If the $processes parameter
98 for the constructor is 0 then, assuming you're in the child process,
99 $pm->start simply returns 0.
100
101 An optional $process\_identifier can be provided to this method... It is used by
102 the "run\_on\_finish" callback (see CALLBACKS) for identifying the finished
103 process.
104
105 - finish \[ $exit\_code \[, $data\_structure\_reference\] \]
106
107 Closes the child process by exiting and accepts an optional exit code
108 (default exit code is 0) which can be retrieved in the parent via callback.
109 If the second optional parameter is provided, the child attempts to send
110 it's contents back to the parent. If you use the program in debug mode
111 ($processes == 0), this method just calls the callback.
112
113 If the $data\_structure\_reference is provided, then it is serialized and
114 passed to the parent process. See RETRIEVING DATASTRUCTURES for more info.
115
116 - set\_max\_procs $processes
117
118 Allows you to set a new maximum number of children to maintain.
119
120 - wait\_all\_children
121
122 You can call this method to wait for all the processes which have been
123 forked. This is a blocking wait.
124
125 - reap\_finished\_children
126
127 This is a non-blocking call to reap children and execute callbacks independent
128 of calls to "start" or "wait\_all\_children". Use this in scenarios where "start"
129 is called infrequently but you would like the callbacks executed quickly.
130
131 - is\_parent
132
133 Returns `true` if within the parent or `false` if within the child.
134
135 - is\_child
136
137 Returns `true` if within the child or `false` if within the parent.
138
139 - max\_procs
140
141 Returns the maximal number of processes the object will fork.
142
143 - running\_procs
144
145 Returns the pids of the forked processes currently monitored by the
146 `Parallel::ForkManager`. Note that children are still reported as running
147 until the fork manager harvest them, via the next call to
148 `start` or `wait_all_children`.
149
150 my @pids = $pm->running_procs;
151
152 my $nbr_children =- $pm->running_procs;
153
154 - wait\_for\_available\_procs( $n )
155
156 Wait until `$n` available process slots are available.
157 If `$n` is not given, defaults to _1_.
158
159 - waitpid\_blocking\_sleep
160
161 Returns the sleep period, in seconds, of the pseudo-blocking calls. The sleep
162 period can be a fraction of second.
163
164 Returns `0` if disabled.
165
166 Defaults to 1 second.
167
168 See _BLOCKING CALLS_ for more details.
169
170 - set\_waitpid\_blocking\_sleep $seconds
171
172 Sets the the sleep period, in seconds, of the pseudo-blocking calls.
173 Set to `0` to disable.
174
175 See _BLOCKING CALLS_ for more details.
176
177 # CALLBACKS
178
179 You can define callbacks in the code, which are called on events like starting
180 a process or upon finish. Declare these before the first call to start().
181
182 The callbacks can be defined with the following methods:
183
184 - run\_on\_finish $code \[, $pid \]
185
186 You can define a subroutine which is called when a child is terminated. It is
187 called in the parent process.
188
189 The parameters of the $code are the following:
190
191 - pid of the process, which is terminated
192 - exit code of the program
193 - identification of the process (if provided in the "start" method)
194 - exit signal (0-127: signal name)
195 - core dump (1 if there was core dump at exit)
196 - datastructure reference or undef (see RETRIEVING DATASTRUCTURES)
197
198 - run\_on\_start $code
199
200 You can define a subroutine which is called when a child is started. It called
201 after the successful startup of a child in the parent process.
202
203 The parameters of the $code are the following:
204
205 - pid of the process which has been started
206 - identification of the process (if provided in the "start" method)
207
208 - run\_on\_wait $code, \[$period\]
209
210 You can define a subroutine which is called when the child process needs to wait
211 for the startup. If $period is not defined, then one call is done per
212 child. If $period is defined, then $code is called periodically and the
213 module waits for $period seconds between the two calls. Note, $period can be
214 fractional number also. The exact "$period seconds" is not guaranteed,
215 signals can shorten and the process scheduler can make it longer (on busy
216 systems).
217
218 The $code called in the "start" and the "wait\_all\_children" method also.
219
220 No parameters are passed to the $code on the call.
221
222 # BLOCKING CALLS
223
224 When it comes to waiting for child processes to terminate, `Parallel::ForkManager` is between
225 a fork and a hard place (if you excuse the terrible pun). The underlying Perl `waitpid` function
226 that the module relies on can block until either one specific or any child process
227 terminate, but not for a process part of a given group.
228
229 This means that the module can do one of two things when it waits for
230 one of its child processes to terminate:
231
232 - Only wait for its own child processes
233
234 This is done via a loop using a `waitpid` non-blocking call and a sleep statement.
235 The code does something along the lines of
236
237 while(1) {
238 if ( any of the P::FM child process terminated ) {
239 return its pid
240 }
241
242 sleep $sleep_period
243 }
244
245 This is the default behavior that the module will use.
246 This is not the most efficient way to wait for child processes, but it's
247 the safest way to ensure that `Parallel::ForkManager` won't interfere with
248 any other part of the codebase.
249
250 The sleep period is set via the method `set_waitpid_blocking_sleep`.
251
252 - Block until any process terminate
253
254 Alternatively, `Parallel::ForkManager` can call `waitpid` such that it will
255 block until any child process terminate. If the child process was not one of
256 the monitored subprocesses, the wait will resume. This is more efficient, but mean
257 that `P::FM` can captures (and discards) the termination notification that a different
258 part of the code might be waiting for.
259
260 If this is a race condition
261 that doesn't apply to your codebase, you can set the
262 _waitpid\_blocking\_sleep_ period to `0`, which will enable `waitpid` call blocking.
263
264 my $pm = Parallel::ForkManager->new( 4 );
265
266 $pm->set_waitpid_blocking_sleep(0); # true blocking calls enabled
267
268 for ( 1..100 ) {
269 $pm->start and next;
270
271 ...; # do work
272
273 $pm->finish;
274 }
275
276 # RETRIEVING DATASTRUCTURES from child processes
277
278 The ability for the parent to retrieve data structures is new as of version
279 0.7.6.
280
281 Each child process may optionally send 1 data structure back to the parent.
282 By data structure, we mean a reference to a string, hash or array. The
283 contents of the data structure are written out to temporary files on disc
284 using the [Storable](https://metacpan.org/pod/Storable) modules' store() method. The reference is then
285 retrieved from within the code you send to the run\_on\_finish callback.
286
287 The data structure can be any scalar perl data structure which makes sense:
288 string, numeric value or a reference to an array, hash or object.
289
290 There are 2 steps involved in retrieving data structures:
291
292 1) A reference to the data structure the child wishes to send back to the
293 parent is provided as the second argument to the finish() call. It is up
294 to the child to decide whether or not to send anything back to the parent.
295
296 2) The data structure reference is retrieved using the callback provided in
297 the run\_on\_finish() method.
298
299 Keep in mind that data structure retrieval is not the same as returning a
300 data structure from a method call. That is not what actually occurs. The
301 data structure referenced in a given child process is serialized and
302 written out to a file by [Storable](https://metacpan.org/pod/Storable). The file is subsequently read back
303 into memory and a new data structure belonging to the parent process is
304 created. Please consider the performance penality it can imply, so try to
305 keep the returned structure small.
306
307 # EXAMPLES
308
309 ## Parallel get
310
311 This small example can be used to get URLs in parallel.
312
313 use Parallel::ForkManager;
314 use LWP::Simple;
315
316 my $pm = Parallel::ForkManager->new(10);
317
318 LINKS:
319 for my $link (@ARGV) {
320 $pm->start and next LINKS;
321 my ($fn) = $link =~ /^.*\/(.*?)$/;
322 if (!$fn) {
323 warn "Cannot determine filename from $fn\n";
324 } else {
325 $0 .= " " . $fn;
326 print "Getting $fn from $link\n";
327 my $rc = getstore($link, $fn);
328 print "$link downloaded. response code: $rc\n";
329 };
330 $pm->finish;
331 };
332
333 ## Callbacks
334
335 Example of a program using callbacks to get child exit codes:
336
337 use strict;
338 use Parallel::ForkManager;
339
340 my $max_procs = 5;
341 my @names = qw( Fred Jim Lily Steve Jessica Bob Dave Christine Rico Sara );
342 # hash to resolve PID's back to child specific information
343
344 my $pm = Parallel::ForkManager->new($max_procs);
345
346 # Setup a callback for when a child finishes up so we can
347 # get it's exit code
348 $pm->run_on_finish( sub {
349 my ($pid, $exit_code, $ident) = @_;
350 print "** $ident just got out of the pool ".
351 "with PID $pid and exit code: $exit_code\n";
352 });
353
354 $pm->run_on_start( sub {
355 my ($pid, $ident)=@_;
356 print "** $ident started, pid: $pid\n";
357 });
358
359 $pm->run_on_wait( sub {
360 print "** Have to wait for one children ...\n"
361 },
362 0.5
363 );
364
365 NAMES:
366 foreach my $child ( 0 .. $#names ) {
367 my $pid = $pm->start($names[$child]) and next NAMES;
368
369 # This code is the child process
370 print "This is $names[$child], Child number $child\n";
371 sleep ( 2 * $child );
372 print "$names[$child], Child $child is about to get out...\n";
373 sleep 1;
374 $pm->finish($child); # pass an exit code to finish
375 }
376
377 print "Waiting for Children...\n";
378 $pm->wait_all_children;
379 print "Everybody is out of the pool!\n";
380
381 ## Data structure retrieval
382
383 In this simple example, each child sends back a string reference.
384
385 use Parallel::ForkManager 0.7.6;
386 use strict;
387
388 my $pm = Parallel::ForkManager->new(2, '/server/path/to/temp/dir/');
389
390 # data structure retrieval and handling
391 $pm -> run_on_finish ( # called BEFORE the first call to start()
392 sub {
393 my ($pid, $exit_code, $ident, $exit_signal, $core_dump, $data_structure_reference) = @_;
394
395 # retrieve data structure from child
396 if (defined($data_structure_reference)) { # children are not forced to send anything
397 my $string = ${$data_structure_reference}; # child passed a string reference
398 print "$string\n";
399 }
400 else { # problems occuring during storage or retrieval will throw a warning
401 print qq|No message received from child process $pid!\n|;
402 }
403 }
404 );
405
406 # prep random statement components
407 my @foods = ('chocolate', 'ice cream', 'peanut butter', 'pickles', 'pizza', 'bacon', 'pancakes', 'spaghetti', 'cookies');
408 my @preferences = ('loves', q|can't stand|, 'always wants more', 'will walk 100 miles for', 'only eats', 'would starve rather than eat');
409
410 # run the parallel processes
411 PERSONS:
412 foreach my $person (qw(Fred Wilma Ernie Bert Lucy Ethel Curly Moe Larry)) {
413 $pm->start() and next PERSONS;
414
415 # generate a random statement about food preferences
416 my $statement = $person . ' ' . $preferences[int(rand @preferences)] . ' ' . $foods[int(rand @foods)];
417
418 # send it back to the parent process
419 $pm->finish(0, \$statement); # note that it's a scalar REFERENCE, not the scalar itself
420 }
421 $pm->wait_all_children;
422
423 A second datastructure retrieval example demonstrates how children decide
424 whether or not to send anything back, what to send and how the parent should
425 process whatever is retrieved.
426
427 use Parallel::ForkManager 0.7.6;
428 use Data::Dumper; # to display the data structures retrieved.
429 use strict;
430
431 my $pm = Parallel::ForkManager->new(20); # using the system temp dir $L<File::Temp::tempdir()
432
433 # data structure retrieval and handling
434 my %retrieved_responses = (); # for collecting responses
435 $pm -> run_on_finish (
436 sub {
437 my ($pid, $exit_code, $ident, $exit_signal, $core_dump, $data_structure_reference) = @_;
438
439 # see what the child sent us, if anything
440 if (defined($data_structure_reference)) { # test rather than assume child sent anything
441 my $reftype = ref($data_structure_reference);
442 print qq|ident "$ident" returned a "$reftype" reference.\n\n|;
443 if (1) { # simple on/off switch to display the contents
444 print &Dumper($data_structure_reference) . qq|end of "$ident" sent structure\n\n|;
445 }
446
447 # we can also collect retrieved data structures for processing after all children have exited
448 $retrieved_responses{$ident} = $data_structure_reference;
449 } else {
450 print qq|ident "$ident" did not send anything.\n\n|;
451 }
452 }
453 );
454
455 # generate a list of instructions
456 my @instructions = ( # a unique identifier and what the child process should send
457 {'name' => '%ENV keys as a string', 'send' => 'keys'},
458 {'name' => 'Send Nothing'}, # not instructing the child to send anything back to the parent
459 {'name' => 'Childs %ENV', 'send' => 'all'},
460 {'name' => 'Child chooses randomly', 'send' => 'random'},
461 {'name' => 'Invalid send instructions', 'send' => 'Na Na Nana Na'},
462 {'name' => 'ENV values in an array', 'send' => 'values'},
463 );
464
465 INSTRUCTS:
466 foreach my $instruction (@instructions) {
467 $pm->start($instruction->{'name'}) and next INSTRUCTS; # this time we are using an explicit, unique child process identifier
468
469 # last step in child processing
470 $pm->finish(0) unless $instruction->{'send'}; # no data structure is sent unless this child is told what to send.
471
472 if ($instruction->{'send'} eq 'keys') {
473 $pm->finish(0, \join(', ', keys %ENV));
474
475 } elsif ($instruction->{'send'} eq 'values') {
476 $pm->finish(0, [values %ENV]); # kinda useless without knowing which keys they belong to...
477
478 } elsif ($instruction->{'send'} eq 'all') {
479 $pm->finish(0, \%ENV); # remember, we are not "returning" anything, just copying the hash to disc
480
481 # demonstrate clearly that the child determines what type of reference to send
482 } elsif ($instruction->{'send'} eq 'random') {
483 my $string = q|I'm just a string.|;
484 my @array = qw(I am an array);
485 my %hash = (type => 'associative array', synonym => 'hash', cool => 'very :)');
486 my $return_choice = ('string', 'array', 'hash')[int(rand 3)]; # randomly choose return data type
487 $pm->finish(0, \$string) if ($return_choice eq 'string');
488 $pm->finish(0, \@array) if ($return_choice eq 'array');
489 $pm->finish(0, \%hash) if ($return_choice eq 'hash');
490
491 # as a responsible child, inform parent that their instruction was invalid
492 } else {
493 $pm->finish(0, \qq|Invalid instructions: "$instruction->{'send'}".|); # ordinarily I wouldn't include invalid input in a response...
494 }
495 }
496 $pm->wait_all_children; # blocks until all forked processes have exited
497
498 # post fork processing of returned data structures
499 for (sort keys %retrieved_responses) {
500 print qq|Post processing "$_"...\n|;
501 }
502
503 # BUGS AND LIMITATIONS
504
505 Do not use Parallel::ForkManager in an environment, where other child
506 processes can affect the run of the main program, so using this module
507 is not recommended in an environment where fork() / wait() is already used.
508
509 If you want to use more than one copies of the Parallel::ForkManager, then
510 you have to make sure that all children processes are terminated, before you
511 use the second object in the main program.
512
513 You are free to use a new copy of Parallel::ForkManager in the child
514 processes, although I don't think it makes sense.
515
516 # CREDITS
517
518 Michael Gang (bug report)
519 Noah Robin <sitz@onastick.net> (documentation tweaks)
520 Chuck Hirstius <chirstius@megapathdsl.net> (callback exit status, example)
521 Grant Hopwood <hopwoodg@valero.com> (win32 port)
522 Mark Southern <mark_southern@merck.com> (bugfix)
523 Ken Clarke <www.perlprogrammer.net> (datastructure retrieval)
524
525 # AUTHORS
526
527 - dLux (Szabó, Balázs) <dlux@dlux.hu>
528 - Yanick Champoux <yanick@cpan.org> [![endorse](http://api.coderwall.com/yanick/endorsecount.png)](http://coderwall.com/yanick)
529 - Gabor Szabo <gabor@szabgab.com>
530
531 # COPYRIGHT AND LICENSE
532
533 This software is copyright (c) 2000 by Balázs Szabó.
534
535 This is free software; you can redistribute it and/or modify it under
536 the same terms as the Perl 5 programming language system itself.
+0
-0
SIGNATURE less more
(New empty file)
+33
-0
cpanfile less more
0 requires "Carp" => "0";
1 requires "File::Path" => "0";
2 requires "File::Spec" => "0";
3 requires "File::Temp" => "0";
4 requires "POSIX" => "0";
5 requires "Storable" => "0";
6 requires "strict" => "0";
7
8 on 'test' => sub {
9 requires "ExtUtils::MakeMaker" => "0";
10 requires "File::Spec" => "0";
11 requires "IO::Handle" => "0";
12 requires "IPC::Open3" => "0";
13 requires "Test::More" => "0.94";
14 requires "Test::Warn" => "0";
15 requires "perl" => "5.006";
16 requires "warnings" => "0";
17 };
18
19 on 'test' => sub {
20 recommends "CPAN::Meta" => "2.120900";
21 };
22
23 on 'configure' => sub {
24 requires "ExtUtils::MakeMaker" => "0";
25 };
26
27 on 'develop' => sub {
28 requires "Test::More" => "0.96";
29 requires "Test::PAUSE::Permissions" => "0";
30 requires "Test::Vars" => "0";
31 requires "warnings" => "0";
32 };
+0
-15
dist.ini less more
0 name = Parallel-ForkManager
1 author = dLux (Szabó, Balázs) <dlux@dlux.hu>
2 author = Yanick Champoux <yanick@cpan.org>
3 author = Gabor Szabo <gabor@szabgab.com>
4 license = Perl_5
5 copyright_holder = Balázs Szabó
6 copyright_year = 2000
7
8 [@Filter]
9 -bundle=@YANICK
10 -remove=Covenant
11 -remove=License
12 authority = cpan:DLUX
13 NextVersion::Semantic.format=%d.%02d
14 upstream=github
+231
-0
doap.xml less more
0 <?xml version="1.0" encoding="UTF-8" ?>
1 <Project
2 xmlns="http://usefulinc.com/ns/doap#"
3 xmlns:dc="http://purl.org/dc/terms/"
4 xmlns:foaf="http://xmlns.com/foaf/0.1/"
5 xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
6 xmlns:rdfs="http://www.w3.org/2000/01/rdf-schema#"
7 >
8 <name>Parallel-ForkManager</name>
9 <shortdesc>A simple parallel processing fork manager</shortdesc>
10 <developer>
11 <foaf:Person>
12 <foaf:name>dLux (Szabó, Balázs)</foaf:name>
13 <foaf:mbox rdf:resource="mailto:dlux@dlux.hu" />
14 </foaf:Person>
15 </developer>
16 <developer>
17 <foaf:Person>
18 <foaf:name>Yanick Champoux</foaf:name>
19 <foaf:mbox rdf:resource="mailto:yanick@cpan.org" />
20 </foaf:Person>
21 </developer>
22 <developer>
23 <foaf:Person>
24 <foaf:name>Gabor Szabo</foaf:name>
25 <foaf:mbox rdf:resource="mailto:gabor@szabgab.com" />
26 </foaf:Person>
27 </developer>
28 <helper>
29 <foaf:Person>
30 <foaf:name>Ninebit</foaf:name>
31 <foaf:mbox rdf:resource="mailto:kevin@9b.io" />
32 </foaf:Person>
33 </helper>
34 <helper>
35 <foaf:Person>
36 <foaf:name>Shlomi Fish</foaf:name>
37 <foaf:mbox rdf:resource="mailto:shlomif@shlomifish.org" />
38 </foaf:Person>
39 </helper>
40 <license rdf:resource="http://dev.perl.org/licenses/" />
41 <homepage rdf:resource="https://github.com/dluxhu/perl-parallel-forkmanager" />
42 <bug-database rdf:resource="https://github.com/dluxhu/perl-parallel-forkmanager/issues" />
43 <repository>
44 <GitRepository>
45 <browse rdf:resource="https://github.com/dluxhu/perl-parallel-forkmanager" />
46 <location rdf:resource="https://github.com/dluxhu/perl-parallel-forkmanager.git" />
47 </GitRepository>
48 </repository>
49 <release>
50 <Version>
51 <revision rdf:datatype="http://www.w3.org/2001/XMLSchema#string">0.7.1</revision>
52 <dc:issued rdf:datatype="http://www.w3.org/2001/XMLSchema#date">2001-04-26</dc:issued>
53 </Version>
54 </release>
55 <release>
56 <Version>
57 <revision rdf:datatype="http://www.w3.org/2001/XMLSchema#string">0.7.2</revision>
58 <dc:issued rdf:datatype="http://www.w3.org/2001/XMLSchema#date">2001-05-14</dc:issued>
59 </Version>
60 </release>
61 <release>
62 <Version>
63 <revision rdf:datatype="http://www.w3.org/2001/XMLSchema#string">0.7.3</revision>
64 <dc:issued rdf:datatype="http://www.w3.org/2001/XMLSchema#date">2001-08-24</dc:issued>
65 </Version>
66 </release>
67 <release>
68 <Version>
69 <revision rdf:datatype="http://www.w3.org/2001/XMLSchema#string">0.7.4</revision>
70 <dc:issued rdf:datatype="http://www.w3.org/2001/XMLSchema#date">2002-07-04</dc:issued>
71 </Version>
72 </release>
73 <release>
74 <Version>
75 <revision rdf:datatype="http://www.w3.org/2001/XMLSchema#string">0.7.5</revision>
76 <dc:issued rdf:datatype="http://www.w3.org/2001/XMLSchema#date">2002-12-25</dc:issued>
77 </Version>
78 </release>
79 <release>
80 <Version>
81 <revision rdf:datatype="http://www.w3.org/2001/XMLSchema#string">0.7.6</revision>
82 <dc:issued rdf:datatype="http://www.w3.org/2001/XMLSchema#date">2010-08-15</dc:issued>
83 </Version>
84 </release>
85 <release>
86 <Version>
87 <revision rdf:datatype="http://www.w3.org/2001/XMLSchema#string">0.7.7</revision>
88 <dc:issued rdf:datatype="http://www.w3.org/2001/XMLSchema#date">2010-09-28</dc:issued>
89 </Version>
90 </release>
91 <release>
92 <Version>
93 <revision rdf:datatype="http://www.w3.org/2001/XMLSchema#string">0.7.8</revision>
94 <dc:issued rdf:datatype="http://www.w3.org/2001/XMLSchema#date">2010-08-25</dc:issued>
95 </Version>
96 </release>
97 <release>
98 <Version>
99 <revision rdf:datatype="http://www.w3.org/2001/XMLSchema#string">0.7.9</revision>
100 <dc:issued rdf:datatype="http://www.w3.org/2001/XMLSchema#date">2010-11-01</dc:issued>
101 </Version>
102 </release>
103 <release>
104 <Version>
105 <revision rdf:datatype="http://www.w3.org/2001/XMLSchema#string">0.5</revision>
106 <dc:issued rdf:datatype="http://www.w3.org/2001/XMLSchema#date">2000-10-18</dc:issued>
107 </Version>
108 </release>
109 <release>
110 <Version>
111 <revision rdf:datatype="http://www.w3.org/2001/XMLSchema#string">0.6</revision>
112 <dc:issued rdf:datatype="http://www.w3.org/2001/XMLSchema#date">2000-11-30</dc:issued>
113 </Version>
114 </release>
115 <release>
116 <Version>
117 <revision rdf:datatype="http://www.w3.org/2001/XMLSchema#string">0.7</revision>
118 <dc:issued rdf:datatype="http://www.w3.org/2001/XMLSchema#date">2001-04-04</dc:issued>
119 </Version>
120 </release>
121 <release>
122 <Version>
123 <revision rdf:datatype="http://www.w3.org/2001/XMLSchema#string">1.0.0</revision>
124 <dc:issued rdf:datatype="http://www.w3.org/2001/XMLSchema#date">2012-12-23</dc:issued>
125 </Version>
126 </release>
127 <release>
128 <Version>
129 <revision rdf:datatype="http://www.w3.org/2001/XMLSchema#string">1.01</revision>
130 <dc:issued rdf:datatype="http://www.w3.org/2001/XMLSchema#date">2012-12-23</dc:issued>
131 </Version>
132 </release>
133 <release>
134 <Version>
135 <revision rdf:datatype="http://www.w3.org/2001/XMLSchema#string">1.02</revision>
136 <dc:issued rdf:datatype="http://www.w3.org/2001/XMLSchema#date">2012-12-24</dc:issued>
137 </Version>
138 </release>
139 <release>
140 <Version>
141 <revision rdf:datatype="http://www.w3.org/2001/XMLSchema#string">1.03</revision>
142 <dc:issued rdf:datatype="http://www.w3.org/2001/XMLSchema#date">2013-03-06</dc:issued>
143 </Version>
144 </release>
145 <release>
146 <Version>
147 <revision rdf:datatype="http://www.w3.org/2001/XMLSchema#string">1.04</revision>
148 <dc:issued rdf:datatype="http://www.w3.org/2001/XMLSchema#date">2013-09-03</dc:issued>
149 </Version>
150 </release>
151 <release>
152 <Version>
153 <revision rdf:datatype="http://www.w3.org/2001/XMLSchema#string">1.05</revision>
154 <dc:issued rdf:datatype="http://www.w3.org/2001/XMLSchema#date">2013-09-18</dc:issued>
155 </Version>
156 </release>
157 <release>
158 <Version>
159 <revision rdf:datatype="http://www.w3.org/2001/XMLSchema#string">1.06</revision>
160 <dc:issued rdf:datatype="http://www.w3.org/2001/XMLSchema#date">2013-12-24</dc:issued>
161 </Version>
162 </release>
163 <release>
164 <Version>
165 <revision rdf:datatype="http://www.w3.org/2001/XMLSchema#string">1.07</revision>
166 <dc:issued rdf:datatype="http://www.w3.org/2001/XMLSchema#date">2014-11-10</dc:issued>
167 </Version>
168 </release>
169 <release>
170 <Version>
171 <revision rdf:datatype="http://www.w3.org/2001/XMLSchema#string">1.08</revision>
172 <dc:issued rdf:datatype="http://www.w3.org/2001/XMLSchema#date">2015-01-07</dc:issued>
173 </Version>
174 </release>
175 <release>
176 <Version>
177 <revision rdf:datatype="http://www.w3.org/2001/XMLSchema#string">1.09</revision>
178 <dc:issued rdf:datatype="http://www.w3.org/2001/XMLSchema#date">2015-01-08</dc:issued>
179 </Version>
180 </release>
181 <release>
182 <Version>
183 <revision rdf:datatype="http://www.w3.org/2001/XMLSchema#string">1.10_1</revision>
184 <dc:issued rdf:datatype="http://www.w3.org/2001/XMLSchema#date">2015-01-22</dc:issued>
185 </Version>
186 </release>
187 <release>
188 <Version>
189 <revision rdf:datatype="http://www.w3.org/2001/XMLSchema#string">1.10_2</revision>
190 <dc:issued rdf:datatype="http://www.w3.org/2001/XMLSchema#date">2015-01-25</dc:issued>
191 </Version>
192 </release>
193 <release>
194 <Version>
195 <revision rdf:datatype="http://www.w3.org/2001/XMLSchema#string">1.11</revision>
196 <dc:issued rdf:datatype="http://www.w3.org/2001/XMLSchema#date">2015-01-30</dc:issued>
197 </Version>
198 </release>
199 <release>
200 <Version>
201 <revision rdf:datatype="http://www.w3.org/2001/XMLSchema#string">1.12</revision>
202 <dc:issued rdf:datatype="http://www.w3.org/2001/XMLSchema#date">2015-02-23</dc:issued>
203 </Version>
204 </release>
205 <release>
206 <Version>
207 <revision rdf:datatype="http://www.w3.org/2001/XMLSchema#string">1.13</revision>
208 <dc:issued rdf:datatype="http://www.w3.org/2001/XMLSchema#date">2015-05-11</dc:issued>
209 </Version>
210 </release>
211 <release>
212 <Version>
213 <revision rdf:datatype="http://www.w3.org/2001/XMLSchema#string">1.14</revision>
214 <dc:issued rdf:datatype="http://www.w3.org/2001/XMLSchema#date">2015-05-17</dc:issued>
215 </Version>
216 </release>
217 <release>
218 <Version>
219 <revision rdf:datatype="http://www.w3.org/2001/XMLSchema#string">1.15</revision>
220 <dc:issued rdf:datatype="http://www.w3.org/2001/XMLSchema#date">2015-07-08</dc:issued>
221 </Version>
222 </release>
223 <release>
224 <Version>
225 <revision rdf:datatype="http://www.w3.org/2001/XMLSchema#string">1.16</revision>
226 <dc:issued rdf:datatype="http://www.w3.org/2001/XMLSchema#date">2015-10-08</dc:issued>
227 </Version>
228 </release>
229 <programming-language>Perl</programming-language>
230 </Project>
+39
-2
lib/Parallel/ForkManager.pm less more
00 package Parallel::ForkManager;
1 our $AUTHORITY = 'cpan:DLUX';
12 # ABSTRACT: A simple parallel processing fork manager
2
3 $Parallel::ForkManager::VERSION = '1.17';
34 use POSIX ":sys_wait_h";
45 use Storable qw(store retrieve);
56 use File::Spec;
277278
278279 __END__
279280
281 =pod
282
283 =encoding UTF-8
284
285 =head1 NAME
286
287 Parallel::ForkManager - A simple parallel processing fork manager
288
289 =head1 VERSION
290
291 version 1.17
292
280293 =head1 SYNOPSIS
281294
282295 use Parallel::ForkManager;
810823 Mark Southern <mark_southern@merck.com> (bugfix)
811824 Ken Clarke <www.perlprogrammer.net> (datastructure retrieval)
812825
826 =head1 AUTHORS
827
828 =over 4
829
830 =item *
831
832 dLux (Szabó, Balázs) <dlux@dlux.hu>
833
834 =item *
835
836 Yanick Champoux <yanick@cpan.org>
837
838 =item *
839
840 Gabor Szabo <gabor@szabgab.com>
841
842 =back
843
844 =head1 COPYRIGHT AND LICENSE
845
846 This software is copyright (c) 2000 by Balázs Szabó.
847
848 This is free software; you can redistribute it and/or modify it under
849 the same terms as the Perl 5 programming language system itself.
850
813851 =cut
814
+51
-0
t/00-compile.t less more
0 use 5.006;
1 use strict;
2 use warnings;
3
4 # this test was generated with Dist::Zilla::Plugin::Test::Compile 2.052
5
6 use Test::More;
7
8 plan tests => 1 + ($ENV{AUTHOR_TESTING} ? 1 : 0);
9
10 my @module_files = (
11 'Parallel/ForkManager.pm'
12 );
13
14
15
16 # no fake home requested
17
18 my $inc_switch = -d 'blib' ? '-Mblib' : '-Ilib';
19
20 use File::Spec;
21 use IPC::Open3;
22 use IO::Handle;
23
24 open my $stdin, '<', File::Spec->devnull or die "can't open devnull: $!";
25
26 my @warnings;
27 for my $lib (@module_files)
28 {
29 # see L<perlfaq8/How can I capture STDERR from an external command?>
30 my $stderr = IO::Handle->new;
31
32 my $pid = open3($stdin, '>&STDERR', $stderr, $^X, $inc_switch, '-e', "require q[$lib]");
33 binmode $stderr, ':crlf' if $^O eq 'MSWin32';
34 my @_warnings = <$stderr>;
35 waitpid($pid, 0);
36 is($?, 0, "$lib loaded ok");
37
38 if (@_warnings)
39 {
40 warn @_warnings;
41 push @warnings, @_warnings;
42 }
43 }
44
45
46
47 is(scalar(@warnings), 0, 'no warnings found')
48 or diag 'got warnings: ', ( Test::More->can('explain') ? Test::More::explain(\@warnings) : join("\n", '', @warnings) ) if $ENV{AUTHOR_TESTING};
49
50
+43
-0
t/00-report-prereqs.dd less more
0 do { my $x = {
1 'configure' => {
2 'requires' => {
3 'ExtUtils::MakeMaker' => '0'
4 }
5 },
6 'develop' => {
7 'requires' => {
8 'Test::More' => '0.96',
9 'Test::PAUSE::Permissions' => '0',
10 'Test::Vars' => '0',
11 'warnings' => '0'
12 }
13 },
14 'runtime' => {
15 'requires' => {
16 'Carp' => '0',
17 'File::Path' => '0',
18 'File::Spec' => '0',
19 'File::Temp' => '0',
20 'POSIX' => '0',
21 'Storable' => '0',
22 'strict' => '0'
23 }
24 },
25 'test' => {
26 'recommends' => {
27 'CPAN::Meta' => '2.120900'
28 },
29 'requires' => {
30 'ExtUtils::MakeMaker' => '0',
31 'File::Spec' => '0',
32 'IO::Handle' => '0',
33 'IPC::Open3' => '0',
34 'Test::More' => '0.94',
35 'Test::Warn' => '0',
36 'perl' => '5.006',
37 'warnings' => '0'
38 }
39 }
40 };
41 $x;
42 }⏎
+183
-0
t/00-report-prereqs.t less more
0 #!perl
1
2 use strict;
3 use warnings;
4
5 # This test was generated by Dist::Zilla::Plugin::Test::ReportPrereqs 0.021
6
7 use Test::More tests => 1;
8
9 use ExtUtils::MakeMaker;
10 use File::Spec;
11
12 # from $version::LAX
13 my $lax_version_re =
14 qr/(?: undef | (?: (?:[0-9]+) (?: \. | (?:\.[0-9]+) (?:_[0-9]+)? )?
15 |
16 (?:\.[0-9]+) (?:_[0-9]+)?
17 ) | (?:
18 v (?:[0-9]+) (?: (?:\.[0-9]+)+ (?:_[0-9]+)? )?
19 |
20 (?:[0-9]+)? (?:\.[0-9]+){2,} (?:_[0-9]+)?
21 )
22 )/x;
23
24 # hide optional CPAN::Meta modules from prereq scanner
25 # and check if they are available
26 my $cpan_meta = "CPAN::Meta";
27 my $cpan_meta_pre = "CPAN::Meta::Prereqs";
28 my $HAS_CPAN_META = eval "require $cpan_meta; $cpan_meta->VERSION('2.120900')" && eval "require $cpan_meta_pre"; ## no critic
29
30 # Verify requirements?
31 my $DO_VERIFY_PREREQS = 1;
32
33 sub _max {
34 my $max = shift;
35 $max = ( $_ > $max ) ? $_ : $max for @_;
36 return $max;
37 }
38
39 sub _merge_prereqs {
40 my ($collector, $prereqs) = @_;
41
42 # CPAN::Meta::Prereqs object
43 if (ref $collector eq $cpan_meta_pre) {
44 return $collector->with_merged_prereqs(
45 CPAN::Meta::Prereqs->new( $prereqs )
46 );
47 }
48
49 # Raw hashrefs
50 for my $phase ( keys %$prereqs ) {
51 for my $type ( keys %{ $prereqs->{$phase} } ) {
52 for my $module ( keys %{ $prereqs->{$phase}{$type} } ) {
53 $collector->{$phase}{$type}{$module} = $prereqs->{$phase}{$type}{$module};
54 }
55 }
56 }
57
58 return $collector;
59 }
60
61 my @include = qw(
62
63 );
64
65 my @exclude = qw(
66
67 );
68
69 # Add static prereqs to the included modules list
70 my $static_prereqs = do 't/00-report-prereqs.dd';
71
72 # Merge all prereqs (either with ::Prereqs or a hashref)
73 my $full_prereqs = _merge_prereqs(
74 ( $HAS_CPAN_META ? $cpan_meta_pre->new : {} ),
75 $static_prereqs
76 );
77
78 # Add dynamic prereqs to the included modules list (if we can)
79 my ($source) = grep { -f } 'MYMETA.json', 'MYMETA.yml';
80 if ( $source && $HAS_CPAN_META ) {
81 if ( my $meta = eval { CPAN::Meta->load_file($source) } ) {
82 $full_prereqs = _merge_prereqs($full_prereqs, $meta->prereqs);
83 }
84 }
85 else {
86 $source = 'static metadata';
87 }
88
89 my @full_reports;
90 my @dep_errors;
91 my $req_hash = $HAS_CPAN_META ? $full_prereqs->as_string_hash : $full_prereqs;
92
93 # Add static includes into a fake section
94 for my $mod (@include) {
95 $req_hash->{other}{modules}{$mod} = 0;
96 }
97
98 for my $phase ( qw(configure build test runtime develop other) ) {
99 next unless $req_hash->{$phase};
100 next if ($phase eq 'develop' and not $ENV{AUTHOR_TESTING});
101
102 for my $type ( qw(requires recommends suggests conflicts modules) ) {
103 next unless $req_hash->{$phase}{$type};
104
105 my $title = ucfirst($phase).' '.ucfirst($type);
106 my @reports = [qw/Module Want Have/];
107
108 for my $mod ( sort keys %{ $req_hash->{$phase}{$type} } ) {
109 next if $mod eq 'perl';
110 next if grep { $_ eq $mod } @exclude;
111
112 my $file = $mod;
113 $file =~ s{::}{/}g;
114 $file .= ".pm";
115 my ($prefix) = grep { -e File::Spec->catfile($_, $file) } @INC;
116
117 my $want = $req_hash->{$phase}{$type}{$mod};
118 $want = "undef" unless defined $want;
119 $want = "any" if !$want && $want == 0;
120
121 my $req_string = $want eq 'any' ? 'any version required' : "version '$want' required";
122
123 if ($prefix) {
124 my $have = MM->parse_version( File::Spec->catfile($prefix, $file) );
125 $have = "undef" unless defined $have;
126 push @reports, [$mod, $want, $have];
127
128 if ( $DO_VERIFY_PREREQS && $HAS_CPAN_META && $type eq 'requires' ) {
129 if ( $have !~ /\A$lax_version_re\z/ ) {
130 push @dep_errors, "$mod version '$have' cannot be parsed ($req_string)";
131 }
132 elsif ( ! $full_prereqs->requirements_for( $phase, $type )->accepts_module( $mod => $have ) ) {
133 push @dep_errors, "$mod version '$have' is not in required range '$want'";
134 }
135 }
136 }
137 else {
138 push @reports, [$mod, $want, "missing"];
139
140 if ( $DO_VERIFY_PREREQS && $type eq 'requires' ) {
141 push @dep_errors, "$mod is not installed ($req_string)";
142 }
143 }
144 }
145
146 if ( @reports ) {
147 push @full_reports, "=== $title ===\n\n";
148
149 my $ml = _max( map { length $_->[0] } @reports );
150 my $wl = _max( map { length $_->[1] } @reports );
151 my $hl = _max( map { length $_->[2] } @reports );
152
153 if ($type eq 'modules') {
154 splice @reports, 1, 0, ["-" x $ml, "", "-" x $hl];
155 push @full_reports, map { sprintf(" %*s %*s\n", -$ml, $_->[0], $hl, $_->[2]) } @reports;
156 }
157 else {
158 splice @reports, 1, 0, ["-" x $ml, "-" x $wl, "-" x $hl];
159 push @full_reports, map { sprintf(" %*s %*s %*s\n", -$ml, $_->[0], $wl, $_->[1], $hl, $_->[2]) } @reports;
160 }
161
162 push @full_reports, "\n";
163 }
164 }
165 }
166
167 if ( @full_reports ) {
168 diag "\nVersions for all modules listed in $source (including optional ones):\n\n", @full_reports;
169 }
170
171 if ( @dep_errors ) {
172 diag join("\n",
173 "\n*** WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING ***\n",
174 "The following REQUIRED prerequisites were not satisfied:\n",
175 @dep_errors,
176 "\n"
177 );
178 }
179
180 pass;
181
182 # vim: ts=4 sts=4 sw=4 et:
+13
-0
xt/release/pause-permissions.t less more
0 use strict;
1 use warnings;
2
3 # this test was generated with Dist::Zilla::Plugin::Test::PAUSE::Permissions 0.002
4
5 use Test::More;
6 BEGIN {
7 plan skip_all => 'Test::PAUSE::Permissions required for testing pause permissions'
8 if $] < 5.010;
9 }
10 use Test::PAUSE::Permissions;
11
12 all_permissions_ok('yanick');
+14
-0
xt/release/unused-vars.t less more
0 #!perl
1
2 use Test::More 0.96 tests => 1;
3 eval { require Test::Vars };
4
5 SKIP: {
6 skip 1 => 'Test::Vars required for testing for unused vars'
7 if $@;
8 Test::Vars->import;
9
10 subtest 'unused vars' => sub {
11 all_vars_ok();
12 };
13 };