File Coverage

blib/lib/DBIx/QuickDB/Watcher.pm
Criterion Covered Total %
statement 21 126 16.6
branch 0 58 0.0
condition 0 8 0.0
subroutine 7 21 33.3
pod 0 8 0.0
total 28 221 12.6


line stmt bran cond sub pod time code
1             package DBIx::QuickDB::Watcher;
2 10     10   82 use strict;
  10         19  
  10         272  
3 10     10   47 use warnings;
  10         42  
  10         395  
4              
5             our $VERSION = '0.000023';
6              
7 10     10   136 use POSIX();
  10         20  
  10         259  
8 10     10   61 use Carp qw/croak/;
  10         35  
  10         557  
9 10     10   71 use Time::HiRes qw/sleep time/;
  10         25  
  10         65  
10 10     10   939 use Scalar::Util qw/weaken/;
  10         29  
  10         621  
11              
12 10         64 use DBIx::QuickDB::Util::HashBase qw{
13            
14            
15            
16            
17            
18            
19              
20            
21            
22 10     10   4193 };
  10         24  
23              
24             sub init {
25 0     0 0   my $self = shift;
26              
27 0   0       $self->{+MASTER_PID} ||= $$;
28              
29 0           weaken($self->{+DB});
30              
31 0           $self->{+LOG_FILE} = $self->{+DB}->gen_log;
32              
33 0           $self->start();
34             }
35              
36             sub start {
37 0     0 0   my $self = shift;
38 0 0         return if $self->{+SERVER_PID};
39              
40 0           my ($rh, $wh);
41 0 0         pipe($rh, $wh) or die "Could not open pipe: $!";
42              
43 0           my $pid = fork;
44 0 0         die "Could not fork: $!" unless defined $pid;
45              
46 0 0         if ($pid) {
47 0           close($wh);
48 0           waitpid($pid, 0);
49 0           chomp($self->{+WATCHER_PID} = <$rh>);
50 0           chomp($self->{+SERVER_PID} = <$rh>);
51 0           close($rh);
52 0 0         die "Did not get watcher pid!" unless $self->{+WATCHER_PID};
53 0 0         die "Did not get server pid!" unless $self->{+SERVER_PID};
54 0           return;
55             }
56              
57 0           close($rh);
58 0           POSIX::setsid();
59 0           setpgrp(0, 0);
60 0           $pid = fork;
61 0 0         die "Could not fork: $!" unless defined $pid;
62 0 0         POSIX::_exit(0) if $pid;
63              
64 0           $wh->autoflush(1);
65 0           print $wh "$$\n";
66              
67             # In watcher now
68 0           $self->watch($wh);
69             }
70              
71             sub stop {
72 0     0 0   my $self = shift;
73 0 0         return if $self->{+STOPPED}++;
74 0 0         my $pid = $self->{+WATCHER_PID} or return;
75 0           kill('INT', $pid);
76             }
77              
78             sub eliminate {
79 0     0 0   my $self = shift;
80 0 0         return if $self->{+ELIMINATED}++;
81 0 0         my $pid = $self->{+WATCHER_PID} or return;
82 0           kill('TERM', $pid);
83             }
84              
85             sub detach {
86 0     0 0   my $self = shift;
87 0 0         return if $self->{+DETACHED}++;
88 0 0         my $pid = $self->{+WATCHER_PID} or return;
89 0           kill('HUP', $pid);
90             }
91              
92             sub wait {
93 0     0 0   my $self = shift;
94 0 0         my $pid = $self->{+WATCHER_PID} or return;
95              
96 0           my $start = time;
97 0           while(kill(0, $pid)) {
98 0           my $waited = time - $start;
99 0 0         if ($waited > 10) {
100 0           kill('KILL', $pid);
101 0           $start = time;
102             }
103 0           sleep 0.02;
104             }
105             }
106              
107             sub watch {
108 0     0 0   my $self = shift;
109 0           my ($wh) = @_;
110              
111 0           $0 = 'db-quick-watcher';
112              
113 0     0     local $SIG{TERM} = sub { $self->_do_eliminate(); POSIX::_exit(0) };
  0            
  0            
114 0     0     local $SIG{INT} = sub { $self->_do_stop(); POSIX::_exit(0) };
  0            
  0            
115 0     0     local $SIG{HUP} = sub { $self->{+DETACHED} = 1 };
  0            
116              
117 0           my $pid = $self->spawn();
118 0           print $wh "$pid\n";
119 0           close($wh);
120              
121 0           while (1) {
122 0           sleep 1;
123 0 0         next if kill(0, $self->{+MASTER_PID});
124              
125 0           $self->_do_eliminate();
126 0           POSIX::_exit(0);
127             }
128              
129 0 0         POSIX::_exit(0) if $self->{+DETACHED};
130 0           die "Scope Leak";
131             }
132              
133             sub _do_stop {
134 0     0     my $self = shift;
135              
136 0           my $db = $self->{+DB};
137 0 0         my $pid = $self->{+SERVER_PID} or return;
138              
139 0 0         if (kill($db->stop_sig, $pid)) {
140 0           my $check = waitpid($pid, 0);
141 0           my $exit = $?;
142 0 0         return if $self->{+DETACHED};
143 0 0 0       if ($exit || $check ne $pid) {
144 0           my $sig = $exit & 127;
145 0           $exit = ($exit >> 8);
146 0           warn "Server had bad exit: Pid: $pid, Check: $check, Exit: $exit, Sig: $sig";
147 0 0         if (my $log_file = $self->{+LOG_FILE}) {
148 0 0         if(open(my $fh, '<', $log_file)) {
149 0           print STDERR <$fh>;
150             }
151             else {
152 0           warn "Could not open log file: $!";
153             }
154             }
155             }
156             }
157             else {
158 0 0         return if $self->{+DETACHED};
159 0           warn "Could not signal server to exit";
160             }
161             }
162              
163             sub _do_eliminate {
164 0     0     my $self = shift;
165 0           my $db = $self->{+DB};
166 0           $self->_do_stop;
167 0 0         $db->cleanup if $db->should_cleanup;
168             }
169              
170             sub spawn {
171 0     0 0   my $self = shift;
172              
173 0 0         croak "Extra spawn" if $self->{+SERVER_PID};
174              
175 0           my $db = $self->{+DB};
176 0   0       my $args = $self->{+ARGS} || [];
177              
178 0           my ($pid, $log_file) = $db->run_command([$db->start_command, @$args], {no_wait => 1, log_file => $self->{+LOG_FILE}});
179 0           $self->{+SERVER_PID} = $pid;
180 0           $self->{+LOG_FILE} = $log_file;
181              
182 0           return $pid;
183             }
184              
185             sub DESTROY {
186 0     0     my $self = shift;
187              
188 0 0         if ($self->{+MASTER_PID} == $$) {
189 0           $self->detach();
190 0           $self->eliminate();
191             }
192             else {
193 0 0         unlink($self->{+LOG_FILE}) if $self->{+LOG_FILE};
194             }
195             }
196              
197             1;
198              
199             __END__