1package IPC::Open3; 2 3use strict; 4no strict 'refs'; # because users pass me bareword filehandles 5our ($VERSION, @ISA, @EXPORT); 6 7require Exporter; 8 9use Carp; 10use Symbol qw(gensym qualify); 11 12$VERSION = 1.05; 13@ISA = qw(Exporter); 14@EXPORT = qw(open3); 15 16=head1 NAME 17 18IPC::Open3 - open a process for reading, writing, and error handling using open3() 19 20=head1 SYNOPSIS 21 22 $pid = open3(\*CHLD_IN, \*CHLD_OUT, \*CHLD_ERR, 23 'some cmd and args', 'optarg', ...); 24 25 my($wtr, $rdr, $err); 26 use Symbol 'gensym'; $err = gensym; 27 $pid = open3($wtr, $rdr, $err, 28 'some cmd and args', 'optarg', ...); 29 30 waitpid( $pid, 0 ); 31 my $child_exit_status = $? >> 8; 32 33=head1 DESCRIPTION 34 35Extremely similar to open2(), open3() spawns the given $cmd and 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 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. 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. 48 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 51in the parameter slot so it can be overwritten in the caller, or 52an exception will be raised. 53 54The filehandles may also be integers, in which case they are understood 55as file descriptors. 56 57open3() returns the process ID of the child process. It doesn't return on 58failure: it just raises an exception matching C</^open3:/>. However, 59C<exec> failures in the child (such as no such file or permission denied), 60are just reported to CHLD_ERR, as it is not possible to trap them. 61 62If the child process dies for any reason, the next write to CHLD_IN is 63likely to generate a SIGPIPE in the parent, which is fatal by default. 64So you may wish to handle this signal. 65 66Note if you specify C<-> as the command, in an analogous fashion to 67C<open(FOO, "-|")> the child process will just be the forked Perl 68process rather than an external command. This feature isn't yet 69supported on Win32 platforms. 70 71open3() does not wait for and reap the child process after it exits. 72Except for short programs where it's acceptable to let the operating system 73take care of this, you need to do this yourself. This is normally as 74simple as calling C<waitpid $pid, 0> when you're done with the process. 75Failing to do this can result in an accumulation of defunct or "zombie" 76processes. See L<perlfunc/waitpid> for more information. 77 78If you try to read from the child's stdout writer and their stderr 79writer, you'll have problems with blocking, which means you'll want 80to use select() or the IO::Select, which means you'd best use 81sysread() instead of readline() for normal stuff. 82 83This is very dangerous, as you may block forever. It assumes it's 84going to talk to something like B<bc>, both writing to it and reading 85from it. This is presumably safe because you "know" that commands 86like B<bc> will read a line at a time and output a line at a time. 87Programs like B<sort> that read their entire input stream first, 88however, are quite apt to cause deadlock. 89 90The big problem with this approach is that if you don't have control 91over source code being run in the child process, you can't control 92what it does with pipe buffering. Thus you can't just open a pipe to 93C<cat -v> and continually read and write a line from it. 94 95=head1 See Also 96 97=over 4 98 99=item L<IPC::Open2> 100 101Like Open3 but without STDERR catpure. 102 103=item L<IPC::Run> 104 105This is a CPAN module that has better error handling and more facilities 106than Open3. 107 108=back 109 110=head1 WARNING 111 112The order of arguments differs from that of open2(). 113 114=cut 115 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> 123# 124# $Id: open3.pl,v 1.1 1993/11/23 06:26:15 marc Exp $ 125# 126# usage: $pid = open3('wtr', 'rdr', 'err' 'some cmd and args', 'optarg', ...); 127# 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). 133 134 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. 139 140 141# WARNING: this is dangerous, as you may block forever 142# unless you are very careful. 143# 144# $wtr is left unbuffered. 145# 146# abort program if 147# rdr or wtr are null 148# a system call fails 149 150our $Me = 'open3 (bug)'; # you should never see this, it's always localized 151 152# Fatal.pm needs to be fixed WRT prototypes. 153 154sub xfork { 155 my $pid = fork; 156 defined $pid or croak "$Me: fork failed: $!"; 157 return $pid; 158} 159 160sub xpipe { 161 pipe $_[0], $_[1] or croak "$Me: pipe($_[0], $_[1]) failed: $!"; 162} 163 164# I tried using a * prototype character for the filehandle but it still 165# disallows a bearword while compiling under strict subs. 166 167sub xopen { 168 open $_[0], $_[1] or croak "$Me: open($_[0], $_[1]) failed: $!"; 169} 170 171sub xclose { 172 close $_[0] or croak "$Me: close($_[0]) failed: $!"; 173} 174 175sub fh_is_fd { 176 return $_[0] =~ /\A=?(\d+)\z/; 177} 178 179sub xfileno { 180 return $1 if $_[0] =~ /\A=?(\d+)\z/; # deal with fh just being an fd 181 return fileno $_[0]; 182} 183 184use constant DO_SPAWN => $^O eq 'os2' || $^O eq 'MSWin32'; 185 186sub _open3 { 187 local $Me = shift; 188 my($package, $dad_wtr, $dad_rdr, $dad_err, @cmd) = @_; 189 my($dup_wtr, $dup_rdr, $dup_err, $kidpid); 190 191 if (@cmd > 1 and $cmd[0] eq '-') { 192 croak "Arguments don't make sense when the command is '-'" 193 } 194 195 # simulate autovivification of filehandles because 196 # it's too ugly to use @_ throughout to make perl do it for us 197 # tchrist 5-Mar-00 198 199 unless (eval { 200 $dad_wtr = $_[1] = gensym unless defined $dad_wtr && length $dad_wtr; 201 $dad_rdr = $_[2] = gensym unless defined $dad_rdr && length $dad_rdr; 202 1; }) 203 { 204 # must strip crud for croak to add back, or looks ugly 205 $@ =~ s/(?<=value attempted) at .*//s; 206 croak "$Me: $@"; 207 } 208 209 $dad_err ||= $dad_rdr; 210 211 $dup_wtr = ($dad_wtr =~ s/^[<>]&//); 212 $dup_rdr = ($dad_rdr =~ s/^[<>]&//); 213 $dup_err = ($dad_err =~ s/^[<>]&//); 214 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); 219 220 my $kid_rdr = gensym; 221 my $kid_wtr = gensym; 222 my $kid_err = gensym; 223 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; 227 228 $kidpid = DO_SPAWN ? -1 : xfork; 229 if ($kidpid == 0) { # Kid 230 # A tie in the parent should not be allowed to cause problems. 231 untie *STDIN; 232 untie *STDOUT; 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)) { 237 my $tmp = gensym; 238 xopen($tmp, ">&$dad_err"); 239 $dad_err = $tmp; 240 } 241 242 if ($dup_wtr) { 243 xopen \*STDIN, "<&$dad_wtr" if fileno(STDIN) != xfileno($dad_wtr); 244 } else { 245 xclose $dad_wtr; 246 xopen \*STDIN, "<&=" . fileno $kid_rdr; 247 } 248 if ($dup_rdr) { 249 xopen \*STDOUT, ">&$dad_rdr" if fileno(STDOUT) != xfileno($dad_rdr); 250 } else { 251 xclose $dad_rdr; 252 xopen \*STDOUT, ">&=" . fileno $kid_wtr; 253 } 254 if ($dad_rdr ne $dad_err) { 255 if ($dup_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); 261 } else { 262 xclose $dad_err; 263 xopen \*STDERR, ">&=" . fileno $kid_err; 264 } 265 } else { 266 xopen \*STDERR, ">&STDOUT" if fileno(STDERR) != fileno(STDOUT); 267 } 268 return 0 if ($cmd[0] eq '-'); 269 local($")=(" "); 270 exec @cmd or do { 271 carp "$Me: exec of @cmd failed"; 272 eval { require POSIX; POSIX::_exit(255); }; 273 exit 255; 274 }; 275 } elsif (DO_SPAWN) { 276 # All the bookkeeping of coincidence between handles is 277 # handled in spawn_with_handles. 278 279 my @close; 280 if ($dup_wtr) { 281 $kid_rdr = \*{$dad_wtr}; 282 push @close, $kid_rdr; 283 } else { 284 push @close, \*{$dad_wtr}, $kid_rdr; 285 } 286 if ($dup_rdr) { 287 $kid_wtr = \*{$dad_rdr}; 288 push @close, $kid_wtr; 289 } else { 290 push @close, \*{$dad_rdr}, $kid_wtr; 291 } 292 if ($dad_rdr ne $dad_err) { 293 if ($dup_err) { 294 $kid_err = \*{$dad_err}; 295 push @close, $kid_err; 296 } else { 297 push @close, \*{$dad_err}, $kid_err; 298 } 299 } else { 300 $kid_err = $kid_wtr; 301 } 302 require IO::Pipe; 303 $kidpid = eval { 304 spawn_with_handles( [ { mode => 'r', 305 open_as => $kid_rdr, 306 handle => \*STDIN }, 307 { mode => 'w', 308 open_as => $kid_wtr, 309 handle => \*STDOUT }, 310 { mode => 'w', 311 open_as => $kid_err, 312 handle => \*STDERR }, 313 ], \@close, @cmd); 314 }; 315 die "$Me: $@" if $@; 316 } 317 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 322 # of it. 323 xclose $dad_wtr if $dup_wtr; 324 325 select((select($dad_wtr), $| = 1)[0]); # unbuffer pipe 326 $kidpid; 327} 328 329sub open3 { 330 if (@_ < 4) { 331 local $" = ', '; 332 croak "open3(@_): not enough arguments"; 333 } 334 return _open3 'open3', scalar caller, @_ 335} 336 337sub 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); 341 require Fcntl; 342 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}; 346 } 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}, 353 $fd->{mode}); 354 } 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! 360 } 361 } 362 363 unless (@errs) { 364 $pid = eval { system 1, @_ }; # 1 == P_NOWAIT 365 push @errs, "IO::Pipe: Can't spawn-NOWAIT: $!" if !$pid || $pid < 0; 366 } 367 368 foreach $fd (@$fds) { 369 $fd->{handle}->fdopen($fd->{tmp_copy}, $fd->{mode}); 370 $fd->{tmp_copy}->close or croak "Can't close: $!"; 371 } 372 croak join "\n", @errs if @errs; 373 return $pid; 374} 375 3761; # so require is happy 377