This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Increase $IPC::Open3::VERSION to 1.16
[perl5.git] / ext / IPC-Open3 / lib / IPC / Open3.pm
CommitLineData
a0d0e21e 1package IPC::Open3;
7e1af8bc 2
3use strict;
4no strict 'refs'; # because users pass me bareword filehandles
2675ae2b 5our ($VERSION, @ISA, @EXPORT);
7e1af8bc 6
a0d0e21e 7require Exporter;
7e1af8bc 8
a0d0e21e 9use Carp;
8b3e92c6 10use Symbol qw(gensym qualify);
7e1af8bc 11
62c7b79a 12$VERSION = '1.16';
7e1af8bc 13@ISA = qw(Exporter);
14@EXPORT = qw(open3);
a0d0e21e 15
f06db76b
AD
16=head1 NAME
17
14333e50 18IPC::Open3 - open a process for reading, writing, and error handling using open3()
f06db76b
AD
19
20=head1 SYNOPSIS
21
3ce239a0 22 $pid = open3(\*CHLD_IN, \*CHLD_OUT, \*CHLD_ERR,
f06db76b
AD
23 'some cmd and args', 'optarg', ...);
24
2675ae2b 25 my($wtr, $rdr, $err);
92be7001 26 use Symbol 'gensym'; $err = gensym;
2675ae2b
GS
27 $pid = open3($wtr, $rdr, $err,
28 'some cmd and args', 'optarg', ...);
29
b2080196 30 waitpid( $pid, 0 );
31 my $child_exit_status = $? >> 8;
32
f06db76b
AD
33=head1 DESCRIPTION
34
35Extremely similar to open2(), open3() spawns the given $cmd and
3ce239a0
BT
36connects CHLD_OUT for reading from the child, CHLD_IN for writing to
37the child, and CHLD_ERR for errors. If CHLD_ERR is false, or the
38same file descriptor as CHLD_OUT, then STDOUT and STDERR of the child
92be7001
SR
39are on the same filehandle (this means that an autovivified lexical
40cannot be used for the STDERR filehandle, see SYNOPSIS). The CHLD_IN
41will have autoflush turned on.
3ce239a0
BT
42
43If CHLD_IN begins with C<< <& >>, then CHLD_IN will be closed in the
44parent, and the child will read from it directly. If CHLD_OUT or
45CHLD_ERR begins with C<< >& >>, then the child will send output
46directly to that filehandle. In both cases, there will be a dup(2)
47instead of a pipe(2) made.
f06db76b 48
2675ae2b
GS
49If either reader or writer is the null string, this will be replaced
50by an autogenerated filehandle. If so, you must pass a valid lvalue
8960aa87 51in the parameter slot so it can be overwritten in the caller, or
2675ae2b 52an exception will be raised.
cb1a09d0 53
036b4402
GS
54The filehandles may also be integers, in which case they are understood
55as file descriptors.
56
7e1af8bc 57open3() returns the process ID of the child process. It doesn't return on
2675ae2b 58failure: it just raises an exception matching C</^open3:/>. However,
eee4b3e7 59C<exec> failures in the child (such as no such file or permission denied),
cccbbce9
PB
60are just reported to CHLD_ERR under Windows and OS/2, as it is not possible
61to trap them.
eee4b3e7
DM
62
63If the child process dies for any reason, the next write to CHLD_IN is
64likely to generate a SIGPIPE in the parent, which is fatal by default.
65So you may wish to handle this signal.
f06db76b 66
a2a63531
AS
67Note if you specify C<-> as the command, in an analogous fashion to
68C<open(FOO, "-|")> the child process will just be the forked Perl
69process rather than an external command. This feature isn't yet
70supported on Win32 platforms.
71
8960aa87 72open3() does not wait for and reap the child process after it exits.
227e8dd4 73Except for short programs where it's acceptable to let the operating system
8960aa87 74take care of this, you need to do this yourself. This is normally as
227e8dd4
GS
75simple as calling C<waitpid $pid, 0> when you're done with the process.
76Failing to do this can result in an accumulation of defunct or "zombie"
77processes. See L<perlfunc/waitpid> for more information.
78
2675ae2b
GS
79If you try to read from the child's stdout writer and their stderr
80writer, you'll have problems with blocking, which means you'll want
81to use select() or the IO::Select, which means you'd best use
82sysread() instead of readline() for normal stuff.
83
84This is very dangerous, as you may block forever. It assumes it's
85going to talk to something like B<bc>, both writing to it and reading
86from it. This is presumably safe because you "know" that commands
87like B<bc> will read a line at a time and output a line at a time.
88Programs like B<sort> that read their entire input stream first,
7e1af8bc 89however, are quite apt to cause deadlock.
90
91The big problem with this approach is that if you don't have control
7a2e2cd6 92over source code being run in the child process, you can't control
7e1af8bc 93what it does with pipe buffering. Thus you can't just open a pipe to
94C<cat -v> and continually read and write a line from it.
95
eee4b3e7
DM
96=head1 See Also
97
98=over 4
99
100=item L<IPC::Open2>
101
181d2a7c 102Like Open3 but without STDERR capture.
eee4b3e7
DM
103
104=item L<IPC::Run>
105
106This is a CPAN module that has better error handling and more facilities
107than Open3.
108
109=back
110
2675ae2b
GS
111=head1 WARNING
112
113The order of arguments differs from that of open2().
114
7e1af8bc 115=cut
a0d0e21e
LW
116
117# &open3: Marc Horowitz <marc@mit.edu>
118# derived mostly from &open2 by tom christiansen, <tchrist@convex.com>
4633a7c4 119# fixed for 5.001 by Ulrich Kunitz <kunitz@mai-koeln.com>
f55ee38a 120# ported to Win32 by Ron Schmidt, Merrill Lynch almost ended my career
2675ae2b 121# fixed for autovivving FHs, tchrist again
6662521e 122# allow fd numbers to be used, by Frank Tobin
a2a63531 123# allow '-' as command (c.f. open "-|"), by Adam Spiers <perl@adamspiers.org>
a0d0e21e 124#
a0d0e21e
LW
125# usage: $pid = open3('wtr', 'rdr', 'err' 'some cmd and args', 'optarg', ...);
126#
127# spawn the given $cmd and connect rdr for
128# reading, wtr for writing, and err for errors.
129# if err is '', or the same as rdr, then stdout and
130# stderr of the child are on the same fh. returns pid
7e1af8bc 131# of child (or dies on failure).
a0d0e21e
LW
132
133
4633a7c4 134# if wtr begins with '<&', then wtr will be closed in the parent, and
a0d0e21e
LW
135# the child will read from it directly. if rdr or err begins with
136# '>&', then the child will send output directly to that fd. In both
137# cases, there will be a dup() instead of a pipe() made.
138
139
140# WARNING: this is dangerous, as you may block forever
141# unless you are very careful.
142#
143# $wtr is left unbuffered.
144#
145# abort program if
146# rdr or wtr are null
7e1af8bc 147# a system call fails
a0d0e21e 148
2675ae2b 149our $Me = 'open3 (bug)'; # you should never see this, it's always localized
a0d0e21e 150
7e1af8bc 151# Fatal.pm needs to be fixed WRT prototypes.
152
7e1af8bc 153sub xpipe {
154 pipe $_[0], $_[1] or croak "$Me: pipe($_[0], $_[1]) failed: $!";
155}
156
157# I tried using a * prototype character for the filehandle but it still
b7b1e41b 158# disallows a bareword while compiling under strict subs.
a0d0e21e 159
7e1af8bc 160sub xopen {
ea87ae30
NC
161 open $_[0], $_[1], @_[2..$#_] and return;
162 local $" = ', ';
163 carp "$Me: open(@_) failed: $!";
7e1af8bc 164}
165
166sub xclose {
8700fd38
SH
167 $_[0] =~ /\A=?(\d+)\z/
168 ? do { my $fh; open($fh, $_[1] . '&=' . $1) and close($fh); }
169 : close $_[0]
f6f8630d 170 or croak "$Me: close($_[0]) failed: $!";
7e1af8bc 171}
172
036b4402
GS
173sub xfileno {
174 return $1 if $_[0] =~ /\A=?(\d+)\z/; # deal with fh just being an fd
175 return fileno $_[0];
6662521e
GS
176}
177
f598f6de
NC
178use constant FORCE_DEBUG_SPAWN => 0;
179use constant DO_SPAWN => $^O eq 'os2' || $^O eq 'MSWin32' || FORCE_DEBUG_SPAWN;
a24d8dfd 180
7e1af8bc 181sub _open3 {
182 local $Me = shift;
eee4b3e7 183
2675ae2b
GS
184 # simulate autovivification of filehandles because
185 # it's too ugly to use @_ throughout to make perl do it for us
186 # tchrist 5-Mar-00
187
ce0d59fd
FC
188 # Historically, open3(undef...) has silently worked, so keep
189 # it working.
190 splice @_, 0, 1, undef if \$_[0] == \undef;
191 splice @_, 1, 1, undef if \$_[1] == \undef;
2675ae2b 192 unless (eval {
cf0c26e1
NC
193 $_[0] = gensym unless defined $_[0] && length $_[0];
194 $_[1] = gensym unless defined $_[1] && length $_[1];
8960aa87 195 1; })
2675ae2b
GS
196 {
197 # must strip crud for croak to add back, or looks ugly
198 $@ =~ s/(?<=value attempted) at .*//s;
199 croak "$Me: $@";
8960aa87 200 }
2675ae2b 201
cae0d269
NC
202 my @handles = ({ mode => '<', handle => \*STDIN },
203 { mode => '>', handle => \*STDOUT },
204 { mode => '>', handle => \*STDERR },
b74a613e
NC
205 );
206
9340a1e0
NC
207 foreach (@handles) {
208 $_->{parent} = shift;
b38d735f 209 $_->{open_as} = gensym;
9340a1e0
NC
210 }
211
9340a1e0 212 if (@_ > 1 and $_[0] eq '-') {
cf0c26e1
NC
213 croak "Arguments don't make sense when the command is '-'"
214 }
215
9340a1e0 216 $handles[2]{parent} ||= $handles[1]{parent};
f2412f89 217 $handles[2]{dup_of_out} = $handles[1]{parent} eq $handles[2]{parent};
a0d0e21e 218
0c12e47a
NC
219 my $package;
220 foreach (@handles) {
221 $_->{dup} = ($_->{parent} =~ s/^[<>]&//);
a0d0e21e 222
0c12e47a
NC
223 if ($_->{parent} !~ /\A=?(\d+)\z/) {
224 # force unqualified filehandles into caller's package
225 $package //= caller 1;
226 $_->{parent} = qualify $_->{parent}, $package;
227 }
7e1af8bc 228
0c12e47a
NC
229 next if $_->{dup} or $_->{dup_of_out};
230 if ($_->{mode} eq '<') {
231 xpipe $_->{open_as}, $_->{parent};
232 } else {
233 xpipe $_->{parent}, $_->{open_as};
234 }
235 }
7e1af8bc 236
38e62fca 237 my $kidpid;
8960aa87
EB
238 if (!DO_SPAWN) {
239 # Used to communicate exec failures.
240 xpipe my $stat_r, my $stat_w;
241
258a5898
NC
242 $kidpid = fork;
243 croak "$Me: fork failed: $!" unless defined $kidpid;
8960aa87
EB
244 if ($kidpid == 0) { # Kid
245 eval {
246 # A tie in the parent should not be allowed to cause problems.
247 untie *STDIN;
248 untie *STDOUT;
249
250 close $stat_r;
258a5898
NC
251 require Fcntl;
252 my $flags = fcntl $stat_w, &Fcntl::F_GETFD, 0;
253 croak "$Me: fcntl failed: $!" unless $flags;
254 fcntl $stat_w, &Fcntl::F_SETFD, $flags|&Fcntl::FD_CLOEXEC
255 or croak "$Me: fcntl failed: $!";
8960aa87
EB
256
257 # If she wants to dup the kid's stderr onto her stdout I need to
258 # save a copy of her stdout before I put something else there.
f2412f89 259 if (!$handles[2]{dup_of_out} && $handles[2]{dup}
9340a1e0 260 && xfileno($handles[2]{parent}) == fileno \*STDOUT) {
8960aa87 261 my $tmp = gensym;
9340a1e0
NC
262 xopen($tmp, '>&', $handles[2]{parent});
263 $handles[2]{parent} = $tmp;
8960aa87
EB
264 }
265
afebf859
NC
266 foreach (@handles) {
267 if ($_->{dup_of_out}) {
268 xopen \*STDERR, ">&STDOUT"
269 if defined fileno STDERR && fileno STDERR != fileno STDOUT;
270 } elsif ($_->{dup}) {
271 xopen $_->{handle}, $_->{mode} . '&', $_->{parent}
272 if fileno $_->{handle} != xfileno($_->{parent});
8960aa87 273 } else {
8700fd38 274 xclose $_->{parent}, $_->{mode};
afebf859
NC
275 xopen $_->{handle}, $_->{mode} . '&=',
276 fileno $_->{open_as};
8960aa87 277 }
8960aa87 278 }
f8b0429f 279 return 1 if ($_[0] eq '-');
9340a1e0 280 exec @_ or do {
8960aa87 281 local($")=(" ");
9340a1e0 282 croak "$Me: exec of @_ failed";
8960aa87 283 };
f8b0429f
SF
284 } and do {
285 close $stat_w;
286 return 0;
287 };
8960aa87
EB
288
289 my $bang = 0+$!;
290 my $err = $@;
291 utf8::encode $err if $] >= 5.008;
292 print $stat_w pack('IIa*', $bang, length($err), $err);
293 close $stat_w;
a0d0e21e 294
8960aa87
EB
295 eval { require POSIX; POSIX::_exit(255); };
296 exit 255;
a0d0e21e 297 }
8960aa87
EB
298 else { # Parent
299 close $stat_w;
300 my $to_read = length(pack('I', 0)) * 2;
301 my $bytes_read = read($stat_r, my $buf = '', $to_read);
302 if ($bytes_read) {
303 (my $bang, $to_read) = unpack('II', $buf);
304 read($stat_r, my $err = '', $to_read);
cccbbce9 305 waitpid $kidpid, 0; # Reap child which should have exited
8960aa87
EB
306 if ($err) {
307 utf8::decode $err if $] >= 5.008;
308 } else {
309 $err = "$Me: " . ($! = $bang);
310 }
311 $! = $bang;
312 die($err);
a0d0e21e 313 }
a0d0e21e 314 }
8960aa87
EB
315 }
316 else { # DO_SPAWN
a24d8dfd
IZ
317 # All the bookkeeping of coincidence between handles is
318 # handled in spawn_with_handles.
319
320 my @close;
a500d274
NC
321
322 foreach (@handles) {
323 if ($_->{dup_of_out}) {
324 $_->{open_as} = $handles[1]{open_as};
325 } elsif ($_->{dup}) {
326 $_->{open_as} = $_->{parent} =~ /\A[0-9]+\z/
327 ? $_->{parent} : \*{$_->{parent}};
328 push @close, $_->{open_as};
a24d8dfd 329 } else {
a500d274 330 push @close, \*{$_->{parent}}, $_->{open_as};
a24d8dfd 331 }
a24d8dfd
IZ
332 }
333 require IO::Pipe;
334 $kidpid = eval {
9340a1e0 335 spawn_with_handles(\@handles, \@close, @_);
a24d8dfd 336 };
ad973f30 337 die "$Me: $@" if $@;
a0d0e21e
LW
338 }
339
0c12e47a
NC
340 foreach (@handles) {
341 next if $_->{dup} or $_->{dup_of_out};
8700fd38 342 xclose $_->{open_as}, $_->{mode};
0c12e47a
NC
343 }
344
7e1af8bc 345 # If the write handle is a dup give it away entirely, close my copy
346 # of it.
8700fd38 347 xclose $handles[0]{parent}, $handles[0]{mode} if $handles[0]{dup};
a0d0e21e 348
9340a1e0 349 select((select($handles[0]{parent}), $| = 1)[0]); # unbuffer pipe
a0d0e21e
LW
350 $kidpid;
351}
7e1af8bc 352
353sub open3 {
a24d8dfd
IZ
354 if (@_ < 4) {
355 local $" = ', ';
356 croak "open3(@_): not enough arguments";
357 }
0689e260 358 return _open3 'open3', @_
7e1af8bc 359}
a0d0e21e 360
a24d8dfd
IZ
361sub spawn_with_handles {
362 my $fds = shift; # Fields: handle, mode, open_as
363 my $close_in_child = shift;
364 my ($fd, $pid, @saved_fh, $saved, %saved, @errs);
a24d8dfd
IZ
365
366 foreach $fd (@$fds) {
367 $fd->{tmp_copy} = IO::Handle->new_from_fd($fd->{handle}, $fd->{mode});
031f91ce 368 $saved{fileno $fd->{handle}} = $fd->{tmp_copy} if $fd->{tmp_copy};
a24d8dfd
IZ
369 }
370 foreach $fd (@$fds) {
371 bless $fd->{handle}, 'IO::Handle'
372 unless eval { $fd->{handle}->isa('IO::Handle') } ;
373 # If some of handles to redirect-to coincide with handles to
374 # redirect, we need to use saved variants:
b38d735f
NC
375 $fd->{handle}->fdopen(defined fileno $fd->{open_as}
376 ? $saved{fileno $fd->{open_as}} || $fd->{open_as}
377 : $fd->{open_as},
a24d8dfd
IZ
378 $fd->{mode});
379 }
f55ee38a 380 unless ($^O eq 'MSWin32') {
cae0d269 381 require Fcntl;
f55ee38a
GS
382 # Stderr may be redirected below, so we save the err text:
383 foreach $fd (@$close_in_child) {
f598f6de 384 next unless fileno $fd;
f55ee38a
GS
385 fcntl($fd, Fcntl::F_SETFD(), 1) or push @errs, "fcntl $fd: $!"
386 unless $saved{fileno $fd}; # Do not close what we redirect!
387 }
a24d8dfd
IZ
388 }
389
390 unless (@errs) {
f598f6de
NC
391 if (FORCE_DEBUG_SPAWN) {
392 pipe my $r, my $w or die "Pipe failed: $!";
393 $pid = fork;
394 die "Fork failed: $!" unless defined $pid;
395 if (!$pid) {
396 { no warnings; exec @_ }
397 print $w 0 + $!;
398 close $w;
399 require POSIX;
400 POSIX::_exit(255);
401 }
402 close $w;
403 my $bad = <$r>;
404 if (defined $bad) {
405 $! = $bad;
406 undef $pid;
407 }
408 } else {
409 $pid = eval { system 1, @_ }; # 1 == P_NOWAIT
410 }
a24d8dfd
IZ
411 push @errs, "IO::Pipe: Can't spawn-NOWAIT: $!" if !$pid || $pid < 0;
412 }
413
031f91ce
NC
414 # Do this in reverse, so that STDERR is restored first:
415 foreach $fd (reverse @$fds) {
a24d8dfd 416 $fd->{handle}->fdopen($fd->{tmp_copy}, $fd->{mode});
031f91ce
NC
417 }
418 foreach (values %saved) {
419 $_->close or croak "Can't close: $!";
a24d8dfd
IZ
420 }
421 croak join "\n", @errs if @errs;
422 return $pid;
423}
424
4251; # so require is happy