Commit f2935a6b505b33cfffec3da394c69e4e3aaea1f3 - libcapture-tiny-perl

Merge commit 'upstream/0.15' Alessandro Ghedini 12 years ago

10 changed file(s) with 117 addition(s) and 190 deletion(s). Raw diff Collapse all Expand all

+13

-0

Changes less more

0	0	Revision history for Capture-Tiny
	1
	2	0.15 2011-12-23 11:10:47 EST5EDT
	3
	4	Fixed:
	5
	6	- Repeated captures from a custom filehandle would return undef instead
	7	of the empty string (and would warn). This has been fixed.
	8	[rt.cpan.org #73374 part two. Thank you to Philipp Herz for help
	9	in reproducing this bug.]
	10
	11	Other:
	12
	13	- Commented out debugging code for slightly less runtime overhead
1	14
2	15	0.14 2011-12-22 10:14:09 EST5EDT
3	16

-132

~~DEBUG~~ less more

0		# starting _capture_tee with (1 1 0 0 CODE(0x18dea30) stdout IO::File=GLOB(0x14f4de8) stderr IO::File=GLOB(0x1509298))...
1		# existing layers for stdin: unix perlio
2		# existing layers for stdout: unix perlio
3		# existing layers for stderr: unix perlio
4		# tied object corrected layers for stdin: unix perlio
5		# tied object corrected layers for stdout: unix perlio
6		# tied object corrected layers for stderr: unix perlio
7		# proxy std:
8		# post-proxy layers for stdin: unix perlio
9		# post-proxy layers for stdout: unix perlio
10		# post-proxy layers for stderr: unix perlio
11		# copying std handles ...
12		# open GEN2, <&STDIN as 8
13		# open GEN3, >&STDOUT as 9
14		# open GEN4, >&STDERR as 10
15		# will capture stdout on 3
16		# will capture stderr on 5
17		# redirecting in parent ...
18		# open STDIN, <&8 as 0
19		# open STDOUT, >&3 as 1
20		# open STDERR, >&5 as 2
21		# finalizing layers ...
22		# requested layers (unix perlio) for 1
23		# applying unique layers () to 1
24		# requested layers (unix perlio) for 2
25		# applying unique layers () to 2
26		# running code CODE(0x18dea30) ...
27		# restoring filehandles ...
28		# open STDIN, <&8 as 0
29		# open STDOUT, >&9 as 1
30		# open STDERR, >&10 as 2
31		# closed GEN2
32		# closed GEN4
33		# closed GEN3
34		# unproxing
35		# requested layers (unix perlio) for 3
36		# applying unique layers () to 3
37		# requested layers (unix perlio) for 5
38		# applying unique layers () to 5
39		# slurping captured stdout from 0 with layers: unix perlio
40		# slurping captured stderr from 0 with layers: unix perlio
41		# slurped 4 bytes from stdout
42		# slurped 4 bytes from stderr
43		# ending _capture_tee with (1 1 0 0 CODE(0x18dea30) stdout IO::File=GLOB(0x14f4de8) stderr IO::File=GLOB(0x1509298))...
44		# starting _capture_tee with (1 1 0 0 CODE(0x18e9808) stdout IO::File=GLOB(0x14f4de8) stderr IO::File=GLOB(0x1509298))...
45		# existing layers for stdin: unix perlio
46		# existing layers for stdout: unix perlio
47		# existing layers for stderr: unix perlio
48		# tied object corrected layers for stdin: unix perlio
49		# tied object corrected layers for stdout: unix perlio
50		# tied object corrected layers for stderr: unix perlio
51		# proxy std:
52		# post-proxy layers for stdin: unix perlio
53		# post-proxy layers for stdout: unix perlio
54		# post-proxy layers for stderr: unix perlio
55		# copying std handles ...
56		# open GEN5, <&STDIN as 9
57		# open GEN6, >&STDOUT as 10
58		# open GEN7, >&STDERR as 11
59		# will capture stdout on 5
60		# will capture stderr on 8
61		# redirecting in parent ...
62		# open STDIN, <&9 as 0
63		# open STDOUT, >&5 as 1
64		# open STDERR, >&8 as 2
65		# finalizing layers ...
66		# requested layers (unix perlio) for 1
67		# applying unique layers () to 1
68		# requested layers (unix perlio) for 2
69		# applying unique layers () to 2
70		# running code CODE(0x18e9808) ...
71		# restoring filehandles ...
72		# open STDIN, <&9 as 0
73		# open STDOUT, >&10 as 1
74		# open STDERR, >&11 as 2
75		# closed GEN5
76		# closed GEN7
77		# closed GEN6
78		# unproxing
79		# requested layers (unix perlio) for 5
80		# applying unique layers () to 5
81		# requested layers (unix perlio) for 8
82		# applying unique layers () to 8
83		# slurping captured stdout from 0 with layers: unix perlio
84		# slurping captured stderr from 0 with layers: unix perlio
85		# slurped 4 bytes from stdout
86		# slurped 4 bytes from stderr
87		# ending _capture_tee with (1 1 0 0 CODE(0x18e9808) stdout IO::File=GLOB(0x14f4de8) stderr IO::File=GLOB(0x1509298))...
88		# starting _capture_tee with (1 1 0 0 CODE(0x191d910) stdout IO::File=GLOB(0x191e7c8) stderr IO::File=GLOB(0x191dc88))...
89		# existing layers for stdin: unix perlio
90		# existing layers for stdout: unix perlio
91		# existing layers for stderr: unix perlio
92		# tied object corrected layers for stdin: unix perlio
93		# tied object corrected layers for stdout: unix perlio
94		# tied object corrected layers for stderr: unix perlio
95		# proxy std:
96		# post-proxy layers for stdin: unix perlio
97		# post-proxy layers for stdout: unix perlio
98		# post-proxy layers for stderr: unix perlio
99		# copying std handles ...
100		# open GEN10, <&STDIN as 9
101		# open GEN11, >&STDOUT as 10
102		# open GEN12, >&STDERR as 11
103		# will capture stdout on 5
104		# will capture stderr on 8
105		# redirecting in parent ...
106		# open STDIN, <&9 as 0
107		# open STDOUT, >&5 as 1
108		# open STDERR, >&8 as 2
109		# finalizing layers ...
110		# requested layers (unix perlio) for 1
111		# applying unique layers () to 1
112		# requested layers (unix perlio) for 2
113		# applying unique layers () to 2
114		# running code CODE(0x191d910) ...
115		# restoring filehandles ...
116		# open STDIN, <&9 as 0
117		# open STDOUT, >&10 as 1
118		# open STDERR, >&11 as 2
119		# closed GEN10
120		# closed GEN12
121		# closed GEN11
122		# unproxing
123		# requested layers (unix perlio) for 5
124		# applying unique layers () to 5
125		# requested layers (unix perlio) for 8
126		# applying unique layers () to 8
127		# slurping captured stdout from 30 with layers: unix perlio
128		# slurping captured stderr from 30 with layers: unix perlio
129		# slurped 4 bytes from stdout
130		# slurped 4 bytes from stderr
131		# ending _capture_tee with (1 1 0 0 CODE(0x191d910) stdout IO::File=GLOB(0x191e7c8) stderr IO::File=GLOB(0x191dc88))...

