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(\*CHLD_IN, \*CHLD_OUT, \*CHLD_ERR,
23 'some cmd and args', 'optarg', ...);
26 use Symbol 'gensym'; $err = gensym;
27 $pid = open3($wtr, $rdr, $err,
28 'some cmd and args', 'optarg', ...);
31 my $child_exit_status = $? >> 8;
35 Extremely similar to open2(), open3() spawns the given $cmd and
36 connects CHLD_OUT for reading from the child, CHLD_IN for writing to
37 the child, and CHLD_ERR for errors. If CHLD_ERR is false, or the
38 same file descriptor as CHLD_OUT, then STDOUT and STDERR of the child
39 are on the same filehandle (this means that an autovivified lexical
40 cannot be used for the STDERR filehandle, see SYNOPSIS). The CHLD_IN
41 will have autoflush turned on.
43 If CHLD_IN begins with C<< <& >>, then CHLD_IN will be closed in the
44 parent, and the child will read from it directly. If CHLD_OUT or
45 CHLD_ERR begins with C<< >& >>, then the child will send output
46 directly to that filehandle. In both cases, there will be a dup(2)
47 instead of a pipe(2) made.
49 If either reader or writer is the null string, this will be replaced
50 by an autogenerated filehandle. If so, you must pass a valid lvalue
51 in the parameter slot so it can be overwritten in the caller, or
52 an exception will be raised.
54 The filehandles may also be integers, in which case they are understood
57 open3() returns the process ID of the child process. It doesn't return on
58 failure: it just raises an exception matching C</^open3:/>. However,
59 C<exec> failures in the child (such as no such file or permission denied),
60 are just reported to CHLD_ERR, as it is not possible to trap them.
62 If the child process dies for any reason, the next write to CHLD_IN is
63 likely to generate a SIGPIPE in the parent, which is fatal by default.
64 So you may wish to handle this signal.
66 Note if you specify C<-> as the command, in an analogous fashion to
67 C<open(FOO, "-|")> the child process will just be the forked Perl
68 process rather than an external command. This feature isn't yet
69 supported on Win32 platforms.
71 open3() does not wait for and reap the child process after it exits.
72 Except for short programs where it's acceptable to let the operating system
73 take care of this, you need to do this yourself. This is normally as
74 simple as calling C<waitpid $pid, 0> when you're done with the process.
75 Failing to do this can result in an accumulation of defunct or "zombie"
76 processes. See L<perlfunc/waitpid> for more information.
78 If you try to read from the child's stdout writer and their stderr
79 writer, you'll have problems with blocking, which means you'll want
80 to use select() or the IO::Select, which means you'd best use
81 sysread() instead of readline() for normal stuff.
83 This is very dangerous, as you may block forever. It assumes it's
84 going to talk to something like B<bc>, both writing to it and reading
85 from it. This is presumably safe because you "know" that commands
86 like B<bc> will read a line at a time and output a line at a time.
87 Programs like B<sort> that read their entire input stream first,
88 however, are quite apt to cause deadlock.
90 The big problem with this approach is that if you don't have control
91 over source code being run in the child process, you can't control
92 what it does with pipe buffering. Thus you can't just open a pipe to
93 C<cat -v> and continually read and write a line from it.
101 Like Open3 but without STDERR catpure.
105 This is a CPAN module that has better error handling and more facilities
112 The order of arguments differs from that of open2().
116 # &open3: Marc Horowitz <marc@mit.edu>
117 # derived mostly from &open2 by tom christiansen, <tchrist@convex.com>
118 # fixed for 5.001 by Ulrich Kunitz <kunitz@mai-koeln.com>
119 # ported to Win32 by Ron Schmidt, Merrill Lynch almost ended my career
120 # fixed for autovivving FHs, tchrist again
121 # allow fd numbers to be used, by Frank Tobin
122 # allow '-' as command (c.f. open "-|"), by Adam Spiers <perl@adamspiers.org>
124 # $Id: open3.pl,v 1.1 1993/11/23 06:26:15 marc Exp $
126 # usage: $pid = open3('wtr', 'rdr', 'err' 'some cmd and args', 'optarg', ...);
128 # spawn the given $cmd and connect rdr for
129 # reading, wtr for writing, and err for errors.
130 # if err is '', or the same as rdr, then stdout and
131 # stderr of the child are on the same fh. returns pid
132 # of child (or dies on failure).
135 # if wtr begins with '<&', then wtr will be closed in the parent, and
136 # the child will read from it directly. if rdr or err begins with
137 # '>&', then the child will send output directly to that fd. In both
138 # cases, there will be a dup() instead of a pipe() made.
141 # WARNING: this is dangerous, as you may block forever
142 # unless you are very careful.
144 # $wtr is left unbuffered.
147 # rdr or wtr are null
148 # a system call fails
150 our $Me = 'open3 (bug)'; # you should never see this, it's always localized
152 # Fatal.pm needs to be fixed WRT prototypes.
156 defined $pid or croak "$Me: fork failed: $!";
161 pipe $_[0], $_[1] or croak "$Me: pipe($_[0], $_[1]) failed: $!";
164 # I tried using a * prototype character for the filehandle but it still
165 # disallows a bearword while compiling under strict subs.
168 open $_[0], $_[1] or croak "$Me: open($_[0], $_[1]) failed: $!";
172 close $_[0] or croak "$Me: close($_[0]) failed: $!";
176 return $_[0] =~ /\A=?(\d+)\z/;
180 return $1 if $_[0] =~ /\A=?(\d+)\z/; # deal with fh just being an fd
184 my $do_spawn = $^O eq 'os2' || $^O eq 'MSWin32';
188 my($package, $dad_wtr, $dad_rdr, $dad_err, @cmd) = @_;
189 my($dup_wtr, $dup_rdr, $dup_err, $kidpid);
191 if (@cmd > 1 and $cmd[0] eq '-') {
192 croak "Arguments don't make sense when the command is '-'"
195 # simulate autovivification of filehandles because
196 # it's too ugly to use @_ throughout to make perl do it for us
200 $dad_wtr = $_[1] = gensym unless defined $dad_wtr && length $dad_wtr;
201 $dad_rdr = $_[2] = gensym unless defined $dad_rdr && length $dad_rdr;
204 # must strip crud for croak to add back, or looks ugly
205 $@ =~ s/(?<=value attempted) at .*//s;
209 $dad_err ||= $dad_rdr;
211 $dup_wtr = ($dad_wtr =~ s/^[<>]&//);
212 $dup_rdr = ($dad_rdr =~ s/^[<>]&//);
213 $dup_err = ($dad_err =~ s/^[<>]&//);
215 # force unqualified filehandles into caller's package
216 $dad_wtr = qualify $dad_wtr, $package unless fh_is_fd($dad_wtr);
217 $dad_rdr = qualify $dad_rdr, $package unless fh_is_fd($dad_rdr);
218 $dad_err = qualify $dad_err, $package unless fh_is_fd($dad_err);
220 my $kid_rdr = gensym;
221 my $kid_wtr = gensym;
222 my $kid_err = gensym;
224 xpipe $kid_rdr, $dad_wtr if !$dup_wtr;
225 xpipe $dad_rdr, $kid_wtr if !$dup_rdr;
226 xpipe $dad_err, $kid_err if !$dup_err && $dad_err ne $dad_rdr;
228 $kidpid = $do_spawn ? -1 : xfork;
229 if ($kidpid == 0) { # Kid
230 # A tie in the parent should not be allowed to cause problems.
233 # If she wants to dup the kid's stderr onto her stdout I need to
234 # save a copy of her stdout before I put something else there.
235 if ($dad_rdr ne $dad_err && $dup_err
236 && xfileno($dad_err) == fileno(STDOUT)) {
238 xopen($tmp, ">&$dad_err");
243 xopen \*STDIN, "<&$dad_wtr" if fileno(STDIN) != xfileno($dad_wtr);
246 xopen \*STDIN, "<&=" . fileno $kid_rdr;
249 xopen \*STDOUT, ">&$dad_rdr" if fileno(STDOUT) != xfileno($dad_rdr);
252 xopen \*STDOUT, ">&=" . fileno $kid_wtr;
254 if ($dad_rdr ne $dad_err) {
256 # I have to use a fileno here because in this one case
257 # I'm doing a dup but the filehandle might be a reference
258 # (from the special case above).
259 xopen \*STDERR, ">&" . xfileno($dad_err)
260 if fileno(STDERR) != xfileno($dad_err);
263 xopen \*STDERR, ">&=" . fileno $kid_err;
266 xopen \*STDERR, ">&STDOUT" if fileno(STDERR) != fileno(STDOUT);
268 return 0 if ($cmd[0] eq '-');
271 carp "$Me: exec of @cmd failed";
272 eval { require POSIX; POSIX::_exit(255); };
275 } elsif ($do_spawn) {
276 # All the bookkeeping of coincidence between handles is
277 # handled in spawn_with_handles.
281 $kid_rdr = \*{$dad_wtr};
282 push @close, $kid_rdr;
284 push @close, \*{$dad_wtr}, $kid_rdr;
287 $kid_wtr = \*{$dad_rdr};
288 push @close, $kid_wtr;
290 push @close, \*{$dad_rdr}, $kid_wtr;
292 if ($dad_rdr ne $dad_err) {
294 $kid_err = \*{$dad_err};
295 push @close, $kid_err;
297 push @close, \*{$dad_err}, $kid_err;
304 spawn_with_handles( [ { mode => 'r',
309 handle => \*STDOUT },
312 handle => \*STDERR },
318 xclose $kid_rdr if !$dup_wtr;
319 xclose $kid_wtr if !$dup_rdr;
320 xclose $kid_err if !$dup_err && $dad_rdr ne $dad_err;
321 # If the write handle is a dup give it away entirely, close my copy
323 xclose $dad_wtr if $dup_wtr;
325 select((select($dad_wtr), $| = 1)[0]); # unbuffer pipe
332 croak "open3(@_): not enough arguments";
334 return _open3 'open3', scalar caller, @_
337 sub spawn_with_handles {
338 my $fds = shift; # Fields: handle, mode, open_as
339 my $close_in_child = shift;
340 my ($fd, $pid, @saved_fh, $saved, %saved, @errs);
343 foreach $fd (@$fds) {
344 $fd->{tmp_copy} = IO::Handle->new_from_fd($fd->{handle}, $fd->{mode});
345 $saved{fileno $fd->{handle}} = $fd->{tmp_copy};
347 foreach $fd (@$fds) {
348 bless $fd->{handle}, 'IO::Handle'
349 unless eval { $fd->{handle}->isa('IO::Handle') } ;
350 # If some of handles to redirect-to coincide with handles to
351 # redirect, we need to use saved variants:
352 $fd->{handle}->fdopen($saved{fileno $fd->{open_as}} || $fd->{open_as},
355 unless ($^O eq 'MSWin32') {
356 # Stderr may be redirected below, so we save the err text:
357 foreach $fd (@$close_in_child) {
358 fcntl($fd, Fcntl::F_SETFD(), 1) or push @errs, "fcntl $fd: $!"
359 unless $saved{fileno $fd}; # Do not close what we redirect!
364 $pid = eval { system 1, @_ }; # 1 == P_NOWAIT
365 push @errs, "IO::Pipe: Can't spawn-NOWAIT: $!" if !$pid || $pid < 0;
368 foreach $fd (@$fds) {
369 $fd->{handle}->fdopen($fd->{tmp_copy}, $fd->{mode});
370 $fd->{tmp_copy}->close or croak "Can't close: $!";
372 croak join "\n", @errs if @errs;
376 1; # so require is happy