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