view release on metacpan or  search on metacpan

lib/IPC/Simple.pm  view on Meta::CPAN

  } else {
    $self->{messages}->put($message);
  }
}

#-------------------------------------------------------------------------------
# Send a signal to the process
#-------------------------------------------------------------------------------
sub signal {
  my ($self, $signal) = @_;
  if ($self->{pid}) {
    $self->debug('sending %s to pid %d', $signal, $self->{pid});
    kill $signal, $self->{pid};
  }
}

#-------------------------------------------------------------------------------
# Stopping the process and waiting on it to complete
#-------------------------------------------------------------------------------
sub terminate {
  my $self = shift;
  my $timeout = shift;

  if ($self->is_running) {
    $self->signal('TERM');
    $self->run_state(STATE_STOPPING);

    $self->{handle_in}->push_shutdown;
    $self->{handle_out}->push_shutdown;
    $self->{handle_err}->push_shutdown;

    if (defined $timeout) {
      $self->{kill_timer} = AnyEvent->timer(
        after => $timeout,
        cb => sub{
          $self->signal('KILL');
          undef $self->{kill_timer};
        },
      );
    }

    if ($self->{term_cb}) {
      $self->{term_cb}->($self);
    }
  }
}

sub join {
  my $self = shift;

  return if $self->is_ready;

  $self->debug('waiting for process to exit, pid %d', $self->{pid});

  my $done = AnyEvent->condvar;

  my $timer; $timer = AnyEvent->timer(
    after => 0,
    interval => 0.01,
    cb => sub{
      # non-blocking waitpid returns 0 if the pid is still alive
      if (waitpid($self->{pid}, WNOHANG) != 0) {
        my $status = $?;

        # another waiter might have already called _on_exit
        unless ($self->is_ready) {
          $self->_on_exit($?);
        }

        $done->send;
      }
    },
  );

  $done->recv;
}

#-------------------------------------------------------------------------------
# Messages
#-------------------------------------------------------------------------------
sub send {
  my ($self, $msg) = @_;
  $self->debug('sending "%s"', $msg);
  $self->{handle_in}->push_write($msg . $self->{eol});
  1;
}

sub recv {
  my ($self, $type) = @_;
  $self->debug('waiting on message from pid %d', $self->{pid});
  $self->{messages}->get;
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

IPC::Simple - simple, non-blocking IPC

=head1 VERSION

version 0.09

=head1 SYNOPSIS

  use IPC::Simple qw(spawn);

  my $ssh = spawn ['ssh', $host];

  if ($ssh->launch) {
    $ssh->send('ls -lah');          # get directory listing
    $ssh->send('echo');             # signal our loop that the listing is done

    while (my $msg = $ssh->recv) {  # echo's output will be an empty string
      if ($msg->error) {            # I/O error