line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package IPC::QWorker::Worker; |
2
|
|
|
|
|
|
|
|
3
|
12
|
|
|
12
|
|
61
|
use strict; |
|
12
|
|
|
|
|
24
|
|
|
12
|
|
|
|
|
421
|
|
4
|
12
|
|
|
12
|
|
61
|
use warnings; |
|
12
|
|
|
|
|
13
|
|
|
12
|
|
|
|
|
332
|
|
5
|
12
|
|
|
12
|
|
137
|
use utf8; |
|
12
|
|
|
|
|
25
|
|
|
12
|
|
|
|
|
76
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
our $VERSION = '0.07'; # VERSION |
8
|
|
|
|
|
|
|
|
9
|
12
|
|
|
12
|
|
469
|
use Carp; |
|
12
|
|
|
|
|
13
|
|
|
12
|
|
|
|
|
1891
|
|
10
|
12
|
|
|
12
|
|
14591
|
use IO::Socket; |
|
12
|
|
|
|
|
401188
|
|
|
12
|
|
|
|
|
72
|
|
11
|
12
|
|
|
12
|
|
23882
|
use Storable qw(fd_retrieve store_fd); |
|
12
|
|
|
|
|
49106
|
|
|
12
|
|
|
|
|
1129
|
|
12
|
12
|
|
|
12
|
|
15391
|
use Data::Dumper; |
|
12
|
|
|
|
|
151148
|
|
|
12
|
|
|
|
|
12006
|
|
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
sub new { |
15
|
65
|
|
|
65
|
0
|
113
|
my $this = shift; |
16
|
65
|
|
33
|
|
|
1067
|
my $class = ref($this) || $this; |
17
|
65
|
|
|
|
|
2310
|
my $self = { |
18
|
|
|
|
|
|
|
'pid' => 0, |
19
|
|
|
|
|
|
|
'pipe' => undef, |
20
|
|
|
|
|
|
|
'calls' => {@_}, |
21
|
|
|
|
|
|
|
'ctx' => {}, |
22
|
|
|
|
|
|
|
'ready' => 0, |
23
|
|
|
|
|
|
|
}; |
24
|
65
|
|
|
|
|
486
|
bless( $self, $class ); |
25
|
65
|
|
|
|
|
581
|
$self->_fork_worker(); |
26
|
55
|
|
|
|
|
3843
|
return ($self); |
27
|
|
|
|
|
|
|
} |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
sub _fork_worker { |
30
|
65
|
|
|
65
|
|
105
|
my $self = shift; |
31
|
65
|
|
|
|
|
103
|
my $pid; |
32
|
|
|
|
|
|
|
my $parent_pipe; |
33
|
0
|
|
|
|
|
0
|
my $child_pipe; |
34
|
|
|
|
|
|
|
|
35
|
65
|
50
|
|
|
|
4874
|
socketpair( $parent_pipe, $child_pipe, AF_UNIX, SOCK_STREAM, PF_UNIX ) |
36
|
|
|
|
|
|
|
or croak("cant create socketpair: $!"); |
37
|
|
|
|
|
|
|
|
38
|
65
|
|
|
|
|
1721
|
$parent_pipe->autoflush(1); |
39
|
65
|
|
|
|
|
10856
|
$child_pipe->autoflush(1); |
40
|
|
|
|
|
|
|
|
41
|
65
|
100
|
|
|
|
178544
|
if ( $pid = fork ) { |
42
|
55
|
|
|
|
|
2236
|
close($parent_pipe); |
43
|
55
|
|
|
|
|
782
|
$self->{'pid'} = $pid; |
44
|
55
|
|
|
|
|
4643
|
$self->{'pipe'} = $child_pipe; |
45
|
|
|
|
|
|
|
} |
46
|
|
|
|
|
|
|
else { |
47
|
10
|
50
|
|
|
|
1146
|
if ( !defined($pid) ) { |
48
|
0
|
|
|
|
|
0
|
croak("cannot fork child process"); |
49
|
|
|
|
|
|
|
} |
50
|
10
|
|
|
|
|
705
|
close($child_pipe); |
51
|
10
|
|
|
|
|
386
|
$self->{'pipe'} = $parent_pipe; |
52
|
10
|
50
|
|
|
|
149
|
if ( defined( $self->{'calls'}->{'_init'} ) ) { |
53
|
10
|
|
|
|
|
422
|
$self->{'calls'}->{'_init'}->( $self->{'ctx'} ); |
54
|
|
|
|
|
|
|
} |
55
|
10
|
|
|
10
|
|
3056
|
$SIG{'HUP'} = sub { $self->_shutdown() }; |
|
10
|
|
|
|
|
20888324
|
|
56
|
10
|
|
|
|
|
267
|
$self->_child_loop(); |
57
|
0
|
|
|
|
|
0
|
close($parent_pipe); |
58
|
0
|
|
|
|
|
0
|
exit; |
59
|
|
|
|
|
|
|
} |
60
|
|
|
|
|
|
|
} |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
sub _child_loop { |
63
|
10
|
|
|
10
|
|
129
|
my $self = shift; |
64
|
10
|
|
|
|
|
998
|
my $qentry; |
65
|
|
|
|
|
|
|
|
66
|
10
|
|
|
|
|
307
|
$self->send_ready(); |
67
|
|
|
|
|
|
|
|
68
|
10
|
|
|
|
|
24
|
while ( $qentry = ${ fd_retrieve( $self->{'pipe'} ) } ) { |
|
130
|
|
|
|
|
1745
|
|
69
|
120
|
50
|
|
|
|
584459
|
if ($IPC::QWorker::DEBUG) { print STDERR Dumper($qentry); } |
|
0
|
|
|
|
|
0
|
|
70
|
|
|
|
|
|
|
|
71
|
120
|
50
|
|
|
|
1981
|
if ( defined $self->{'calls'}->{ $qentry->{'cmd'} } ) { |
72
|
120
|
|
|
|
|
4711
|
$self->{'calls'}->{ $qentry->{'cmd'} } |
73
|
|
|
|
|
|
|
->( $self->{'ctx'}, $qentry->{'params'} ); |
74
|
|
|
|
|
|
|
} |
75
|
|
|
|
|
|
|
else { |
76
|
0
|
|
|
|
|
0
|
croak( $$ . ": no such call defined in this worker" ); |
77
|
|
|
|
|
|
|
} |
78
|
|
|
|
|
|
|
|
79
|
120
|
|
|
|
|
37335
|
$self->send_ready(); |
80
|
|
|
|
|
|
|
} |
81
|
|
|
|
|
|
|
} |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
sub send_ready { |
84
|
130
|
|
|
130
|
0
|
836
|
my $self = shift(); |
85
|
|
|
|
|
|
|
|
86
|
130
|
|
|
|
|
480
|
print ${ $self->{'pipe'} }($$." READY\n"); |
|
130
|
|
|
|
|
6432
|
|
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
sub send_entry { |
90
|
120
|
|
|
120
|
0
|
143
|
my $self = shift; |
91
|
120
|
|
|
|
|
164
|
my $qentry = shift; |
92
|
|
|
|
|
|
|
|
93
|
120
|
|
|
|
|
163
|
$self->{'ready'} = 0; |
94
|
|
|
|
|
|
|
|
95
|
120
|
50
|
|
|
|
240
|
if ($IPC::QWorker::DEBUG) { |
96
|
0
|
|
|
|
|
0
|
print STDERR $$ . ": sending entry...\n"; |
97
|
|
|
|
|
|
|
} |
98
|
120
|
|
|
|
|
470
|
store_fd( \$qentry, $self->{'pipe'} ); |
99
|
|
|
|
|
|
|
} |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
sub exit_child { |
102
|
10
|
|
|
10
|
0
|
118
|
my $self = shift(); |
103
|
|
|
|
|
|
|
|
104
|
10
|
50
|
|
|
|
78
|
if ( $self->{'pid'} == 0 ) { # do nothing when called from within child |
105
|
0
|
|
|
|
|
0
|
return (); |
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
|
108
|
10
|
|
|
|
|
20785
|
kill( 'HUP', $self->{'pid'} ); |
109
|
10
|
|
|
|
|
5298760
|
waitpid( $self->{'pid'}, 0 ); |
110
|
|
|
|
|
|
|
} |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
sub _shutdown { |
113
|
10
|
|
|
10
|
|
37
|
my $self = shift(); |
114
|
|
|
|
|
|
|
|
115
|
10
|
50
|
|
|
|
641
|
if ( defined( $self->{'calls'}->{'_destroy'} ) ) { |
116
|
10
|
|
|
|
|
118
|
$self->{'calls'}->{'_destroy'}->( $self->{'ctx'} ); |
117
|
|
|
|
|
|
|
} |
118
|
10
|
50
|
|
|
|
872
|
if ($IPC::QWorker::DEBUG) { print STDERR $$ . ": exiting...\n"; } |
|
0
|
|
|
|
|
0
|
|
119
|
10
|
|
|
|
|
5766
|
exit(0); |
120
|
|
|
|
|
|
|
} |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
1; |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
# vim:ts=2:syntax=perl: |
125
|
|
|
|
|
|
|
# vim600:foldmethod=marker: |