← Index
NYTProf Performance Profile   « line view »
For split.pl
  Run on Thu Apr 20 02:05:47 2023
Reported on Thu Apr 20 18:31:09 2023

Filename/home/hejohns/perl5/lib/perl5/IPC/Run/IO.pm
StatementsExecuted 15964903 statements in 25.3s
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
133036114.62s5.69sIPC::Run::IO::::_new_internalIPC::Run::IO::_new_internal
266092114.49s40.0sIPC::Run::IO::::_do_filtersIPC::Run::IO::_do_filters
266094114.22s48.4sIPC::Run::IO::::pollIPC::Run::IO::poll
266072113.21s4.06sIPC::Run::IO::::__ANON__[:216]IPC::Run::IO::__ANON__[:216]
266092111.53s1.53sIPC::Run::IO::::CORE:regcompIPC::Run::IO::CORE:regcomp (opcode)
532166311.44s1.44sIPC::Run::IO::::dirIPC::Run::IO::dir
133036111.44s17.5sIPC::Run::IO::::_do_openIPC::Run::IO::_do_open
133036111.18s1.28sIPC::Run::IO::::_init_filtersIPC::Run::IO::_init_filters
133036111.13s6.65sIPC::Run::IO::::closeIPC::Run::IO::close
13303611971ms18.6sIPC::Run::IO::::open_pipeIPC::Run::IO::open_pipe
13303611450ms450msIPC::Run::IO::::binmodeIPC::Run::IO::binmode
13303611339ms339msIPC::Run::IO::::_cleanupIPC::Run::IO::_cleanup
13303611192ms192msIPC::Run::IO::::opIPC::Run::IO::op
39912821188ms188msIPC::Run::IO::::CORE:matchIPC::Run::IO::CORE:match (opcode)
11113µs42µsIPC::Run::IO::::BEGIN@72IPC::Run::IO::BEGIN@72
11112µs15µsIPC::Run::IO::::BEGIN@65IPC::Run::IO::BEGIN@65
1117µs26µsIPC::Run::IO::::BEGIN@66IPC::Run::IO::BEGIN@66
1117µs121µsIPC::Run::IO::::BEGIN@68IPC::Run::IO::BEGIN@68
1116µs22µsIPC::Run::IO::::BEGIN@482IPC::Run::IO::BEGIN@482
1116µs29µsIPC::Run::IO::::BEGIN@67IPC::Run::IO::BEGIN@67
1114µs24µsIPC::Run::IO::::BEGIN@71IPC::Run::IO::BEGIN@71
1114µs18µsIPC::Run::IO::::BEGIN@74IPC::Run::IO::BEGIN@74
1114µs5µsIPC::Run::IO::::BEGIN@76IPC::Run::IO::BEGIN@76
1114µs19µsIPC::Run::IO::::BEGIN@69IPC::Run::IO::BEGIN@69
0000s0sIPC::Run::IO::::__ANON__[:168]IPC::Run::IO::__ANON__[:168]
0000s0sIPC::Run::IO::::__ANON__[:194]IPC::Run::IO::__ANON__[:194]
0000s0sIPC::Run::IO::::filenameIPC::Run::IO::filename
0000s0sIPC::Run::IO::::filenoIPC::Run::IO::fileno
0000s0sIPC::Run::IO::::initIPC::Run::IO::init
0000s0sIPC::Run::IO::::modeIPC::Run::IO::mode
0000s0sIPC::Run::IO::::newIPC::Run::IO::new
0000s0sIPC::Run::IO::::openIPC::Run::IO::open
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package IPC::Run::IO;
2
3=head1 NAME
4
5IPC::Run::IO -- I/O channels for IPC::Run.
6
7=head1 SYNOPSIS
8
9B<NOT IMPLEMENTED YET ON Win32! Win32 does not allow select() on
10normal file descriptors; IPC::RUN::IO needs to use IPC::Run::Win32Helper
11to do this.>
12
13 use IPC::Run qw( io );
14
15 ## The sense of '>' and '<' is opposite of perl's open(),
16 ## but agrees with IPC::Run.
17 $io = io( "filename", '>', \$recv );
18 $io = io( "filename", 'r', \$recv );
19
20 ## Append to $recv:
21 $io = io( "filename", '>>', \$recv );
22 $io = io( "filename", 'ra', \$recv );
23
24 $io = io( "filename", '<', \$send );
25 $io = io( "filename", 'w', \$send );
26
27 $io = io( "filename", '<<', \$send );
28 $io = io( "filename", 'wa', \$send );
29
30 ## Handles / IO objects that the caller opens:
31 $io = io( \*HANDLE, '<', \$send );
32
33 $f = IO::Handle->new( ... ); # Any subclass of IO::Handle
34 $io = io( $f, '<', \$send );
35
36 require IPC::Run::IO;
37 $io = IPC::Run::IO->new( ... );
38
39 ## Then run(), harness(), or start():
40 run $io, ...;
41
42 ## You can, of course, use io() or IPC::Run::IO->new() as an
43 ## argument to run(), harness, or start():
44 run io( ... );
45
46=head1 DESCRIPTION
47
48This class and module allows filehandles and filenames to be harnessed for
49I/O when used IPC::Run, independent of anything else IPC::Run is doing
50(except that errors & exceptions can affect all things that IPC::Run is
51doing).
52
53=head1 SUBCLASSING
54
55INCOMPATIBLE CHANGE: due to the awkwardness introduced in ripping pseudohashes
56out of Perl, this class I<no longer> uses the fields pragma.
57
58=cut
59
60## This class is also used internally by IPC::Run in a very intimate way,
61## since this is a partial factoring of code from IPC::Run plus some code
62## needed to do standalone channels. This factoring process will continue
63## at some point. Don't know how far how fast.
64
65222µs218µs
# spent 15µs (12+3) within IPC::Run::IO::BEGIN@65 which was called: # once (12µs+3µs) by main::BEGIN@29 at line 65
use strict;
# spent 15µs making 1 call to IPC::Run::IO::BEGIN@65 # spent 3µs making 1 call to strict::import
66218µs245µs
# spent 26µs (7+19) within IPC::Run::IO::BEGIN@66 which was called: # once (7µs+19µs) by main::BEGIN@29 at line 66
use warnings;
# spent 26µs making 1 call to IPC::Run::IO::BEGIN@66 # spent 19µs making 1 call to warnings::import
67215µs252µs
# spent 29µs (6+23) within IPC::Run::IO::BEGIN@67 which was called: # once (6µs+23µs) by main::BEGIN@29 at line 67
use Carp;
# spent 29µs making 1 call to IPC::Run::IO::BEGIN@67 # spent 23µs making 1 call to Exporter::import
68215µs2236µs
# spent 121µs (7+115) within IPC::Run::IO::BEGIN@68 which was called: # once (7µs+115µs) by main::BEGIN@29 at line 68
use Fcntl;
# spent 121µs making 1 call to IPC::Run::IO::BEGIN@68 # spent 115µs making 1 call to Exporter::import
69213µs234µs
# spent 19µs (4+15) within IPC::Run::IO::BEGIN@69 which was called: # once (4µs+15µs) by main::BEGIN@29 at line 69
use Symbol;
# spent 19µs making 1 call to IPC::Run::IO::BEGIN@69 # spent 15µs making 1 call to Exporter::import
70
71215µs244µs
# spent 24µs (4+20) within IPC::Run::IO::BEGIN@71 which was called: # once (4µs+20µs) by main::BEGIN@29 at line 71
use IPC::Run::Debug;
# spent 24µs making 1 call to IPC::Run::IO::BEGIN@71 # spent 20µs making 1 call to Exporter::import
72226µs271µs
# spent 42µs (13+29) within IPC::Run::IO::BEGIN@72 which was called: # once (13µs+29µs) by main::BEGIN@29 at line 72
use IPC::Run qw( Win32_MODE );
# spent 42µs making 1 call to IPC::Run::IO::BEGIN@72 # spent 29µs making 1 call to Exporter::import
73
74239µs233µs
# spent 18µs (4+15) within IPC::Run::IO::BEGIN@74 which was called: # once (4µs+15µs) by main::BEGIN@29 at line 74
use vars qw{$VERSION};
# spent 18µs making 1 call to IPC::Run::IO::BEGIN@74 # spent 15µs making 1 call to vars::import
75
76
# spent 5µs (4+1) within IPC::Run::IO::BEGIN@76 which was called: # once (4µs+1µs) by main::BEGIN@29 at line 83
BEGIN {
771200ns $VERSION = '20220807.0';
7812µs11µs if (Win32_MODE) {
# spent 1µs making 1 call to constant::__ANON__[constant.pm:192]
79 eval "use IPC::Run::Win32Helper; require IPC::Run::Win32IO; 1"
80 or ( $@ && die )
81 or die "$!";
82 }
8311000µs15µs}
# spent 5µs making 1 call to IPC::Run::IO::BEGIN@76
84
85sub _empty($);
8612µs*_empty = \&IPC::Run::_empty;
87
88=head1 SUBROUTINES
89
90=over 4
91
92=item new
93
94I think it takes >> or << along with some other data.
95
96TODO: Needs more thorough documentation. Patches welcome.
97
98=cut
99
100sub new {
101 my $class = shift;
102 $class = ref $class || $class;
103
104 my ( $external, $type, $internal ) = ( shift, shift, pop );
105
106 croak "$class: '$_' is not a valid I/O operator"
107 unless $type =~ /^(?:<<?|>>?)$/;
108
109 my IPC::Run::IO $self = $class->_new_internal( $type, undef, undef, $internal, undef, @_ );
110
111 if ( !ref $external ) {
112 $self->{FILENAME} = $external;
113 }
114 elsif ( ref $external eq 'GLOB' || UNIVERSAL::isa( $external, 'IO::Handle' ) ) {
115 $self->{HANDLE} = $external;
116 $self->{DONT_CLOSE} = 1;
117 }
118 else {
119 croak "$class: cannot accept " . ref($external) . " to do I/O with";
120 }
121
122 return $self;
123}
124
125## IPC::Run uses this ctor, since it preparses things and needs more
126## smarts.
127
# spent 5.69s (4.62+1.07) within IPC::Run::IO::_new_internal which was called 133036 times, avg 43µs/call: # 133036 times (4.62s+1.07s) by IPC::Run::harness at line 1914 of IPC/Run.pm, avg 43µs/call
sub _new_internal {
12813303640.2ms my $class = shift;
12913303651.4ms $class = ref $class || $class;
130
131133036120ms13303671.9ms $class = "IPC::Run::Win32IO"
# spent 71.9ms making 133036 calls to constant::__ANON__[constant.pm:192], avg 540ns/call
132 if Win32_MODE && $class eq "IPC::Run::IO";
133
13413303623.4ms my IPC::Run::IO $self;
13513303667.8ms $self = bless {}, $class;
136
137133036112ms my ( $type, $kfd, $pty_id, $internal, $binmode, @filters ) = @_;
138
139 # Older perls (<=5.00503, at least) don't do list assign to
140 # psuedo-hashes well.
141133036129ms $self->{TYPE} = $type;
14213303660.4ms $self->{KFD} = $kfd;
14313303685.5ms $self->{PTY_ID} = $pty_id;
144133036417ms133036450ms $self->binmode($binmode);
# spent 450ms making 133036 calls to IPC::Run::IO::binmode, avg 3µs/call
14513303687.2ms $self->{FILTERS} = [@filters];
146
147 ## Add an adapter to the end of the filter chain (which is usually just the
148 ## read/writer sub pushed by IPC::Run) to the DEST or SOURCE, if need be.
149133036749ms266072336ms if ( $self->op =~ />/ ) {
# spent 192ms making 133036 calls to IPC::Run::IO::op, avg 1µs/call # spent 144ms making 133036 calls to IPC::Run::IO::CORE:match, avg 1µs/call
150 croak "'$_' missing a destination" if _empty $internal;
151 $self->{DEST} = $internal;
152 if ( UNIVERSAL::isa( $self->{DEST}, 'CODE' ) ) {
153 ## Put a filter on the end of the filter chain to pass the
154 ## output on to the CODE ref. For SCALAR refs, the last
155 ## filter in the chain writes directly to the scalar itself. See
156 ## _init_filters(). For CODE refs, however, we need to adapt from
157 ## the SCALAR to calling the CODE.
158 unshift(
159 @{ $self->{FILTERS} },
160 sub {
161 my ($in_ref) = @_;
162
163 return IPC::Run::input_avail() && do {
164 $self->{DEST}->($$in_ref);
165 $$in_ref = '';
166 1;
167 }
168 }
169 );
170 }
171 }
172 else {
173133036118ms133036118ms croak "'$_' missing a source" if _empty $internal;
# spent 118ms making 133036 calls to IPC::Run::_empty, avg 884ns/call
17413303663.3ms $self->{SOURCE} = $internal;
175133036772ms26607298.8ms if ( UNIVERSAL::isa( $internal, 'CODE' ) ) {
# spent 98.8ms making 266072 calls to UNIVERSAL::isa, avg 371ns/call
176 push(
177 @{ $self->{FILTERS} },
178 sub {
179 my ( $in_ref, $out_ref ) = @_;
180 return 0 if length $$out_ref;
181
182 return undef
183 if $self->{SOURCE_EMPTY};
184
185 my $in = $internal->();
186 unless ( defined $in ) {
187 $self->{SOURCE_EMPTY} = 1;
188 return undef;
189 }
190 return 0 unless length $in;
191 $$out_ref = $in;
192
193 return 1;
194 }
195 );
196 }
197 elsif ( UNIVERSAL::isa( $internal, 'SCALAR' ) ) {
198 push(
199 @{ $self->{FILTERS} },
200
# spent 4.06s (3.21+852ms) within IPC::Run::IO::__ANON__[/home/hejohns/perl5/lib/perl5/IPC/Run/IO.pm:216] which was called 266072 times, avg 15µs/call: # 266072 times (3.21s+852ms) by IPC::Run::get_more_input at line 4162 of IPC/Run.pm, avg 15µs/call
sub {
201266072429ms my ( $in_ref, $out_ref ) = @_;
20226607265.3ms return 0 if length $$out_ref;
203
204 ## pump() clears auto_close_ins, finish() sets it.
205 return $self->{HARNESS}->{auto_close_ins} ? undef : 0
206 if IPC::Run::_empty ${ $self->{SOURCE} }
2072660721.74s266072852ms || $self->{SOURCE_EMPTY};
# spent 852ms making 266072 calls to IPC::Run::_empty, avg 3µs/call
208
209133036327ms $$out_ref = $$internal;
210 eval { $$internal = '' }
21113303679.6ms if $self->{HARNESS}->{clear_ins};
212
213133036115ms $self->{SOURCE_EMPTY} = $self->{HARNESS}->{auto_close_ins};
214
215133036773ms return 1;
216 }
217133036538ms );
218 }
219 }
220
221133036586ms return $self;
222}
223
224=item filename
225
226Gets/sets the filename. Returns the value after the name change, if
227any.
228
229=cut
230
231sub filename {
232 my IPC::Run::IO $self = shift;
233 $self->{FILENAME} = shift if @_;
234 return $self->{FILENAME};
235}
236
237=item init
238
239Does initialization required before this can be run. This includes open()ing
240the file, if necessary, and clearing the destination scalar if necessary.
241
242=cut
243
244sub init {
245 my IPC::Run::IO $self = shift;
246
247 $self->{SOURCE_EMPTY} = 0;
248 ${ $self->{DEST} } = ''
249 if $self->mode =~ /r/ && ref $self->{DEST} eq 'SCALAR';
250
251 $self->open if defined $self->filename;
252 $self->{FD} = $self->fileno;
253
254 if ( !$self->{FILTERS} ) {
255 $self->{FBUFS} = undef;
256 }
257 else {
258 @{ $self->{FBUFS} } = map {
259 my $s = "";
260 \$s;
261 } ( @{ $self->{FILTERS} }, '' );
262
263 $self->{FBUFS}->[0] = $self->{DEST}
264 if $self->{DEST} && ref $self->{DEST} eq 'SCALAR';
265 push @{ $self->{FBUFS} }, $self->{SOURCE};
266 }
267
268 return undef;
269}
270
271=item open
272
273If a filename was passed in, opens it. Determines if the handle is open
274via fileno(). Throws an exception on error.
275
276=cut
277
27812µsmy %open_flags = (
279 '>' => O_RDONLY,
280 '>>' => O_RDONLY,
281 '<' => O_WRONLY | O_CREAT | O_TRUNC,
282 '<<' => O_WRONLY | O_CREAT | O_APPEND,
283);
284
285sub open {
286 my IPC::Run::IO $self = shift;
287
288 croak "IPC::Run::IO: Can't open() a file with no name"
289 unless defined $self->{FILENAME};
290 $self->{HANDLE} = gensym unless $self->{HANDLE};
291
292 _debug "opening '", $self->filename, "' mode '", $self->mode, "'"
293 if _debugging_data;
294 sysopen(
295 $self->{HANDLE},
296 $self->filename,
297 $open_flags{ $self->op },
298 ) or croak "IPC::Run::IO: $! opening '$self->{FILENAME}', mode '" . $self->mode . "'";
299
300 return undef;
301}
302
303=item open_pipe
304
305If this is a redirection IO object, this opens the pipe in a platform
306independent manner.
307
308=cut
309
310
# spent 17.5s (1.44+16.1) within IPC::Run::IO::_do_open which was called 133036 times, avg 132µs/call: # 133036 times (1.44s+16.1s) by IPC::Run::IO::open_pipe at line 337, avg 132µs/call
sub _do_open {
31113303622.2ms my $self = shift;
31213303656.3ms my ( $child_debug_fd, $parent_handle ) = @_;
313
314133036467ms133036246ms if ( $self->dir eq "<" ) {
# spent 246ms making 133036 calls to IPC::Run::IO::dir, avg 2µs/call
315133036636ms13303615.8s ( $self->{TFD}, $self->{FD} ) = IPC::Run::_pipe_nb;
# spent 15.8s making 133036 calls to IPC::Run::_pipe_nb, avg 119µs/call
31613303630.2ms if ($parent_handle) {
317 CORE::open $parent_handle, ">&=$self->{FD}"
318 or croak "$! duping write end of pipe for caller";
319 }
320 }
321 else {
322 ( $self->{FD}, $self->{TFD} ) = IPC::Run::_pipe;
323 if ($parent_handle) {
324 CORE::open $parent_handle, "<&=$self->{FD}"
325 or croak "$! duping read end of pipe for caller";
326 }
327 }
328}
329
330
# spent 18.6s (971ms+17.7) within IPC::Run::IO::open_pipe which was called 133036 times, avg 140µs/call: # 133036 times (971ms+17.7s) by IPC::Run::_open_pipes at line 2178 of IPC/Run.pm, avg 140µs/call
sub open_pipe {
33113303627.5ms my IPC::Run::IO $self = shift;
332
333 ## Hmmm, Maybe allow named pipes one day. But until then...
334 croak "IPC::Run::IO: Can't pipe() when a file name has been set"
33513303658.3ms if defined $self->{FILENAME};
336
337133036262ms13303617.5s $self->_do_open(@_);
# spent 17.5s making 133036 calls to IPC::Run::IO::_do_open, avg 132µs/call
338
339 ## return ( child_fd, parent_fd )
340 return $self->dir eq "<"
341 ? ( $self->{TFD}, $self->{FD} )
342133036600ms133036155ms : ( $self->{FD}, $self->{TFD} );
# spent 155ms making 133036 calls to IPC::Run::IO::dir, avg 1µs/call
343}
344
345
# spent 339ms within IPC::Run::IO::_cleanup which was called 133036 times, avg 3µs/call: # 133036 times (339ms+0s) by IPC::Run::_cleanup at line 3265 of IPC/Run.pm, avg 3µs/call
sub _cleanup { ## Called from Run.pm's _cleanup
34613303625.9ms my $self = shift;
347133036684ms undef $self->{FAKE_PIPE};
348}
349
350=item close
351
352Closes the handle. Throws an exception on failure.
353
354
355=cut
356
357
# spent 6.65s (1.13+5.52) within IPC::Run::IO::close which was called 133036 times, avg 50µs/call: # 133036 times (1.13s+5.52s) by IPC::Run::_clobber at line 2960 of IPC/Run.pm, avg 50µs/call
sub close {
35813303639.1ms my IPC::Run::IO $self = shift;
359
360133036122ms if ( defined $self->{HANDLE} ) {
361 close $self->{HANDLE}
362 or croak(
363 "IPC::Run::IO: $! closing "
364 . (
365 defined $self->{FILENAME}
366 ? "'$self->{FILENAME}'"
367 : "handle"
368 )
369 );
370 }
371 else {
372133036183ms1330365.52s IPC::Run::_close( $self->{FD} );
# spent 5.52s making 133036 calls to IPC::Run::_close, avg 42µs/call
373 }
374
37513303654.2ms $self->{FD} = undef;
376
377133036408ms return undef;
378}
379
380=item fileno
381
382Returns the fileno of the handle. Throws an exception on failure.
383
384
385=cut
386
387sub fileno {
388 my IPC::Run::IO $self = shift;
389
390 my $fd = fileno $self->{HANDLE};
391 croak(
392 "IPC::Run::IO: $! "
393 . (
394 defined $self->{FILENAME}
395 ? "'$self->{FILENAME}'"
396 : "handle"
397 )
398 ) unless defined $fd;
399
400 return $fd;
401}
402
403=item mode
404
405Returns the operator in terms of 'r', 'w', and 'a'. There is a state
406'ra', unlike Perl's open(), which indicates that data read from the
407handle or file will be appended to the output if the output is a scalar.
408This is only meaningful if the output is a scalar, it has no effect if
409the output is a subroutine.
410
411The redirection operators can be a little confusing, so here's a reference
412table:
413
414 > r Read from handle in to process
415 < w Write from process out to handle
416 >> ra Read from handle in to process, appending it to existing
417 data if the destination is a scalar.
418 << wa Write from process out to handle, appending to existing
419 data if IPC::Run::IO opened a named file.
420
421=cut
422
423sub mode {
424 my IPC::Run::IO $self = shift;
425
426 croak "IPC::Run::IO: unexpected arguments for mode(): @_" if @_;
427
428 ## TODO: Optimize this
429 return ( $self->{TYPE} =~ /</ ? 'w' : 'r' ) . ( $self->{TYPE} =~ /<<|>>/ ? 'a' : '' );
430}
431
432=item op
433
434Returns the operation: '<', '>', '<<', '>>'. See L</mode> if you want
435to spell these 'r', 'w', etc.
436
437=cut
438
439
# spent 192ms within IPC::Run::IO::op which was called 133036 times, avg 1µs/call: # 133036 times (192ms+0s) by IPC::Run::IO::_new_internal at line 149, avg 1µs/call
sub op {
44013303620.8ms my IPC::Run::IO $self = shift;
441
44213303623.6ms croak "IPC::Run::IO: unexpected arguments for op(): @_" if @_;
443
444133036371ms return $self->{TYPE};
445}
446
447=item binmode
448
449Sets/gets whether this pipe is in binmode or not. No effect off of Win32
450OSs, of course, and on Win32, no effect after the harness is start()ed.
451
452=cut
453
454
# spent 450ms within IPC::Run::IO::binmode which was called 133036 times, avg 3µs/call: # 133036 times (450ms+0s) by IPC::Run::IO::_new_internal at line 144, avg 3µs/call
sub binmode {
45513303621.6ms my IPC::Run::IO $self = shift;
456
457133036103ms $self->{BINMODE} = shift if @_;
458
459133036369ms return $self->{BINMODE};
460}
461
462=item dir
463
464Returns the first character of $self->op. This is either "<" or ">".
465
466=cut
467
468
# spent 1.44s within IPC::Run::IO::dir which was called 532166 times, avg 3µs/call: # 266094 times (1.04s+0s) by IPC::Run::IO::poll at line 519, avg 4µs/call # 133036 times (246ms+0s) by IPC::Run::IO::_do_open at line 314, avg 2µs/call # 133036 times (155ms+0s) by IPC::Run::IO::open_pipe at line 342, avg 1µs/call
sub dir {
46953216681.8ms my IPC::Run::IO $self = shift;
470
47153216698.6ms croak "IPC::Run::IO: unexpected arguments for dir(): @_" if @_;
472
4735321662.04s return substr $self->{TYPE}, 0, 1;
474}
475
476##
477## Filter Scaffolding
478##
479#my $filter_op ; ## The op running a filter chain right now
480#my $filter_num; ## Which filter is being run right now.
481
482
# spent 22µs (6+16) within IPC::Run::IO::BEGIN@482 which was called: # once (6µs+16µs) by main::BEGIN@29 at line 485
use vars (
48312µs116µs '$filter_op', ## The op running a filter chain right now
# spent 16µs making 1 call to vars::import
484 '$filter_num' ## Which filter is being run right now.
4851267µs122µs);
# spent 22µs making 1 call to IPC::Run::IO::BEGIN@482
486
487
# spent 1.28s (1.18+99.0ms) within IPC::Run::IO::_init_filters which was called 133036 times, avg 10µs/call: # 133036 times (1.18s+99.0ms) by IPC::Run::_open_pipes at line 2196 of IPC/Run.pm, avg 10µs/call
sub _init_filters {
48813303623.1ms my IPC::Run::IO $self = shift;
489
490133036430ms13303699.0ms confess "\$self not an IPC::Run::IO" unless UNIVERSAL::isa( $self, "IPC::Run::IO" );
# spent 99.0ms making 133036 calls to UNIVERSAL::isa, avg 744ns/call
49113303674.4ms $self->{FBUFS} = [];
492
493 $self->{FBUFS}->[0] = $self->{DEST}
49413303641.0ms if $self->{DEST} && ref $self->{DEST} eq 'SCALAR';
495
49613303679.4ms return unless $self->{FILTERS} && @{ $self->{FILTERS} };
497
498 push @{ $self->{FBUFS} }, map {
49926607253.3ms my $s = "";
500266072132ms \$s;
501133036265ms } ( @{ $self->{FILTERS} }, '' );
502
503133036376ms push @{ $self->{FBUFS} }, $self->{SOURCE};
504}
505
506=item poll
507
508TODO: Needs confirmation that this is correct. Was previously undocumented.
509
510I believe this is polling the IO for new input and then returns undef if there will never be any more input, 0 if there is none now, but there might be in the future, and TRUE if more input was gotten.
511
512=cut
513
514
# spent 48.4s (4.22+44.2) within IPC::Run::IO::poll which was called 266094 times, avg 182µs/call: # 266094 times (4.22s+44.2s) by IPC::Run::_select_loop at line 3159 of IPC/Run.pm, avg 182µs/call
sub poll {
51526609459.8ms my IPC::Run::IO $self = shift;
51626609488.9ms my ($harness) = @_;
517
518266094125ms if ( defined $self->{FD} ) {
519266094846ms2660941.04s my $d = $self->dir;
# spent 1.04s making 266094 calls to IPC::Run::IO::dir, avg 4µs/call
520266094130ms if ( $d eq "<" ) {
521266094198ms if ( vec $harness->{WOUT}, $self->{FD}, 1 ) {
522266092246ms2660923.20s _debug_desc_fd( "filtering data to", $self )
# spent 3.20s making 266092 calls to IPC::Run::Debug::_debugging_details, avg 12µs/call
523 if _debugging_details;
5242660921.23s26609240.0s return $self->_do_filters($harness);
# spent 40.0s making 266092 calls to IPC::Run::IO::_do_filters, avg 150µs/call
525 }
526 }
527 elsif ( $d eq ">" ) {
528 if ( vec $harness->{ROUT}, $self->{FD}, 1 ) {
529 _debug_desc_fd( "filtering data from", $self )
530 if _debugging_details;
531 return $self->_do_filters($harness);
532 }
533 }
534 }
53525µs return 0;
536}
537
538
# spent 40.0s (4.49+35.5) within IPC::Run::IO::_do_filters which was called 266092 times, avg 150µs/call: # 266092 times (4.49s+35.5s) by IPC::Run::IO::poll at line 524, avg 150µs/call
sub _do_filters {
53926609247.8ms my IPC::Run::IO $self = shift;
540
541266092643ms ( $self->{HARNESS} ) = @_;
542
543266092114ms my ( $saved_op, $saved_num ) = ( $IPC::Run::filter_op, $IPC::Run::filter_num );
544266092126ms $IPC::Run::filter_op = $self;
54526609248.8ms $IPC::Run::filter_num = -1;
54626609240.2ms my $redos = 0;
54726609234.8ms my $r;
548 {
549532184172ms $@ = '';
550532184886ms26609233.9s $r = eval { IPC::Run::get_more_input(); };
# spent 33.9s making 266092 calls to IPC::Run::get_more_input, avg 127µs/call
551
552 # Detect Resource temporarily unavailable and re-try 200 times (2 seconds), assuming select behaves (which it doesn't always? need ref)
5532660923.39s5321841.57s if ( ( $@ || '' ) =~ $IPC::Run::_EAGAIN && $redos++ < 200 ) {
# spent 1.53s making 266092 calls to IPC::Run::IO::CORE:regcomp, avg 6µs/call # spent 43.6ms making 266092 calls to IPC::Run::IO::CORE:match, avg 164ns/call
554 select( undef, undef, undef, 0.01 );
555 redo;
556 }
557 }
558266092119ms ( $IPC::Run::filter_op, $IPC::Run::filter_num ) = ( $saved_op, $saved_num );
559266092103ms $self->{HARNESS} = undef;
56026609237.6ms die "ack ", $@ if $@;
561266092802ms return $r;
562}
563
564=back
565
566=head1 AUTHOR
567
568Barrie Slaymaker <barries@slaysys.com>
569
570=head1 TODO
571
572Implement bidirectionality.
573
574=cut
575
57614µs1;
 
# spent 188ms within IPC::Run::IO::CORE:match which was called 399128 times, avg 471ns/call: # 266092 times (43.6ms+0s) by IPC::Run::IO::_do_filters at line 553, avg 164ns/call # 133036 times (144ms+0s) by IPC::Run::IO::_new_internal at line 149, avg 1µs/call
sub IPC::Run::IO::CORE:match; # opcode
# spent 1.53s within IPC::Run::IO::CORE:regcomp which was called 266092 times, avg 6µs/call: # 266092 times (1.53s+0s) by IPC::Run::IO::_do_filters at line 553, avg 6µs/call
sub IPC::Run::IO::CORE:regcomp; # opcode
Report produced by the NYTProf 6.12 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.