Profile of IPC/Open3.pm

← Index
NYTProf Performance Profile «block view•line view•sub view»
For xt/tapper-mcp-scheduler-with-db-longrun.t
Run on Tue May 22 17:18:39 2012
Reported on Tue May 22 17:23:51 2012

Filename | /2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/5.12.3/IPC/Open3.pm
Statements | Executed 22 statements in 1.26ms

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
1 | 1 | 1 | 14µs | 68µs | IPC::Open3::::BEGIN@184IPC::Open3::BEGIN@184
1 | 1 | 1 | 12µs | 14µs | IPC::Open3::::BEGIN@3IPC::Open3::BEGIN@3
1 | 1 | 1 | 7µs | 44µs | IPC::Open3::::BEGIN@9IPC::Open3::BEGIN@9
1 | 1 | 1 | 7µs | 51µs | IPC::Open3::::BEGIN@10IPC::Open3::BEGIN@10
1 | 1 | 1 | 7µs | 20µs | IPC::Open3::::BEGIN@4IPC::Open3::BEGIN@4
0 | 0 | 0 | 0s | 0s | IPC::Open3::::_open3IPC::Open3::_open3
0 | 0 | 0 | 0s | 0s | IPC::Open3::::fh_is_fdIPC::Open3::fh_is_fd
0 | 0 | 0 | 0s | 0s | IPC::Open3::::open3IPC::Open3::open3
0 | 0 | 0 | 0s | 0s | IPC::Open3::::spawn_with_handlesIPC::Open3::spawn_with_handles
0 | 0 | 0 | 0s | 0s | IPC::Open3::::xcloseIPC::Open3::xclose
0 | 0 | 0 | 0s | 0s | IPC::Open3::::xfilenoIPC::Open3::xfileno
0 | 0 | 0 | 0s | 0s | IPC::Open3::::xforkIPC::Open3::xfork
0 | 0 | 0 | 0s | 0s | IPC::Open3::::xopenIPC::Open3::xopen
0 | 0 | 0 | 0s | 0s | IPC::Open3::::xpipeIPC::Open3::xpipe

Call graph for these subroutines as a Graphviz dot language file.

