← 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/Capture/Tiny.pm
StatementsExecuted 13835692 statements in 53.0s
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1330351120.9s53695sCapture::Tiny::::_capture_teeCapture::Tiny::_capture_tee
7982101110.0s10.0sCapture::Tiny::::CORE:openCapture::Tiny::CORE:open (opcode)
266070215.29s7.28sCapture::Tiny::::_relayerCapture::Tiny::_relayer
798210313.70s13.7sCapture::Tiny::::_openCapture::Tiny::_open
133035113.59s12.4sCapture::Tiny::::_copy_stdCapture::Tiny::_copy_std
266070213.48s13.8sCapture::Tiny::::_open_stdCapture::Tiny::_open_std
798210311.23s1.23sCapture::Tiny::::CORE:binmodeCapture::Tiny::CORE:binmode (opcode)
266070111.19s1.19sCapture::Tiny::::CORE:closeCapture::Tiny::CORE:close (opcode)
26607011989ms2.18sCapture::Tiny::::_closeCapture::Tiny::_close
13303511553ms553msCapture::Tiny::::_proxy_stdCapture::Tiny::_proxy_std
13303511479ms479msCapture::Tiny::::_unproxyCapture::Tiny::_unproxy
13303511305ms305msCapture::Tiny::::CORE:seekCapture::Tiny::CORE:seek (opcode)
1330351136.9ms36.9msCapture::Tiny::::CORE:tellCapture::Tiny::CORE:tell (opcode)
111165µs166µsCapture::Tiny::::BEGIN@14Capture::Tiny::BEGIN@14
11113µs13µsmain::::BEGIN@1.5 main::BEGIN@1.5
1115µs10µsCapture::Tiny::::BEGIN@102Capture::Tiny::BEGIN@102
1115µs24µsCapture::Tiny::::BEGIN@11Capture::Tiny::BEGIN@11
1115µs15µsCapture::Tiny::::BEGIN@12Capture::Tiny::BEGIN@12
1114µs6µsmain::::BEGIN@2 main::BEGIN@2
1114µs22µsmain::::BEGIN@3.6 main::BEGIN@3.6
1112µs2µsCapture::Tiny::::BEGIN@9Capture::Tiny::BEGIN@9
1112µs2µsCapture::Tiny::::BEGIN@7Capture::Tiny::BEGIN@7
1112µs2µsCapture::Tiny::::BEGIN@10Capture::Tiny::BEGIN@10
1112µs2µsCapture::Tiny::::BEGIN@8Capture::Tiny::BEGIN@8
0000s0sCapture::Tiny::::__ANON__[:17]Capture::Tiny::__ANON__[:17]
0000s0sCapture::Tiny::::_files_existCapture::Tiny::_files_exist
0000s0sCapture::Tiny::::_fork_execCapture::Tiny::_fork_exec
0000s0sCapture::Tiny::::_kill_teesCapture::Tiny::_kill_tees
0000s0sCapture::Tiny::::_nameCapture::Tiny::_name
0000s0sCapture::Tiny::::_slurpCapture::Tiny::_slurp
0000s0sCapture::Tiny::::_start_teeCapture::Tiny::_start_tee
0000s0sCapture::Tiny::::_wait_for_teesCapture::Tiny::_wait_for_tees
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1228µs113µs
# spent 13µs within main::BEGIN@1.5 which was called: # once (13µs+0s) by main::BEGIN@26 at line 1
use 5.006;
# spent 13µs making 1 call to main::BEGIN@1.5
2214µs28µs
# spent 6µs (4+2) within main::BEGIN@2 which was called: # once (4µs+2µs) by main::BEGIN@26 at line 2
use strict;
# spent 6µs making 1 call to main::BEGIN@2 # spent 2µs making 1 call to strict::import
3224µs240µs
# spent 22µs (4+18) within main::BEGIN@3.6 which was called: # once (4µs+18µs) by main::BEGIN@26 at line 3
use warnings;
# spent 22µs making 1 call to main::BEGIN@3.6 # spent 18µs making 1 call to warnings::import
4package Capture::Tiny;
5# ABSTRACT: Capture STDOUT and STDERR from Perl, XS or external programs
61400nsour $VERSION = '0.48';
7211µs12µs
# spent 2µs within Capture::Tiny::BEGIN@7 which was called: # once (2µs+0s) by main::BEGIN@26 at line 7
use Carp ();
# spent 2µs making 1 call to Capture::Tiny::BEGIN@7
829µs12µs
# spent 2µs within Capture::Tiny::BEGIN@8 which was called: # once (2µs+0s) by main::BEGIN@26 at line 8
use Exporter ();
# spent 2µs making 1 call to Capture::Tiny::BEGIN@8
928µs12µs
# spent 2µs within Capture::Tiny::BEGIN@9 which was called: # once (2µs+0s) by main::BEGIN@26 at line 9
use IO::Handle ();
# spent 2µs making 1 call to Capture::Tiny::BEGIN@9
10211µs12µs
# spent 2µs within Capture::Tiny::BEGIN@10 which was called: # once (2µs+0s) by main::BEGIN@26 at line 10
use File::Spec ();
# spent 2µs making 1 call to Capture::Tiny::BEGIN@10
11217µs243µs
# spent 24µs (5+19) within Capture::Tiny::BEGIN@11 which was called: # once (5µs+19µs) by main::BEGIN@26 at line 11
use File::Temp qw/tempfile tmpnam/;
# spent 24µs making 1 call to Capture::Tiny::BEGIN@11 # spent 19µs making 1 call to Exporter::import
12240µs224µs
# spent 15µs (5+10) within Capture::Tiny::BEGIN@12 which was called: # once (5µs+10µs) by main::BEGIN@26 at line 12
use Scalar::Util qw/reftype blessed/;
# spent 15µs making 1 call to Capture::Tiny::BEGIN@12 # spent 10µs making 1 call to Exporter::import
13# Get PerlIO or fake it
14
# spent 166µs (165+1) within Capture::Tiny::BEGIN@14 which was called: # once (165µs+1µs) by main::BEGIN@26 at line 18
BEGIN {
151200ns local $@;
162161µs11µs eval { require PerlIO; PerlIO->can('get_layers') }
# spent 1µs making 1 call to UNIVERSAL::can
1712µs or *PerlIO::get_layers = sub { return () };
181160µs1166µs}
# spent 166µs making 1 call to Capture::Tiny::BEGIN@14
19
20#--------------------------------------------------------------------------#
21# create API subroutines and export them
22# [do STDOUT flag, do STDERR flag, do merge flag, do tee flag]
23#--------------------------------------------------------------------------#
24
2513µsmy %api = (
26 capture => [1,1,0,0],
27 capture_stdout => [1,0,0,0],
28 capture_stderr => [0,1,0,0],
29 capture_merged => [1,1,1,0],
30 tee => [1,1,0,1],
31 tee_stdout => [1,0,0,1],
32 tee_stderr => [0,1,0,1],
33 tee_merged => [1,1,1,1],
34);
35
3611µsfor my $sub ( keys %api ) {
3787µs my $args = join q{, }, @{$api{$sub}};
388177µs eval "sub $sub(&;@) {unshift \@_, $args; goto \\&_capture_tee;}"; ## no critic
# spent 1.22s executing statements in string eval
# includes 487ms spent executing 133035 calls to 1 sub defined therein.
39}
40
4119µsour @ISA = qw/Exporter/;
421900nsour @EXPORT_OK = keys %api;
431700nsour %EXPORT_TAGS = ( 'all' => \@EXPORT_OK );
44
45#--------------------------------------------------------------------------#
46# constants and fixtures
47#--------------------------------------------------------------------------#
48
4911µsmy $IS_WIN32 = $^O eq 'MSWin32';
50
51##our $DEBUG = $ENV{PERL_CAPTURE_TINY_DEBUG};
52##
53##my $DEBUGFH;
54##open $DEBUGFH, "> DEBUG" if $DEBUG;
55##
56##*_debug = $DEBUG ? sub(@) { print {$DEBUGFH} @_ } : sub(){0};
57
581100nsour $TIMEOUT = 30;
59
60#--------------------------------------------------------------------------#
61# command to tee output -- the argument is a filename that must
62# be opened to signal that the process is ready to receive input.
63# This is annoying, but seems to be the best that can be done
64# as a simple, portable IPC technique
65#--------------------------------------------------------------------------#
6611µsmy @cmd = ($^X, '-C0', '-e', <<'HERE');
67use Fcntl;
68$SIG{HUP}=sub{exit};
69if ( my $fn=shift ) {
70 sysopen(my $fh, qq{$fn}, O_WRONLY|O_CREAT|O_EXCL) or die $!;
71 print {$fh} $$;
72 close $fh;
73}
74my $buf; while (sysread(STDIN, $buf, 2048)) {
75 syswrite(STDOUT, $buf); syswrite(STDERR, $buf);
76}
77HERE
78
79#--------------------------------------------------------------------------#
80# filehandle manipulation
81#--------------------------------------------------------------------------#
82
83
# spent 7.28s (5.29+1.99) within Capture::Tiny::_relayer which was called 266070 times, avg 27µs/call: # 133035 times (3.03s+1.10s) by Capture::Tiny::_capture_tee at line 394, avg 31µs/call # 133035 times (2.26s+891ms) by Capture::Tiny::_capture_tee at line 377, avg 24µs/call
sub _relayer {
84266070138ms my ($fh, $apply_layers) = @_;
85 # _debug("# requested layers (@{$layers}) for @{[fileno $fh]}\n");
86
87 # eliminate pseudo-layers
882660701.16s266070389ms binmode( $fh, ":raw" );
# spent 389ms making 266070 calls to Capture::Tiny::CORE:binmode, avg 1µs/call
89 # strip off real layers until only :unix is left
902660703.44s798210995ms while ( 1 < ( my $layers =()= PerlIO::get_layers( $fh, output => 1 ) ) ) {
# spent 762ms making 532140 calls to PerlIO::get_layers, avg 1µs/call # spent 234ms making 266070 calls to Capture::Tiny::CORE:binmode, avg 878ns/call
91 binmode( $fh, ":pop" );
92 }
93 # apply other layers
94266070471ms my @to_apply = @$apply_layers;
9526607091.1ms shift @to_apply; # eliminate initial :unix
96 # _debug("# applying layers (unix @to_apply) to @{[fileno $fh]}\n");
972660702.22s266070604ms binmode($fh, ":" . join(":",@to_apply));
# spent 604ms making 266070 calls to Capture::Tiny::CORE:binmode, avg 2µs/call
98}
99
100sub _name {
101 my $glob = shift;
10221.36ms216µs
# spent 10µs (5+5) within Capture::Tiny::BEGIN@102 which was called: # once (5µs+5µs) by main::BEGIN@26 at line 102
no strict 'refs'; ## no critic
# spent 10µs making 1 call to Capture::Tiny::BEGIN@102 # spent 5µs making 1 call to strict::unimport
103 return *{$glob}{NAME};
104}
105
106
# spent 13.7s (3.70+10.0) within Capture::Tiny::_open which was called 798210 times, avg 17µs/call: # 266070 times (1.91s+4.29s) by Capture::Tiny::_open_std at line 194, avg 23µs/call # 266070 times (850ms+3.27s) by Capture::Tiny::_open_std at line 195, avg 15µs/call # 266070 times (943ms+2.46s) by Capture::Tiny::_copy_std at line 184, avg 13µs/call
sub _open {
10779821014.8s79821010.0s open $_[0], $_[1] or Carp::confess "Error from open(" . join(q{, }, @_) . "): $!";
# spent 10.0s making 798210 calls to Capture::Tiny::CORE:open, avg 13µs/call
108 # _debug( "# open " . join( ", " , map { defined $_ ? _name($_) : 'undef' } @_ ) . " as " . fileno( $_[0] ) . "\n" );
109}
110
111
# spent 2.18s (989ms+1.19) within Capture::Tiny::_close which was called 266070 times, avg 8µs/call: # 266070 times (989ms+1.19s) by Capture::Tiny::_capture_tee at line 392, avg 8µs/call
sub _close {
112 # _debug( "# closing " . ( defined $_[0] ? _name($_[0]) : 'undef' ) . " on " . fileno( $_[0] ) . "\n" );
1132660702.67s2660701.19s close $_[0] or Carp::confess "Error from close(" . join(q{, }, @_) . "): $!";
# spent 1.19s making 266070 calls to Capture::Tiny::CORE:close, avg 4µs/call
114}
115
1161200nsmy %dup; # cache this so STDIN stays fd0
117my %proxy_count;
118
# spent 553ms within Capture::Tiny::_proxy_std which was called 133035 times, avg 4µs/call: # 133035 times (553ms+0s) by Capture::Tiny::_capture_tee at line 350, avg 4µs/call
sub _proxy_std {
11913303523.7ms my %proxies;
12013303557.6ms if ( ! defined fileno STDIN ) {
121 $proxy_count{stdin}++;
122 if (defined $dup{stdin}) {
123 _open \*STDIN, "<&=" . fileno($dup{stdin});
124 # _debug( "# restored proxy STDIN as " . (defined fileno STDIN ? fileno STDIN : 'undef' ) . "\n" );
125 }
126 else {
127 _open \*STDIN, "<" . File::Spec->devnull;
128 # _debug( "# proxied STDIN as " . (defined fileno STDIN ? fileno STDIN : 'undef' ) . "\n" );
129 _open $dup{stdin} = IO::Handle->new, "<&=STDIN";
130 }
131 $proxies{stdin} = \*STDIN;
132 binmode(STDIN, ':utf8') if $] >= 5.008; ## no critic
133 }
134133035249ms if ( ! defined fileno STDOUT ) {
135 $proxy_count{stdout}++;
136 if (defined $dup{stdout}) {
137 _open \*STDOUT, ">&=" . fileno($dup{stdout});
138 # _debug( "# restored proxy STDOUT as " . (defined fileno STDOUT ? fileno STDOUT : 'undef' ) . "\n" );
139 }
140 else {
141 _open \*STDOUT, ">" . File::Spec->devnull;
142 # _debug( "# proxied STDOUT as " . (defined fileno STDOUT ? fileno STDOUT : 'undef' ) . "\n" );
143 _open $dup{stdout} = IO::Handle->new, ">&=STDOUT";
144 }
145 $proxies{stdout} = \*STDOUT;
146 binmode(STDOUT, ':utf8') if $] >= 5.008; ## no critic
147 }
14813303536.7ms if ( ! defined fileno STDERR ) {
149 $proxy_count{stderr}++;
150 if (defined $dup{stderr}) {
151 _open \*STDERR, ">&=" . fileno($dup{stderr});
152 # _debug( "# restored proxy STDERR as " . (defined fileno STDERR ? fileno STDERR : 'undef' ) . "\n" );
153 }
154 else {
155 _open \*STDERR, ">" . File::Spec->devnull;
156 # _debug( "# proxied STDERR as " . (defined fileno STDERR ? fileno STDERR : 'undef' ) . "\n" );
157 _open $dup{stderr} = IO::Handle->new, ">&=STDERR";
158 }
159 $proxies{stderr} = \*STDERR;
160 binmode(STDERR, ':utf8') if $] >= 5.008; ## no critic
161 }
162133035439ms return %proxies;
163}
164
165
# spent 479ms within Capture::Tiny::_unproxy which was called 133035 times, avg 4µs/call: # 133035 times (479ms+0s) by Capture::Tiny::_capture_tee at line 396, avg 4µs/call
sub _unproxy {
16613303556.9ms my (%proxies) = @_;
167 # _debug( "# unproxying: " . join(" ", keys %proxies) . "\n" );
168133035801ms for my $p ( keys %proxies ) {
169 $proxy_count{$p}--;
170 # _debug( "# unproxied " . uc($p) . " ($proxy_count{$p} left)\n" );
171 if ( ! $proxy_count{$p} ) {
172 _close $proxies{$p};
173 _close $dup{$p} unless $] < 5.008; # 5.6 will have already closed this as dup
174 delete $dup{$p};
175 }
176 }
177}
178
179
# spent 12.4s (3.59+8.84) within Capture::Tiny::_copy_std which was called 133035 times, avg 93µs/call: # 133035 times (3.59s+8.84s) by Capture::Tiny::_capture_tee at line 357, avg 93µs/call
sub _copy_std {
18013303533.3ms my %handles;
181133035314ms for my $h ( qw/stdout stderr stdin/ ) {
182399105128ms next if $h eq 'stdin' && ! $IS_WIN32; # WIN32 hangs on tee without STDIN copied
183266070275ms my $redir = $h eq 'stdin' ? "<&" : ">&";
1842660702.20s5321408.84s _open $handles{$h} = IO::Handle->new(), $redir . uc($h); # ">&STDOUT" or "<&STDIN"
# spent 5.43s making 266070 calls to IO::Handle::new, avg 20µs/call # spent 3.40s making 266070 calls to Capture::Tiny::_open, avg 13µs/call
185 }
186133035372ms return \%handles;
187}
188
189# In some cases we open all (prior to forking) and in others we only open
190# the output handles (setting up redirection)
191
# spent 13.8s (3.48+10.3) within Capture::Tiny::_open_std which was called 266070 times, avg 52µs/call: # 133035 times (2.27s+6.58s) by Capture::Tiny::_capture_tee at line 391, avg 67µs/call # 133035 times (1.21s+3.74s) by Capture::Tiny::_capture_tee at line 370, avg 37µs/call
sub _open_std {
192266070133ms my ($handles) = @_;
193266070125ms _open \*STDIN, "<&" . fileno $handles->{stdin} if defined $handles->{stdin};
1942660701.33s2660706.20s _open \*STDOUT, ">&" . fileno $handles->{stdout} if defined $handles->{stdout};
# spent 6.20s making 266070 calls to Capture::Tiny::_open, avg 23µs/call
1952660701.48s2660704.12s _open \*STDERR, ">&" . fileno $handles->{stderr} if defined $handles->{stderr};
# spent 4.12s making 266070 calls to Capture::Tiny::_open, avg 15µs/call
196}
197
198#--------------------------------------------------------------------------#
199# private subs
200#--------------------------------------------------------------------------#
201
202sub _start_tee {
203 my ($which, $stash) = @_; # $which is "stdout" or "stderr"
204 # setup pipes
205 $stash->{$_}{$which} = IO::Handle->new for qw/tee reader/;
206 pipe $stash->{reader}{$which}, $stash->{tee}{$which};
207 # _debug( "# pipe for $which\: " . _name($stash->{tee}{$which}) . " " . fileno( $stash->{tee}{$which} ) . " => " . _name($stash->{reader}{$which}) . " " . fileno( $stash->{reader}{$which}) . "\n" );
208 select((select($stash->{tee}{$which}), $|=1)[0]); # autoflush
209 # setup desired redirection for parent and child
210 $stash->{new}{$which} = $stash->{tee}{$which};
211 $stash->{child}{$which} = {
212 stdin => $stash->{reader}{$which},
213 stdout => $stash->{old}{$which},
214 stderr => $stash->{capture}{$which},
215 };
216 # flag file is used to signal the child is ready
217 $stash->{flag_files}{$which} = scalar( tmpnam() ) . $$;
218 # execute @cmd as a separate process
219 if ( $IS_WIN32 ) {
220 my $old_eval_err=$@;
221 undef $@;
222
223 eval "use Win32API::File qw/GetOsFHandle SetHandleInformation fileLastError HANDLE_FLAG_INHERIT INVALID_HANDLE_VALUE/ ";
224 # _debug( "# Win32API::File loaded\n") unless $@;
225 my $os_fhandle = GetOsFHandle( $stash->{tee}{$which} );
226 # _debug( "# Couldn't get OS handle: " . fileLastError() . "\n") if ! defined $os_fhandle || $os_fhandle == INVALID_HANDLE_VALUE();
227 my $result = SetHandleInformation( $os_fhandle, HANDLE_FLAG_INHERIT(), 0);
228 # _debug( $result ? "# set no-inherit flag on $which tee\n" : ("# can't disable tee handle flag inherit: " . fileLastError() . "\n"));
229 _open_std( $stash->{child}{$which} );
230 $stash->{pid}{$which} = system(1, @cmd, $stash->{flag_files}{$which});
231 # not restoring std here as it all gets redirected again shortly anyway
232 $@=$old_eval_err;
233 }
234 else { # use fork
235 _fork_exec( $which, $stash );
236 }
237}
238
239sub _fork_exec {
240 my ($which, $stash) = @_; # $which is "stdout" or "stderr"
241 my $pid = fork;
242 if ( not defined $pid ) {
243 Carp::confess "Couldn't fork(): $!";
244 }
245 elsif ($pid == 0) { # child
246 # _debug( "# in child process ...\n" );
247 untie *STDIN; untie *STDOUT; untie *STDERR;
248 _close $stash->{tee}{$which};
249 # _debug( "# redirecting handles in child ...\n" );
250 _open_std( $stash->{child}{$which} );
251 # _debug( "# calling exec on command ...\n" );
252 exec @cmd, $stash->{flag_files}{$which};
253 }
254 $stash->{pid}{$which} = $pid
255}
256
257122µsmy $have_usleep = eval "use Time::HiRes 'usleep'; 1";
# spent 104µs executing statements in string eval
# includes 522µs spent executing 1 call to 1 sub defined therein.
258sub _files_exist {
259 return 1 if @_ == grep { -f } @_;
260 Time::HiRes::usleep(1000) if $have_usleep;
261 return 0;
262}
263
264sub _wait_for_tees {
265 my ($stash) = @_;
266 my $start = time;
267 my @files = values %{$stash->{flag_files}};
268 my $timeout = defined $ENV{PERL_CAPTURE_TINY_TIMEOUT}
269 ? $ENV{PERL_CAPTURE_TINY_TIMEOUT} : $TIMEOUT;
270 1 until _files_exist(@files) || ($timeout && (time - $start > $timeout));
271 Carp::confess "Timed out waiting for subprocesses to start" if ! _files_exist(@files);
272 unlink $_ for @files;
273}
274
275sub _kill_tees {
276 my ($stash) = @_;
277 if ( $IS_WIN32 ) {
278 # _debug( "# closing handles\n");
279 close($_) for values %{ $stash->{tee} };
280 # _debug( "# waiting for subprocesses to finish\n");
281 my $start = time;
282 1 until wait == -1 || (time - $start > 30);
283 }
284 else {
285 _close $_ for values %{ $stash->{tee} };
286 waitpid $_, 0 for values %{ $stash->{pid} };
287 }
288}
289
290sub _slurp {
291 my ($name, $stash) = @_;
292 my ($fh, $pos) = map { $stash->{$_}{$name} } qw/capture pos/;
293 # _debug( "# slurping captured $name from " . fileno($fh) . " at pos $pos with layers: @{[PerlIO::get_layers($fh)]}\n");
294 seek( $fh, $pos, 0 ) or die "Couldn't seek on capture handle for $name\n";
295 my $text = do { local $/; scalar readline $fh };
296 return defined($text) ? $text : "";
297}
298
299#--------------------------------------------------------------------------#
300# _capture_tee() -- generic main sub for capturing or teeing
301#--------------------------------------------------------------------------#
302
303
# spent 53695s (20.9+53674) within Capture::Tiny::_capture_tee which was called 133035 times, avg 404ms/call: # 133035 times (20.9s+53674s) by main::__ANON__[split.pl:90] at line 1 of (eval 16)[Capture/Tiny.pm:38], avg 404ms/call
sub _capture_tee {
304 # _debug( "# starting _capture_tee with (@_)...\n" );
30513303566.7ms my ($do_stdout, $do_stderr, $do_merge, $do_tee, $code, @opts) = @_;
306133035153ms my %do = ($do_stdout ? (stdout => 1) : (), $do_stderr ? (stderr => 1) : ());
30713303593.6ms Carp::confess("Custom capture options must be given as key/value pairs\n")
308 unless @opts % 2 == 0;
309133035153ms my $stash = { capture => { @opts } };
310133035175ms for ( keys %{$stash->{capture}} ) {
311 my $fh = $stash->{capture}{$_};
312 Carp::confess "Custom handle for $_ must be seekable\n"
313 unless ref($fh) eq 'GLOB' || (blessed($fh) && $fh->isa("IO::Seekable"));
314 }
315 # save existing filehandles and setup captures
316133035320ms local *CT_ORIG_STDIN = *STDIN ;
31713303551.8ms local *CT_ORIG_STDOUT = *STDOUT;
318133035220ms local *CT_ORIG_STDERR = *STDERR;
319 # find initial layers
3201330351.80s399105471ms my %layers = (
# spent 471ms making 399105 calls to PerlIO::get_layers, avg 1µs/call
321 stdin => [PerlIO::get_layers(\*STDIN) ],
322 stdout => [PerlIO::get_layers(\*STDOUT, output => 1)],
323 stderr => [PerlIO::get_layers(\*STDERR, output => 1)],
324 );
325 # _debug( "# existing layers for $_\: @{$layers{$_}}\n" ) for qw/stdin stdout stderr/;
326 # get layers from underlying glob of tied filehandles if we can
327 # (this only works for things that work like Tie::StdHandle)
32813303551.5ms $layers{stdout} = [PerlIO::get_layers(tied *STDOUT)]
329 if tied(*STDOUT) && (reftype tied *STDOUT eq 'GLOB');
33013303534.2ms $layers{stderr} = [PerlIO::get_layers(tied *STDERR)]
331 if tied(*STDERR) && (reftype tied *STDERR eq 'GLOB');
332 # _debug( "# tied object corrected layers for $_\: @{$layers{$_}}\n" ) for qw/stdin stdout stderr/;
333 # bypass scalar filehandles and tied handles
334 # localize scalar STDIN to get a proxy to pick up FD0, then restore later to CT_ORIG_STDIN
33513303537.2ms my %localize;
336 $localize{stdin}++, local(*STDIN)
337133035180ms if grep { $_ eq 'scalar' } @{$layers{stdin}};
338 $localize{stdout}++, local(*STDOUT)
339133035118ms if $do_stdout && grep { $_ eq 'scalar' } @{$layers{stdout}};
340 $localize{stderr}++, local(*STDERR)
34113303547.1ms if ($do_stderr || $do_merge) && grep { $_ eq 'scalar' } @{$layers{stderr}};
34213303540.3ms $localize{stdin}++, local(*STDIN), _open( \*STDIN, "<&=0")
343 if tied *STDIN && $] >= 5.008;
34413303545.9ms $localize{stdout}++, local(*STDOUT), _open( \*STDOUT, ">&=1")
345 if $do_stdout && tied *STDOUT && $] >= 5.008;
34613303543.5ms $localize{stderr}++, local(*STDERR), _open( \*STDERR, ">&=2")
347 if ($do_stderr || $do_merge) && tied *STDERR && $] >= 5.008;
348 # _debug( "# localized $_\n" ) for keys %localize;
349 # proxy any closed/localized handles so we don't use fds 0, 1 or 2
350133035206ms133035553ms my %proxy_std = _proxy_std();
# spent 553ms making 133035 calls to Capture::Tiny::_proxy_std, avg 4µs/call
351 # _debug( "# proxy std: @{ [%proxy_std] }\n" );
352 # update layers after any proxying
35313303558.6ms $layers{stdout} = [PerlIO::get_layers(\*STDOUT, output => 1)] if $proxy_std{stdout};
35413303531.1ms $layers{stderr} = [PerlIO::get_layers(\*STDERR, output => 1)] if $proxy_std{stderr};
355 # _debug( "# post-proxy layers for $_\: @{$layers{$_}}\n" ) for qw/stdin stdout stderr/;
356 # store old handles and setup handles for capture
357133035217ms13303512.4s $stash->{old} = _copy_std();
# spent 12.4s making 133035 calls to Capture::Tiny::_copy_std, avg 93µs/call
358133035237ms $stash->{new} = { %{$stash->{old}} }; # default to originals
359133035132ms for ( keys %do ) {
3601330351.15s13303542.8s $stash->{new}{$_} = ($stash->{capture}{$_} ||= File::Temp->new);
# spent 42.8s making 133035 calls to File::Temp::new, avg 321µs/call
361133035718ms133035305ms seek( $stash->{capture}{$_}, 0, 2 ) or die "Could not seek on capture handle for $_\n";
# spent 305ms making 133035 calls to Capture::Tiny::CORE:seek, avg 2µs/call
362133035462ms13303536.9ms $stash->{pos}{$_} = tell $stash->{capture}{$_};
# spent 36.9ms making 133035 calls to Capture::Tiny::CORE:tell, avg 277ns/call
363 # _debug("# will capture $_ on " . fileno($stash->{capture}{$_})."\n" );
36413303571.3ms _start_tee( $_ => $stash ) if $do_tee; # tees may change $stash->{new}
365 }
36613303522.8ms _wait_for_tees( $stash ) if $do_tee;
367 # finalize redirection
36813303517.6ms $stash->{new}{stderr} = $stash->{new}{stdout} if $do_merge;
369 # _debug( "# redirecting in parent ...\n" );
370133035196ms1330354.95s _open_std( $stash->{new} );
# spent 4.95s making 133035 calls to Capture::Tiny::_open_std, avg 37µs/call
371 # execute user provided code
37213303533.5ms my ($exit_code, $inner_error, $outer_error, $orig_pid, @result);
373 {
374266070198ms $orig_pid = $$;
37513303535.7ms local *STDIN = *CT_ORIG_STDIN if $localize{stdin}; # get original, not proxy STDIN
376 # _debug( "# finalizing layers ...\n" );
377133035231ms1330353.15s _relayer(\*STDOUT, $layers{stdout}) if $do_stdout;
# spent 3.15s making 133035 calls to Capture::Tiny::_relayer, avg 24µs/call
37813303523.3ms _relayer(\*STDERR, $layers{stderr}) if $do_stderr;
379 # _debug( "# running code $code ...\n" );
38013303542.0ms my $old_eval_err=$@;
38113303543.4ms undef $@;
3823991051.20s13303553563s eval { @result = $code->(); $inner_error = $@ };
# spent 53563s making 133035 calls to main::__ANON__[split.pl:88], avg 403ms/call
38313303563.6ms $exit_code = $?; # save this for later
38413303526.0ms $outer_error = $@; # save this for later
3851330351.25s133035357ms STDOUT->flush if $do_stdout;
# spent 357ms making 133035 calls to IO::Handle::flush, avg 3µs/call
38613303527.8ms STDERR->flush if $do_stderr;
38713303566.5ms $@ = $old_eval_err;
388 }
389 # restore prior filehandles and shut down tees
390 # _debug( "# restoring filehandles ...\n" );
391133035687ms1330358.85s _open_std( $stash->{old} );
# spent 8.85s making 133035 calls to Capture::Tiny::_open_std, avg 67µs/call
392133035509ms2660702.18s _close( $_ ) for values %{$stash->{old}}; # don't leak fds
# spent 2.18s making 266070 calls to Capture::Tiny::_close, avg 8µs/call
393 # shouldn't need relayering originals, but see rt.perl.org #114404
394133035469ms1330354.12s _relayer(\*STDOUT, $layers{stdout}) if $do_stdout;
# spent 4.12s making 133035 calls to Capture::Tiny::_relayer, avg 31µs/call
39513303528.0ms _relayer(\*STDERR, $layers{stderr}) if $do_stderr;
396133035357ms133035479ms _unproxy( %proxy_std );
# spent 479ms making 133035 calls to Capture::Tiny::_unproxy, avg 4µs/call
397 # _debug( "# killing tee subprocesses ...\n" ) if $do_tee;
39813303525.7ms _kill_tees( $stash ) if $do_tee;
399 # return captured output, but shortcut in void context
400 # unless we have to echo output to tied/scalar handles;
401133035202ms my %got;
402133035256ms if ( $orig_pid == $$ and ( defined wantarray or ($do_tee && keys %localize) ) ) {
403 for ( keys %do ) {
404 _relayer($stash->{capture}{$_}, $layers{$_});
405 $got{$_} = _slurp($_, $stash);
406 # _debug("# slurped " . length($got{$_}) . " bytes from $_\n");
407 }
408 print CT_ORIG_STDOUT $got{stdout}
409 if $do_stdout && $do_tee && $localize{stdout};
410 print CT_ORIG_STDERR $got{stderr}
411 if $do_stderr && $do_tee && $localize{stderr};
412 }
41313303596.4ms $? = $exit_code;
41413303532.7ms $@ = $inner_error if $inner_error;
41513303516.2ms die $outer_error if $outer_error;
416 # _debug( "# ending _capture_tee with (@_)...\n" );
4171330356.95s13303530.3s return unless defined wantarray;
# spent 30.3s making 133035 calls to File::Temp::DESTROY, avg 228µs/call
418 my @return;
419 push @return, $got{stdout} if $do_stdout;
420 push @return, $got{stderr} if $do_stderr && ! $do_merge;
421 push @return, @result;
422 return wantarray ? @return : $return[0];
423}
424
425114µs1;
426
427__END__
 
