lib/MooseX/Runnable/Invocation/Plugin/Restart/Base.pm

   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} = sub {
  44             # handle the case where the child dies unexpectedly
  45             waitpid $self->child_pid, 0;
  46             $self->clear_child_pid;
  47             my ($code, $sig) = ($? >> 8, $? & 127);
  48             eval { $self->_debug_message(
  49                 "Exiting early, child died with status $code (signal $sig).",
  50             )};
  51
  52             # relay the error up, so the shell (etc.) can see it
  53             kill $sig, $$ if $sig; # no-op?
  54             exit $code;
  55         };
  56
  57         # parent
  58         $self->child_pid( $pid );
  59         $self->_restart_parent_setup;
  60
  61         my $code = $self->run_parent_loop;
  62         eval { $self->_debug_message("Shutting down.") };
  63
  64         $self->kill_child;
  65         return $code;
  66     }
  67     else {
  68         # we go to all this effort so that the child process is always
  69         # free of any "infection" by the parent (like the event loop,
  70         # used by the parent to receive filesystem events or signals,
  71         # which can't be cancelled by the child)
  72
  73         my $child_body; $child_body = sub {
  74             while(1){
  75                 my $pid2 = fork;
  76                 if($pid2){
  77                     # parent? wait for kid to die
  78                     local $SIG{HUP} = sub {
  79                         kill 'KILL', $pid2;
  80                     };
  81                     waitpid $pid2, 0;
  82                     my $code = $? >> 8;
  83                     if($code == 0){
  84                         goto $child_body;
  85                     }
  86                     else {
  87                         eval { $self->_debug_message(
  88                             "Child exited with non-zero status; aborting.",
  89                         )};
  90                         exit $code;
  91                     }
  92                 }
  93                 else {
  94                     # child? actually do the work
  95                     exit $self->$next(@args);
  96                 }
  97             }
  98         };
  99
 100         $child_body->();
 101     }
 102 };
 103
 104 1;