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