[comp.lang.perl] dup'ed pipe-handles

hakanson@ogicse.ogi.edu (Marion Hakanson) (03/09/90)

This is Perl-3.0.12, on DYNIX-3.0.12, Sequent Symmetry, but I've
seen similar behavior in other scripts on 3.0.6 & SunOS-4/4.3bsd.

I've run into (and complained about) something like this before, but
it at least bears warning folks about, if not a "fix".  Briefly, the
problem has to do with a pipe filehandle created by (e.g.)
open(FH,"|..."), where that FH is then dup'ed via open(FH2,">&FH") in
the parent.  See the following example (tee_err.pl), but I've seen
related cases in other applications.

In my opinion, it sure would be nice if all dup's of a pipe's
filehandle were equivalent to each other and to the original.  There
have been a couple of times where I wanted to redirect STDOUT or
STDERR to a pipe by using this technique, and it seems messy to have
to keep around the original pipe-handle when you're through with it
(as in the case where you don't care about the exit status of the
child).  It's also messy to have to code in such a way as to tell the
difference between pipe-handles and other filehandles.

How about it Larry, could Perl wait to do the wait(2) until the last
dup is closed?  Or if that's too tough, at least document this added
distinction between file and pipe handles?  I didn't find any mention
of this caveat in the latest man page.

=========cut here=========
#!/usr/bin/perl
# test program to tee stderr -- 90/03/08
#   Marion Hakanson (hakanson@cse.ogi.edu)
#   Oregon Graduate Institute of Science and Technology

( $#ARGV == $[ ) || die "Need a filename arg, aborted";
$logfile = $ARGV[$[];

# Could open LOG in child, but we don't want the parent to
# proceed if there is an error doing this.
open(LOG, ">$logfile") || die "Cannot open $logfile: $!, aborted";

# make unbuffered (we'll be forking, too)
select(LOG); $| = 1;
select(STDERR); $| = 1;
select(STDOUT); $| = 1;

$pid = open(TEE_ERR, "|-");
die "Cannot do pipefork: $!, aborted" unless defined($pid);

if ( $pid == 0 ) {	# child
  while (<STDIN>) {
    print STDERR || die "Error printing to STDERR: $!, aborted";
    print LOG || die "Error printing to $logfile: $!, aborted";
  }
  print STDERR "EOF on STDIN -- child exiting\n";
  close(LOG) || die "Error closing $logfile: $!, aborted";
  exit(0);
}

# parent
close(LOG);	# don't need it

# redirect STDERR
open(SAVERR, ">&STDERR") || die "Cannot dup STDERR: $!, aborted";
open(STDERR, ">&TEE_ERR") || die "Cannot redirect STDERR: $!, aborted";

# test things
print "Data to STDOUT\n";
print STDERR "Data to STDERR\n";
sleep(1); # simulate a longer-running process

# cleanup
print "Restoring STDERR in 3 seconds\n"; sleep(3);
open(STDERR, ">&SAVERR") || die "Cannot restore STDERR: $!, aborted";

# Note TEE_ERR must be closed last (AFTER dup's of it), otherwise
# we get a deadlock -- child waiting on EOF, parent waiting on child.

print "Closing TEE_ERR in 3 seconds\n"; sleep(3);
close(TEE_ERR) || die "Cannot close TEE_ERR in parent: $!, aborted";
die "Child has nonzero exit status: $?, aborted" if ( $? );

exit(0);
=========cut here=========

-- 
Marion Hakanson         Domain: hakanson@cse.ogi.edu
                        UUCP  : {hp-pcd,tektronix}!ogicse!hakanson