X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FIPC%2FOpen2.pm;h=cfd15a848bc2079aba184c89bcf4b9f32628d2ab;hb=7e1af8bca57f405a8444b575a870918a6d88fc5c;hp=35bb0d1f16ff9f6314fe8508a45b78856cabfb33;hpb=7f3dfc00eaef7e421633b2b47af9963dbc626e75;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/lib/IPC/Open2.pm b/lib/IPC/Open2.pm
index 35bb0d1..cfd15a8 100644
--- a/lib/IPC/Open2.pm
+++ b/lib/IPC/Open2.pm
@@ -1,7 +1,14 @@
 package IPC::Open2;
+
+use strict;
+use vars qw($VERSION @ISA @EXPORT);
+
 require 5.000;
 require Exporter;
-use Carp;
+
+$VERSION	= 1.01;
+@ISA		= qw(Exporter);
+@EXPORT		= qw(open2);
 
 =head1 NAME
 
@@ -22,6 +29,13 @@ when you try
 
     open(HANDLE, "|cmd args|");
 
+If $rdr is a string (that is, a bareword filehandle rather than a glob
+or a reference) and it begins with ">&", then the child will send output
+directly to that file handle.  If $wtr is a string that begins with
+"<&", then WTR will be closed in the parent, and the child will read
+from it directly.  In both cases, there will be a dup(2) instead of a
+pipe(2) made.
+
 open2() returns the process ID of the child process.  It doesn't return on
 failure: it just raises an exception matching C</^open2:/>.
 
@@ -44,13 +58,11 @@ read and write a line from it.
 
 =head1 SEE ALSO
 
-See L<open3> for an alternative that handles STDERR as well.
+See L<IPC::Open3> for an alternative that handles STDERR as well.  This
+function is really just a wrapper around open3().
 
 =cut
 
-@ISA = qw(Exporter);
-@EXPORT = qw(open2);
-
 # &open2: tom christiansen, <tchrist@convex.com>
 #
 # usage: $pid = open2('rdr', 'wtr', 'some cmd and args');
@@ -67,41 +79,15 @@ See L<open3> for an alternative that handles STDERR as well.
 # 
 # abort program if
 #	rdr or wtr are null
-# 	pipe or fork or exec fails
+# 	a system call fails
 
-$fh = 'FHOPEN000';  # package static in case called more than once
+require IPC::Open3;
 
 sub open2 {
-    local($kidpid);
-    local($dad_rdr, $dad_wtr, @cmd) = @_;
-
-    $dad_rdr ne '' 		|| croak "open2: rdr should not be null";
-    $dad_wtr ne '' 		|| croak "open2: wtr should not be null";
-
-    # force unqualified filehandles into callers' package
-    local($package) = caller;
-    $dad_rdr =~ s/^([^']+$)/$package'$1/ unless ref $dad_rdr;
-    $dad_wtr =~ s/^([^']+$)/$package'$1/ unless ref $dad_wtr;
-
-    local($kid_rdr) = ++$fh;
-    local($kid_wtr) = ++$fh;
-
-    pipe($dad_rdr, $kid_wtr) 	|| croak "open2: pipe 1 failed: $!";
-    pipe($kid_rdr, $dad_wtr) 	|| croak "open2: pipe 2 failed: $!";
-
-    if (($kidpid = fork) < 0) {
-	croak "open2: fork failed: $!";
-    } elsif ($kidpid == 0) {
-	close $dad_rdr; close $dad_wtr;
-	open(STDIN,  "<&$kid_rdr");
-	open(STDOUT, ">&$kid_wtr");
-	warn "execing @cmd\n" if $debug;
-	exec @cmd
-	    or croak "open2: exec of @cmd failed";   
-    } 
-    close $kid_rdr; close $kid_wtr;
-    select((select($dad_wtr), $| = 1)[0]); # unbuffer pipe
-    $kidpid;
+    my ($read, $write, @cmd) = @_;
+    local $Carp::CarpLevel = $Carp::CarpLevel + 1;
+    return IPC::Open3::_open3('open2', scalar caller,
+				$write, $read, '>&STDERR', @cmd);
 }
-1; # so require is happy
 
+1