line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package IPC::QWorker::Worker; |
2
|
|
|
|
|
|
|
|
3
|
12
|
|
|
12
|
|
84
|
use strict; |
|
12
|
|
|
|
|
24
|
|
|
12
|
|
|
|
|
359
|
|
4
|
12
|
|
|
12
|
|
71
|
use warnings; |
|
12
|
|
|
|
|
13
|
|
|
12
|
|
|
|
|
289
|
|
5
|
12
|
|
|
12
|
|
60
|
use utf8; |
|
12
|
|
|
|
|
35
|
|
|
12
|
|
|
|
|
59
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
# ABSTRACT: worker process for IPC::QWorker |
8
|
|
|
|
|
|
|
our $VERSION = '0.08'; # VERSION |
9
|
|
|
|
|
|
|
|
10
|
12
|
|
|
12
|
|
479
|
use Carp; |
|
12
|
|
|
|
|
35
|
|
|
12
|
|
|
|
|
837
|
|
11
|
12
|
|
|
12
|
|
6141
|
use IO::Socket; |
|
12
|
|
|
|
|
276878
|
|
|
12
|
|
|
|
|
49
|
|
12
|
12
|
|
|
12
|
|
13078
|
use Storable qw(fd_retrieve store_fd); |
|
12
|
|
|
|
|
37279
|
|
|
12
|
|
|
|
|
811
|
|
13
|
12
|
|
|
12
|
|
7553
|
use Data::Dumper; |
|
12
|
|
|
|
|
79469
|
|
|
12
|
|
|
|
|
8647
|
|
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
sub new { |
16
|
65
|
|
|
65
|
0
|
218
|
my $this = shift; |
17
|
65
|
|
33
|
|
|
632
|
my $class = ref($this) || $this; |
18
|
65
|
|
|
|
|
3250
|
my $self = { |
19
|
|
|
|
|
|
|
'pid' => 0, |
20
|
|
|
|
|
|
|
'pipe' => undef, |
21
|
|
|
|
|
|
|
'calls' => {@_}, |
22
|
|
|
|
|
|
|
'ctx' => {}, |
23
|
|
|
|
|
|
|
'ready' => 0, |
24
|
|
|
|
|
|
|
}; |
25
|
65
|
|
|
|
|
771
|
bless( $self, $class ); |
26
|
65
|
|
|
|
|
265
|
$self->_fork_worker(); |
27
|
55
|
|
|
|
|
2853
|
return ($self); |
28
|
|
|
|
|
|
|
} |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
sub _fork_worker { |
31
|
65
|
|
|
65
|
|
100
|
my $self = shift; |
32
|
65
|
|
|
|
|
168
|
my $pid; |
33
|
|
|
|
|
|
|
my $parent_pipe; |
34
|
65
|
|
|
|
|
0
|
my $child_pipe; |
35
|
|
|
|
|
|
|
|
36
|
65
|
50
|
|
|
|
5615
|
socketpair( $parent_pipe, $child_pipe, AF_UNIX, SOCK_STREAM, PF_UNIX ) |
37
|
|
|
|
|
|
|
or croak("cant create socketpair: $!"); |
38
|
|
|
|
|
|
|
|
39
|
65
|
|
|
|
|
1350
|
$parent_pipe->autoflush(1); |
40
|
65
|
|
|
|
|
8409
|
$child_pipe->autoflush(1); |
41
|
|
|
|
|
|
|
|
42
|
65
|
100
|
|
|
|
52669
|
if ( $pid = fork ) { |
43
|
55
|
|
|
|
|
2750
|
close($parent_pipe); |
44
|
55
|
|
|
|
|
459
|
$self->{'pid'} = $pid; |
45
|
55
|
|
|
|
|
3628
|
$self->{'pipe'} = $child_pipe; |
46
|
|
|
|
|
|
|
} |
47
|
|
|
|
|
|
|
else { |
48
|
10
|
50
|
|
|
|
1019
|
if ( !defined($pid) ) { |
49
|
0
|
|
|
|
|
0
|
croak("cannot fork child process"); |
50
|
|
|
|
|
|
|
} |
51
|
10
|
|
|
|
|
408
|
close($child_pipe); |
52
|
10
|
|
|
|
|
218
|
$self->{'pipe'} = $parent_pipe; |
53
|
10
|
50
|
|
|
|
298
|
if ( defined( $self->{'calls'}->{'_init'} ) ) { |
54
|
10
|
|
|
|
|
496
|
$self->{'calls'}->{'_init'}->( $self->{'ctx'} ); |
55
|
|
|
|
|
|
|
} |
56
|
10
|
|
|
10
|
|
1659
|
$SIG{'HUP'} = sub { $self->_shutdown() }; |
|
10
|
|
|
|
|
9569348
|
|
57
|
10
|
|
|
|
|
300
|
$self->_child_loop(); |
58
|
0
|
|
|
|
|
0
|
close($parent_pipe); |
59
|
0
|
|
|
|
|
0
|
exit; |
60
|
|
|
|
|
|
|
} |
61
|
|
|
|
|
|
|
} |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
sub _child_loop { |
64
|
10
|
|
|
10
|
|
42
|
my $self = shift; |
65
|
10
|
|
|
|
|
83
|
my $qentry; |
66
|
|
|
|
|
|
|
|
67
|
10
|
|
|
|
|
292
|
$self->send_ready(); |
68
|
|
|
|
|
|
|
|
69
|
10
|
|
|
|
|
57
|
while ( $qentry = ${ fd_retrieve( $self->{'pipe'} ) } ) { |
|
130
|
|
|
|
|
1041
|
|
70
|
120
|
50
|
|
|
|
251096
|
if ($IPC::QWorker::DEBUG) { print STDERR Dumper($qentry); } |
|
0
|
|
|
|
|
0
|
|
71
|
|
|
|
|
|
|
|
72
|
120
|
50
|
|
|
|
2594
|
if ( defined $self->{'calls'}->{ $qentry->{'cmd'} } ) { |
73
|
|
|
|
|
|
|
$self->{'calls'}->{ $qentry->{'cmd'} } |
74
|
120
|
|
|
|
|
993
|
->( $self->{'ctx'}, $qentry->{'params'} ); |
75
|
|
|
|
|
|
|
} |
76
|
|
|
|
|
|
|
else { |
77
|
0
|
|
|
|
|
0
|
croak( $$ . ": no such call defined in this worker" ); |
78
|
|
|
|
|
|
|
} |
79
|
|
|
|
|
|
|
|
80
|
120
|
|
|
|
|
17190
|
$self->send_ready(); |
81
|
|
|
|
|
|
|
} |
82
|
|
|
|
|
|
|
} |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
sub send_ready { |
85
|
130
|
|
|
130
|
0
|
355
|
my $self = shift(); |
86
|
|
|
|
|
|
|
|
87
|
130
|
|
|
|
|
290
|
print ${ $self->{'pipe'} }($$." READY\n"); |
|
130
|
|
|
|
|
2628
|
|
88
|
|
|
|
|
|
|
} |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
sub send_entry { |
91
|
120
|
|
|
120
|
0
|
175
|
my $self = shift; |
92
|
120
|
|
|
|
|
146
|
my $qentry = shift; |
93
|
|
|
|
|
|
|
|
94
|
120
|
|
|
|
|
168
|
$self->{'ready'} = 0; |
95
|
|
|
|
|
|
|
|
96
|
120
|
50
|
|
|
|
198
|
if ($IPC::QWorker::DEBUG) { |
97
|
0
|
|
|
|
|
0
|
print STDERR $$ . ": sending entry...\n"; |
98
|
|
|
|
|
|
|
} |
99
|
120
|
|
|
|
|
310
|
store_fd( \$qentry, $self->{'pipe'} ); |
100
|
|
|
|
|
|
|
} |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
sub exit_child { |
103
|
10
|
|
|
10
|
0
|
40
|
my $self = shift(); |
104
|
|
|
|
|
|
|
|
105
|
10
|
50
|
|
|
|
92
|
if ( $self->{'pid'} == 0 ) { # do nothing when called from within child |
106
|
0
|
|
|
|
|
0
|
return (); |
107
|
|
|
|
|
|
|
} |
108
|
|
|
|
|
|
|
|
109
|
10
|
|
|
|
|
642
|
kill( 'HUP', $self->{'pid'} ); |
110
|
10
|
|
|
|
|
2142660
|
waitpid( $self->{'pid'}, 0 ); |
111
|
|
|
|
|
|
|
} |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
sub _shutdown { |
114
|
10
|
|
|
10
|
|
45
|
my $self = shift(); |
115
|
|
|
|
|
|
|
|
116
|
10
|
50
|
|
|
|
105
|
if ( defined( $self->{'calls'}->{'_destroy'} ) ) { |
117
|
10
|
|
|
|
|
137
|
$self->{'calls'}->{'_destroy'}->( $self->{'ctx'} ); |
118
|
|
|
|
|
|
|
} |
119
|
10
|
50
|
|
|
|
723
|
if ($IPC::QWorker::DEBUG) { print STDERR $$ . ": exiting...\n"; } |
|
0
|
|
|
|
|
0
|
|
120
|
10
|
|
|
|
|
4844
|
exit(0); |
121
|
|
|
|
|
|
|
} |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
1; |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
# vim:ts=2:expandtab:syntax=perl: |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
__END__ |