view release on metacpan or  search on metacpan

Reliable.pm  view on Meta::CPAN

      $fileno_getstdin = fileno(GETSTDIN) || die("couldn't get fileno 5");
      $fileno_putstdin = fileno(PUTSTDIN) || die("couldn't get fileno 6");
      PUTSTDIN->autoflush(1);
    }
    
    # fork starts a child process, returns pid for parent, 0 for child
    STDOUT->flush();   # don't dup a non-empty buffer
    $redo = 0;

    #jvr added
    my($oldsigchld) = $SIG{CHLD};
    $SIG{CHLD} = sub { $self->_collect_child(); };

    ##### PARENT PROCESS #####
    if($pid = fork()) {
      # close the ends of the pipes the child will be using
      close(PUTSTDOUT);
      close(PUTSTDERR);
      if(defined($inputref)) {
	close(GETSTDIN);
      }

Reliable.pm  view on Meta::CPAN

	kill('KILL', $pid);
      }

      # wait until process exits or wait-time is exceeded.
      $s = 0;
      while(!defined($self->{status}) && kill(0, $pid) && ($s < $self->sigkill_exit_time)) {
	select(undef, undef, undef, $_WAIT_INCR_SEC);
	$s += $_WAIT_INCR_SEC;
      }

      $SIG{CHLD} = $oldsigchld;  # why is this giving '-w' warning?

      #print("sigs 3: ",$SIG{ALRM}," , ",$SIG{PIPE}," , ",$SIG{CHLD},"\n");
      
      if(!defined($self->{status})) {
	if(kill(0, $pid)) {
	  # get here if unable to kill or if coredump takes longer than sigkill_exit_time
	  $self->{msg} .= "unable to kill subprocess $pid";
	}
	$self->{status} = -1;
	$self->{msg} .= "no return status from subprocess\n";