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         };
  48
  49         # parent
  50         $self->child_pid( $pid );
  51         $self->_restart_parent_setup;
  52
  53         my $code = $self->run_parent_loop;
  54         eval { $self->_debug_message("Shutting down.") };
  55
  56         $self->kill_child;
  57         return $code;
  58     }
  59     else {
  60         # we go to all this effort so that the child process is always
  61         # free of any "infection" by the parent (like the event loop,
  62         # used by the parent to receive filesystem events or signals,
  63         # which can't be cancelled by the child)
  64
  65         my $child_body; $child_body = sub {
  66             while(1){
  67                 my $pid2 = fork;
  68                 if($pid2){
  69                     # parent? wait for kid to die
  70                     local $SIG{HUP} = sub {
  71                         kill 'KILL', $pid2;
  72                     };
  73                     waitpid $pid2, 0;
  74                     $child_body->();
  75                 }
  76                 else {
  77                     # child? actually do the work
  78                     exit $self->$next(@args);
  79
  80                 }
  81             }
  82         };
  83
  84         $child_body->();
  85     }
  86 };
  87
  88 1;