Re: Debugger in beta3
[p5sagit/p5-mst-13.2.git] / lib / IPC / Open3.pm
CommitLineData
a0d0e21e 1package IPC::Open3;
4633a7c4 2require 5.001;
a0d0e21e 3require Exporter;
4use Carp;
5
f06db76b 6=head1 NAME
7
8IPC::Open3, open3 - open a process for reading, writing, and error handling
9
10=head1 SYNOPSIS
11
cb1a09d0 12 $pid = open3(\*WTRFH, \*RDRFH, \*ERRFH
f06db76b 13 'some cmd and args', 'optarg', ...);
14
15=head1 DESCRIPTION
16
17Extremely similar to open2(), open3() spawns the given $cmd and
18connects RDRFH for reading, WTRFH for writing, and ERRFH for errors. If
19ERRFH is '', or the same as RDRFH, then STDOUT and STDERR of the child are
20on the same file handle.
21
4633a7c4 22If WTRFH begins with "<&", then WTRFH will be closed in the parent, and
23the child will read from it directly. If RDRFH or ERRFH begins with
f06db76b 24">&", then the child will send output directly to that file handle. In both
25cases, there will be a dup(2) instead of a pipe(2) made.
26
cb1a09d0 27If you try to read from the child's stdout writer and their stderr
28writer, you'll have problems with blocking, which means you'll
29want to use select(), which means you'll have to use sysread() instead
30of normal stuff.
31
f06db76b 32All caveats from open2() continue to apply. See L<open2> for details.
33
34=cut
35
a0d0e21e 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>
4633a7c4 41# fixed for 5.001 by Ulrich Kunitz <kunitz@mai-koeln.com>
a0d0e21e 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
4633a7c4 54# if wtr begins with '<&', then wtr will be closed in the parent, and
a0d0e21e 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
71sub open3 {
4633a7c4 72 my($kidpid);
73 my($dad_wtr, $dad_rdr, $dad_err, @cmd) = @_;
74 my($dup_wtr, $dup_rdr, $dup_err);
a0d0e21e 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
4633a7c4 80 $dup_wtr = ($dad_wtr =~ s/^[<>]&//);
81 $dup_rdr = ($dad_rdr =~ s/^[<>]&//);
82 $dup_err = ($dad_err =~ s/^[<>]&//);
a0d0e21e 83
84 # force unqualified filehandles into callers' package
4633a7c4 85 my($package) = caller;
cb1a09d0 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;
a0d0e21e 89
4633a7c4 90 my($kid_rdr) = ++$fh;
91 my($kid_wtr) = ++$fh;
92 my($kid_err) = ++$fh;
a0d0e21e 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) {
c07a80fd 105 croak "open3: fork failed: $!";
a0d0e21e 106 } elsif ($kidpid == 0) {
107 if ($dup_wtr) {
4633a7c4 108 open(STDIN, "<&$dad_wtr") if (fileno(STDIN) != fileno($dad_wtr));
a0d0e21e 109 } else {
110 close($dad_wtr);
4633a7c4 111 open(STDIN, "<&$kid_rdr");
a0d0e21e 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($")=(" ");
c07a80fd 131 exec @cmd
132 or croak "open3: exec of @cmd failed";
a0d0e21e 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}
1431; # so require is happy
144