1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
|
package MooseX::Runnable::Invocation::Plugin::Restart::Base;
our $VERSION = '0.10';
use Moose::Role;
use MooseX::Types::Moose qw(Int);
use namespace::autoclean;
has 'child_pid' => (
is => 'rw',
isa => Int,
clearer => 'clear_child_pid',
predicate => 'has_child_pid',
);
# XXX: blocking is probably a bad idea; refactor this later
requires 'run_parent_loop';
my $is_debug = sub { return 1;
$_[0]->meta->does_role('MooseX::Runnable::Invocation::Plugin::Debug');
};
sub _restart_parent_setup {
my $self = shift;
}
sub restart {
my $self = shift;
return unless $self->has_child_pid;
eval { $self->_debug_message("Restarting...") };
kill 'HUP', $self->child_pid;
}
sub kill_child {
my $self = shift;
return unless $self->has_child_pid;
eval { $self->_debug_message("Killing ", $self->child_pid) };
kill 'KILL', $self->child_pid;
$self->clear_child_pid;
}
around 'run' => sub {
my ($next, $self, @args) = @_;
my $pid = fork();
if($pid){
local $SIG{CHLD} = sub {
# handle the case where the child dies unexpectedly
waitpid $self->child_pid, 0;
$self->clear_child_pid;
my ($code, $sig) = ($? >> 8, $? & 127);
eval { $self->_debug_message(
"Exiting early, child died with status $code (signal $sig).",
)};
# relay the error up, so the shell (etc.) can see it
kill $sig, $$ if $sig; # no-op?
exit $code;
};
# parent
$self->child_pid( $pid );
$self->_restart_parent_setup;
my $code = $self->run_parent_loop;
eval { $self->_debug_message("Shutting down.") };
$self->kill_child;
return $code;
}
else {
# we go to all this effort so that the child process is always
# free of any "infection" by the parent (like the event loop,
# used by the parent to receive filesystem events or signals,
# which can't be cancelled by the child)
my $child_body; $child_body = sub {
while(1){
my $pid2 = fork;
if($pid2){
# parent? wait for kid to die
local $SIG{HUP} = sub {
kill 'KILL', $pid2;
};
waitpid $pid2, 0;
my $code = $? >> 8;
if($code == 0){
goto $child_body;
}
else {
eval { $self->_debug_message(
"Child exited with non-zero status; aborting.",
)};
exit $code;
}
}
else {
# child? actually do the work
exit $self->$next(@args);
}
}
};
$child_body->();
}
};
1;
|
