home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl502b.zip / lib / IPC / Open3.pm < prev   
Text File  |  1996-01-29  |  4KB  |  145 lines
  1. package IPC::Open3;
  2. require 5.001;
  3. require Exporter;
  4. use Carp;
  5.  
  6. =head1 NAME
  7.  
  8. IPC::Open3, open3 - open a process for reading, writing, and error handling
  9.  
  10. =head1 SYNOPSIS
  11.  
  12.     $pid = open3(\*WTRFH, \*RDRFH, \*ERRFH 
  13.             'some cmd and args', 'optarg', ...);
  14.  
  15. =head1 DESCRIPTION
  16.  
  17. Extremely similar to open2(), open3() spawns the given $cmd and
  18. connects RDRFH for reading, WTRFH for writing, and ERRFH for errors.  If
  19. ERRFH is '', or the same as RDRFH, then STDOUT and STDERR of the child are
  20. on the same file handle.
  21.  
  22. If WTRFH begins with "<&", then WTRFH will be closed in the parent, and
  23. the child will read from it directly.  If RDRFH or ERRFH begins with
  24. ">&", then the child will send output directly to that file handle.  In both
  25. cases, there will be a dup(2) instead of a pipe(2) made.
  26.  
  27. If you try to read from the child's stdout writer and their stderr
  28. writer, you'll have problems with blocking, which means you'll
  29. want to use select(), which means you'll have to use sysread() instead
  30. of normal stuff.
  31.  
  32. All caveats from open2() continue to apply.  See L<open2> for details.
  33.  
  34. =cut
  35.  
  36. @ISA = qw(Exporter);
  37. @EXPORT = qw(open3);
  38.  
  39. # &open3: Marc Horowitz <marc@mit.edu>
  40. # derived mostly from &open2 by tom christiansen, <tchrist@convex.com>
  41. # fixed for 5.001 by Ulrich Kunitz <kunitz@mai-koeln.com>
  42. #
  43. # $Id: open3.pl,v 1.1 1993/11/23 06:26:15 marc Exp $
  44. #
  45. # usage: $pid = open3('wtr', 'rdr', 'err' 'some cmd and args', 'optarg', ...);
  46. #
  47. # spawn the given $cmd and connect rdr for
  48. # reading, wtr for writing, and err for errors.
  49. # if err is '', or the same as rdr, then stdout and
  50. # stderr of the child are on the same fh.  returns pid
  51. # of child, or 0 on failure.
  52.  
  53.  
  54. # if wtr begins with '<&', then wtr will be closed in the parent, and
  55. # the child will read from it directly.  if rdr or err begins with
  56. # '>&', then the child will send output directly to that fd.  In both
  57. # cases, there will be a dup() instead of a pipe() made.
  58.  
  59.  
  60. # WARNING: this is dangerous, as you may block forever
  61. # unless you are very careful.
  62. #
  63. # $wtr is left unbuffered.
  64. #
  65. # abort program if
  66. #   rdr or wtr are null
  67. #   pipe or fork or exec fails
  68.  
  69. $fh = 'FHOPEN000';  # package static in case called more than once
  70.  
  71. sub open3 {
  72.     my($kidpid);
  73.     my($dad_wtr, $dad_rdr, $dad_err, @cmd) = @_;
  74.     my($dup_wtr, $dup_rdr, $dup_err);
  75.  
  76.     $dad_wtr            || croak "open3: wtr should not be null";
  77.     $dad_rdr            || croak "open3: rdr should not be null";
  78.     $dad_err = $dad_rdr if ($dad_err eq '');
  79.  
  80.     $dup_wtr = ($dad_wtr =~ s/^[<>]&//);
  81.     $dup_rdr = ($dad_rdr =~ s/^[<>]&//);
  82.     $dup_err = ($dad_err =~ s/^[<>]&//);
  83.  
  84.     # force unqualified filehandles into callers' package
  85.     my($package) = caller;
  86.     $dad_wtr =~ s/^[^:]+$/$package\:\:$&/ unless ref $dad_wtr;
  87.     $dad_rdr =~ s/^[^:]+$/$package\:\:$&/ unless ref $dad_rdr;
  88.     $dad_err =~ s/^[^:]+$/$package\:\:$&/ unless ref $dad_err;
  89.  
  90.     my($kid_rdr) = ++$fh;
  91.     my($kid_wtr) = ++$fh;
  92.     my($kid_err) = ++$fh;
  93.  
  94.     if (!$dup_wtr) {
  95.     pipe($kid_rdr, $dad_wtr)    || croak "open3: pipe 1 (stdin) failed: $!";
  96.     }
  97.     if (!$dup_rdr) {
  98.     pipe($dad_rdr, $kid_wtr)    || croak "open3: pipe 2 (stdout) failed: $!";
  99.     }
  100.     if ($dad_err ne $dad_rdr && !$dup_err) {
  101.     pipe($dad_err, $kid_err)    || croak "open3: pipe 3 (stderr) failed: $!";
  102.     }
  103.  
  104.     if (($kidpid = fork) < 0) {
  105.         croak "open3: fork failed: $!";
  106.     } elsif ($kidpid == 0) {
  107.     if ($dup_wtr) {
  108.         open(STDIN,  "<&$dad_wtr") if (fileno(STDIN) != fileno($dad_wtr));
  109.     } else {
  110.         close($dad_wtr);
  111.         open(STDIN,  "<&$kid_rdr");
  112.     }
  113.     if ($dup_rdr) {
  114.         open(STDOUT, ">&$dad_rdr") if (fileno(STDOUT) != fileno($dad_rdr));
  115.     } else {
  116.         close($dad_rdr);
  117.         open(STDOUT, ">&$kid_wtr");
  118.     }
  119.     if ($dad_rdr ne $dad_err) {
  120.         if ($dup_err) {
  121.         open(STDERR, ">&$dad_err")
  122.             if (fileno(STDERR) != fileno($dad_err));
  123.         } else {
  124.         close($dad_err);
  125.         open(STDERR, ">&$kid_err");
  126.         }
  127.     } else {
  128.         open(STDERR, ">&STDOUT") if (fileno(STDERR) != fileno(STDOUT));
  129.     }
  130.     local($")=(" ");
  131.     exec @cmd
  132.         or croak "open3: exec of @cmd failed";
  133.     }
  134.  
  135.     close $kid_rdr; close $kid_wtr; close $kid_err;
  136.     if ($dup_wtr) {
  137.     close($dad_wtr);
  138.     }
  139.  
  140.     select((select($dad_wtr), $| = 1)[0]); # unbuffer pipe
  141.     $kidpid;
  142. }
  143. 1; # so require is happy
  144.  
  145.