Line | State ments | Time on line | Calls | Time in subs | Code
--- | --- | --- | --- | --- | ---
1 |  |  |  |  | package IPC::Open3;
2 |  |  |  |  |
3 | 3 | 19µs | 2 | 16µs | # spent 14µs (12+2) within IPC::Open3::BEGIN@3 which was called: # once (12µs+2µs) by Net::SSH::BEGIN@9 at line 3 use strict; # spent 14µs making 1 call to IPC::Open3::BEGIN@3 # spent 2µs making 1 call to strict::import
4 | 3 | 34µs | 2 | 34µs | # spent 20µs (7+14) within IPC::Open3::BEGIN@4 which was called: # once (7µs+14µs) by Net::SSH::BEGIN@9 at line 4 no strict 'refs'; # because users pass me bareword filehandles # spent 20µs making 1 call to IPC::Open3::BEGIN@4 # spent 14µs making 1 call to strict::unimport
5 | 1 | 400ns |  |  | our ($VERSION, @ISA, @EXPORT);
6 |  |  |  |  |
7 | 1 | 600ns |  |  | require Exporter;
8 |  |  |  |  |
9 | 3 | 19µs | 2 | 80µs | # spent 44µs (7+36) within IPC::Open3::BEGIN@9 which was called: # once (7µs+36µs) by Net::SSH::BEGIN@9 at line 9 use Carp; # spent 44µs making 1 call to IPC::Open3::BEGIN@9 # spent 36µs making 1 call to Exporter::import
10 | 3 | 296µs | 2 | 95µs | # spent 51µs (7+44) within IPC::Open3::BEGIN@10 which was called: # once (7µs+44µs) by Net::SSH::BEGIN@9 at line 10 use Symbol qw(gensym qualify); # spent 51µs making 1 call to IPC::Open3::BEGIN@10 # spent 44µs making 1 call to Exporter::import
11 |  |  |  |  |
12 | 1 | 300ns |  |  | $VERSION = 1.05;
13 | 1 | 7µs |  |  | @ISA = qw(Exporter);
14 | 1 | 500ns |  |  | @EXPORT = qw(open3);
15 |  |  |  |  |
16 |  |  |  |  | =head1 NAME
17 |  |  |  |  |
18 |  |  |  |  | IPC::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 |  |  |  |  |
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.
42 |  |  |  |  |
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.
48 |  |  |  |  |
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.
53 |  |  |  |  |
54 |  |  |  |  | The filehandles may also be integers, in which case they are understood
55 |  |  |  |  | as file descriptors.
56 |  |  |  |  |
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.
61 |  |  |  |  |
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.
65 |  |  |  |  |
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.
70 |  |  |  |  |
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.
77 |  |  |  |  |
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.
82 |  |  |  |  |
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.
89 |  |  |  |  |
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.
94 |  |  |  |  |
95 |  |  |  |  | =head1 See Also
96 |  |  |  |  |
97 |  |  |  |  | =over 4
98 |  |  |  |  |
99 |  |  |  |  | =item L<IPC::Open2>
100 |  |  |  |  |
101 |  |  |  |  | Like Open3 but without STDERR catpure.
102 |  |  |  |  |
103 |  |  |  |  | =item L<IPC::Run>
104 |  |  |  |  |
105 |  |  |  |  | This is a CPAN module that has better error handling and more facilities
106 |  |  |  |  | than Open3.
107 |  |  |  |  |
108 |  |  |  |  | =back
109 |  |  |  |  |
110 |  |  |  |  | =head1 WARNING
111 |  |  |  |  |
112 |  |  |  |  | The 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 |  |  |  |  |
150 | 1 | 200ns |  |  | our $Me = 'open3 (bug)'; # you should never see this, it's always localized
151 |  |  |  |  |
152 |  |  |  |  | # Fatal.pm needs to be fixed WRT prototypes.
153 |  |  |  |  |
154 |  |  |  |  | sub xfork {
155 |  |  |  |  | my $pid = fork;
156 |  |  |  |  | defined $pid or croak "$Me: fork failed: $!";
157 |  |  |  |  | return $pid;
158 |  |  |  |  | }
159 |  |  |  |  |
160 |  |  |  |  | sub 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 |  |  |  |  |
167 |  |  |  |  | sub xopen {
168 |  |  |  |  | open $_[0], $_[1] or croak "$Me: open($_[0], $_[1]) failed: $!";
169 |  |  |  |  | }
170 |  |  |  |  |
171 |  |  |  |  | sub xclose {
172 |  |  |  |  | close $_[0] or croak "$Me: close($_[0]) failed: $!";
173 |  |  |  |  | }
174 |  |  |  |  |
175 |  |  |  |  | sub fh_is_fd {
176 |  |  |  |  | return $_[0] =~ /\A=?(\d+)\z/;
177 |  |  |  |  | }
178 |  |  |  |  |
179 |  |  |  |  | sub xfileno {
180 |  |  |  |  | return $1 if $_[0] =~ /\A=?(\d+)\z/; # deal with fh just being an fd
181 |  |  |  |  | return fileno $_[0];
182 |  |  |  |  | }
183 |  |  |  |  |
184 | 3 | 879µs | 2 | 122µs | # spent 68µs (14+54) within IPC::Open3::BEGIN@184 which was called: # once (14µs+54µs) by Net::SSH::BEGIN@9 at line 184 use constant DO_SPAWN => $^O eq 'os2' || $^O eq 'MSWin32'; # spent 68µs making 1 call to IPC::Open3::BEGIN@184 # spent 54µs making 1 call to constant::import
185 |  |  |  |  |
186 |  |  |  |  | sub _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 |  |  |  |  |
329 |  |  |  |  | sub open3 {
330 |  |  |  |  | if (@_ < 4) {
331 |  |  |  |  | local $" = ', ';
332 |  |  |  |  | croak "open3(@_): not enough arguments";
333 |  |  |  |  | }
334 |  |  |  |  | return _open3 'open3', scalar caller, @_
335 |  |  |  |  | }
336 |  |  |  |  |
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);
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 |  |  |  |  |
376 | 1 | 4µs |  |  | 1; # so require is happy