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} = '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;