File Coverage

blib/lib/IPC/QWorker/Worker.pm
Criterion Covered Total %
statement 71 79 89.8
branch 11 20 55.0
condition 1 3 33.3
subroutine 15 15 100.0
pod 0 4 0.0
total 98 121 80.9


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__