line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# |
2
|
|
|
|
|
|
|
# (c) Jan Gehring |
3
|
|
|
|
|
|
|
# |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
package Rex::Fork::Manager; |
6
|
|
|
|
|
|
|
|
7
|
56
|
|
|
56
|
|
853
|
use v5.12.5; |
|
56
|
|
|
|
|
249
|
|
8
|
56
|
|
|
56
|
|
303
|
use warnings; |
|
56
|
|
|
|
|
151
|
|
|
56
|
|
|
|
|
2585
|
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
our $VERSION = '1.14.3'; # VERSION |
11
|
|
|
|
|
|
|
|
12
|
56
|
|
|
56
|
|
696
|
use Rex::Fork::Task; |
|
56
|
|
|
|
|
153
|
|
|
56
|
|
|
|
|
638
|
|
13
|
56
|
|
|
56
|
|
1881
|
use Time::HiRes qw(sleep); |
|
56
|
|
|
|
|
138
|
|
|
56
|
|
|
|
|
399
|
|
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
sub new { |
16
|
138
|
|
|
138
|
0
|
784
|
my $that = shift; |
17
|
138
|
|
33
|
|
|
1203
|
my $proto = ref($that) || $that; |
18
|
138
|
|
|
|
|
737
|
my $self = {@_}; |
19
|
|
|
|
|
|
|
|
20
|
138
|
|
|
|
|
503
|
bless( $self, $proto ); |
21
|
|
|
|
|
|
|
|
22
|
138
|
|
|
|
|
675
|
$self->{'forks'} = []; |
23
|
138
|
|
|
|
|
835
|
$self->{'running'} = 0; |
24
|
|
|
|
|
|
|
|
25
|
138
|
|
|
|
|
478
|
return $self; |
26
|
|
|
|
|
|
|
} |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
sub add { |
29
|
135
|
|
|
135
|
0
|
519
|
my ( $self, $coderef ) = @_; |
30
|
|
|
|
|
|
|
|
31
|
135
|
|
|
|
|
1487
|
my $f = Rex::Fork::Task->new( coderef => $coderef ); |
32
|
|
|
|
|
|
|
|
33
|
135
|
|
|
|
|
574
|
push( @{ $self->{'forks'} }, $f ); |
|
135
|
|
|
|
|
511
|
|
34
|
|
|
|
|
|
|
|
35
|
135
|
|
|
|
|
789
|
$f->start; |
36
|
106
|
|
|
|
|
1283
|
++$self->{'running'}; |
37
|
|
|
|
|
|
|
|
38
|
106
|
50
|
|
|
|
2313
|
if ( $self->{'running'} >= $self->{'max'} ) { |
39
|
106
|
|
|
|
|
3340
|
$self->wait_for_one; |
40
|
|
|
|
|
|
|
} |
41
|
|
|
|
|
|
|
} |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
sub start { |
44
|
0
|
|
|
0
|
0
|
0
|
my ($self) = @_; |
45
|
|
|
|
|
|
|
|
46
|
0
|
|
|
|
|
0
|
my @threads = @{ $self->{'forks'} }; |
|
0
|
|
|
|
|
0
|
|
47
|
0
|
|
|
|
|
0
|
for ( my $i = 0 ; $i < scalar(@threads) ; ++$i ) { |
48
|
0
|
|
|
|
|
0
|
$threads[$i]->start; |
49
|
0
|
|
|
|
|
0
|
++$self->{'running'}; |
50
|
0
|
0
|
|
|
|
0
|
if ( $self->{'running'} >= $self->{'max'} ) { |
51
|
0
|
|
|
|
|
0
|
$self->wait_for_one; |
52
|
|
|
|
|
|
|
} |
53
|
|
|
|
|
|
|
} |
54
|
|
|
|
|
|
|
|
55
|
0
|
|
|
|
|
0
|
$self->wait_for_all; |
56
|
|
|
|
|
|
|
} |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
sub wait_for_one { |
59
|
106
|
|
|
106
|
0
|
1849
|
my ($self) = @_; |
60
|
106
|
|
|
|
|
2129
|
$self->wait_for; |
61
|
|
|
|
|
|
|
} |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
sub wait_for_all { |
64
|
107
|
|
|
107
|
0
|
957
|
my ($self) = @_; |
65
|
107
|
|
|
|
|
914
|
$self->wait_for(1); |
66
|
|
|
|
|
|
|
} |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
sub wait_for { |
69
|
213
|
|
|
213
|
0
|
1437
|
my ( $self, $all ) = @_; |
70
|
|
|
|
|
|
|
do { |
71
|
6631
|
|
|
|
|
25810
|
FORK: for ( my $i = 0 ; $i < scalar( @{ $self->{'forks'} } ) ; $i++ ) { |
|
13155
|
|
|
|
|
144060
|
|
72
|
6630
|
|
|
|
|
25421
|
my $thr = $self->{'forks'}->[$i]; |
73
|
6630
|
100
|
|
|
|
31749
|
unless ( $thr->{'running'} ) { |
74
|
106
|
|
|
|
|
880
|
next FORK; |
75
|
|
|
|
|
|
|
} |
76
|
|
|
|
|
|
|
|
77
|
6524
|
|
|
|
|
14569
|
my $kid; |
78
|
6524
|
|
|
|
|
64623
|
$kid = $thr->wait; |
79
|
|
|
|
|
|
|
|
80
|
6524
|
100
|
|
|
|
29760
|
if ( $kid == -1 ) { |
81
|
106
|
|
|
|
|
766
|
$thr = undef; |
82
|
106
|
|
|
|
|
2890
|
$thr->{running} = 0; |
83
|
106
|
|
|
|
|
570
|
--$self->{'running'}; |
84
|
|
|
|
|
|
|
|
85
|
106
|
50
|
|
|
|
3493
|
return 1 unless $all; |
86
|
|
|
|
|
|
|
} |
87
|
6418
|
|
|
|
|
63407
|
sleep Rex::Config->get_waitpid_blocking_sleep_time; |
88
|
|
|
|
|
|
|
} |
89
|
213
|
|
|
|
|
977
|
} until $self->{'running'} == 0; |
90
|
|
|
|
|
|
|
} |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
1; |