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 | |
13 | requires 'run_parent_loop'; |
14 | |
15 | my $is_debug = sub { return 1; |
16 | $_[0]->meta->does_role('MooseX::Runnable::Invocation::Plugin::Debug'); |
17 | }; |
18 | |
19 | sub _restart_parent_setup { |
20 | my $self = shift; |
21 | } |
22 | |
23 | sub restart { |
24 | my $self = shift; |
25 | return unless $self->has_child_pid; |
26 | eval { $self->_debug_message("Restarting...") }; |
27 | kill 'HUP', $self->child_pid; |
28 | } |
29 | |
30 | sub kill_child { |
31 | my $self = shift; |
32 | return unless $self->has_child_pid; |
33 | eval { $self->_debug_message("Killing ", $self->child_pid) }; |
34 | |
35 | kill 'KILL', $self->child_pid; |
36 | $self->clear_child_pid; |
37 | } |
38 | |
39 | around 'run' => sub { |
40 | my ($next, $self, @args) = @_; |
41 | my $pid = fork(); |
42 | if($pid){ |
43 | local $SIG{CHLD} = 'IGNORE'; |
44 | |
45 | # parent |
46 | $self->child_pid( $pid ); |
47 | $self->_restart_parent_setup; |
48 | |
49 | my $code = $self->run_parent_loop; |
50 | eval { $self->_debug_message("Shutting down.") }; |
51 | |
52 | $self->kill_child; |
53 | return $code; |
54 | } |
55 | else { |
56 | # we go to all this effort so that the child process is always |
57 | # free of any "infection" by the parent (like the event loop, |
58 | # used by the parent to receive filesystem events or signals, |
59 | # which can't be cancelled by the child) |
60 | |
61 | my $child_body; $child_body = sub { |
62 | while(1){ |
63 | my $pid2 = fork; |
64 | if($pid2){ |
65 | # parent? wait for kid to die |
66 | local $SIG{HUP} = sub { |
67 | kill 'KILL', $pid2; |
68 | }; |
69 | waitpid $pid2, 0; |
70 | $child_body->(); |
71 | } |
72 | else { |
73 | # child? actually do the work |
74 | exit $self->$next(@args); |
75 | |
76 | } |
77 | } |
78 | }; |
79 | |
80 | $child_body->(); |
81 | } |
82 | }; |
83 | |
84 | 1; |