1use 5.006; 2use strict; 3use warnings; 4package Capture::Tiny; 5# ABSTRACT: Capture STDOUT and STDERR from Perl, XS or external programs 6our $VERSION = '0.27'; 7use Carp (); 8use Exporter (); 9use IO::Handle (); 10use File::Spec (); 11use File::Temp qw/tempfile tmpnam/; 12use Scalar::Util qw/reftype blessed/; 13# Get PerlIO or fake it 14BEGIN { 15 local $@; 16 eval { require PerlIO; PerlIO->can('get_layers') } 17 or *PerlIO::get_layers = sub { return () }; 18} 19 20#--------------------------------------------------------------------------# 21# create API subroutines and export them 22# [do STDOUT flag, do STDERR flag, do merge flag, do tee flag] 23#--------------------------------------------------------------------------# 24 25my %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 36for my $sub ( keys %api ) { 37 my $args = join q{, }, @{$api{$sub}}; 38 eval "sub $sub(&;@) {unshift \@_, $args; goto \\&_capture_tee;}"; ## no critic 39} 40 41our @ISA = qw/Exporter/; 42our @EXPORT_OK = keys %api; 43our %EXPORT_TAGS = ( 'all' => \@EXPORT_OK ); 44 45#--------------------------------------------------------------------------# 46# constants and fixtures 47#--------------------------------------------------------------------------# 48 49my $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 58our $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#--------------------------------------------------------------------------# 66my @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 83sub _relayer { 84 my ($fh, $layers) = @_; 85 # _debug("# requested layers (@{$layers}) for @{[fileno $fh]}\n"); 86 my %seen = ( unix => 1, perlio => 1 ); # filter these out 87 my @unique = grep { !$seen{$_}++ } @$layers; 88 # _debug("# applying unique layers (@unique) to @{[fileno $fh]}\n"); 89 binmode($fh, join(":", ":raw", @unique)); 90} 91 92sub _name { 93 my $glob = shift; 94 no strict 'refs'; ## no critic 95 return *{$glob}{NAME}; 96} 97 98sub _open { 99 open $_[0], $_[1] or Carp::confess "Error from open(" . join(q{, }, @_) . "): $!"; 100 # _debug( "# open " . join( ", " , map { defined $_ ? _name($_) : 'undef' } @_ ) . " as " . fileno( $_[0] ) . "\n" ); 101} 102 103sub _close { 104 # _debug( "# closing " . ( defined $_[0] ? _name($_[0]) : 'undef' ) . " on " . fileno( $_[0] ) . "\n" ); 105 close $_[0] or Carp::confess "Error from close(" . join(q{, }, @_) . "): $!"; 106} 107 108my %dup; # cache this so STDIN stays fd0 109my %proxy_count; 110sub _proxy_std { 111 my %proxies; 112 if ( ! defined fileno STDIN ) { 113 $proxy_count{stdin}++; 114 if (defined $dup{stdin}) { 115 _open \*STDIN, "<&=" . fileno($dup{stdin}); 116 # _debug( "# restored proxy STDIN as " . (defined fileno STDIN ? fileno STDIN : 'undef' ) . "\n" ); 117 } 118 else { 119 _open \*STDIN, "<" . File::Spec->devnull; 120 # _debug( "# proxied STDIN as " . (defined fileno STDIN ? fileno STDIN : 'undef' ) . "\n" ); 121 _open $dup{stdin} = IO::Handle->new, "<&=STDIN"; 122 } 123 $proxies{stdin} = \*STDIN; 124 binmode(STDIN, ':utf8') if $] >= 5.008; ## no critic 125 } 126 if ( ! defined fileno STDOUT ) { 127 $proxy_count{stdout}++; 128 if (defined $dup{stdout}) { 129 _open \*STDOUT, ">&=" . fileno($dup{stdout}); 130 # _debug( "# restored proxy STDOUT as " . (defined fileno STDOUT ? fileno STDOUT : 'undef' ) . "\n" ); 131 } 132 else { 133 _open \*STDOUT, ">" . File::Spec->devnull; 134 # _debug( "# proxied STDOUT as " . (defined fileno STDOUT ? fileno STDOUT : 'undef' ) . "\n" ); 135 _open $dup{stdout} = IO::Handle->new, ">&=STDOUT"; 136 } 137 $proxies{stdout} = \*STDOUT; 138 binmode(STDOUT, ':utf8') if $] >= 5.008; ## no critic 139 } 140 if ( ! defined fileno STDERR ) { 141 $proxy_count{stderr}++; 142 if (defined $dup{stderr}) { 143 _open \*STDERR, ">&=" . fileno($dup{stderr}); 144 # _debug( "# restored proxy STDERR as " . (defined fileno STDERR ? fileno STDERR : 'undef' ) . "\n" ); 145 } 146 else { 147 _open \*STDERR, ">" . File::Spec->devnull; 148 # _debug( "# proxied STDERR as " . (defined fileno STDERR ? fileno STDERR : 'undef' ) . "\n" ); 149 _open $dup{stderr} = IO::Handle->new, ">&=STDERR"; 150 } 151 $proxies{stderr} = \*STDERR; 152 binmode(STDERR, ':utf8') if $] >= 5.008; ## no critic 153 } 154 return %proxies; 155} 156 157sub _unproxy { 158 my (%proxies) = @_; 159 # _debug( "# unproxying: " . join(" ", keys %proxies) . "\n" ); 160 for my $p ( keys %proxies ) { 161 $proxy_count{$p}--; 162 # _debug( "# unproxied " . uc($p) . " ($proxy_count{$p} left)\n" ); 163 if ( ! $proxy_count{$p} ) { 164 _close $proxies{$p}; 165 _close $dup{$p} unless $] < 5.008; # 5.6 will have already closed this as dup 166 delete $dup{$p}; 167 } 168 } 169} 170 171sub _copy_std { 172 my %handles; 173 for my $h ( qw/stdout stderr stdin/ ) { 174 next if $h eq 'stdin' && ! $IS_WIN32; # WIN32 hangs on tee without STDIN copied 175 my $redir = $h eq 'stdin' ? "<&" : ">&"; 176 _open $handles{$h} = IO::Handle->new(), $redir . uc($h); # ">&STDOUT" or "<&STDIN" 177 } 178 return \%handles; 179} 180 181# In some cases we open all (prior to forking) and in others we only open 182# the output handles (setting up redirection) 183sub _open_std { 184 my ($handles) = @_; 185 _open \*STDIN, "<&" . fileno $handles->{stdin} if defined $handles->{stdin}; 186 _open \*STDOUT, ">&" . fileno $handles->{stdout} if defined $handles->{stdout}; 187 _open \*STDERR, ">&" . fileno $handles->{stderr} if defined $handles->{stderr}; 188} 189 190#--------------------------------------------------------------------------# 191# private subs 192#--------------------------------------------------------------------------# 193 194sub _start_tee { 195 my ($which, $stash) = @_; # $which is "stdout" or "stderr" 196 # setup pipes 197 $stash->{$_}{$which} = IO::Handle->new for qw/tee reader/; 198 pipe $stash->{reader}{$which}, $stash->{tee}{$which}; 199 # _debug( "# pipe for $which\: " . _name($stash->{tee}{$which}) . " " . fileno( $stash->{tee}{$which} ) . " => " . _name($stash->{reader}{$which}) . " " . fileno( $stash->{reader}{$which}) . "\n" ); 200 select((select($stash->{tee}{$which}), $|=1)[0]); # autoflush 201 # setup desired redirection for parent and child 202 $stash->{new}{$which} = $stash->{tee}{$which}; 203 $stash->{child}{$which} = { 204 stdin => $stash->{reader}{$which}, 205 stdout => $stash->{old}{$which}, 206 stderr => $stash->{capture}{$which}, 207 }; 208 # flag file is used to signal the child is ready 209 $stash->{flag_files}{$which} = scalar tmpnam(); 210 # execute @cmd as a separate process 211 if ( $IS_WIN32 ) { 212 local $@; 213 eval "use Win32API::File qw/CloseHandle GetOsFHandle SetHandleInformation fileLastError HANDLE_FLAG_INHERIT INVALID_HANDLE_VALUE/ "; 214 # _debug( "# Win32API::File loaded\n") unless $@; 215 my $os_fhandle = GetOsFHandle( $stash->{tee}{$which} ); 216 # _debug( "# Couldn't get OS handle: " . fileLastError() . "\n") if ! defined $os_fhandle || $os_fhandle == INVALID_HANDLE_VALUE(); 217 my $result = SetHandleInformation( $os_fhandle, HANDLE_FLAG_INHERIT(), 0); 218 # _debug( $result ? "# set no-inherit flag on $which tee\n" : ("# can't disable tee handle flag inherit: " . fileLastError() . "\n")); 219 _open_std( $stash->{child}{$which} ); 220 $stash->{pid}{$which} = system(1, @cmd, $stash->{flag_files}{$which}); 221 # not restoring std here as it all gets redirected again shortly anyway 222 } 223 else { # use fork 224 _fork_exec( $which, $stash ); 225 } 226} 227 228sub _fork_exec { 229 my ($which, $stash) = @_; # $which is "stdout" or "stderr" 230 my $pid = fork; 231 if ( not defined $pid ) { 232 Carp::confess "Couldn't fork(): $!"; 233 } 234 elsif ($pid == 0) { # child 235 # _debug( "# in child process ...\n" ); 236 untie *STDIN; untie *STDOUT; untie *STDERR; 237 _close $stash->{tee}{$which}; 238 # _debug( "# redirecting handles in child ...\n" ); 239 _open_std( $stash->{child}{$which} ); 240 # _debug( "# calling exec on command ...\n" ); 241 exec @cmd, $stash->{flag_files}{$which}; 242 } 243 $stash->{pid}{$which} = $pid 244} 245 246my $have_usleep = eval "use Time::HiRes 'usleep'; 1"; 247sub _files_exist { 248 return 1 if @_ == grep { -f } @_; 249 Time::HiRes::usleep(1000) if $have_usleep; 250 return 0; 251} 252 253sub _wait_for_tees { 254 my ($stash) = @_; 255 my $start = time; 256 my @files = values %{$stash->{flag_files}}; 257 my $timeout = defined $ENV{PERL_CAPTURE_TINY_TIMEOUT} 258 ? $ENV{PERL_CAPTURE_TINY_TIMEOUT} : $TIMEOUT; 259 1 until _files_exist(@files) || ($timeout && (time - $start > $timeout)); 260 Carp::confess "Timed out waiting for subprocesses to start" if ! _files_exist(@files); 261 unlink $_ for @files; 262} 263 264sub _kill_tees { 265 my ($stash) = @_; 266 if ( $IS_WIN32 ) { 267 # _debug( "# closing handles with CloseHandle\n"); 268 CloseHandle( GetOsFHandle($_) ) for values %{ $stash->{tee} }; 269 # _debug( "# waiting for subprocesses to finish\n"); 270 my $start = time; 271 1 until wait == -1 || (time - $start > 30); 272 } 273 else { 274 _close $_ for values %{ $stash->{tee} }; 275 waitpid $_, 0 for values %{ $stash->{pid} }; 276 } 277} 278 279sub _slurp { 280 my ($name, $stash) = @_; 281 my ($fh, $pos) = map { $stash->{$_}{$name} } qw/capture pos/; 282 # _debug( "# slurping captured $name from " . fileno($fh) . " at pos $pos with layers: @{[PerlIO::get_layers($fh)]}\n"); 283 seek( $fh, $pos, 0 ) or die "Couldn't seek on capture handle for $name\n"; 284 my $text = do { local $/; scalar readline $fh }; 285 return defined($text) ? $text : ""; 286} 287 288#--------------------------------------------------------------------------# 289# _capture_tee() -- generic main sub for capturing or teeing 290#--------------------------------------------------------------------------# 291 292sub _capture_tee { 293 # _debug( "# starting _capture_tee with (@_)...\n" ); 294 my ($do_stdout, $do_stderr, $do_merge, $do_tee, $code, @opts) = @_; 295 my %do = ($do_stdout ? (stdout => 1) : (), $do_stderr ? (stderr => 1) : ()); 296 Carp::confess("Custom capture options must be given as key/value pairs\n") 297 unless @opts % 2 == 0; 298 my $stash = { capture => { @opts } }; 299 for ( keys %{$stash->{capture}} ) { 300 my $fh = $stash->{capture}{$_}; 301 Carp::confess "Custom handle for $_ must be seekable\n" 302 unless ref($fh) eq 'GLOB' || (blessed($fh) && $fh->isa("IO::Seekable")); 303 } 304 # save existing filehandles and setup captures 305 local *CT_ORIG_STDIN = *STDIN ; 306 local *CT_ORIG_STDOUT = *STDOUT; 307 local *CT_ORIG_STDERR = *STDERR; 308 # find initial layers 309 my %layers = ( 310 stdin => [PerlIO::get_layers(\*STDIN) ], 311 stdout => [PerlIO::get_layers(\*STDOUT, output => 1)], 312 stderr => [PerlIO::get_layers(\*STDERR, output => 1)], 313 ); 314 # _debug( "# existing layers for $_\: @{$layers{$_}}\n" ) for qw/stdin stdout stderr/; 315 # get layers from underlying glob of tied filehandles if we can 316 # (this only works for things that work like Tie::StdHandle) 317 $layers{stdout} = [PerlIO::get_layers(tied *STDOUT)] 318 if tied(*STDOUT) && (reftype tied *STDOUT eq 'GLOB'); 319 $layers{stderr} = [PerlIO::get_layers(tied *STDERR)] 320 if tied(*STDERR) && (reftype tied *STDERR eq 'GLOB'); 321 # _debug( "# tied object corrected layers for $_\: @{$layers{$_}}\n" ) for qw/stdin stdout stderr/; 322 # bypass scalar filehandles and tied handles 323 # localize scalar STDIN to get a proxy to pick up FD0, then restore later to CT_ORIG_STDIN 324 my %localize; 325 $localize{stdin}++, local(*STDIN) 326 if grep { $_ eq 'scalar' } @{$layers{stdin}}; 327 $localize{stdout}++, local(*STDOUT) 328 if $do_stdout && grep { $_ eq 'scalar' } @{$layers{stdout}}; 329 $localize{stderr}++, local(*STDERR) 330 if ($do_stderr || $do_merge) && grep { $_ eq 'scalar' } @{$layers{stderr}}; 331 $localize{stdin}++, local(*STDIN), _open( \*STDIN, "<&=0") 332 if tied *STDIN && $] >= 5.008; 333 $localize{stdout}++, local(*STDOUT), _open( \*STDOUT, ">&=1") 334 if $do_stdout && tied *STDOUT && $] >= 5.008; 335 $localize{stderr}++, local(*STDERR), _open( \*STDERR, ">&=2") 336 if ($do_stderr || $do_merge) && tied *STDERR && $] >= 5.008; 337 # _debug( "# localized $_\n" ) for keys %localize; 338 # proxy any closed/localized handles so we don't use fds 0, 1 or 2 339 my %proxy_std = _proxy_std(); 340 # _debug( "# proxy std: @{ [%proxy_std] }\n" ); 341 # update layers after any proxying 342 $layers{stdout} = [PerlIO::get_layers(\*STDOUT, output => 1)] if $proxy_std{stdout}; 343 $layers{stderr} = [PerlIO::get_layers(\*STDERR, output => 1)] if $proxy_std{stderr}; 344 # _debug( "# post-proxy layers for $_\: @{$layers{$_}}\n" ) for qw/stdin stdout stderr/; 345 # store old handles and setup handles for capture 346 $stash->{old} = _copy_std(); 347 $stash->{new} = { %{$stash->{old}} }; # default to originals 348 for ( keys %do ) { 349 $stash->{new}{$_} = ($stash->{capture}{$_} ||= File::Temp->new); 350 seek( $stash->{capture}{$_}, 0, 2 ) or die "Could not seek on capture handle for $_\n"; 351 $stash->{pos}{$_} = tell $stash->{capture}{$_}; 352 # _debug("# will capture $_ on " . fileno($stash->{capture}{$_})."\n" ); 353 _start_tee( $_ => $stash ) if $do_tee; # tees may change $stash->{new} 354 } 355 _wait_for_tees( $stash ) if $do_tee; 356 # finalize redirection 357 $stash->{new}{stderr} = $stash->{new}{stdout} if $do_merge; 358 # _debug( "# redirecting in parent ...\n" ); 359 _open_std( $stash->{new} ); 360 # execute user provided code 361 my ($exit_code, $inner_error, $outer_error, @result); 362 { 363 local *STDIN = *CT_ORIG_STDIN if $localize{stdin}; # get original, not proxy STDIN 364 # _debug( "# finalizing layers ...\n" ); 365 _relayer(\*STDOUT, $layers{stdout}) if $do_stdout; 366 _relayer(\*STDERR, $layers{stderr}) if $do_stderr; 367 # _debug( "# running code $code ...\n" ); 368 local $@; 369 eval { @result = $code->(); $inner_error = $@ }; 370 $exit_code = $?; # save this for later 371 $outer_error = $@; # save this for later 372 } 373 # restore prior filehandles and shut down tees 374 # _debug( "# restoring filehandles ...\n" ); 375 _open_std( $stash->{old} ); 376 _close( $_ ) for values %{$stash->{old}}; # don't leak fds 377 # shouldn't need relayering originals, but see rt.perl.org #114404 378 _relayer(\*STDOUT, $layers{stdout}) if $do_stdout; 379 _relayer(\*STDERR, $layers{stderr}) if $do_stderr; 380 _unproxy( %proxy_std ); 381 # _debug( "# killing tee subprocesses ...\n" ) if $do_tee; 382 _kill_tees( $stash ) if $do_tee; 383 # return captured output, but shortcut in void context 384 # unless we have to echo output to tied/scalar handles; 385 my %got; 386 if ( defined wantarray or ($do_tee && keys %localize) ) { 387 for ( keys %do ) { 388 _relayer($stash->{capture}{$_}, $layers{$_}); 389 $got{$_} = _slurp($_, $stash); 390 # _debug("# slurped " . length($got{$_}) . " bytes from $_\n"); 391 } 392 print CT_ORIG_STDOUT $got{stdout} 393 if $do_stdout && $do_tee && $localize{stdout}; 394 print CT_ORIG_STDERR $got{stderr} 395 if $do_stderr && $do_tee && $localize{stderr}; 396 } 397 $? = $exit_code; 398 $@ = $inner_error if $inner_error; 399 die $outer_error if $outer_error; 400 # _debug( "# ending _capture_tee with (@_)...\n" ); 401 return unless defined wantarray; 402 my @return; 403 push @return, $got{stdout} if $do_stdout; 404 push @return, $got{stderr} if $do_stderr && ! $do_merge; 405 push @return, @result; 406 return wantarray ? @return : $return[0]; 407} 408 4091; 410 411__END__ 412 413=pod 414 415=encoding UTF-8 416 417=head1 NAME 418 419Capture::Tiny - Capture STDOUT and STDERR from Perl, XS or external programs 420 421=head1 VERSION 422 423version 0.27 424 425=head1 SYNOPSIS 426 427 use Capture::Tiny ':all'; 428 429 # capture from external command 430 431 ($stdout, $stderr, $exit) = capture { 432 system( $cmd, @args ); 433 }; 434 435 # capture from arbitrary code (Perl or external) 436 437 ($stdout, $stderr, @result) = capture { 438 # your code here 439 }; 440 441 # capture partial or merged output 442 443 $stdout = capture_stdout { ... }; 444 $stderr = capture_stderr { ... }; 445 $merged = capture_merged { ... }; 446 447 # tee output 448 449 ($stdout, $stderr) = tee { 450 # your code here 451 }; 452 453 $stdout = tee_stdout { ... }; 454 $stderr = tee_stderr { ... }; 455 $merged = tee_merged { ... }; 456 457=head1 DESCRIPTION 458 459Capture::Tiny provides a simple, portable way to capture almost anything sent 460to STDOUT or STDERR, regardless of whether it comes from Perl, from XS code or 461from an external program. Optionally, output can be teed so that it is 462captured while being passed through to the original filehandles. Yes, it even 463works on Windows (usually). Stop guessing which of a dozen capturing modules 464to use in any particular situation and just use this one. 465 466=head1 USAGE 467 468The following functions are available. None are exported by default. 469 470=head2 capture 471 472 ($stdout, $stderr, @result) = capture \&code; 473 $stdout = capture \&code; 474 475The C<<< capture >>> function takes a code reference and returns what is sent to 476STDOUT and STDERR as well as any return values from the code reference. In 477scalar context, it returns only STDOUT. If no output was received for a 478filehandle, it returns an empty string for that filehandle. Regardless of calling 479context, all output is captured -- nothing is passed to the existing filehandles. 480 481It is prototyped to take a subroutine reference as an argument. Thus, it 482can be called in block form: 483 484 ($stdout, $stderr) = capture { 485 # your code here ... 486 }; 487 488Note that the coderef is evaluated in list context. If you wish to force 489scalar context on the return value, you must use the C<<< scalar >>> keyword. 490 491 ($stdout, $stderr, $count) = capture { 492 my @list = qw/one two three/; 493 return scalar @list; # $count will be 3 494 }; 495 496Also note that within the coderef, the C<<< @_ >>> variable will be empty. So don't 497use arguments from a surrounding subroutine without copying them to an array 498first: 499 500 sub wont_work { 501 my ($stdout, $stderr) = capture { do_stuff( @_ ) }; # WRONG 502 ... 503 } 504 505 sub will_work { 506 my @args = @_; 507 my ($stdout, $stderr) = capture { do_stuff( @args ) }; # RIGHT 508 ... 509 } 510 511Captures are normally done to an anonymous temporary filehandle. To 512capture via a named file (e.g. to externally monitor a long-running capture), 513provide custom filehandles as a trailing list of option pairs: 514 515 my $out_fh = IO::File->new("out.txt", "w+"); 516 my $err_fh = IO::File->new("out.txt", "w+"); 517 capture { ... } stdout => $out_fh, stderr => $err_fh; 518 519The filehandles must be readE<sol>write and seekable. Modifying the files or 520filehandles during a capture operation will give unpredictable results. 521Existing IO layers on them may be changed by the capture. 522 523When called in void context, C<<< capture >>> saves memory and time by 524not reading back from the capture handles. 525 526=head2 capture_stdout 527 528 ($stdout, @result) = capture_stdout \&code; 529 $stdout = capture_stdout \&code; 530 531The C<<< capture_stdout >>> function works just like C<<< capture >>> except only 532STDOUT is captured. STDERR is not captured. 533 534=head2 capture_stderr 535 536 ($stderr, @result) = capture_stderr \&code; 537 $stderr = capture_stderr \&code; 538 539The C<<< capture_stderr >>> function works just like C<<< capture >>> except only 540STDERR is captured. STDOUT is not captured. 541 542=head2 capture_merged 543 544 ($merged, @result) = capture_merged \&code; 545 $merged = capture_merged \&code; 546 547The C<<< capture_merged >>> function works just like C<<< capture >>> except STDOUT and 548STDERR are merged. (Technically, STDERR is redirected to the same capturing 549handle as STDOUT before executing the function.) 550 551Caution: STDOUT and STDERR output in the merged result are not guaranteed to be 552properly ordered due to buffering. 553 554=head2 tee 555 556 ($stdout, $stderr, @result) = tee \&code; 557 $stdout = tee \&code; 558 559The C<<< tee >>> function works just like C<<< capture >>>, except that output is captured 560as well as passed on to the original STDOUT and STDERR. 561 562When called in void context, C<<< tee >>> saves memory and time by 563not reading back from the capture handles, except when the 564original STDOUT OR STDERR were tied or opened to a scalar 565handle. 566 567=head2 tee_stdout 568 569 ($stdout, @result) = tee_stdout \&code; 570 $stdout = tee_stdout \&code; 571 572The C<<< tee_stdout >>> function works just like C<<< tee >>> except only 573STDOUT is teed. STDERR is not teed (output goes to STDERR as usual). 574 575=head2 tee_stderr 576 577 ($stderr, @result) = tee_stderr \&code; 578 $stderr = tee_stderr \&code; 579 580The C<<< tee_stderr >>> function works just like C<<< tee >>> except only 581STDERR is teed. STDOUT is not teed (output goes to STDOUT as usual). 582 583=head2 tee_merged 584 585 ($merged, @result) = tee_merged \&code; 586 $merged = tee_merged \&code; 587 588The C<<< tee_merged >>> function works just like C<<< capture_merged >>> except that output 589is captured as well as passed on to STDOUT. 590 591Caution: STDOUT and STDERR output in the merged result are not guaranteed to be 592properly ordered due to buffering. 593 594=head1 LIMITATIONS 595 596=head2 Portability 597 598Portability is a goal, not a guarantee. C<<< tee >>> requires fork, except on 599Windows where C<<< system(1, @cmd) >>> is used instead. Not tested on any 600particularly esoteric platforms yet. See the 601L<CPAN Testers Matrix|http://matrix.cpantesters.org/?dist=Capture-Tiny> 602for test result by platform. 603 604=head2 PerlIO layers 605 606Capture::Tiny does it's best to preserve PerlIO layers such as ':utf8' or 607':crlf' when capturing (only for Perl 5.8.1+) . Layers should be applied to 608STDOUT or STDERR I<before> the call to C<<< capture >>> or C<<< tee >>>. This may not work 609for tied filehandles (see below). 610 611=head2 Modifying filehandles before capturing 612 613Generally speaking, you should do little or no manipulation of the standard IO 614filehandles prior to using Capture::Tiny. In particular, closing, reopening, 615localizing or tying standard filehandles prior to capture may cause a variety of 616unexpected, undesirable andE<sol>or unreliable behaviors, as described below. 617Capture::Tiny does its best to compensate for these situations, but the 618results may not be what you desire. 619 620B<Closed filehandles> 621 622Capture::Tiny will work even if STDIN, STDOUT or STDERR have been previously 623closed. However, since they will be reopened to capture or tee output, any 624code within the captured block that depends on finding them closed will, of 625course, not find them to be closed. If they started closed, Capture::Tiny will 626close them again when the capture block finishes. 627 628Note that this reopening will happen even for STDIN or a filehandle not being 629captured to ensure that the filehandle used for capture is not opened to file 630descriptor 0, as this causes problems on various platforms. 631 632Prior to Perl 5.12, closed STDIN combined with PERL_UNICODE=D leaks filehandles 633and also breaks tee() for undiagnosed reasons. So don't do that. 634 635B<Localized filehandles> 636 637If code localizes any of Perl's standard filehandles before capturing, the capture 638will affect the localized filehandles and not the original ones. External system 639calls are not affected by localizing a filehandle in Perl and will continue 640to send output to the original filehandles (which will thus not be captured). 641 642B<Scalar filehandles> 643 644If STDOUT or STDERR are reopened to scalar filehandles prior to the call to 645C<<< capture >>> or C<<< tee >>>, then Capture::Tiny will override the output filehandle for 646the duration of the C<<< capture >>> or C<<< tee >>> call and then, for C<<< tee >>>, send captured 647output to the output filehandle after the capture is complete. (Requires Perl 6485.8) 649 650Capture::Tiny attempts to preserve the semantics of STDIN opened to a scalar 651reference, but note that external processes will not be able to read from such 652a handle. Capture::Tiny tries to ensure that external processes will read from 653the null device instead, but this is not guaranteed. 654 655B<Tied output filehandles> 656 657If STDOUT or STDERR are tied prior to the call to C<<< capture >>> or C<<< tee >>>, then 658Capture::Tiny will attempt to override the tie for the duration of the 659C<<< capture >>> or C<<< tee >>> call and then send captured output to the tied filehandle after 660the capture is complete. (Requires Perl 5.8) 661 662Capture::Tiny may not succeed resending UTF-8 encoded data to a tied 663STDOUT or STDERR filehandle. Characters may appear as bytes. If the tied filehandle 664is based on L<Tie::StdHandle>, then Capture::Tiny will attempt to determine 665appropriate layers like C<<< :utf8 >>> from the underlying filehandle and do the right 666thing. 667 668B<Tied input filehandle> 669 670Capture::Tiny attempts to preserve the semantics of tied STDIN, but this 671requires Perl 5.8 and is not entirely predictable. External processes 672will not be able to read from such a handle. 673 674Unless having STDIN tied is crucial, it may be safest to localize STDIN when 675capturing: 676 677 my ($out, $err) = do { local *STDIN; capture { ... } }; 678 679=head2 Modifying filehandles during a capture 680 681Attempting to modify STDIN, STDOUT or STDERR I<during> C<<< capture >>> or C<<< tee >>> is 682almost certainly going to cause problems. Don't do that. 683 684=head2 No support for Perl 5.8.0 685 686It's just too buggy when it comes to layers and UTF-8. Perl 5.8.1 or later 687is recommended. 688 689=head2 Limited support for Perl 5.6 690 691Perl 5.6 predates PerlIO. UTF-8 data may not be captured correctly. 692 693=head1 ENVIRONMENT 694 695=head2 PERL_CAPTURE_TINY_TIMEOUT 696 697Capture::Tiny uses subprocesses for C<<< tee >>>. By default, Capture::Tiny will 698timeout with an error if the subprocesses are not ready to receive data within 69930 seconds (or whatever is the value of C<<< $Capture::Tiny::TIMEOUT >>>). An 700alternate timeout may be specified by setting the C<<< PERL_CAPTURE_TINY_TIMEOUT >>> 701environment variable. Setting it to zero will disable timeouts. 702 703=head1 SEE ALSO 704 705This module was, inspired by L<IO::CaptureOutput>, which provides 706similar functionality without the ability to tee output and with more 707complicated code and API. L<IO::CaptureOutput> does not handle layers 708or most of the unusual cases described in the L</Limitations> section and 709I no longer recommend it. 710 711There are many other CPAN modules that provide some sort of output capture, 712albeit with various limitations that make them appropriate only in particular 713circumstances. I'm probably missing some. The long list is provided to show 714why I felt Capture::Tiny was necessary. 715 716=over 717 718=item * 719 720L<IO::Capture> 721 722=item * 723 724L<IO::Capture::Extended> 725 726=item * 727 728L<IO::CaptureOutput> 729 730=item * 731 732L<IPC::Capture> 733 734=item * 735 736L<IPC::Cmd> 737 738=item * 739 740L<IPC::Open2> 741 742=item * 743 744L<IPC::Open3> 745 746=item * 747 748L<IPC::Open3::Simple> 749 750=item * 751 752L<IPC::Open3::Utils> 753 754=item * 755 756L<IPC::Run> 757 758=item * 759 760L<IPC::Run::SafeHandles> 761 762=item * 763 764L<IPC::Run::Simple> 765 766=item * 767 768L<IPC::Run3> 769 770=item * 771 772L<IPC::System::Simple> 773 774=item * 775 776L<Tee> 777 778=item * 779 780L<IO::Tee> 781 782=item * 783 784L<File::Tee> 785 786=item * 787 788L<Filter::Handle> 789 790=item * 791 792L<Tie::STDERR> 793 794=item * 795 796L<Tie::STDOUT> 797 798=item * 799 800L<Test::Output> 801 802=back 803 804=for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan 805 806=head1 SUPPORT 807 808=head2 Bugs / Feature Requests 809 810Please report any bugs or feature requests through the issue tracker 811at L<https://github.com/dagolden/Capture-Tiny/issues>. 812You will be notified automatically of any progress on your issue. 813 814=head2 Source Code 815 816This is open source software. The code repository is available for 817public review and contribution under the terms of the license. 818 819L<https://github.com/dagolden/Capture-Tiny> 820 821 git clone https://github.com/dagolden/Capture-Tiny.git 822 823=head1 AUTHOR 824 825David Golden <dagolden@cpan.org> 826 827=head1 CONTRIBUTORS 828 829=for stopwords Dagfinn Ilmari Mannsåker David E. Wheeler 830 831=over 4 832 833=item * 834 835Dagfinn Ilmari Mannsåker <ilmari@ilmari.org> 836 837=item * 838 839David E. Wheeler <david@justatheory.com> 840 841=back 842 843=head1 COPYRIGHT AND LICENSE 844 845This software is Copyright (c) 2009 by David Golden. 846 847This is free software, licensed under: 848 849 The Apache License, Version 2.0, January 2004 850 851=cut 852