Acme-Throw
view release on metacpan or search on metacpan
t/lib/Capture/Tiny.pm view on Meta::CPAN
our $TIMEOUT = 30;
#--------------------------------------------------------------------------#
# command to tee output -- the argument is a filename that must
# be opened to signal that the process is ready to receive input.
# This is annoying, but seems to be the best that can be done
# as a simple, portable IPC technique
#--------------------------------------------------------------------------#
my @cmd = ($^X, '-C0', '-e', '$SIG{HUP}=sub{exit}; '
. 'if( my $fn=shift ){ open my $fh, qq{>$fn}; print {$fh} $$; close $fh;} '
. 'my $buf; while (sysread(STDIN, $buf, 2048)) { '
. 'syswrite(STDOUT, $buf); syswrite(STDERR, $buf)}'
);
#--------------------------------------------------------------------------#
# filehandle manipulation
#--------------------------------------------------------------------------#
sub _relayer {
my ($fh, $layers) = @_;
# _debug("# requested layers (@{$layers}) for @{[fileno $fh]}\n");
my %seen = ( unix => 1, perlio => 1 ); # filter these out
my @unique = grep { !$seen{$_}++ } @$layers;
# _debug("# applying unique layers (@unique) to @{[fileno $fh]}\n");
binmode($fh, join(":", ":raw", @unique));
}
sub _name {
my $glob = shift;
no strict 'refs'; ## no critic
return *{$glob}{NAME};
}
sub _open {
open $_[0], $_[1] or Carp::confess "Error from open(" . join(q{, }, @_) . "): $!";
# _debug( "# open " . join( ", " , map { defined $_ ? _name($_) : 'undef' } @_ ) . " as " . fileno( $_[0] ) . "\n" );
}
sub _close {
# _debug( "# closing " . ( defined $_[0] ? _name($_[0]) : 'undef' ) . " on " . fileno( $_[0] ) . "\n" );
close $_[0] or Carp::confess "Error from close(" . join(q{, }, @_) . "): $!";
}
my %dup; # cache this so STDIN stays fd0
my %proxy_count;
sub _proxy_std {
my %proxies;
if ( ! defined fileno STDIN ) {
$proxy_count{stdin}++;
if (defined $dup{stdin}) {
_open \*STDIN, "<&=" . fileno($dup{stdin});
# _debug( "# restored proxy STDIN as " . (defined fileno STDIN ? fileno STDIN : 'undef' ) . "\n" );
}
else {
_open \*STDIN, "<" . File::Spec->devnull;
# _debug( "# proxied STDIN as " . (defined fileno STDIN ? fileno STDIN : 'undef' ) . "\n" );
_open $dup{stdin} = IO::Handle->new, "<&=STDIN";
}
$proxies{stdin} = \*STDIN;
binmode(STDIN, ':utf8') if $] >= 5.008; ## no critic
}
if ( ! defined fileno STDOUT ) {
$proxy_count{stdout}++;
if (defined $dup{stdout}) {
_open \*STDOUT, ">&=" . fileno($dup{stdout});
# _debug( "# restored proxy STDOUT as " . (defined fileno STDOUT ? fileno STDOUT : 'undef' ) . "\n" );
}
else {
_open \*STDOUT, ">" . File::Spec->devnull;
# _debug( "# proxied STDOUT as " . (defined fileno STDOUT ? fileno STDOUT : 'undef' ) . "\n" );
_open $dup{stdout} = IO::Handle->new, ">&=STDOUT";
}
$proxies{stdout} = \*STDOUT;
binmode(STDOUT, ':utf8') if $] >= 5.008; ## no critic
}
if ( ! defined fileno STDERR ) {
$proxy_count{stderr}++;
if (defined $dup{stderr}) {
_open \*STDERR, ">&=" . fileno($dup{stderr});
# _debug( "# restored proxy STDERR as " . (defined fileno STDERR ? fileno STDERR : 'undef' ) . "\n" );
}
else {
_open \*STDERR, ">" . File::Spec->devnull;
# _debug( "# proxied STDERR as " . (defined fileno STDERR ? fileno STDERR : 'undef' ) . "\n" );
_open $dup{stderr} = IO::Handle->new, ">&=STDERR";
}
$proxies{stderr} = \*STDERR;
binmode(STDERR, ':utf8') if $] >= 5.008; ## no critic
}
return %proxies;
}
sub _unproxy {
my (%proxies) = @_;
# _debug( "# unproxying: " . join(" ", keys %proxies) . "\n" );
for my $p ( keys %proxies ) {
$proxy_count{$p}--;
# _debug( "# unproxied " . uc($p) . " ($proxy_count{$p} left)\n" );
if ( ! $proxy_count{$p} ) {
_close $proxies{$p};
_close $dup{$p} unless $] < 5.008; # 5.6 will have already closed this as dup
delete $dup{$p};
}
}
}
sub _copy_std {
my %handles;
for my $h ( qw/stdout stderr stdin/ ) {
next if $h eq 'stdin' && ! $IS_WIN32; # WIN32 hangs on tee without STDIN copied
my $redir = $h eq 'stdin' ? "<&" : ">&";
_open $handles{$h} = IO::Handle->new(), $redir . uc($h); # ">&STDOUT" or "<&STDIN"
}
return \%handles;
}
# In some cases we open all (prior to forking) and in others we only open
# the output handles (setting up redirection)
sub _open_std {
my ($handles) = @_;
_open \*STDIN, "<&" . fileno $handles->{stdin} if defined $handles->{stdin};
_open \*STDOUT, ">&" . fileno $handles->{stdout} if defined $handles->{stdout};
_open \*STDERR, ">&" . fileno $handles->{stderr} if defined $handles->{stderr};
}
#--------------------------------------------------------------------------#
# private subs
#--------------------------------------------------------------------------#
sub _start_tee {
my ($which, $stash) = @_; # $which is "stdout" or "stderr"
# setup pipes
$stash->{$_}{$which} = IO::Handle->new for qw/tee reader/;
pipe $stash->{reader}{$which}, $stash->{tee}{$which};
# _debug( "# pipe for $which\: " . _name($stash->{tee}{$which}) . " " . fileno( $stash->{tee}{$which} ) . " => " . _name($stash->{reader}{$which}) . " " . fileno( $stash->{reader}{$which}) . "\n" );
select((select($stash->{tee}{$which}), $|=1)[0]); # autoflush
# setup desired redirection for parent and child
$stash->{new}{$which} = $stash->{tee}{$which};
$stash->{child}{$which} = {
stdin => $stash->{reader}{$which},
stdout => $stash->{old}{$which},
stderr => $stash->{capture}{$which},
};
# flag file is used to signal the child is ready
$stash->{flag_files}{$which} = scalar tmpnam();
# execute @cmd as a separate process
if ( $IS_WIN32 ) {
local $@;
t/lib/Capture/Tiny.pm view on Meta::CPAN
The C<<< capture_merged >>> function works just like C<<< capture >>> except STDOUT and
STDERR are merged. (Technically, STDERR is redirected to the same capturing
handle as STDOUT before executing the function.)
Caution: STDOUT and STDERR output in the merged result are not guaranteed to be
properly ordered due to buffering.
=head2 tee
($stdout, $stderr, @result) = tee \&code;
$stdout = tee \&code;
The C<<< tee >>> function works just like C<<< capture >>>, except that output is captured
as well as passed on to the original STDOUT and STDERR.
When called in void context, C<<< tee >>> saves memory and time by
not reading back from the capture handles, except when the
original STDOUT OR STDERR were tied or opened to a scalar
handle.
=head2 tee_stdout
($stdout, @result) = tee_stdout \&code;
$stdout = tee_stdout \&code;
The C<<< tee_stdout >>> function works just like C<<< tee >>> except only
STDOUT is teed. STDERR is not teed (output goes to STDERR as usual).
=head2 tee_stderr
($stderr, @result) = tee_stderr \&code;
$stderr = tee_stderr \&code;
The C<<< tee_stderr >>> function works just like C<<< tee >>> except only
STDERR is teed. STDOUT is not teed (output goes to STDOUT as usual).
=head2 tee_merged
($merged, @result) = tee_merged \&code;
$merged = tee_merged \&code;
The C<<< tee_merged >>> function works just like C<<< capture_merged >>> except that output
is captured as well as passed on to STDOUT.
Caution: STDOUT and STDERR output in the merged result are not guaranteed to be
properly ordered due to buffering.
=head1 LIMITATIONS
=head2 Portability
Portability is a goal, not a guarantee. C<<< tee >>> requires fork, except on
Windows where C<<< system(1, @cmd) >>> is used instead. Not tested on any
particularly esoteric platforms yet. See the
L<CPAN Testers Matrix|http://matrix.cpantesters.org/?dist=Capture-Tiny>
for test result by platform.
=head2 PerlIO layers
Capture::Tiny does it's best to preserve PerlIO layers such as ':utf8' or
':crlf' when capturing (only for Perl 5.8.1+) . Layers should be applied to
STDOUT or STDERR I<before> the call to C<<< capture >>> or C<<< tee >>>. This may not work
for tied filehandles (see below).
=head2 Modifying filehandles before capturing
Generally speaking, you should do little or no manipulation of the standard IO
filehandles prior to using Capture::Tiny. In particular, closing, reopening,
localizing or tying standard filehandles prior to capture may cause a variety of
unexpected, undesirable andE<sol>or unreliable behaviors, as described below.
Capture::Tiny does its best to compensate for these situations, but the
results may not be what you desire.
B<Closed filehandles>
Capture::Tiny will work even if STDIN, STDOUT or STDERR have been previously
closed. However, since they will be reopened to capture or tee output, any
code within the captured block that depends on finding them closed will, of
course, not find them to be closed. If they started closed, Capture::Tiny will
close them again when the capture block finishes.
Note that this reopening will happen even for STDIN or a filehandle not being
captured to ensure that the filehandle used for capture is not opened to file
descriptor 0, as this causes problems on various platforms.
Prior to Perl 5.12, closed STDIN combined with PERL_UNICODE=D leaks filehandles
and also breaks tee() for undiagnosed reasons. So don't do that.
B<Localized filehandles>
If code localizes any of Perl's standard filehandles before capturing, the capture
will affect the localized filehandles and not the original ones. External system
calls are not affected by localizing a filehandle in Perl and will continue
to send output to the original filehandles (which will thus not be captured).
B<Scalar filehandles>
If STDOUT or STDERR are reopened to scalar filehandles prior to the call to
C<<< capture >>> or C<<< tee >>>, then Capture::Tiny will override the output filehandle for
the duration of the C<<< capture >>> or C<<< tee >>> call and then, for C<<< tee >>>, send captured
output to the output filehandle after the capture is complete. (Requires Perl
5.8)
Capture::Tiny attempts to preserve the semantics of STDIN opened to a scalar
reference, but note that external processes will not be able to read from such
a handle. Capture::Tiny tries to ensure that external processes will read from
the null device instead, but this is not guaranteed.
B<Tied output filehandles>
If STDOUT or STDERR are tied prior to the call to C<<< capture >>> or C<<< tee >>>, then
Capture::Tiny will attempt to override the tie for the duration of the
C<<< capture >>> or C<<< tee >>> call and then send captured output to the tied filehandle after
the capture is complete. (Requires Perl 5.8)
Capture::Tiny may not succeed resending UTF-8 encoded data to a tied
STDOUT or STDERR filehandle. Characters may appear as bytes. If the tied filehandle
is based on L<Tie::StdHandle>, then Capture::Tiny will attempt to determine
appropriate layers like C<<< :utf8 >>> from the underlying filehandle and do the right
thing.
B<Tied input filehandle>
Capture::Tiny attempts to preserve the semantics of tied STDIN, but this
requires Perl 5.8 and is not entirely predictable. External processes
will not be able to read from such a handle.
Unless having STDIN tied is crucial, it may be safest to localize STDIN when
capturing:
my ($out, $err) = do { local *STDIN; capture { ... } };
=head2 Modifying filehandles during a capture
Attempting to modify STDIN, STDOUT or STDERR I<during> C<<< capture >>> or C<<< tee >>> is
almost certainly going to cause problems. Don't do that.
=head2 No support for Perl 5.8.0
It's just too buggy when it comes to layers and UTF-8. Perl 5.8.1 or later
is recommended.
=head2 Limited support for Perl 5.6
Perl 5.6 predates PerlIO. UTF-8 data may not be captured correctly.
=head1 ENVIRONMENT
=head2 PERL_CAPTURE_TINY_TIMEOUT
Capture::Tiny uses subprocesses for C<<< tee >>>. By default, Capture::Tiny will
timeout with an error if the subprocesses are not ready to receive data within
30 seconds (or whatever is the value of C<<< $Capture::Tiny::TIMEOUT >>>). An
alternate timeout may be specified by setting the C<<< PERL_CAPTURE_TINY_TIMEOUT >>>
environment variable. Setting it to zero will disable timeouts.
=head1 SEE ALSO
This module was, inspired by L<IO::CaptureOutput>, which provides
similar functionality without the ability to tee output and with more
complicated code and API. L<IO::CaptureOutput> does not handle layers
or most of the unusual cases described in the L</Limitations> section and
I no longer recommend it.
There are many other CPAN modules that provide some sort of output capture,
albeit with various limitations that make them appropriate only in particular
circumstances. I'm probably missing some. The long list is provided to show
why I felt Capture::Tiny was necessary.
=over
=item *
L<IO::Capture>
=item *
L<IO::Capture::Extended>
( run in 1.328 second using v1.01-cache-2.11-cpan-8f98c5d2c55 )