| 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: |