diff options
Diffstat (limited to 'contrib/perl5/lib/IPC/Open3.pm')
| -rw-r--r-- | contrib/perl5/lib/IPC/Open3.pm | 83 |
1 files changed, 56 insertions, 27 deletions
diff --git a/contrib/perl5/lib/IPC/Open3.pm b/contrib/perl5/lib/IPC/Open3.pm index d079041..99709ac 100644 --- a/contrib/perl5/lib/IPC/Open3.pm +++ b/contrib/perl5/lib/IPC/Open3.pm @@ -2,9 +2,8 @@ package IPC::Open3; use strict; no strict 'refs'; # because users pass me bareword filehandles -use vars qw($VERSION @ISA @EXPORT $Me); +our ($VERSION, @ISA, @EXPORT); -require 5.001; require Exporter; use Carp; @@ -23,37 +22,50 @@ IPC::Open3, open3 - open a process for reading, writing, and error handling $pid = open3(\*WTRFH, \*RDRFH, \*ERRFH, '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. +ERRFH is false, or the same file descriptor as RDRFH, then STDOUT and +STDERR of the child are on the same filehandle. The WTRFH will have +autoflush turned on. -If WTRFH begins with "E<lt>&", then WTRFH will be closed in the parent, and +If WTRFH begins with C<< <& >>, then WTRFH will be closed in the parent, and the child will read from it directly. If RDRFH or ERRFH begins with -"E<gt>&", then the child will send output directly to that file handle. +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 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. +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. open3() returns the process ID of the child process. It doesn't return on -failure: it just raises an exception matching C</^open3:/>. +failure: it just raises an exception matching C</^open3:/>. However, +C<exec> failures in the child are not detected. You'll have to +trap SIGPIPE yourself. -=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. +open2() 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<waitpid $pid, 0> when you're done with the process. +Failing to do this can result in an accumulation of defunct or "zombie" +processes. See L<perlfunc/waitpid> for more information. -Additionally, this is very dangerous as you may block forever. It -assumes it's going to talk to something like B<bc>, both writing to it -and reading from it. This is presumably safe because you "know" that -commands like B<bc> will read a line at a time and output a line at a -time. Programs like B<sort> 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<bc>, both writing to it and reading +from it. This is presumably safe because you "know" that commands +like B<bc> will read a line at a time and output a line at a time. +Programs like B<sort> 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,12 +73,17 @@ 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<cat -v> and continually read and write a line from it. +=head1 WARNING + +The order of arguments differs from that of open2(). + =cut # &open3: Marc Horowitz <marc@mit.edu> # derived mostly from &open2 by tom christiansen, <tchrist@convex.com> # fixed for 5.001 by Ulrich Kunitz <kunitz@mai-koeln.com> # ported to Win32 by Ron Schmidt, Merrill Lynch almost ended my career +# fixed for autovivving FHs, tchrist again # # $Id: open3.pl,v 1.1 1993/11/23 06:26:15 marc Exp $ # @@ -94,7 +111,7 @@ C<cat -v> and continually read and write a line from it. # rdr or wtr are null # a system call fails -$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. @@ -126,15 +143,27 @@ sub _open3 { 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 ''); + # 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 + # force unqualified filehandles into caller's package $dad_wtr = qualify $dad_wtr, $package; $dad_rdr = qualify $dad_rdr, $package; $dad_err = qualify $dad_err, $package; @@ -185,7 +214,7 @@ sub _open3 { xopen \*STDERR, ">&STDOUT" if fileno(STDERR) != fileno(STDOUT); } local($")=(" "); - exec @cmd + exec @cmd # XXX: wrong process to croak from or croak "$Me: exec of @cmd failed"; } elsif ($do_spawn) { # All the bookkeeping of coincidence between handles is |
