view release on metacpan or  search on metacpan

inc/inc_IPC-Cmd/IPC/Cmd.pm  view on Meta::CPAN

sub open3_run {
  my ($cmd, $opts) = @_;

  $opts = {} unless $opts;

  my $child_in = FileHandle->new;
  my $child_out = FileHandle->new;
  my $child_err = FileHandle->new;
  $child_out->autoflush(1);
  $child_err->autoflush(1);

  my $pid = open3($child_in, $child_out, $child_err, $cmd);

  # push my child's pid to our parent
  # so in case i am killed parent
  # could stop my child (search for
  # child_child_pid in parent code)
  if ($opts->{'parent_info'}) {
    my $ps = $opts->{'parent_info'};
    print $ps "spawned $pid\n";
  }

  if ($child_in && $child_out->opened && $opts->{'child_stdin'}) {

    # If the child process dies for any reason,
    # the next write to CHLD_IN is likely to generate
    # a SIGPIPE in the parent, which is fatal by default.
    # So you may wish to handle this signal.
    #
    # from http://perldoc.perl.org/IPC/Open3.html,
    # absolutely needed to catch piped commands errors.
    #
    local $SIG{'PIPE'} = sub { 1; };

    print $child_in $opts->{'child_stdin'};
  }
  close($child_in);

  my $child_output = {
    'out' => $child_out->fileno,
    'err' => $child_err->fileno,
    $child_out->fileno => {
      'parent_socket' => $opts->{'parent_stdout'},
      'scalar_buffer' => "",
      'child_handle' => $child_out,
      'block_size' => ($child_out->stat)[11] || 1024,
      },
    $child_err->fileno => {
      'parent_socket' => $opts->{'parent_stderr'},
      'scalar_buffer' => "",
      'child_handle' => $child_err,
      'block_size' => ($child_err->stat)[11] || 1024,
      },
    };

  my $select = IO::Select->new();
  $select->add($child_out, $child_err);

  # pass any signal to the child
  # effectively creating process
  # strongly attached to the child:
  # it will terminate only after child
  # has terminated (except for SIGKILL,
  # which is specially handled)
  foreach my $s (keys %SIG) {
    my $sig_handler;
    $sig_handler = sub {
      kill("$s", $pid);
      $SIG{$s} = $sig_handler;
    };
    $SIG{$s} = $sig_handler;
  }

  my $child_finished = 0;

  my $got_sig_child = 0;
  $SIG{'CHLD'} = sub { $got_sig_child = time(); };

  while(!$child_finished && ($child_out->opened || $child_err->opened)) {

    # parent was killed otherwise we would have got
    # the same signal as parent and process it same way
    if (getppid() eq "1") {

      # end my process group with all the children
      # (i am the process group leader, so my pid
      # equals to the process group id)
      #
      # same thing which is done
      # with $opts->{'clean_up_children'}
      # in run_forked
      #
      kill(-9, $$);

      POSIX::_exit 1;
    }

    if ($got_sig_child) {
      if (time() - $got_sig_child > 1) {
        # select->can_read doesn't return 0 after SIG_CHLD
        #
        # "On POSIX-compliant platforms, SIGCHLD is the signal
        # sent to a process when a child process terminates."
        # http://en.wikipedia.org/wiki/SIGCHLD
        #
        # nevertheless kill KILL wouldn't break anything here
        #
        kill (9, $pid);
        $child_finished = 1;
      }
    }

    Time::HiRes::usleep(1);

    foreach my $fd ($select->can_read(1/100)) {
      my $str = $child_output->{$fd->fileno};
      psSnake::die("child stream not found: $fd") unless $str;

      my $data;
      my $count = $fd->sysread($data, $str->{'block_size'});