view release on metacpan or  search on metacpan

lib/App/Chart/Glib/Ex/ChildPid.pm  view on Meta::CPAN

  return kill ($sig, $pid);
}

sub wait {
  my ($self, $flags) = @_;
  delete $self->{'watch_ids'};
  my $pid = delete $self->{'pid'}
    || do {
      ## no critic (RequireLocalizedPunctuationVars), it's an output
      $! = POSIX::ECHILD();
      return -1;
    };

  ### ChildPid wait: $pid
  my $status = waitpid ($pid, $flags || 0);
  if ($status != -1) {
    $self->{'exited'} = 1;
    $self->notify ('exited');
    $self->signal_emit ('exited', $status);
  }
  return $status;
}

sub kill_and_wait {
  my ($self, $sig) = @_;
  my $pid = $self->{'pid'};
  if (! $pid || $self->{'exited'}) {
    ## no critic (RequireLocalizedPunctuationVars), it's an output
    $! = POSIX::ECHILD();
    return -1;
  }
  if ($self->kill($sig) != 1) { return -1; }
  Time::HiRes::usleep (10000);
  my $sleeps = 0;
  for (;;) {
    my $status = $self->wait (POSIX::WNOHANG());
    if ($status != 0) { return $status; }
    if ($sleeps >= 3) { last; }
    sleep 1;
    $sleeps++;
  }
  if ($self->kill ('KILL') != 1) { return -1; }
  return $self->wait;
}

sub terminate_with_timeout {
  my ($self, $sig) = @_;
  my $pid = $self->{'pid'};
  if (! $pid || $self->{'exited'}) {
    ## no critic (RequireLocalizedPunctuationVars), it's an output
    $! = POSIX::ECHILD();
    return -1;
  }
  if (! defined $sig) { $sig = 'TERM'; }
  $self->{'terminate_sig'} = $sig;
  if ($self->kill($sig) != 1) {
    return -1;
  }

  $self->{'terminate_ids'} = Glib::Ex::SourceIds->new
    (Glib::Timeout->add ($self->get('terminate-timeout'),
                         \&_terminate_timeout,
                         App::Chart::Glib::Ex::MoreUtils::ref_weak($self)));
  return 1;
}
sub _terminate_timeout {
  my ($ref_weak_self) = @_;
  my $self = $$ref_weak_self || return;
  my $sig = $self->{'terminate_sig'};

  if ($sig eq 'KILL' || $sig eq POSIX::SIGKILL()) {
    Glib::Log->warning (__PACKAGE__, 'child did not die with SIGKILL');

  } else {
    if ($sig eq 'TERM' || $sig eq POSIX::SIGTERM()) {
      $sig = 'KILL';
    } else {
      $sig = 'TERM';
    }
    $self->terminate_with_timeout ($sig);
  }

  return 0; # Glib::SOURCE_REMOVE
}

1;
__END__

=for stopwords subprocess SIGTERM boolean ChildPid SIGSTOP SIGTSTP

=head1 NAME

App::Chart::Glib::Ex::ChildPid -- object holding child process ID

=for test_synopsis my ($pid)

=head1 SYNOPSIS

 use App::Chart::Glib::Ex::ChildPid;
 my $pobj = App::Chart::Glib::Ex::ChildPid->new (pid => $pid);

 $pobj->kill ('INT');
 $pobj->terminate_with_timeout;

=head1 DESCRIPTION

A C<App::Chart::Glib::Ex::ChildPid> holds the process ID (an integer) for a child
process created by C<fork> or similar spawn.

The fork and subprocess emulation described in L<perlfork> doesn't work with
Glib process watching (as of Perl-Glib 1.200) and cannot be used with
C<App::Chart::Glib::Ex::ChildPid>.

=head1 FUNCTIONS

=over 4

=item C<< $pobj->kill () >>

=item C<< $pobj->kill ($sig) >>