view release on metacpan or  search on metacpan

lib/App/SuperviseMe.pm  view on Meta::CPAN

  my $self = shift;
  my $sv   = AE::cv;

  my $int_s = AE::signal 'INT' => sub { $self->_signal_all_cmds('INT', $sv); };
  my $term_s = AE::signal 'TERM' => sub { $self->_signal_all_cmds('TERM'); $sv->send };

  for my $cmd (@{ $self->{cmds} }) {
    $self->_start_cmd($cmd);
  }

  $sv->recv;
}


##########
# Magic...

sub _start_cmd {
  my ($self, $cmd) = @_;
  $self->_progress("Starting '@{$cmd->{cmd}}'");

  my $pid = fork();
  if (!defined $pid) {
    $self->_error("fork() failed: $!");
    $self->_restart_cmd($cmd);
    return;
  }

  if ($pid == 0) {    ## Child
    $cmd = $cmd->{cmd};
    $self->_debug("Exec'ing '@$cmd'");
    exec(@$cmd);
    exit(1);
  }

  ## parent
  $self->_debug("Watching pid $pid for '@{$cmd->{cmd}}'");
  $cmd->{pid} = $pid;
  $cmd->{watcher} = AE::child $pid, sub { $self->_child_exited($cmd, @_) };

  return;
}

sub _child_exited {
  my ($self, $cmd, undef, $status) = @_;
  $self->_debug("Child $cmd->{pid} exited, status $status: '@{$cmd->{cmd}}'");

  delete $cmd->{watcher};
  delete $cmd->{pid};

  $cmd->{last_status} = $status >> 8;

  $self->_restart_cmd($cmd);
}

sub _restart_cmd {
  my ($self, $cmd) = @_;
  $self->_progress("Restarting cmd '@{$cmd->{cmd}}' in 1 second");

  my $t;
  $t = AE::timer 1, 0, sub { $self->_start_cmd($cmd); undef $t };
}

sub _signal_all_cmds {
  my ($self, $signal, $cv) = @_;
  $self->_debug("Received signal $signal");
  my $is_any_alive = 0;
  for my $cmd (@{ $self->{cmds} }) {
    next unless my $pid = $cmd->{pid};
    $self->_debug("... sent signal $signal to $pid");
    $is_any_alive++;
    kill($signal, $pid);
  }

  return if $cv and $is_any_alive;

  $self->_progress('Exiting...');
  $cv->send if $cv;
}


#########
# Loggers

sub _out {
  return unless -t \*STDOUT && -t \*STDIN;

  print @_, "\n";
}

sub _progress {
  my $self = shift;
  return unless $self->{progress};

  print @_, "\n";
  $self->_debug('progress msg: ', @_);
}

sub _debug {
  my $self = shift;
  return unless $self->{debug};

  print STDERR "DEBUG [$$] ", @_, "\n";
}

sub _error {
  shift;
  print "ERROR: ", @_, "\n";
  return;
}

1;

__END__

=pod

=encoding utf-8

=for :stopwords Pedro Melo ACKNOWLEDGEMENTS cpan testmatrix url annocpan anno bugtracker rt
cpants kwalitee diff irc mailto metadata placeholders metacpan