-1

MANIFEST less more

0	0	Changes
1		DEBUG
2	1	LICENSE
3	2	MANIFEST
4	3	META.json

-2

META.json less more

54	54	"provides" : {
55	55	"Capture::Tiny" : {
56	56	"file" : "lib/Capture/Tiny.pm",
57		"version" : "0.14"
	57	"version" : "0.15"
58	58	}
59	59	},
60	60	"release_status" : "stable",

70	70	"web" : "https://github.com/dagolden/capture-tiny"
71	71	}
72	72	},
73		"version" : "0.14"
	73	"version" : "0.15"
74	74	}
75	75

-2

META.yml less more

26	26	provides:
27	27	Capture::Tiny:
28	28	file: lib/Capture/Tiny.pm
29		version: 0.14
	29	version: 0.15
30	30	requires:
31	31	Carp: 0
32	32	Exporter: 0

41	41	bugtracker: http://rt.cpan.org/Public/Dist/Display.html?Name=Capture-Tiny
42	42	homepage: https://github.com/dagolden/capture-tiny
43	43	repository: https://github.com/dagolden/capture-tiny.git
44		version: 0.14
	44	version: 0.15

-1

Makefile.PL less more

33	33	"strict" => 0,
34	34	"warnings" => 0
35	35	},
36		"VERSION" => "0.14",
	36	"VERSION" => "0.15",
