4 no strict 'refs'; # because users pass me bareword filehandles
5 our ($VERSION, @ISA, @EXPORT);
10 use Symbol qw(gensym qualify);
18 IPC::Open3, open3 - open a process for reading, writing, and error handling
22 $pid = open3(\*WTRFH, \*RDRFH, \*ERRFH,
23 'some cmd and args', 'optarg', ...);
26 $pid = open3($wtr, $rdr, $err,
27 'some cmd and args', 'optarg', ...);
31 Extremely similar to open2(), open3() spawns the given $cmd and
32 connects RDRFH for reading, WTRFH for writing, and ERRFH for errors. If
33 ERRFH is false, or the same file descriptor as RDRFH, then STDOUT and
34 STDERR of the child are on the same filehandle. The WTRFH will have
37 If WTRFH begins with C<< <& >>, then WTRFH will be closed in the parent, and
38 the child will read from it directly. If RDRFH or ERRFH begins with
39 C<< >& >>, then the child will send output directly to that filehandle.
40 In both cases, there will be a dup(2) instead of a pipe(2) made.
42 If either reader or writer is the null string, this will be replaced
43 by an autogenerated filehandle. If so, you must pass a valid lvalue
44 in the parameter slot so it can be overwritten in the caller, or
45 an exception will be raised.
47 open3() returns the process ID of the child process. It doesn't return on
48 failure: it just raises an exception matching C</^open3:/>. However,
49 C<exec> failures in the child are not detected. You'll have to
50 trap SIGPIPE yourself.
52 If you try to read from the child's stdout writer and their stderr
53 writer, you'll have problems with blocking, which means you'll want
54 to use select() or the IO::Select, which means you'd best use
55 sysread() instead of readline() for normal stuff.
57 This is very dangerous, as you may block forever. It assumes it's
58 going to talk to something like B<bc>, both writing to it and reading
59 from it. This is presumably safe because you "know" that commands
60 like B<bc> will read a line at a time and output a line at a time.
61 Programs like B<sort> that read their entire input stream first,
62 however, are quite apt to cause deadlock.
64 The big problem with this approach is that if you don't have control
65 over source code being run in the child process, you can't control
66 what it does with pipe buffering. Thus you can't just open a pipe to
67 C<cat -v> and continually read and write a line from it.
71 The order of arguments differs from that of open2().
75 # &open3: Marc Horowitz <marc@mit.edu>
76 # derived mostly from &open2 by tom christiansen, <tchrist@convex.com>
77 # fixed for 5.001 by Ulrich Kunitz <kunitz@mai-koeln.com>
78 # ported to Win32 by Ron Schmidt, Merrill Lynch almost ended my career
79 # fixed for autovivving FHs, tchrist again
81 # $Id: open3.pl,v 1.1 1993/11/23 06:26:15 marc Exp $
83 # usage: $pid = open3('wtr', 'rdr', 'err' 'some cmd and args', 'optarg', ...);
85 # spawn the given $cmd and connect rdr for
86 # reading, wtr for writing, and err for errors.
87 # if err is '', or the same as rdr, then stdout and
88 # stderr of the child are on the same fh. returns pid
89 # of child (or dies on failure).
92 # if wtr begins with '<&', then wtr will be closed in the parent, and
93 # the child will read from it directly. if rdr or err begins with
94 # '>&', then the child will send output directly to that fd. In both
95 # cases, there will be a dup() instead of a pipe() made.
98 # WARNING: this is dangerous, as you may block forever
99 # unless you are very careful.
101 # $wtr is left unbuffered.
104 # rdr or wtr are null
105 # a system call fails
107 our $Me = 'open3 (bug)'; # you should never see this, it's always localized
109 # Fatal.pm needs to be fixed WRT prototypes.
113 defined $pid or croak "$Me: fork failed: $!";
118 pipe $_[0], $_[1] or croak "$Me: pipe($_[0], $_[1]) failed: $!";
121 # I tried using a * prototype character for the filehandle but it still
122 # disallows a bearword while compiling under strict subs.
125 open $_[0], $_[1] or croak "$Me: open($_[0], $_[1]) failed: $!";
129 close $_[0] or croak "$Me: close($_[0]) failed: $!";
132 my $do_spawn = $^O eq 'os2' || $^O eq 'MSWin32';
136 my($package, $dad_wtr, $dad_rdr, $dad_err, @cmd) = @_;
137 my($dup_wtr, $dup_rdr, $dup_err, $kidpid);
139 # simulate autovivification of filehandles because
140 # it's too ugly to use @_ throughout to make perl do it for us
144 $dad_wtr = $_[1] = gensym unless defined $dad_wtr && length $dad_wtr;
145 $dad_rdr = $_[2] = gensym unless defined $dad_rdr && length $dad_rdr;
148 # must strip crud for croak to add back, or looks ugly
149 $@ =~ s/(?<=value attempted) at .*//s;
153 $dad_err ||= $dad_rdr;
155 $dup_wtr = ($dad_wtr =~ s/^[<>]&//);
156 $dup_rdr = ($dad_rdr =~ s/^[<>]&//);
157 $dup_err = ($dad_err =~ s/^[<>]&//);
159 # force unqualified filehandles into caller's package
160 $dad_wtr = qualify $dad_wtr, $package;
161 $dad_rdr = qualify $dad_rdr, $package;
162 $dad_err = qualify $dad_err, $package;
164 my $kid_rdr = gensym;
165 my $kid_wtr = gensym;
166 my $kid_err = gensym;
168 xpipe $kid_rdr, $dad_wtr if !$dup_wtr;
169 xpipe $dad_rdr, $kid_wtr if !$dup_rdr;
170 xpipe $dad_err, $kid_err if !$dup_err && $dad_err ne $dad_rdr;
172 $kidpid = $do_spawn ? -1 : xfork;
173 if ($kidpid == 0) { # Kid
174 # If she wants to dup the kid's stderr onto her stdout I need to
175 # save a copy of her stdout before I put something else there.
176 if ($dad_rdr ne $dad_err && $dup_err
177 && fileno($dad_err) == fileno(STDOUT)) {
179 xopen($tmp, ">&$dad_err");
184 xopen \*STDIN, "<&$dad_wtr" if fileno(STDIN) != fileno($dad_wtr);
187 xopen \*STDIN, "<&=" . fileno $kid_rdr;
190 xopen \*STDOUT, ">&$dad_rdr" if fileno(STDOUT) != fileno($dad_rdr);
193 xopen \*STDOUT, ">&=" . fileno $kid_wtr;
195 if ($dad_rdr ne $dad_err) {
197 # I have to use a fileno here because in this one case
198 # I'm doing a dup but the filehandle might be a reference
199 # (from the special case above).
200 xopen \*STDERR, ">&" . fileno $dad_err
201 if fileno(STDERR) != fileno($dad_err);
204 xopen \*STDERR, ">&=" . fileno $kid_err;
207 xopen \*STDERR, ">&STDOUT" if fileno(STDERR) != fileno(STDOUT);
210 exec @cmd # XXX: wrong process to croak from
211 or croak "$Me: exec of @cmd failed";
212 } elsif ($do_spawn) {
213 # All the bookkeeping of coincidence between handles is
214 # handled in spawn_with_handles.
218 $kid_rdr = \*{$dad_wtr};
219 push @close, $kid_rdr;
221 push @close, \*{$dad_wtr}, $kid_rdr;
224 $kid_wtr = \*{$dad_rdr};
225 push @close, $kid_wtr;
227 push @close, \*{$dad_rdr}, $kid_wtr;
229 if ($dad_rdr ne $dad_err) {
231 $kid_err = \*{$dad_err};
232 push @close, $kid_err;
234 push @close, \*{$dad_err}, $kid_err;
241 spawn_with_handles( [ { mode => 'r',
246 handle => \*STDOUT },
249 handle => \*STDERR },
255 xclose $kid_rdr if !$dup_wtr;
256 xclose $kid_wtr if !$dup_rdr;
257 xclose $kid_err if !$dup_err && $dad_rdr ne $dad_err;
258 # If the write handle is a dup give it away entirely, close my copy
260 xclose $dad_wtr if $dup_wtr;
262 select((select($dad_wtr), $| = 1)[0]); # unbuffer pipe
269 croak "open3(@_): not enough arguments";
271 return _open3 'open3', scalar caller, @_
274 sub spawn_with_handles {
275 my $fds = shift; # Fields: handle, mode, open_as
276 my $close_in_child = shift;
277 my ($fd, $pid, @saved_fh, $saved, %saved, @errs);
280 foreach $fd (@$fds) {
281 $fd->{tmp_copy} = IO::Handle->new_from_fd($fd->{handle}, $fd->{mode});
282 $saved{fileno $fd->{handle}} = $fd->{tmp_copy};
284 foreach $fd (@$fds) {
285 bless $fd->{handle}, 'IO::Handle'
286 unless eval { $fd->{handle}->isa('IO::Handle') } ;
287 # If some of handles to redirect-to coincide with handles to
288 # redirect, we need to use saved variants:
289 $fd->{handle}->fdopen($saved{fileno $fd->{open_as}} || $fd->{open_as},
292 unless ($^O eq 'MSWin32') {
293 # Stderr may be redirected below, so we save the err text:
294 foreach $fd (@$close_in_child) {
295 fcntl($fd, Fcntl::F_SETFD(), 1) or push @errs, "fcntl $fd: $!"
296 unless $saved{fileno $fd}; # Do not close what we redirect!
301 $pid = eval { system 1, @_ }; # 1 == P_NOWAIT
302 push @errs, "IO::Pipe: Can't spawn-NOWAIT: $!" if !$pid || $pid < 0;
305 foreach $fd (@$fds) {
306 $fd->{handle}->fdopen($fd->{tmp_copy}, $fd->{mode});
307 $fd->{tmp_copy}->close or croak "Can't close: $!";
309 croak join "\n", @errs if @errs;
313 1; # so require is happy