[comp.lang.perl] open3 for perl

marc@athena.mit.edu (Marc Horowitz) (05/24/91)

|> I want to be able to capture STDERR from an external command and do
|> some substitution and reprint it back out.  Following is an experiment
|> I was doing to get this to work.  The ls command used is the GNU ls,
|> which with the -h option, prints its options to stderr:

I recently needed to capture stderr separately from stdout for an
application, so I hacked on open3 a little, to take an arg for the fd
for stderr as well.  This may be overkill for the case of getting the
usage message from gnu ls, but it is generally useful.

		Marc



# &open3: Marc Horowitz <marc@mit.edu>
# derived mostly from &open2 by tom christiansen, <tchrist@convex.com>
#
# usage: $pid = open3('wtr', 'rdr', 'err' 'some cmd and args', 'optarg', ...);
#
# spawn the given $cmd and connect rdr for
# reading, wtr for writing, and err for errors.
# if err is '', or the same as rdr, then stdout and
# stderr of the child are on the same fh.  returns pid
# of child, or 0 on failure.
#
# WARNING: this is dangerous, as you may block forever
# unless you are very careful.
#
# $wtr is left unbuffered.
#
# abort program if
#   rdr or wtr are null
#   pipe or fork or exec fails

package open3;

$fh = 'FHOPEN000';  # package static in case called more than once

sub main'open3 {
    local($kidpid);
    local($dad_wtr, $dad_rdr, $dad_err, @cmd) = @_;

    $dad_wtr ne ''          || die "open3: wtr should not be null";
    $dad_rdr ne ''          || die "open3: rdr should not be null";
    $dad_err = $dad_rdr if ($dad_err eq '');

    # force unqualified filehandles into callers' package
    local($package) = caller;
    $dad_wtr =~ s/^[^']+$/$package'$&/;
    $dad_rdr =~ s/^[^']+$/$package'$&/;
    $dad_err =~ s/^[^']+$/$package'$&/;

    local($kid_rdr) = ++$fh;
    local($kid_wtr) = ++$fh;
    local($kid_err) = ++$fh;

    pipe($kid_rdr, $dad_wtr)	    || die "open3: pipe 1 (stdin) failed: $!";
    pipe($dad_rdr, $kid_wtr)        || die "open3: pipe 2 (stdout) failed: $!";
    if ($dad_rdr ne $dad_err) {
	pipe($dad_err, $kid_err)    || die "open3: pipe 3 (stderr) failed: $!";
    }

    if (($kidpid = fork) < 0) {
        die "open2: fork failed: $!";
    } elsif ($kidpid == 0) {
        close $dad_rdr; close $dad_wtr;
        open(STDIN,  ">&$kid_rdr");
        open(STDOUT, ">&$kid_wtr");
	if ($dad_rdr ne $dad_err) {
	    open(STDERR, ">&$kid_err");
	} else {
	    open(STDERR, ">&$kid_wtr");
	}
        exec @cmd;
	    local($")=(" ");
        die "open2: exec of @cmd failed";
    }

    close $kid_rdr; close $kid_wtr; close $kid_err;
    select((select($dad_wtr), $| = 1)[0]); # unbuffer pipe
    $kidpid;
}
1; # so require is happy