File Coverage

blib/lib/Metabrik/Worker/Fork.pm
Criterion Covered Total %
statement 9 38 23.6
branch 0 10 0.0
condition n/a
subroutine 3 9 33.3
pod 2 5 40.0
total 14 62 22.5


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # worker::fork Brik
5             #
6             package Metabrik::Worker::Fork;
7 1     1   524 use strict;
  1         2  
  1         30  
8 1     1   4 use warnings;
  1         2  
  1         29  
9              
10 1     1   6 use base qw(Metabrik);
  1         1  
  1         555  
11              
12             # Default attribute values put here will BE inherited by subclasses
13             sub brik_properties {
14             return {
15 0     0 1   revision => '$Revision$',
16             tags => [ qw(unstable process) ],
17             author => 'GomoR ',
18             license => 'http://opensource.org/licenses/BSD-3-Clause',
19             attributes => {
20             pid => [ qw(forked_process_id) ],
21             },
22             commands => {
23             start => [ ],
24             stop => [ ],
25             is_son_alive => [ ],
26             },
27             require_modules => {
28             #'POSIX' => [ ],
29             },
30             };
31             }
32              
33             sub start {
34 0     0 0   my $self = shift;
35              
36             # Fork a new process
37 0 0         defined(my $pid = fork()) or return $self->log->error("start: fork: $!");
38 0 0         if ($pid) { # Father
39 0           my $restore = $SIG{INT};
40              
41 0           $self->pid($pid);
42              
43             $SIG{INT} = sub {
44 0     0     $self->log->debug("SIGINT: caught, son [$pid] QUITs now");
45 0           $self->stop;
46 0           $SIG{INT} = $restore;
47 0           return 1;
48 0           };
49             }
50              
51             # Return to father and son processes
52 0           return $pid;
53             }
54              
55             sub stop {
56 0     0 0   my $self = shift;
57              
58 0 0         if ($self->pid) {
59 0           kill('TERM', $self->pid);
60 0           waitpid($self->pid, POSIX::WNOHANG()); # Cleanup zombie state in case it is dead
61 0           $self->pid(undef);
62             }
63              
64 0           return 1;
65             }
66              
67             sub is_son_alive {
68 0     0 0   my $self = shift;
69              
70 0           my $pid = $self->pid;
71 0 0         if (defined($pid)) {
72 0           waitpid($pid, POSIX::WNOHANG()); # Cleanup zombie state in case it is dead
73 0           my $r = kill('ZERO', $pid);
74 0           $self->log->debug("is_son_alive: kill returned [$r] for pid [$pid]");
75 0 0         if ($r) { # Son still alive
76 0           return 1;
77             }
78             }
79              
80 0           return 0;
81             }
82              
83             sub brik_fini {
84 0     0 1   my $self = shift;
85              
86 0           return $self->stop;
87             }
88              
89             1;
90              
91             __END__