Does it work 'where'? I had it bracketing the write call and added bracketing for the close statement:
sub close_child_io () {
Debug "SigCHLD: close iopair[1]";
local * pipe_catch = sub ($) { Debug "Child already closed";
$iopair[1] = $iopair[0] = undef; };
my $tmp = $PathTree::iopair[1];
$PathTree::iopair[1] = undef;
$SIG{PIPE}=\&pipe_catch;
close($tmp);
$SIG{PIPE}='DEFAULT';
};
Only the "using-TNT-to-kill-a-fly" idea of redirecting STDERR to /dev/null before every write through perl seems to shut it up:
|2588 local * write_child = sub ($) {
|2589 my $out=$_[0];
|2590 return unless $iopair[1] and ref $iopair[1] and -w $iopair
+[1];
|2591
|2592 local * pipe_catch = sub ($) { Debug "Child closed";
|2593 $iopair[1] = $iopair[0] = undef; };
|2594
|2595 $SIG{PIPE}=\&pipe_catch;
|2596 no warnings;
|2597 open (OLDERR, ">&", \*STDERR) or die "Can't dup STDERR: $!
+";
|2598 open (STDERR, ">", "/dev/null") or die "Can't redirect STD
+ERR to /dev/null: $!";
|2599 select STDERR; $|=1;
|2600 P $iopair[1], $out."\n" ;
|2601 open(STDERR, ">&OLDERR") or die "Can't restore stderr: $!"
+;
|2602 $SIG{PIPE}='DEFAULT';
|2603 };