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