File Coverage

blib/lib/CPAN/ParseDistribution/Unix.pm
Criterion Covered Total %
statement 20 20 100.0
branch 4 4 100.0
condition 2 3 66.6
subroutine 5 5 100.0
pod n/a
total 31 32 96.8


line stmt bran cond sub pod time code
1             package CPAN::ParseDistribution::Unix;
2              
3 89     89   356 use strict;
  89         89  
  89         1958  
4 89     89   267 use warnings;
  89         178  
  89         17177  
5              
6             =head1 NAME
7              
8             CPAN::ParseDistribution::Unix
9              
10             =head1 DESCRIPTION
11              
12             Unix-specific functionality
13              
14             =cut
15              
16             sub _run {
17 4004     4004   14124 my(undef, $safe_compartment, $code) = @_;
18 4004         7713 my $result;
19 4004         37330 my $fork_manager = Parallel::ForkManager->new(1);
20             # to retrieve data returned from child
21 4004     3916   1789321 $fork_manager->run_on_finish(sub { $result = $_[-1]; });
  3916         23342302  
22              
23             # checking time instead of saying run_on_wait(..., 5) is because of
24             # differences between 5.8.x and 5.18 (god knows when the difference came in)
25 4004         36913 my($start_time, $timed_out, $pid) = (time(), 0);
26             $fork_manager->run_on_wait(sub {
27 276864 100   276864   2790877549 if(time() - $start_time >= 5) {
28 13200         23835 $timed_out = 1;
29 13200         111660 kill(15, $pid);
30             }
31 4004         30002 }, 0.01);
32              
33 4004   66     33398 $pid = $fork_manager->start() || do {
34             my $v = eval { $safe_compartment->reval($code) };
35             if($@) { $result = { error => $@ }; }
36             else { $result = { result => $v }; }
37             $fork_manager->finish(0, $result);
38             };
39 3916         5364433 $fork_manager->wait_all_children();
40 3916 100       53422 $result->{error} = 'Safe compartment timed out' if($timed_out);
41 3916         40840 return $result;
42             }
43              
44             1;