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 # XXX: blocking is probably a bad idea; refactor this later
  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){
  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;
  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;
  56         };
  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;
  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                     }
  93                 }
  94                 else {
  95                     # child? actually do the work
  96                     exit $self->$next(@args);
  97                 }
  98             }
  99         };
 100
 101         $child_body->();
 102     }
 103 };
 104
 105 1;