37	37	"test" => {
38	38	"TESTS" => "t/*.t"
39	39	}

-1

README less more

2	2	programs
3	3
4	4	VERSION
5		version 0.14
	5	version 0.15
6	6
7	7	SYNOPSIS
8	8	use Capture::Tiny ':all';

+52

-50

lib/Capture/Tiny.pm less more

2	2	use warnings;
3	3	package Capture::Tiny;
4	4	# ABSTRACT: Capture STDOUT and STDERR from Perl, XS or external programs
5		our $VERSION = '0.14'; # VERSION
	5	our $VERSION = '0.15'; # VERSION
6	6	use Carp ();
7	7	use Exporter ();
8	8	use IO::Handle ();

47	47
48	48	my $IS_WIN32 = $^O eq 'MSWin32';
49	49
50		our $DEBUG = $ENV{PERL_CAPTURE_TINY_DEBUG};
51
52		my $DEBUGFH;
53		open $DEBUGFH, "> DEBUG" if $DEBUG;
54
55		*_debug = $DEBUG ? sub(@) { print {$DEBUGFH} @_ } : sub(){0};
	50	#our $DEBUG = $ENV{PERL_CAPTURE_TINY_DEBUG};
	51	#
	52	#my $DEBUGFH;
	53	#open $DEBUGFH, "> DEBUG" if $DEBUG;
	54	#
	55	#*_debug = $DEBUG ? sub(@) { print {$DEBUGFH} @_ } : sub(){0};
56	56
57	57	our $TIMEOUT = 30;
58	58

74	74
75	75	sub _relayer {
76	76	my ($fh, $layers) = @_;
77		_debug("# requested layers (@{$layers}) for @{[fileno $fh]}\n");
	77	# _debug("# requested layers (@{$layers}) for @{[fileno $fh]}\n");
78	78	my %seen = ( unix => 1, perlio => 1 ); # filter these out
79	79	my @unique = grep { !$seen{$_}++ } @$layers;
80		_debug("# applying unique layers (@unique) to @{[fileno $fh]}\n");
	80	# _debug("# applying unique layers (@unique) to @{[fileno $fh]}\n");
81	81	binmode($fh, join(":", ":raw", @unique));
82	82	}
83	83

89	89
90	90	sub _open {
91	91	open $_[0], $_[1] or Carp::confess "Error from open(" . join(q{, }, @_) . "): $!";
92		_debug( "# open " . join( ", " , map { defined $_ ? _name($_) : 'undef' } @_ ) . " as " . fileno( $_[0] ) . "\n" );
	92	# _debug( "# open " . join( ", " , map { defined $_ ? _name($_) : 'undef' } @_ ) . " as " . fileno( $_[0] ) . "\n" );
93	93	}
94	94
95	95	sub _close {
96	96	close $_[0] or Carp::confess "Error from close(" . join(q{, }, @_) . "): $!";
97		_debug( "# closed " . ( defined $_[0] ? _name($_[0]) : 'undef' ) . "\n" );
	97	# _debug( "# closed " . ( defined $_[0] ? _name($_[0]) : 'undef' ) . "\n" );
98	98	}
99	99
100	100	my %dup; # cache this so STDIN stays fd0

105	105	$proxy_count{stdin}++;
106	106	if (defined $dup{stdin}) {
107	107	_open \*STDIN, "<&=" . fileno($dup{stdin});
108		_debug( "# restored proxy STDIN as " . (defined fileno STDIN ? fileno STDIN : 'undef' ) . "\n" );
	108	# _debug( "# restored proxy STDIN as " . (defined fileno STDIN ? fileno STDIN : 'undef' ) . "\n" );
109	109	}
110	110	else {
111	111	_open \*STDIN, "<" . File::Spec->devnull;
112		_debug( "# proxied STDIN as " . (defined fileno STDIN ? fileno STDIN : 'undef' ) . "\n" );
	112	# _debug( "# proxied STDIN as " . (defined fileno STDIN ? fileno STDIN : 'undef' ) . "\n" );
113	113	_open $dup{stdin} = IO::Handle->new, "<&=STDIN";
114	114	}
115	115	$proxies{stdin} = \*STDIN;

