X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FIPC%2FOpen3.pm;h=95313fce3d95f8f3355c49b1b5248dd20edd8ee6;hb=fe98d82b2e4171a609025e7b159d7945efe2900c;hp=46ebd68cef35228900020307448cb790075c589d;hpb=4375e838ae24b385ae79fa7b6918e613bedaaee6;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/lib/IPC/Open3.pm b/lib/IPC/Open3.pm
index 46ebd68..95313fc 100644
--- a/lib/IPC/Open3.pm
+++ b/lib/IPC/Open3.pm
@@ -9,7 +9,7 @@ require Exporter;
 use Carp;
 use Symbol qw(gensym qualify);
 
-$VERSION	= 1.0103;
+$VERSION	= 1.02;
 @ISA		= qw(Exporter);
 @EXPORT		= qw(open3);
 
@@ -19,7 +19,7 @@ IPC::Open3, open3 - open a process for reading, writing, and error handling
 
 =head1 SYNOPSIS
 
-    $pid = open3(\*WTRFH, \*RDRFH, \*ERRFH,
+    $pid = open3(\*CHLD_IN, \*CHLD_OUT, \*CHLD_ERR,
 		    'some cmd and args', 'optarg', ...);
 
     my($wtr, $rdr, $err);
@@ -29,25 +29,39 @@ IPC::Open3, open3 - open a process for reading, writing, and error handling
 =head1 DESCRIPTION
 
 Extremely similar to open2(), open3() spawns the given $cmd and
-connects RDRFH for reading, WTRFH for writing, and ERRFH for errors.  If
-ERRFH is false, or the same file descriptor as RDRFH, then STDOUT and 
-STDERR of the child are on the same filehandle.  The WTRFH will have
-autoflush turned on.
-
-If WTRFH begins with C<< <& >>, then WTRFH will be closed in the parent, and
-the child will read from it directly.  If RDRFH or ERRFH begins with
-C<< >& >>, then the child will send output directly to that filehandle.
-In both cases, there will be a dup(2) instead of a pipe(2) made.
+connects CHLD_OUT for reading from the child, CHLD_IN for writing to
+the child, and CHLD_ERR for errors.  If CHLD_ERR is false, or the
+same file descriptor as CHLD_OUT, then STDOUT and STDERR of the child
+are on the same filehandle.  The CHLD_IN will have autoflush turned
+on.
+
+If CHLD_IN begins with C<< <& >>, then CHLD_IN will be closed in the
+parent, and the child will read from it directly.  If CHLD_OUT or
+CHLD_ERR begins with C<< >& >>, then the child will send output
+directly to that filehandle.  In both cases, there will be a dup(2)
+instead of a pipe(2) made.
 
 If either reader or writer is the null string, this will be replaced
 by an autogenerated filehandle.  If so, you must pass a valid lvalue
 in the parameter slot so it can be overwritten in the caller, or 
 an exception will be raised.
 
+The filehandles may also be integers, in which case they are understood
+as file descriptors.
+
 open3() returns the process ID of the child process.  It doesn't return on
 failure: it just raises an exception matching C</^open3:/>.  However,
-C<exec> failures in the child are not detected.  You'll have to 
-trap SIGPIPE yourself.
+C<exec> failures in the child (such as no such file or permission denied),
+are just reported to CHLD_ERR, as it is not possible to trap them.
+
+If the child process dies for any reason, the next write to CHLD_IN is
+likely to generate a SIGPIPE in the parent, which is fatal by default.
+So you may wish to handle this signal.
+
+Note if you specify C<-> as the command, in an analogous fashion to
+C<open(FOO, "-|")> the child process will just be the forked Perl
+process rather than an external command.  This feature isn't yet
+supported on Win32 platforms.
 
 open3() does not wait for and reap the child process after it exits.  
 Except for short programs where it's acceptable to let the operating system
@@ -73,6 +87,21 @@ over source code being run in the child process, you can't control
 what it does with pipe buffering.  Thus you can't just open a pipe to
 C<cat -v> and continually read and write a line from it.
 
+=head1 See Also
+
+=over 4
+
+=item L<IPC::Open2>
+
+Like Open3 but without STDERR catpure.
+
+=item L<IPC::Run>
+
+This is a CPAN module that has better error handling and more facilities
+than Open3.
+
+=back
+
 =head1 WARNING
 
 The order of arguments differs from that of open2().
@@ -84,6 +113,8 @@ The order of arguments differs from that of open2().
 # fixed for 5.001 by Ulrich Kunitz <kunitz@mai-koeln.com>
 # ported to Win32 by Ron Schmidt, Merrill Lynch almost ended my career
 # fixed for autovivving FHs, tchrist again
+# allow fd numbers to be used, by Frank Tobin
+# allow '-' as command (c.f. open "-|"), by Adam Spiers <perl@adamspiers.org>
 #
 # $Id: open3.pl,v 1.1 1993/11/23 06:26:15 marc Exp $
 #
@@ -136,6 +167,15 @@ sub xclose {
     close $_[0] or croak "$Me: close($_[0]) failed: $!";
 }
 
+sub fh_is_fd {
+    return $_[0] =~ /\A=?(\d+)\z/;
+}
+
+sub xfileno {
+    return $1 if $_[0] =~ /\A=?(\d+)\z/;  # deal with fh just being an fd
+    return fileno $_[0];
+}
+
 my $do_spawn = $^O eq 'os2' || $^O eq 'MSWin32';
 
 sub _open3 {
@@ -143,6 +183,10 @@ sub _open3 {
     my($package, $dad_wtr, $dad_rdr, $dad_err, @cmd) = @_;
     my($dup_wtr, $dup_rdr, $dup_err, $kidpid);
 
+    if (@cmd > 1 and $cmd[0] eq '-') {
+	croak "Arguments don't make sense when the command is '-'"
+    }
+
     # simulate autovivification of filehandles because
     # it's too ugly to use @_ throughout to make perl do it for us
     # tchrist 5-Mar-00
@@ -164,9 +208,9 @@ sub _open3 {
     $dup_err = ($dad_err =~ s/^[<>]&//);
 
     # force unqualified filehandles into caller's package
-    $dad_wtr = qualify $dad_wtr, $package;
-    $dad_rdr = qualify $dad_rdr, $package;
-    $dad_err = qualify $dad_err, $package;
+    $dad_wtr = qualify $dad_wtr, $package unless fh_is_fd($dad_wtr);
+    $dad_rdr = qualify $dad_rdr, $package unless fh_is_fd($dad_rdr);
+    $dad_err = qualify $dad_err, $package unless fh_is_fd($dad_err);
 
     my $kid_rdr = gensym;
     my $kid_wtr = gensym;
@@ -178,23 +222,26 @@ sub _open3 {
 
     $kidpid = $do_spawn ? -1 : xfork;
     if ($kidpid == 0) {		# Kid
+	# A tie in the parent should not be allowed to cause problems.
+	untie *STDIN;
+	untie *STDOUT;
 	# If she wants to dup the kid's stderr onto her stdout I need to
 	# save a copy of her stdout before I put something else there.
 	if ($dad_rdr ne $dad_err && $dup_err
-		&& fileno($dad_err) == fileno(STDOUT)) {
+		&& xfileno($dad_err) == fileno(STDOUT)) {
 	    my $tmp = gensym;
 	    xopen($tmp, ">&$dad_err");
 	    $dad_err = $tmp;
 	}
 
 	if ($dup_wtr) {
-	    xopen \*STDIN,  "<&$dad_wtr" if fileno(STDIN) != fileno($dad_wtr);
+	    xopen \*STDIN,  "<&$dad_wtr" if fileno(STDIN) != xfileno($dad_wtr);
 	} else {
 	    xclose $dad_wtr;
 	    xopen \*STDIN,  "<&=" . fileno $kid_rdr;
 	}
 	if ($dup_rdr) {
-	    xopen \*STDOUT, ">&$dad_rdr" if fileno(STDOUT) != fileno($dad_rdr);
+	    xopen \*STDOUT, ">&$dad_rdr" if fileno(STDOUT) != xfileno($dad_rdr);
 	} else {
 	    xclose $dad_rdr;
 	    xopen \*STDOUT, ">&=" . fileno $kid_wtr;
@@ -204,8 +251,8 @@ sub _open3 {
 		# I have to use a fileno here because in this one case
 		# I'm doing a dup but the filehandle might be a reference
 		# (from the special case above).
-		xopen \*STDERR, ">&" . fileno $dad_err
-		    if fileno(STDERR) != fileno($dad_err);
+		xopen \*STDERR, ">&" . xfileno($dad_err)
+		    if fileno(STDERR) != xfileno($dad_err);
 	    } else {
 		xclose $dad_err;
 		xopen \*STDERR, ">&=" . fileno $kid_err;
@@ -213,9 +260,13 @@ sub _open3 {
 	} else {
 	    xopen \*STDERR, ">&STDOUT" if fileno(STDERR) != fileno(STDOUT);
 	}
+	return 0 if ($cmd[0] eq '-');
 	local($")=(" ");
-	exec @cmd # XXX: wrong process to croak from
-	    or croak "$Me: exec of @cmd failed";
+	exec @cmd or do {
+	    carp "$Me: exec of @cmd failed";
+	    eval { require POSIX; POSIX::_exit(255); };
+	    exit 255;
+	};
     } elsif ($do_spawn) {
 	# All the bookkeeping of coincidence between handles is
 	# handled in spawn_with_handles.