X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FIPC%2FOpen3.pm;h=95313fce3d95f8f3355c49b1b5248dd20edd8ee6;hb=fe98d82b2e4171a609025e7b159d7945efe2900c;hp=7b06a21fa4368ee191ef9299f321729a4bf6da33;hpb=ad973f306c11e119dc3a8448590409962bde25db;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/IPC/Open3.pm b/lib/IPC/Open3.pm index 7b06a21..95313fc 100644 --- a/lib/IPC/Open3.pm +++ b/lib/IPC/Open3.pm @@ -2,15 +2,14 @@ package IPC::Open3; use strict; no strict 'refs'; # because users pass me bareword filehandles -use vars qw($VERSION @ISA @EXPORT $Fh $Me); +our ($VERSION, @ISA, @EXPORT); -require 5.001; require Exporter; use Carp; -use Symbol 'qualify'; +use Symbol qw(gensym qualify); -$VERSION = 1.0101; +$VERSION = 1.02; @ISA = qw(Exporter); @EXPORT = qw(open3); @@ -20,40 +19,67 @@ IPC::Open3, open3 - open a process for reading, writing, and error handling =head1 SYNOPSIS - $pid = open3(\*WTRFH, \*RDRFH, \*ERRFH, + $pid = open3(\*CHLD_IN, \*CHLD_OUT, \*CHLD_ERR, + 'some cmd and args', 'optarg', ...); + + my($wtr, $rdr, $err); + $pid = open3($wtr, $rdr, $err, 'some cmd and args', 'optarg', ...); =head1 DESCRIPTION Extremely similar to open2(), open3() spawns the given $cmd and -connects RDRFH for reading, WTRFH for writing, and ERRFH for errors. If -ERRFH is '', or the same as RDRFH, then STDOUT and STDERR of the child are -on the same file handle. The WTRFH will have autoflush turned on. - -If WTRFH begins with "E&", then WTRFH will be closed in the parent, and -the child will read from it directly. If RDRFH or ERRFH begins with -"E&", then the child will send output directly to that file handle. -In both cases, there will be a dup(2) instead of a pipe(2) made. - -If you try to read from the child's stdout writer and their stderr -writer, you'll have problems with blocking, which means you'll -want to use select(), which means you'll have to use sysread() instead -of normal stuff. +connects CHLD_OUT for reading from the child, CHLD_IN for writing to +the child, and CHLD_ERR for errors. If CHLD_ERR is false, or the +same file descriptor as CHLD_OUT, then STDOUT and STDERR of the child +are on the same filehandle. The CHLD_IN will have autoflush turned +on. + +If CHLD_IN begins with C<< <& >>, then CHLD_IN will be closed in the +parent, and the child will read from it directly. If CHLD_OUT or +CHLD_ERR begins with C<< >& >>, then the child will send output +directly to that filehandle. In both cases, there will be a dup(2) +instead of a pipe(2) made. + +If either reader or writer is the null string, this will be replaced +by an autogenerated filehandle. If so, you must pass a valid lvalue +in the parameter slot so it can be overwritten in the caller, or +an exception will be raised. + +The filehandles may also be integers, in which case they are understood +as file descriptors. open3() returns the process ID of the child process. It doesn't return on -failure: it just raises an exception matching C. - -=head1 WARNING - -It will not create these file handles for you. You have to do this -yourself. So don't pass it empty variables expecting them to get filled -in for you. +failure: it just raises an exception matching C. However, +C failures in the child (such as no such file or permission denied), +are just reported to CHLD_ERR, as it is not possible to trap them. + +If the child process dies for any reason, the next write to CHLD_IN is +likely to generate a SIGPIPE in the parent, which is fatal by default. +So you may wish to handle this signal. + +Note if you specify C<-> as the command, in an analogous fashion to +C the child process will just be the forked Perl +process rather than an external command. This feature isn't yet +supported on Win32 platforms. + +open3() does not wait for and reap the child process after it exits. +Except for short programs where it's acceptable to let the operating system +take care of this, you need to do this yourself. This is normally as +simple as calling C when you're done with the process. +Failing to do this can result in an accumulation of defunct or "zombie" +processes. See L for more information. -Additionally, this is very dangerous as you may block forever. It -assumes it's going to talk to something like B, both writing to it -and reading from it. This is presumably safe because you "know" that -commands like B will read a line at a time and output a line at a -time. Programs like B that read their entire input stream first, +If you try to read from the child's stdout writer and their stderr +writer, you'll have problems with blocking, which means you'll want +to use select() or the IO::Select, which means you'd best use +sysread() instead of readline() for normal stuff. + +This is very dangerous, as you may block forever. It assumes it's +going to talk to something like B, both writing to it and reading +from it. This is presumably safe because you "know" that commands +like B will read a line at a time and output a line at a time. +Programs like B that read their entire input stream first, however, are quite apt to cause deadlock. The big problem with this approach is that if you don't have control @@ -61,11 +87,34 @@ over source code being run in the child process, you can't control what it does with pipe buffering. Thus you can't just open a pipe to C and continually read and write a line from it. +=head1 See Also + +=over 4 + +=item L + +Like Open3 but without STDERR catpure. + +=item L + +This is a CPAN module that has better error handling and more facilities +than Open3. + +=back + +=head1 WARNING + +The order of arguments differs from that of open2(). + =cut # &open3: Marc Horowitz # derived mostly from &open2 by tom christiansen, # fixed for 5.001 by Ulrich Kunitz +# ported to Win32 by Ron Schmidt, Merrill Lynch almost ended my career +# fixed for autovivving FHs, tchrist again +# allow fd numbers to be used, by Frank Tobin +# allow '-' as command (c.f. open "-|"), by Adam Spiers # # $Id: open3.pl,v 1.1 1993/11/23 06:26:15 marc Exp $ # @@ -93,8 +142,7 @@ C and continually read and write a line from it. # rdr or wtr are null # a system call fails -$Fh = 'FHOPEN000'; # package static in case called more than once -$Me = 'open3 (bug)'; # you should never see this, it's always localized +our $Me = 'open3 (bug)'; # you should never see this, it's always localized # Fatal.pm needs to be fixed WRT prototypes. @@ -119,29 +167,54 @@ sub xclose { close $_[0] or croak "$Me: close($_[0]) failed: $!"; } -my $do_spawn = $^O eq 'os2'; +sub fh_is_fd { + return $_[0] =~ /\A=?(\d+)\z/; +} + +sub xfileno { + return $1 if $_[0] =~ /\A=?(\d+)\z/; # deal with fh just being an fd + return fileno $_[0]; +} + +my $do_spawn = $^O eq 'os2' || $^O eq 'MSWin32'; sub _open3 { local $Me = shift; my($package, $dad_wtr, $dad_rdr, $dad_err, @cmd) = @_; my($dup_wtr, $dup_rdr, $dup_err, $kidpid); - $dad_wtr or croak "$Me: wtr should not be null"; - $dad_rdr or croak "$Me: rdr should not be null"; - $dad_err = $dad_rdr if ($dad_err eq ''); + if (@cmd > 1 and $cmd[0] eq '-') { + croak "Arguments don't make sense when the command is '-'" + } + + # simulate autovivification of filehandles because + # it's too ugly to use @_ throughout to make perl do it for us + # tchrist 5-Mar-00 + + unless (eval { + $dad_wtr = $_[1] = gensym unless defined $dad_wtr && length $dad_wtr; + $dad_rdr = $_[2] = gensym unless defined $dad_rdr && length $dad_rdr; + 1; }) + { + # must strip crud for croak to add back, or looks ugly + $@ =~ s/(?<=value attempted) at .*//s; + croak "$Me: $@"; + } + + $dad_err ||= $dad_rdr; $dup_wtr = ($dad_wtr =~ s/^[<>]&//); $dup_rdr = ($dad_rdr =~ s/^[<>]&//); $dup_err = ($dad_err =~ s/^[<>]&//); - # force unqualified filehandles into callers' package - $dad_wtr = qualify $dad_wtr, $package; - $dad_rdr = qualify $dad_rdr, $package; - $dad_err = qualify $dad_err, $package; + # force unqualified filehandles into caller's package + $dad_wtr = qualify $dad_wtr, $package unless fh_is_fd($dad_wtr); + $dad_rdr = qualify $dad_rdr, $package unless fh_is_fd($dad_rdr); + $dad_err = qualify $dad_err, $package unless fh_is_fd($dad_err); - my $kid_rdr = ++$Fh; - my $kid_wtr = ++$Fh; - my $kid_err = ++$Fh; + my $kid_rdr = gensym; + my $kid_wtr = gensym; + my $kid_err = gensym; xpipe $kid_rdr, $dad_wtr if !$dup_wtr; xpipe $dad_rdr, $kid_wtr if !$dup_rdr; @@ -149,67 +222,74 @@ sub _open3 { $kidpid = $do_spawn ? -1 : xfork; if ($kidpid == 0) { # Kid + # A tie in the parent should not be allowed to cause problems. + untie *STDIN; + untie *STDOUT; # If she wants to dup the kid's stderr onto her stdout I need to # save a copy of her stdout before I put something else there. if ($dad_rdr ne $dad_err && $dup_err - && fileno($dad_err) == fileno(STDOUT)) { - my $tmp = ++$Fh; + && xfileno($dad_err) == fileno(STDOUT)) { + my $tmp = gensym; xopen($tmp, ">&$dad_err"); $dad_err = $tmp; } if ($dup_wtr) { - xopen \*STDIN, "<&$dad_wtr" if fileno(STDIN) != fileno($dad_wtr); + xopen \*STDIN, "<&$dad_wtr" if fileno(STDIN) != xfileno($dad_wtr); } else { xclose $dad_wtr; - xopen \*STDIN, "<&$kid_rdr"; - xclose $kid_rdr; + xopen \*STDIN, "<&=" . fileno $kid_rdr; } if ($dup_rdr) { - xopen \*STDOUT, ">&$dad_rdr" if fileno(STDOUT) != fileno($dad_rdr); + xopen \*STDOUT, ">&$dad_rdr" if fileno(STDOUT) != xfileno($dad_rdr); } else { xclose $dad_rdr; - xopen \*STDOUT, ">&$kid_wtr"; - xclose $kid_wtr; + xopen \*STDOUT, ">&=" . fileno $kid_wtr; } if ($dad_rdr ne $dad_err) { if ($dup_err) { - xopen \*STDERR, ">&$dad_err" - if fileno(STDERR) != fileno($dad_err); + # I have to use a fileno here because in this one case + # I'm doing a dup but the filehandle might be a reference + # (from the special case above). + xopen \*STDERR, ">&" . xfileno($dad_err) + if fileno(STDERR) != xfileno($dad_err); } else { xclose $dad_err; - xopen \*STDERR, ">&$kid_err"; - xclose $kid_err; + xopen \*STDERR, ">&=" . fileno $kid_err; } } else { xopen \*STDERR, ">&STDOUT" if fileno(STDERR) != fileno(STDOUT); } + return 0 if ($cmd[0] eq '-'); local($")=(" "); - exec @cmd - or croak "$Me: exec of @cmd failed"; + exec @cmd or do { + carp "$Me: exec of @cmd failed"; + eval { require POSIX; POSIX::_exit(255); }; + exit 255; + }; } elsif ($do_spawn) { # All the bookkeeping of coincidence between handles is # handled in spawn_with_handles. my @close; if ($dup_wtr) { - $kid_rdr = $dad_wtr; - push @close, \*{$kid_rdr}; + $kid_rdr = \*{$dad_wtr}; + push @close, $kid_rdr; } else { - push @close, \*{$dad_wtr}, \*{$kid_rdr}; + push @close, \*{$dad_wtr}, $kid_rdr; } if ($dup_rdr) { - $kid_wtr = $dad_rdr; - push @close, \*{$kid_wtr}; + $kid_wtr = \*{$dad_rdr}; + push @close, $kid_wtr; } else { - push @close, \*{$dad_rdr}, \*{$kid_wtr}; + push @close, \*{$dad_rdr}, $kid_wtr; } if ($dad_rdr ne $dad_err) { if ($dup_err) { - $kid_err = $dad_err ; - push @close, \*{$kid_err}; + $kid_err = \*{$dad_err}; + push @close, $kid_err; } else { - push @close, \*{$dad_err}, \*{$kid_err}; + push @close, \*{$dad_err}, $kid_err; } } else { $kid_err = $kid_wtr; @@ -217,13 +297,13 @@ sub _open3 { require IO::Pipe; $kidpid = eval { spawn_with_handles( [ { mode => 'r', - open_as => \*{$kid_rdr}, + open_as => $kid_rdr, handle => \*STDIN }, { mode => 'w', - open_as => \*{$kid_wtr}, + open_as => $kid_wtr, handle => \*STDOUT }, { mode => 'w', - open_as => \*{$kid_err}, + open_as => $kid_err, handle => \*STDERR }, ], \@close, @cmd); }; @@ -267,10 +347,12 @@ sub spawn_with_handles { $fd->{handle}->fdopen($saved{fileno $fd->{open_as}} || $fd->{open_as}, $fd->{mode}); } - # Stderr may be redirected below, so we save the err text: - foreach $fd (@$close_in_child) { - fcntl($fd, Fcntl::F_SETFD(), 1) or push @errs, "fcntl $fd: $!" - unless $saved{fileno $fd}; # Do not close what we redirect! + unless ($^O eq 'MSWin32') { + # Stderr may be redirected below, so we save the err text: + foreach $fd (@$close_in_child) { + fcntl($fd, Fcntl::F_SETFD(), 1) or push @errs, "fcntl $fd: $!" + unless $saved{fileno $fd}; # Do not close what we redirect! + } } unless (@errs) {