119	119	$proxy_count{stdout}++;
120	120	if (defined $dup{stdout}) {
121	121	_open \*STDOUT, ">&=" . fileno($dup{stdout});
122		_debug( "# restored proxy STDOUT as " . (defined fileno STDOUT ? fileno STDOUT : 'undef' ) . "\n" );
	122	# _debug( "# restored proxy STDOUT as " . (defined fileno STDOUT ? fileno STDOUT : 'undef' ) . "\n" );
123	123	}
124	124	else {
125	125	_open \*STDOUT, ">" . File::Spec->devnull;
126		_debug( "# proxied STDOUT as " . (defined fileno STDOUT ? fileno STDOUT : 'undef' ) . "\n" );
	126	# _debug( "# proxied STDOUT as " . (defined fileno STDOUT ? fileno STDOUT : 'undef' ) . "\n" );
127	127	_open $dup{stdout} = IO::Handle->new, ">&=STDOUT";
128	128	}
129	129	$proxies{stdout} = \*STDOUT;

133	133	$proxy_count{stderr}++;
134	134	if (defined $dup{stderr}) {
135	135	_open \*STDERR, ">&=" . fileno($dup{stderr});
136		_debug( "# restored proxy STDERR as " . (defined fileno STDERR ? fileno STDERR : 'undef' ) . "\n" );
	136	# _debug( "# restored proxy STDERR as " . (defined fileno STDERR ? fileno STDERR : 'undef' ) . "\n" );
137	137	}
138	138	else {
139	139	_open \*STDERR, ">" . File::Spec->devnull;
140		_debug( "# proxied STDERR as " . (defined fileno STDERR ? fileno STDERR : 'undef' ) . "\n" );
	140	# _debug( "# proxied STDERR as " . (defined fileno STDERR ? fileno STDERR : 'undef' ) . "\n" );
141	141	_open $dup{stderr} = IO::Handle->new, ">&=STDERR";
142	142	}
143	143	$proxies{stderr} = \*STDERR;

