lib/IPC/Open3.pm

   1 package IPC::Open3;
   2 require 5.000;
   3 require Exporter;
   4 use Carp;
   5
   6 @ISA = qw(Exporter);
   7 @EXPORT = qw(open3);
   8
   9 # &open3: Marc Horowitz <marc@mit.edu>
  10 # derived mostly from &open2 by tom christiansen, <tchrist@convex.com>
  11 #
  12 # $Id: open3.pl,v 1.1 1993/11/23 06:26:15 marc Exp $
  13 #
  14 # usage: $pid = open3('wtr', 'rdr', 'err' 'some cmd and args', 'optarg', ...);
  15 #
  16 # spawn the given $cmd and connect rdr for
  17 # reading, wtr for writing, and err for errors.
  18 # if err is '', or the same as rdr, then stdout and
  19 # stderr of the child are on the same fh.  returns pid
  20 # of child, or 0 on failure.
  21
  22
  23 # if wtr begins with '>&', then wtr will be closed in the parent, and
  24 # the child will read from it directly.  if rdr or err begins with
  25 # '>&', then the child will send output directly to that fd.  In both
  26 # cases, there will be a dup() instead of a pipe() made.
  27
  28
  29 # WARNING: this is dangerous, as you may block forever
  30 # unless you are very careful.
  31 #
  32 # $wtr is left unbuffered.
  33 #
  34 # abort program if
  35 #   rdr or wtr are null
  36 #   pipe or fork or exec fails
  37
  38 $fh = 'FHOPEN000';  # package static in case called more than once
  39
  40 sub open3 {
  41     local($kidpid);
  42     local($dad_wtr, $dad_rdr, $dad_err, @cmd) = @_;
  43     local($dup_wtr, $dup_rdr, $dup_err);
  44
  45     $dad_wtr                    || croak "open3: wtr should not be null";
  46     $dad_rdr                    || croak "open3: rdr should not be null";
  47     $dad_err = $dad_rdr if ($dad_err eq '');
  48
  49     $dup_wtr = ($dad_wtr =~ s/^\>\&//);
  50     $dup_rdr = ($dad_rdr =~ s/^\>\&//);
  51     $dup_err = ($dad_err =~ s/^\>\&//);
  52
  53     # force unqualified filehandles into callers' package
  54     local($package) = caller;
  55     $dad_wtr =~ s/^[^']+$/$package'$&/;
  56     $dad_rdr =~ s/^[^']+$/$package'$&/;
  57     $dad_err =~ s/^[^']+$/$package'$&/;
  58
  59     local($kid_rdr) = ++$fh;
  60     local($kid_wtr) = ++$fh;
  61     local($kid_err) = ++$fh;
  62
  63     if (!$dup_wtr) {
  64         pipe($kid_rdr, $dad_wtr)    || croak "open3: pipe 1 (stdin) failed: $!";
  65     }
  66     if (!$dup_rdr) {
  67         pipe($dad_rdr, $kid_wtr)    || croak "open3: pipe 2 (stdout) failed: $!";
  68     }
  69     if ($dad_err ne $dad_rdr && !$dup_err) {
  70         pipe($dad_err, $kid_err)    || croak "open3: pipe 3 (stderr) failed: $!";
  71     }
  72
  73     if (($kidpid = fork) < 0) {
  74         croak "open2: fork failed: $!";
  75     } elsif ($kidpid == 0) {
  76         if ($dup_wtr) {
  77             open(STDIN,  ">&$dad_wtr") if (fileno(STDIN) != fileno($dad_wtr));
  78         } else {
  79             close($dad_wtr);
  80             open(STDIN,  ">&$kid_rdr");
  81         }
  82         if ($dup_rdr) {
  83             open(STDOUT, ">&$dad_rdr") if (fileno(STDOUT) != fileno($dad_rdr));
  84         } else {
  85             close($dad_rdr);
  86             open(STDOUT, ">&$kid_wtr");
  87         }
  88         if ($dad_rdr ne $dad_err) {
  89             if ($dup_err) {
  90                 open(STDERR, ">&$dad_err")
  91                     if (fileno(STDERR) != fileno($dad_err));
  92             } else {
  93                 close($dad_err);
  94                 open(STDERR, ">&$kid_err");
  95             }
  96         } else {
  97             open(STDERR, ">&STDOUT") if (fileno(STDERR) != fileno(STDOUT));
  98         }
  99         local($")=(" ");
 100         exec @cmd;
 101         croak "open2: exec of @cmd failed";
 102     }
 103
 104     close $kid_rdr; close $kid_wtr; close $kid_err;
 105     if ($dup_wtr) {
 106         close($dad_wtr);
 107     }
 108
 109     select((select($dad_wtr), $| = 1)[0]); # unbuffer pipe
 110     $kidpid;
 111 }
 112 1; # so require is happy
 113