# spent 1.23s within Capture::Tiny::CORE:binmode which was called 798210 times, avg 2µs/call: # 266070 times (604ms+0s) by Capture::Tiny::_relayer at line 97, avg 2µs/call # 266070 times (389ms+0s) by Capture::Tiny::_relayer at line 88, avg 1µs/call # 266070 times (234ms+0s) by Capture::Tiny::_relayer at line 90, avg 878ns/call
sub Capture::Tiny::CORE:binmode; # opcode
# spent 1.19s within Capture::Tiny::CORE:close which was called 266070 times, avg 4µs/call: # 266070 times (1.19s+0s) by Capture::Tiny::_close at line 113, avg 4µs/call
sub Capture::Tiny::CORE:close; # opcode
# spent 10.0s within Capture::Tiny::CORE:open which was called 798210 times, avg 13µs/call: # 798210 times (10.0s+0s) by Capture::Tiny::_open at line 107, avg 13µs/call
sub Capture::Tiny::CORE:open; # opcode
# spent 305ms within Capture::Tiny::CORE:seek which was called 133035 times, avg 2µs/call: # 133035 times (305ms+0s) by Capture::Tiny::_capture_tee at line 361, avg 2µs/call
sub Capture::Tiny::CORE:seek; # opcode
# spent 36.9ms within Capture::Tiny::CORE:tell which was called 133035 times, avg 277ns/call: # 133035 times (36.9ms+0s) by Capture::Tiny::_capture_tee at line 362, avg 277ns/call
sub Capture::Tiny::CORE:tell; # 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.