148	148
149	149	sub _unproxy {
150	150	my (%proxies) = @_;
151		_debug( "# unproxing " . join(" ", keys %proxies) . "\n" );
	151	# _debug( "# unproxing " . join(" ", keys %proxies) . "\n" );
152	152	for my $p ( keys %proxies ) {
153	153	$proxy_count{$p}--;
154		_debug( "# unproxied " . uc($p) . " ($proxy_count{$p} left)\n" );
	154	# _debug( "# unproxied " . uc($p) . " ($proxy_count{$p} left)\n" );
155	155	if ( ! $proxy_count{$p} ) {
156	156	_close $proxies{$p};
157	157	_close $dup{$p} unless $] < 5.008; # 5.6 will have already closed this as dup

162	162
163	163	sub _copy_std {
164	164	my %handles = map { $_, IO::Handle->new } qw/stdin stdout stderr/;
165		_debug( "# copying std handles ...\n" );
	165	# _debug( "# copying std handles ...\n" );
166	166	_open $handles{stdin}, "<&STDIN";
167	167	_open $handles{stdout}, ">&STDOUT";
168	168	_open $handles{stderr}, ">&STDERR";

185	185	# setup pipes
186	186	$stash->{$_}{$which} = IO::Handle->new for qw/tee reader/;
187	187	pipe $stash->{reader}{$which}, $stash->{tee}{$which};
188		_debug( "# pipe for $which\: " . _name($stash->{tee}{$which}) . " "
189		. fileno( $stash->{tee}{$which} ) . " => " . _name($stash->{reader}{$which})
190		. " " . fileno( $stash->{reader}{$which}) . "\n" );
	188	# _debug( "# pipe for $which\: " . _name($stash->{tee}{$which}) . " "
	189	# . fileno( $stash->{tee}{$which} ) . " => " . _name($stash->{reader}{$which})
	190	# . " " . fileno( $stash->{reader}{$which}) . "\n" );
191	191	select((select($stash->{tee}{$which}), $\|=1)[0]); # autoflush
192	192	# setup desired redirection for parent and child
193	193	$stash->{new}{$which} = $stash->{tee}{$which};

202	202	if ( $IS_WIN32 ) {
203	203	local $@;
204	204	eval "use Win32API::File qw/CloseHandle GetOsFHandle SetHandleInformation fileLastError HANDLE_FLAG_INHERIT INVALID_HANDLE_VALUE/ ";
205		_debug( "# Win32API::File loaded\n") unless $@;
	205	# _debug( "# Win32API::File loaded\n") unless $@;
206	206	my $os_fhandle = GetOsFHandle( $stash->{tee}{$which} );
207		_debug( "# Couldn't get OS handle: " . fileLastError() . "\n") if ! defined $os_fhandle \|\| $os_fhandle == INVALID_HANDLE_VALUE();
	207	# _debug( "# Couldn't get OS handle: " . fileLastError() . "\n") if ! defined $os_fhandle \|\| $os_fhandle == INVALID_HANDLE_VALUE();
208	208	if ( SetHandleInformation( $os_fhandle, HANDLE_FLAG_INHERIT(), 0) ) {
209		_debug( "# set no-inherit flag on $which tee\n" );
	209	# _debug( "# set no-inherit flag on $which tee\n" );
210	210	}
211	211	else {
212		_debug( "# can't disable tee handle flag inherit: " . fileLastError() . "\n");
	212	# _debug( "# can't disable tee handle flag inherit: " . fileLastError() . "\n");
213	213	}
214	214	_open_std( $stash->{child}{$which} );
215	215	$stash->{pid}{$which} = system(1, @cmd, $stash->{flag_files}{$which});

227	227	Carp::confess "Couldn't fork(): $!";
228	228	}
229	229	elsif ($pid == 0) { # child
230		_debug( "# in child process ...\n" );
	230	# _debug( "# in child process ...\n" );
231	231	untie STDIN; untie STDOUT; untie *STDERR;
232	232	_close $stash->{tee}{$which};
233		_debug( "# redirecting handles in child ...\n" );
	233	# _debug( "# redirecting handles in child ...\n" );
234	234	_open_std( $stash->{child}{$which} );
235		_debug( "# calling exec on command ...\n" );
	235	# _debug( "# calling exec on command ...\n" );
236	236	exec @cmd, $stash->{flag_files}{$which};
237	237	}
238	238	$stash->{pid}{$which} = $pid

259	259	sub _kill_tees {
260	260	my ($stash) = @_;
261	261	if ( $IS_WIN32 ) {
262		_debug( "# closing handles with CloseHandle\n");
	262	# _debug( "# closing handles with CloseHandle\n");
263	263	CloseHandle( GetOsFHandle($_) ) for values %{ $stash->{tee} };
264		_debug( "# waiting for subprocesses to finish\n");
	264	# _debug( "# waiting for subprocesses to finish\n");
265	265	my $start = time;
266	266	1 until wait == -1 \|\| (time - $start > 30);
267	267	}

274	274	sub _slurp {
275	275	my ($name, $stash) = @_;
276	276	my ($fh, $pos) = map { $stash->{$_}{$name} } qw/capture pos/;
277		_debug( "# slurping captured $name from $pos with layers: @{[PerlIO::get_layers($fh)]}\n");
278		return do { local $/; seek $fh,$pos,0; scalar readline $fh };
	277	# _debug( "# slurping captured $name from $pos with layers: @{[PerlIO::get_layers($fh)]}\n");
	278	seek( $fh, $pos, 0 ) or die "Couldn't seek on capture handle for $name\n";
	279	my $text = do { local $/; scalar readline $fh };
	280	return defined($text) ? $text : "";
279	281	}
280	282
281	283	#--------------------------------------------------------------------------#

283	285	#--------------------------------------------------------------------------#
284	286
285	287	sub _capture_tee {
286		_debug( "# starting _capture_tee with (@_)...\n" );
	288	# _debug( "# starting _capture_tee with (@_)...\n" );
287	289	my ($do_stdout, $do_stderr, $do_merge, $do_tee, $code, @opts) = @_;
288	290	my %do = ($do_stdout ? (stdout => 1) : (), $do_stderr ? (stderr => 1) : ());
289	291	Carp::confess("Custom capture options must be given as key/value pairs\n")

304	306	stdout => [PerlIO::get_layers(\*STDOUT)],
305	307	stderr => [PerlIO::get_layers(\*STDERR)],
306	308	);
307		_debug( "# existing layers for $_\: @{$layers{$_}}\n" ) for qw/stdin stdout stderr/;
	309	# _debug( "# existing layers for $_\: @{$layers{$_}}\n" ) for qw/stdin stdout stderr/;
308	310	# get layers from underlying glob of tied filehandles if we can
309	311	# (this only works for things that work like Tie::StdHandle)
310	312	$layers{stdout} = [PerlIO::get_layers(tied *STDOUT)]
311	313	if tied(STDOUT) && (reftype tied STDOUT eq 'GLOB');
312	314	$layers{stderr} = [PerlIO::get_layers(tied *STDERR)]
313	315	if tied(STDERR) && (reftype tied STDERR eq 'GLOB');
314		_debug( "# tied object corrected layers for $_\: @{$layers{$_}}\n" ) for qw/stdin stdout stderr/;
	316	# _debug( "# tied object corrected layers for $_\: @{$layers{$_}}\n" ) for qw/stdin stdout stderr/;
315	317	# bypass scalar filehandles and tied handles
316	318	my %localize;
317	319	$localize{stdin}++, local(*STDIN)

324	326	if $do_stdout && tied *STDOUT && $] >= 5.008;
325	327	$localize{stderr}++, local(STDERR), _open( \STDERR, ">&=2")
326	328	if ($do_stderr \|\| $do_merge) && tied *STDERR && $] >= 5.008;
327		_debug( "# localized $_\n" ) for keys %localize;
	329	# _debug( "# localized $_\n" ) for keys %localize;
328	330	# proxy any closed/localized handles so we don't use fds 0, 1 or 2
329	331	my %proxy_std = _proxy_std();
330		_debug( "# proxy std: @{ [%proxy_std] }\n" );
	332	# _debug( "# proxy std: @{ [%proxy_std] }\n" );
331	333	# update layers after any proxying
332	334	$layers{stdin} = [PerlIO::get_layers(\*STDIN)] if $proxy_std{stdin};
333	335	$layers{stdout} = [PerlIO::get_layers(\*STDOUT)] if $proxy_std{stdout};
334	336	$layers{stderr} = [PerlIO::get_layers(\*STDERR)] if $proxy_std{stderr};
335		_debug( "# post-proxy layers for $_\: @{$layers{$_}}\n" ) for qw/stdin stdout stderr/;
	337	# _debug( "# post-proxy layers for $_\: @{$layers{$_}}\n" ) for qw/stdin stdout stderr/;
336	338	# store old handles and setup handles for capture
337	339	$stash->{old} = _copy_std();
338	340	$stash->{new} = { %{$stash->{old}} }; # default to originals
339	341	for ( keys %do ) {
340	342	$stash->{new}{$_} = ($stash->{capture}{$_} \|\|= File::Temp->new);
341		seek $stash->{capture}{$_}, 0, 2;
	343	seek( $stash->{capture}{$_}, 0, 2 ) or die "Could not seek on capture handle for $_\n";
342	344	$stash->{pos}{$_} = tell $stash->{capture}{$_};
343		_debug("# will capture $_ on " . fileno($stash->{capture}{$_})."\n" );
	345	# _debug("# will capture $_ on " . fileno($stash->{capture}{$_})."\n" );
344	346	_start_tee( $_ => $stash ) if $do_tee; # tees may change $stash->{new}
345	347	}
346	348	_wait_for_tees( $stash ) if $do_tee;
347	349	# finalize redirection
348	350	$stash->{new}{stderr} = $stash->{new}{stdout} if $do_merge;
349		_debug( "# redirecting in parent ...\n" );
	351	# _debug( "# redirecting in parent ...\n" );
350	352	_open_std( $stash->{new} );
351	353	# execute user provided code
352	354	my ($exit_code, $inner_error, $outer_error, @result);
353	355	{
354	356	local STDIN = CT_ORIG_STDIN if $localize{stdin}; # get original, not proxy STDIN
355	357	local STDERR = STDOUT if $do_merge; # minimize buffer mixups during $code
356		_debug( "# finalizing layers ...\n" );
	358	# _debug( "# finalizing layers ...\n" );
357	359	_relayer(\*STDOUT, $layers{stdout}) if $do_stdout;
358	360	_relayer(\*STDERR, $layers{stderr}) if $do_stderr;
359		_debug( "# running code $code ...\n" );
	361	# _debug( "# running code $code ...\n" );
360	362	local $@;
361	363	eval { @result = $code->(); $inner_error = $@ };
362	364	$exit_code = $?; # save this for later
363	365	$outer_error = $@; # save this for later
364	366	}
365	367	# restore prior filehandles and shut down tees
366		_debug( "# restoring filehandles ...\n" );
	368	# _debug( "# restoring filehandles ...\n" );
367	369	_open_std( $stash->{old} );
368	370	_close( $_ ) for values %{$stash->{old}}; # don't leak fds
369	371	_unproxy( %proxy_std );
370		_debug( "# killing tee subprocesses ...\n" ) if $do_tee;
	372	# _debug( "# killing tee subprocesses ...\n" ) if $do_tee;
371	373	_kill_tees( $stash ) if $do_tee;
372	374	# return captured output
373	375	my %got;
374	376	for ( keys %do ) {
375	377	_relayer($stash->{capture}{$_}, $layers{$_});
376	378	$got{$_} = _slurp($_, $stash);
377		_debug("# slurped " . length($got{$_}) . " bytes from $_\n");
	379	# _debug("# slurped " . length($got{$_}) . " bytes from $_\n");
378	380	}
379	381	print CT_ORIG_STDOUT $got{stdout}
380	382	if $do_stdout && $do_tee && $localize{stdout};

383	385	$? = $exit_code;
384	386	$@ = $inner_error if $inner_error;
385	387	die $outer_error if $outer_error;
386		_debug( "# ending _capture_tee with (@_)...\n" );
	388	# _debug( "# ending _capture_tee with (@_)...\n" );
387	389	my @return;
388	390	push @return, $got{stdout} if $do_stdout;
389	391	push @return, $got{stderr} if $do_stderr;

403	405
404	406	=head1 VERSION
405	407
406		version 0.14
	408	version 0.15
407	409
408	410	=head1 SYNOPSIS
409	411

+38

-1

t/18-custom-capture.t less more

14	14	use Capture::Tiny ':all';
15	15	use Config;
16	16
17		plan tests => 13;
	17	plan tests => 19;
18	18
19	19	local $ENV{PERL_CAPTURE_TINY_TIMEOUT} = 0; # no timeouts
20	20

121	121	unlink $_ for $temp_out, $temp_err;
122	122
123	123	#--------------------------------------------------------------------------#
	124	# repeated append to custom IO::File with no output
	125	#--------------------------------------------------------------------------#
	126
	127	$temp_out = tmpnam();
	128	$temp_err = tmpnam();
	129
	130	ok( !-e $temp_out, "Temp out '$temp_out' doesn't exist" );
	131	ok( !-e $temp_err, "Temp out '$temp_err' doesn't exist" );
	132
	133	$out_fh = IO::File->new($temp_out, "a+");
	134	$err_fh = IO::File->new($temp_err, "a+");
	135
	136	($got_out, $got_err) = capture {
	137	my $i = 0; $i++ for 1 .. 10; # no output, just busywork
	138	} stdout => $out_fh, stderr => $err_fh;
	139
	140	is( $got_out, "",
	141	"Try 1: captured empty appended STDOUT to custom handle"
	142	);
	143	is( $got_err, "",
	144	"Try 1: captured empty appended STDERR to custom handle"
	145	);
	146
	147	($got_out, $got_err) = capture {
	148	my $i = 0; $i++ for 1 .. 10; # no output, just busywork
	149	} stdout => $out_fh, stderr => $err_fh;
	150
	151	is( $got_out, "",
	152	"Try 2: captured empty appended STDOUT to custom handle"
	153	);
	154	is( $got_err, "",
	155	"Try 2: captured empty appended STDERR to custom handle"
	156	);
	157
	158	unlink $_ for $temp_out, $temp_err;
	159
	160	#--------------------------------------------------------------------------#
124	161	# finish
125	162	#--------------------------------------------------------------------------#
126	163

-0

t/lib/Cases.pm less more

77	77	both => {
78	78	output => sub { _binmode($_[0]) . "print STDOUT qq{STDOUT:$texts{$_[0]}}; print STDERR qq{STDERR:$texts{$_[0]}}" },
79	79	expect => sub { eval "qq{STDOUT:$texts{$_[0]}}", eval "qq{STDERR:$texts{$_[0]}}" },
	80	},
	81	empty => {
	82	output => sub { _binmode($_[0]) . "print STDOUT qq{}; print STDERR qq{}" },
	83	expect => sub { "", "" },
	84	},
	85	nooutput=> {
	86	output => sub { _binmode($_[0]) },
	87	expect => sub { "", "" },
80	88	},
81	89	);
82	90