File Coverage

blib/lib/IPC/QWorker/Worker.pm
Criterion Covered Total %
statement 70 79 88.6
branch 11 20 55.0
condition 1 3 33.3
subroutine 15 15 100.0
pod 0 4 0.0
total 97 121 80.1


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: