Commit 061c0d153bcd3e57f702ccc217114ea3c64e8e4d - libcapture-tiny-perl

Imported Upstream version 0.13 gregor herrmann 12 years ago

34 changed file(s) with 813 addition(s) and 305 deletion(s). Raw diff Collapse all Expand all

+31

-0

Changes less more

0	0	Revision history for Capture-Tiny
	1
	2	0.13 2011-12-02 13:39:00 EST5EDT
	3
	4	Fixed:
	5
	6	- Fixed t/18-custom-capture.t failures on Windows due to tempfile
	7	removal problems in the testfile
	8
	9	0.12 2011-12-01 16:58:05 EST5EDT
	10
	11	Added:
	12
	13	- New functions capture_stdout, capture_stderr, tee_stdout, tee_stderr
	14	[rt.cpan.org #60515]
	15
	16	- Capture functions also returns the return values from the executed
	17	coderef [rt.cpan.org #61794, adapted from patch by Christian Walde]
	18
	19	- Capture functions take optional custom filehandles for capturing
	20	via named files instead of anonymous ones [inspired by Christian Walde]
	21
	22	Fixed:
	23
	24	- Tied filehandles based on Tie::StdHandle can now use the ":utf8"
	25	layer; removed remaining TODO tests; adds Scalar::Util as a dependency
	26
	27	Changed:
	28
	29	- When Time::HiRes::usleep is available, tee operations will
	30	sleep during the busy-loop waiting for tee processes to be ready
	31	[rt.cpan.org #67858]
1	32
2	33	0.11 2011-05-19 23:34:23 America/New_York
3	34

-0

MANIFEST less more

4	4	META.yml
5	5	Makefile.PL
6	6	README
	7	README.PATCHING
7	8	Todo
8	9	dist.ini
9	10	examples/rt-58208.pl

25	26	t/14-stderr-tied.t
26	27	t/15-stdin-tied.t
27	28	t/16-catch-errors.t
	29	t/17-pass-results.t
	30	t/18-custom-capture.t
28	31	t/lib/Cases.pm
29	32	t/lib/TieLC.pm
30	33	t/lib/Utils.pm

32	35	xt/release/pod-coverage.t
33	36	xt/release/pod-syntax.t
34	37	xt/release/portability.t
	38	xt/release/test-version.t

+12

-8

META.json less more

3	3	"David Golden <dagolden@cpan.org>"
4	4	],
5	5	"dynamic_config" : 1,
6		"generated_by" : "Dist::Zilla version 4.200005, CPAN::Meta::Converter version 2.110580",
	6	"generated_by" : "Dist::Zilla version 4.300002, CPAN::Meta::Converter version 2.112580",
7	7	"license" : [
8	8	"apache_2_0"
9	9	],

26	26	"prereqs" : {
27	27	"configure" : {
28	28	"requires" : {
29		"ExtUtils::MakeMaker" : "6.31"
	29	"ExtUtils::MakeMaker" : "6.30"
30	30	}
31	31	},
32	32	"runtime" : {

36	36	"File::Spec" : 0,
37	37	"File::Temp" : 0,
38	38	"IO::Handle" : 0,
39		"perl" : "5.006"
	39	"Scalar::Util" : 0,
	40	"perl" : "5.006",
	41	"strict" : 0,
	42	"warnings" : 0
40	43	}
41	44	},
42	45	"test" : {
43	46	"requires" : {
44	47	"Config" : 0,
45	48	"File::Find" : 0,
	49	"IO::File" : 0,
46	50	"Test::More" : "0.62"
47	51	}
48	52	}

50	54	"provides" : {
51	55	"Capture::Tiny" : {
52	56	"file" : "lib/Capture/Tiny.pm",
53		"version" : "0.11"
	57	"version" : "0.13"
54	58	}
55	59	},
56	60	"release_status" : "stable",

59	63	"mailto" : "bug-capture-tiny at rt.cpan.org",
60	64	"web" : "http://rt.cpan.org/Public/Dist/Display.html?Name=Capture-Tiny"
61	65	},
62		"homepage" : "http://github.com/dagolden/capture-tiny/tree",
	66	"homepage" : "https://github.com/dagolden/capture-tiny",
63	67	"repository" : {
64	68	"type" : "git",
65		"url" : "git://github.com/dagolden/capture-tiny.git",
66		"web" : "http://github.com/dagolden/capture-tiny/tree"
	69	"url" : "https://github.com/dagolden/capture-tiny.git",
	70	"web" : "https://github.com/dagolden/capture-tiny"
67	71	}
68	72	},
69		"version" : "0.11"
	73	"version" : "0.13"
70	74	}
71	75

+10

-6

META.yml less more

4	4	build_requires:
5	5	Config: 0
6	6	File::Find: 0
	7	IO::File: 0
7	8	Test::More: 0.62
8	9	configure_requires:
9		ExtUtils::MakeMaker: 6.31
	10	ExtUtils::MakeMaker: 6.30
10	11	dynamic_config: 1
11		generated_by: 'Dist::Zilla version 4.200005, CPAN::Meta::Converter version 2.110580'
	12	generated_by: 'Dist::Zilla version 4.300002, CPAN::Meta::Converter version 2.112580'
12	13	license: apache
13	14	meta-spec:
14	15	url: http://module-build.sourceforge.net/META-spec-v1.4.html

25	26	provides:
26	27	Capture::Tiny:
27	28	file: lib/Capture/Tiny.pm
28		version: 0.11
	29	version: 0.13
29	30	requires:
30	31	Carp: 0
31	32	Exporter: 0
32	33	File::Spec: 0
33	34	File::Temp: 0
34	35	IO::Handle: 0
	36	Scalar::Util: 0
35	37	perl: 5.006
	38	strict: 0
	39	warnings: 0
36	40	resources:
37	41	bugtracker: http://rt.cpan.org/Public/Dist/Display.html?Name=Capture-Tiny
38		homepage: http://github.com/dagolden/capture-tiny/tree
39		repository: git://github.com/dagolden/capture-tiny.git
40		version: 0.11
	42	homepage: https://github.com/dagolden/capture-tiny
	43	repository: https://github.com/dagolden/capture-tiny.git
	44	version: 0.13

+27

-23

Makefile.PL less more

1	1	use strict;
2	2	use warnings;
3	3
4		BEGIN { require 5.006; }
	4	use 5.006;
5	5
6		use ExtUtils::MakeMaker 6.31;
	6	use ExtUtils::MakeMaker 6.30;
7	7
8	8
9	9
10	10	my %WriteMakefileArgs = (
11		'ABSTRACT' => 'Capture STDOUT and STDERR from Perl, XS or external programs',
12		'AUTHOR' => 'David Golden <dagolden@cpan.org>',
13		'BUILD_REQUIRES' => {
14		'Config' => '0',
15		'File::Find' => '0',
16		'Test::More' => '0.62'
	11	"ABSTRACT" => "Capture STDOUT and STDERR from Perl, XS or external programs",
	12	"AUTHOR" => "David Golden <dagolden\@cpan.org>",
	13	"BUILD_REQUIRES" => {
	14	"Config" => 0,
	15	"File::Find" => 0,
	16	"IO::File" => 0,
	17	"Test::More" => "0.62"
17	18	},
18		'CONFIGURE_REQUIRES' => {
19		'ExtUtils::MakeMaker' => '6.31'
	19	"CONFIGURE_REQUIRES" => {
	20	"ExtUtils::MakeMaker" => "6.30"
20	21	},
21		'DISTNAME' => 'Capture-Tiny',
22		'EXE_FILES' => [],
23		'LICENSE' => 'apache',
24		'NAME' => 'Capture::Tiny',
25		'PREREQ_PM' => {
26		'Carp' => '0',
27		'Exporter' => '0',
28		'File::Spec' => '0',
29		'File::Temp' => '0',
30		'IO::Handle' => '0'
	22	"DISTNAME" => "Capture-Tiny",
	23	"EXE_FILES" => [],
	24	"LICENSE" => "apache",
	25	"NAME" => "Capture::Tiny",
	26	"PREREQ_PM" => {
	27	"Carp" => 0,
	28	"Exporter" => 0,
	29	"File::Spec" => 0,
	30	"File::Temp" => 0,
	31	"IO::Handle" => 0,
	32	"Scalar::Util" => 0,
	33	"strict" => 0,
	34	"warnings" => 0
31	35	},
32		'VERSION' => '0.11',
33		'test' => {
34		'TESTS' => 't/*.t'
	36	"VERSION" => "0.13",
	37	"test" => {
	38	"TESTS" => "t/*.t"
35	39	}
36	40	);
37	41

+128

-46

README less more

2	2	programs
3	3
4	4	VERSION
5		version 0.11
	5	version 0.13
6	6
7	7	SYNOPSIS
8		use Capture::Tiny qw/capture tee capture_merged tee_merged/;
	8	use Capture::Tiny ':all';
9	9
10		($stdout, $stderr) = capture {
	10	($stdout, $stderr, @result) = capture {
11	11	# your code here
12	12	};
	13
	14	$stdout = capture_stdout { ... };
	15	$stderr = capture_stderr { ... };
	16	$merged = capture_merged { ... };
13	17
14	18	($stdout, $stderr) = tee {
15	19	# your code here
16	20	};
17	21
18		$merged = capture_merged {
19		# your code here
20		};
21
22		$merged = tee_merged {
23		# your code here
24		};
	22	$stdout = tee_stdout { ... };
	23	$stderr = tee_stderr { ... };
	24	$merged = tee_merged { ... };
25	25
26	26	DESCRIPTION
27		Capture::Tiny provides a simple, portable way to capture anything sent
28		to STDOUT or STDERR, regardless of whether it comes from Perl, from XS
29		code or from an external program. Optionally, output can be teed so that
30		it is captured while being passed through to the original handles. Yes,
31		it even works on Windows. Stop guessing which of a dozen capturing
32		modules to use in any particular situation and just use this one.
33
34		This module was heavily inspired by IO::CaptureOutput, which provides
35		similar functionality without the ability to tee output and with more
36		complicated code and API.
	27	Capture::Tiny provides a simple, portable way to capture almost anything
	28	sent to STDOUT or STDERR, regardless of whether it comes from Perl, from
	29	XS code or from an external program. Optionally, output can be teed so
	30	that it is captured while being passed through to the original handles.
	31	Yes, it even works on Windows (usually). Stop guessing which of a dozen
	32	capturing modules to use in any particular situation and just use this
	33	one.
37	34
38	35	USAGE
39	36	The following functions are available. None are exported by default.
40	37
41	38	capture
42		($stdout, $stderr) = capture \&code;
	39	($stdout, $stderr, @result) = capture \&code;
43	40	$stdout = capture \&code;
44	41
45	42	The "capture" function takes a code reference and returns what is sent
46		to STDOUT and STDERR. In scalar context, it returns only STDOUT. If no
47		output was received, returns an empty string. Regardless of context, all
48		output is captured -- nothing is passed to the existing handles.
	43	to STDOUT and STDERR as well as any return values from the code
	44	reference. In scalar context, it returns only STDOUT. If no output was
	45	received for a handle, it returns an empty string for that handle.
	46	Regardless of calling context, all output is captured -- nothing is
	47	passed to the existing handles.
49	48
50	49	It is prototyped to take a subroutine reference as an argument. Thus, it
51	50	can be called in block form:

54	53	# your code here ...
55	54	};
56	55
	56	Note that the coderef is evaluated in list context. If you wish to force
	57	scalar context on the return value, you must use the "scalar" keyword.
	58
	59	($stdout, $stderr, $count) = capture {
	60	my @list = qw/one two three/;
	61	return scalar @list; # $count will be 3
	62	};
	63
	64	Captures are normally done internally to an anonymous filehandle. To
	65	capture via a named file (e.g. to externally monitor a long-running
	66	capture), provide custom filehandles as a trailing list of option pairs:
	67
	68	my $out_fh = IO::File->new("out.txt", "w+");
	69	my $err_fh = IO::File->new("out.txt", "w+");
	70	capture { ... } stdout => $out_fh, stderr => $err_fh;
	71
	72	The filehandles must be read/write and seekable and should be empty.
	73	Modifying the files externally during a capture operation will give
	74	unpredictable results. Existing IO layers on them may be changed by the
	75	capture.
	76
	77	capture_stdout
	78	($stdout, @result) = capture_stdout \&code;
	79	$stdout = capture_stdout \&code;
	80
	81	The "capture_stdout" function works just like "capture" except only
	82	STDOUT is captured. STDERR is not captured.
	83
	84	capture_stderr
	85	($stderr, @result) = capture_stderr \&code;
	86	$stderr = capture_stderr \&code;
	87
	88	The "capture_stderr" function works just like "capture" except only
	89	STDERR is captured. STDOUT is not captured.
	90
57	91	capture_merged
	92	($merged, @result) = capture_merged \&code;
58	93	$merged = capture_merged \&code;
59	94
60	95	The "capture_merged" function works just like "capture" except STDOUT
61	96	and STDERR are merged. (Technically, STDERR is redirected to STDOUT
62		before executing the function.) If no output was received, returns an
63		empty string. As with "capture" it may be called in block form.
	97	before executing the function.)
64	98
65	99	Caution: STDOUT and STDERR output in the merged result are not
66	100	guaranteed to be properly ordered due to buffering.
67	101
68	102	tee
69		($stdout, $stderr) = tee \&code;
	103	($stdout, $stderr, @result) = tee \&code;
70	104	$stdout = tee \&code;
71	105
72	106	The "tee" function works just like "capture", except that output is
73		captured as well as passed on to the original STDOUT and STDERR. As with
74		"capture" it may be called in block form.
	107	captured as well as passed on to the original STDOUT and STDERR.
	108
	109	tee_stdout
	110	($stdout, @result) = tee_stdout \&code;
	111	$stdout = tee_stdout \&code;
	112
	113	The "tee_stdout" function works just like "tee" except only STDOUT is
	114	teed. STDERR is not teed (output goes to STDERR as usual).
	115
	116	tee_stderr
	117	($stderr, @result) = tee_stderr \&code;
	118	$stderr = tee_stderr \&code;
	119
	120	The "tee_stderr" function works just like "tee" except only STDERR is
	121	teed. STDOUT is not teed (output goes to STDOUT as usual).
75	122
76	123	tee_merged
	124	($merged, @result) = tee_merged \&code;
77	125	$merged = tee_merged \&code;
78	126
79	127	The "tee_merged" function works just like "capture_merged" except that
80		output is captured as well as passed on to STDOUT. As with "capture" it
81		may be called in block form.
	128	output is captured as well as passed on to STDOUT.
82	129
83	130	Caution: STDOUT and STDERR output in the merged result are not
84	131	guaranteed to be properly ordered due to buffering.

92	139	PerlIO layers
93	140	Capture::Tiny does it's best to preserve PerlIO layers such as ':utf8'
94	141	or ':crlf' when capturing. Layers should be applied to STDOUT or STDERR
95		before the call to "capture" or "tee".
96
97		Closed STDIN, STDOUT or STDERR
	142	before the call to "capture" or "tee". This may not work for tied
	143	handles (see below).
	144
	145	Modifying filehandles before capturing
	146	Generally speaking, you should do little or no manipulation of the
	147	standard IO handles prior to using Capture::Tiny. In particular,
	148	closing, reopening, localizing or tying standard handles prior to
	149	capture may cause a variety of unexpected, undesireable and/or
	150	unreliable behaviors, as described below. Capture::Tiny does its best to
	151	compensate for these situations, but the results may not be what you
	152	desire.
	153
	154	Closed filehandles
	155
98	156	Capture::Tiny will work even if STDIN, STDOUT or STDERR have been
99		previously closed. However, since they may be reopened to capture or tee
100		output, any code within the captured block that depends on finding them
101		closed will, of course, not find them to be closed. If they started
	157	previously closed. However, since they will be reopened to capture or
	158	tee output, any code within the captured block that depends on finding
	159	them closed will, of course, not find them to be closed. If they started
102	160	closed, Capture::Tiny will reclose them again when the capture block
103	161	finishes.
104	162
105		Scalar filehandles and STDIN, STDOUT or STDERR
	163	Note that this reopening will happen even for STDIN or a handle not
	164	being captured to ensure that the filehandle used for capture is not
	165	opened to file descriptor 0, as this causes problems on various
	166	platforms.
	167
	168	Localized filehandles
	169
	170	If code localizes any of Perl's standard handles before capturing, the
	171	capture will affect the localized handles and not the original ones.
	172	External system calls are not affected by localizing a handle in Perl
	173	and will continue to send output to the original handles (which will
	174	thus not be captured).
	175
	176	Scalar filehandles
	177
106	178	If STDOUT or STDERR are reopened to scalar filehandles prior to the call
107	179	to "capture" or "tee", then Capture::Tiny will override the output
108	180	handle for the duration of the "capture" or "tee" call and then send

112	184	Capture::Tiny attempts to preserve the semantics of STDIN opened to a
113	185	scalar reference.
114	186
115		Tied STDIN, STDOUT or STDERR
	187	Tied handles
	188
116	189	If STDOUT or STDERR are tied prior to the call to "capture" or "tee",
117	190	then Capture::Tiny will attempt to override the tie for the duration of
118	191	the "capture" or "tee" call and then send captured output to the tied
119	192	handle after the capture is complete. (Requires Perl 5.8)
120	193
121		Capture::Tiny does not (yet) support resending utf8 encoded data to a
122		tied STDOUT or STDERR handle. Characters will appear as bytes.
	194	Capture::Tiny may not succeed resending utf8 encoded data to a tied
	195	STDOUT or STDERR handle. Characters may appear as bytes. If the tied
	196	handle is based on Tie::StdHandle, then Capture::Tiny will attempt to
	197	determine appropriate layers like ":utf8" from the underlying handle and
	198	do the right thing.
123	199
124	200	Capture::Tiny attempts to preserve the semantics of tied STDIN, but
125	201	capturing or teeing when STDIN is tied is currently broken on Windows.
126	202
127		Modifiying STDIN, STDOUT or STDERR during a capture
	203	Modifiying handles during a capture
128	204	Attempting to modify STDIN, STDOUT or STDERR during "capture" or "tee"
129	205	is almost certainly going to cause problems. Don't do that.
130	206

149	225	to an existing test-file that illustrates the bug or desired feature.
150	226
151	227	SEE ALSO
152		This is a selection of CPAN modules that provide some sort of output
	228	This module was, inspired by IO::CaptureOutput, which provides similar
	229	functionality without the ability to tee output and with more
	230	complicated code and API. IO::CaptureOutput does not handle layers or
	231	most of the unusual cases described in the "Limitations" section and I
	232	no longer recommend it.
	233
	234	There are many other CPAN modules that provide some sort of output
153	235	capture, albeit with various limitations that make them appropriate only
154	236	in particular circumstances. I'm probably missing some. The long list is
155	237	provided to show why I felt Capture::Tiny was necessary.

208	290	This is open source software. The code repository is available for
209	291	public review and contribution under the terms of the license.
210	292
211		<http://github.com/dagolden/capture-tiny/tree>
212
213		git clone git://github.com/dagolden/capture-tiny.git
	293	<https://github.com/dagolden/capture-tiny>
	294
	295	git clone https://github.com/dagolden/capture-tiny.git
214	296
215	297	AUTHOR
216	298	David Golden <dagolden@cpan.org>

+42

-0

README.PATCHING less more

	0	README.PATCHING
	1
	2	Thank you for considering contributing to this distribution. This file
	3	contains instructions that will help you work with the source code.
	4
	5	The distribution is managed with Dist::Zilla. This means than many of the
	6	usual files you might expect are not in the repository, but are generated
	7	at release time (e.g. Makefile.PL).
	8
	9	However, you can run tests directly using the 'prove' tool:
	10
	11	$ prove -l
	12	$ prove -lv t/some_test_file.t
	13
	14	For most distributions, 'prove' is entirely sufficent for you to test any
	15	patches you have.
	16
	17	Likewise, much of the documentation Pod is generated at release time.
	18	Depending on the distribution, some documentation may be written in a Pod
	19	dialect called WikiDoc. (See Pod::WikiDoc on CPAN.) If you would like to
	20	submit a documentation edit, please limit yourself to the documentation you
	21	see.
	22
	23	If you see typos or documentation issues in the generated docs, please
	24	email or open a bug ticket instead of patching.
	25
	26	Dist::Zilla is a very powerful authoring tool, but requires a number of
	27	author-specific plugins. If you would like to use it for contributing,
	28	install it from CPAN, then run one of the following commands, depending on
	29	your CPAN client:
	30
	31	$ cpan `dzil authordeps`
	32	$ dzil authordeps \| cpanm
	33
	34	Once installed, here are some dzil commands you might try:
	35
	36	$ dzil build
	37	$ dzil test
	38	$ dzil xtest
	39
	40	You can learn more about Dist::Zilla at http://dzil.org/
	41

-1

dist.ini less more

4	4	copyright_year = 2009
5	5
6	6	[@DAGOLDEN]
7		git_remote = github
8	7
9	8	[OSPrereqs / MSWin32]
10	9	Win32API::File = 0

-9

examples/rt-58208.pl less more

0		#
1		# This file is part of Capture-Tiny
2		#
3		# This software is Copyright (c) 2009 by David Golden.
4		#
5		# This is free software, licensed under:
6		#
7		# The Apache License, Version 2.0, January 2004
8		#
9	0	use Capture::Tiny qw[ capture ];
10	1
11	2	my ( $out, $err ) =

-9

examples/tee.pl less more

0		#
1		# This file is part of Capture-Tiny
2		#
3		# This software is Copyright (c) 2009 by David Golden.
4		#
5		# This is free software, licensed under:
6		#
7		# The Apache License, Version 2.0, January 2004
8		#
9	0	use strict;
10	1	use warnings;
11	2

+229

-116

lib/Capture/Tiny.pm less more

0		#
1		# This file is part of Capture-Tiny
2		#
3		# This software is Copyright (c) 2009 by David Golden.
4		#
5		# This is free software, licensed under:
6		#
7		# The Apache License, Version 2.0, January 2004
8		#
9	0	use 5.006;
10	1	use strict;
11	2	use warnings;
12	3	package Capture::Tiny;
13		BEGIN {
14		$Capture::Tiny::VERSION = '0.11';
15		}
16	4	# ABSTRACT: Capture STDOUT and STDERR from Perl, XS or external programs
	5	our $VERSION = '0.13'; # VERSION
17	6	use Carp ();
18	7	use Exporter ();
19	8	use IO::Handle ();
20	9	use File::Spec ();
21	10	use File::Temp qw/tempfile tmpnam/;
	11	use Scalar::Util qw/reftype blessed/;
22	12	# Get PerlIO or fake it
23	13	BEGIN {
24	14	local $@;

26	16	or *PerlIO::get_layers = sub { return () };
27	17	}
28	18
	19	#--------------------------------------------------------------------------#
	20	# create API subroutines and export them
	21	# [do STDOUT flag, do STDERR flag, do merge flag, do tee flag]
	22	#--------------------------------------------------------------------------#
	23
	24	my %api = (
	25	capture => [1,1,0,0],
	26	capture_stdout => [1,0,0,0],
	27	capture_stderr => [0,1,0,0],
	28	capture_merged => [1,0,1,0], # don't do STDERR since merging
	29	tee => [1,1,0,1],
	30	tee_stdout => [1,0,0,1],
	31	tee_stderr => [0,1,0,1],
	32	tee_merged => [1,0,1,1], # don't do STDERR since merging
	33	);
	34
	35	for my $sub ( keys %api ) {
	36	my $args = join q{, }, @{$api{$sub}};
	37	eval "sub $sub(&;@) {unshift \@_, $args; goto \\&_capture_tee;}"; ## no critic
	38	}
	39
29	40	our @ISA = qw/Exporter/;
30		our @EXPORT_OK = qw/capture capture_merged tee tee_merged/;
	41	our @EXPORT_OK = keys %api;
31	42	our %EXPORT_TAGS = ( 'all' => \@EXPORT_OK );
32	43
	44	#--------------------------------------------------------------------------#
	45	# constants and fixtures
	46	#--------------------------------------------------------------------------#
	47
33	48	my $IS_WIN32 = $^O eq 'MSWin32';
34	49
35	50	our $DEBUG = $ENV{PERL_CAPTURE_TINY_DEBUG};
	51
36	52	my $DEBUGFH;
37		open $DEBUGFH, ">&STDERR" if $DEBUG;
	53	open $DEBUGFH, "> DEBUG" if $DEBUG;
38	54
39	55	*_debug = $DEBUG ? sub(@) { print {$DEBUGFH} @_ } : sub(){0};
40	56

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

222	238	$stash->{pid}{$which} = $pid
223	239	}
224	240
225		sub _files_exist { -f $_ \|\| return 0 for @_; return 1 }
	241	my $have_usleep = eval "use Time::HiRes 'usleep'; 1";
	242	sub _files_exist {
	243	return 1 if @_ == grep { -f } @_;
	244	Time::HiRes::usleep(1000) if $have_usleep;
	245	return 0;
	246	}
226	247
227	248	sub _wait_for_tees {
228	249	my ($stash) = @_;

251	272	}
252	273
253	274	sub _slurp {
254		seek $_[0],0,0; local $/; return scalar readline $_[0];
	275	my ($name, $fh) = @_;
	276	_debug( "# slurping captured $name with layers: @{[PerlIO::get_layers($fh)]}\n");
	277	seek $fh,0,0; local $/; return scalar readline $fh
255	278	}
256	279
257	280	#--------------------------------------------------------------------------#

260	283
261	284	sub _capture_tee {
262	285	_debug( "# starting _capture_tee with (@_)...\n" );
263		my ($tee_stdout, $tee_stderr, $merge, $code) = @_;
	286	my ($do_stdout, $do_stderr, $do_merge, $do_tee, $code, @opts) = @_;
	287	Carp::confess("Custom capture options must be given as key/value pairs\n")
	288	unless @opts % 2 == 0;
	289	my $stash = { capture => { @opts } };
	290	for my $n ( keys %{$stash->{capture}} ) {
	291	my $fh = $stash->{capture}{$n};
	292	Carp::confess "Custom handle for $n must be seekable\n"
	293	unless ref($fh) eq 'GLOB' \|\| (blessed($fh) && $fh->isa("IO::Seekable"));
	294	}
264	295	# save existing filehandles and setup captures
265	296	local CT_ORIG_STDIN = STDIN ;
266	297	local CT_ORIG_STDOUT = STDOUT;

272	303	stderr => [PerlIO::get_layers(\*STDERR)],
273	304	);
274	305	_debug( "# existing layers for $_\: @{$layers{$_}}\n" ) for qw/stdin stdout stderr/;
	306	# get layers from underlying glob of tied filehandles if we can
	307	# (this only works for things that work like Tie::StdHandle)
	308	$layers{stdout} = [PerlIO::get_layers(tied *STDOUT)]
	309	if tied(STDOUT) && (reftype tied STDOUT eq 'GLOB');
	310	$layers{stderr} = [PerlIO::get_layers(tied *STDERR)]
	311	if tied(STDERR) && (reftype tied STDERR eq 'GLOB');
	312	_debug( "# tied object corrected layers for $_\: @{$layers{$_}}\n" ) for qw/stdin stdout stderr/;
275	313	# bypass scalar filehandles and tied handles
276	314	my %localize;
277		$localize{stdin}++, local(*STDIN) if grep { $_ eq 'scalar' } @{$layers{stdin}};
278		$localize{stdout}++, local(*STDOUT) if grep { $_ eq 'scalar' } @{$layers{stdout}};
279		$localize{stderr}++, local(*STDERR) if grep { $_ eq 'scalar' } @{$layers{stderr}};
280		$localize{stdout}++, local(STDOUT), _open( \STDOUT, ">&=1") if tied *STDOUT && $] >= 5.008;
281		$localize{stderr}++, local(STDERR), _open( \STDERR, ">&=2") if tied *STDERR && $] >= 5.008;
	315	$localize{stdin}++, local(*STDIN)
	316	if grep { $_ eq 'scalar' } @{$layers{stdin}};
	317	$localize{stdout}++, local(*STDOUT)
	318	if $do_stdout && grep { $_ eq 'scalar' } @{$layers{stdout}};
	319	$localize{stderr}++, local(*STDERR)
	320	if ($do_stderr \|\| $do_merge) && grep { $_ eq 'scalar' } @{$layers{stderr}};
	321	$localize{stdout}++, local(STDOUT), _open( \STDOUT, ">&=1")
	322	if $do_stdout && tied *STDOUT && $] >= 5.008;
	323	$localize{stderr}++, local(STDERR), _open( \STDERR, ">&=2")
	324	if ($do_stderr \|\| $do_merge) && tied *STDERR && $] >= 5.008;
282	325	_debug( "# localized $_\n" ) for keys %localize;
	326	# proxy any closed/localized handles so we don't use fds 0, 1 or 2
283	327	my %proxy_std = _proxy_std();
284		_debug( "# proxy std is @{ [%proxy_std] }\n" );
285		my $stash = { old => _copy_std() };
	328	_debug( "# proxy std: @{ [%proxy_std] }\n" );
286	329	# update layers after any proxying
287		%layers = (
288		stdin => [PerlIO::get_layers(\*STDIN) ],
289		stdout => [PerlIO::get_layers(\*STDOUT)],
290		stderr => [PerlIO::get_layers(\*STDERR)],
291		);
	330	$layers{stdin} = [PerlIO::get_layers(\*STDIN)] if $proxy_std{stdin};
	331	$layers{stdout} = [PerlIO::get_layers(\*STDOUT)] if $proxy_std{stdout};
	332	$layers{stderr} = [PerlIO::get_layers(\*STDERR)] if $proxy_std{stderr};
292	333	_debug( "# post-proxy layers for $_\: @{$layers{$_}}\n" ) for qw/stdin stdout stderr/;
	334	# store old handles and setup handles for capture
	335	$stash->{old} = _copy_std();
	336	$stash->{new} = { %{$stash->{old}} }; # default to originals
	337	$stash->{new}{stdout} = ($stash->{capture}{stdout} \|\|= File::Temp->new) if $do_stdout;
	338	$stash->{new}{stderr} = ($stash->{capture}{stderr} \|\|= File::Temp->new) if $do_stderr;
	339	_debug("# will capture stdout on " . fileno($stash->{capture}{stdout})."\n" ) if $do_stdout;
	340	_debug("# will capture stderr on " . fileno($stash->{capture}{stderr})."\n" ) if $do_stderr;
293	341	# get handles for capture and apply existing IO layers
294		$stash->{new}{$_} = $stash->{capture}{$_} = File::Temp->new for qw/stdout stderr/;
295		_debug("# will capture $_ on " .fileno($stash->{capture}{$_})."\n" ) for qw/stdout stderr/;
296	342	# tees may change $stash->{new}
297		_start_tee( stdout => $stash ) if $tee_stdout;
298		_start_tee( stderr => $stash ) if $tee_stderr;
299		_wait_for_tees( $stash ) if $tee_stdout \|\| $tee_stderr;
	343	_start_tee( stdout => $stash ) if $do_stdout && $do_tee;
	344	_start_tee( stderr => $stash ) if $do_stderr && $do_tee;
	345	_wait_for_tees( $stash ) if $do_tee;
300	346	# finalize redirection
301		$stash->{new}{stderr} = $stash->{new}{stdout} if $merge;
302		$stash->{new}{stdin} = $stash->{old}{stdin};
	347	$stash->{new}{stderr} = $stash->{new}{stdout} if $do_merge;
303	348	_debug( "# redirecting in parent ...\n" );
304	349	_open_std( $stash->{new} );
305	350	# execute user provided code
306		my ($exit_code, $inner_error, $outer_error);
	351	my ($exit_code, $inner_error, $outer_error, @result);
307	352	{
308	353	local STDIN = CT_ORIG_STDIN if $localize{stdin}; # get original, not proxy STDIN
309		local STDERR = STDOUT if $merge; # minimize buffer mixups during $code
	354	local STDERR = STDOUT if $do_merge; # minimize buffer mixups during $code
310	355	_debug( "# finalizing layers ...\n" );
311		_relayer(\*STDOUT, $layers{stdout});
312		_relayer(\*STDERR, $layers{stderr}) unless $merge;
	356	_relayer(\*STDOUT, $layers{stdout}) if $do_stdout;
	357	_relayer(\*STDERR, $layers{stderr}) if $do_stderr;
313	358	_debug( "# running code $code ...\n" );
314	359	local $@;
315		eval { $code->(); $inner_error = $@ };
	360	eval { @result = $code->(); $inner_error = $@ };
316	361	$exit_code = $?; # save this for later
317	362	$outer_error = $@; # save this for later
318	363	}
319	364	# restore prior filehandles and shut down tees
320		_debug( "# restoring ...\n" );
	365	_debug( "# restoring filehandles ...\n" );
321	366	_open_std( $stash->{old} );
322	367	_close( $_ ) for values %{$stash->{old}}; # don't leak fds
323	368	_unproxy( %proxy_std );
324		_kill_tees( $stash ) if $tee_stdout \|\| $tee_stderr;
	369	_debug( "# killing tee subprocesses ...\n" ) if $do_tee;
	370	_kill_tees( $stash ) if $do_tee;
325	371	# return captured output
326		_relayer($stash->{capture}{stdout}, $layers{stdout});
327		_relayer($stash->{capture}{stderr}, $layers{stderr}) unless $merge;
328		_debug( "# slurping captured $_ with layers: @{[PerlIO::get_layers($stash->{capture}{$_})]}\n") for qw/stdout stderr/;
329		my $got_out = _slurp($stash->{capture}{stdout});
330		my $got_err = $merge ? q() : _slurp($stash->{capture}{stderr});
331		print CT_ORIG_STDOUT $got_out if $localize{stdout} && $tee_stdout;
332		print CT_ORIG_STDERR $got_err if !$merge && $localize{stderr} && $tee_stdout;
	372	_relayer($stash->{capture}{stdout}, $layers{stdout}) if $do_stdout;
	373	_relayer($stash->{capture}{stderr}, $layers{stderr}) if $do_stderr;
	374	my $got_out = $do_stdout ? _slurp('stdout' => $stash->{capture}{stdout}) : q();
	375	my $got_err = $do_stderr ? _slurp('stderr' => $stash->{capture}{stderr}) : q();
	376	_debug("# slurped " . length($got_out) . " bytes from stdout\n");
	377	_debug("# slurped " . length($got_err) . " bytes from stderr\n");
	378	print CT_ORIG_STDOUT $got_out
	379	if $do_stdout && $do_tee && $localize{stdout};
	380	print CT_ORIG_STDERR $got_err
	381	if $do_stderr && $do_tee && $localize{stderr};
333	382	$? = $exit_code;
334	383	$@ = $inner_error if $inner_error;
335	384	die $outer_error if $outer_error;
336	385	_debug( "# ending _capture_tee with (@_)...\n" );
337		return $got_out if $merge;
338		return wantarray ? ($got_out, $got_err) : $got_out;
339		}
340
341		#--------------------------------------------------------------------------#
342		# create API subroutines from [tee STDOUT flag, tee STDERR, merge flag]
343		#--------------------------------------------------------------------------#
344
345		my %api = (
346		capture => [0,0,0],
347		capture_merged => [0,0,1],
348		tee => [1,1,0],
349		tee_merged => [1,0,1], # don't tee STDOUT since merging
350		);
351
352		for my $sub ( keys %api ) {
353		my $args = join q{, }, @{$api{$sub}};
354		eval "sub $sub(&) {unshift \@_, $args; goto \\&_capture_tee;}"; ## no critic
	386	my @return;
	387	push @return, $got_out if $do_stdout;
	388	push @return, $got_err if $do_stderr;
	389	push @return, @result;
	390	return wantarray ? @return : $return[0];
355	391	}
356	392
357	393	1;

366	402
367	403	=head1 VERSION
368	404
369		version 0.11
	405	version 0.13
370	406
371	407	=head1 SYNOPSIS
372	408
373		use Capture::Tiny qw/capture tee capture_merged tee_merged/;
	409	use Capture::Tiny ':all';
374	410
375		($stdout, $stderr) = capture {
	411	($stdout, $stderr, @result) = capture {
376	412	# your code here
377	413	};
	414
	415	$stdout = capture_stdout { ... };
	416	$stderr = capture_stderr { ... };
	417	$merged = capture_merged { ... };
378	418
379	419	($stdout, $stderr) = tee {
380	420	# your code here
381	421	};
382	422
383		$merged = capture_merged {
384		# your code here
385		};
386
387		$merged = tee_merged {
388		# your code here
389		};
	423	$stdout = tee_stdout { ... };
	424	$stderr = tee_stderr { ... };
	425	$merged = tee_merged { ... };
390	426
391	427	=head1 DESCRIPTION
392	428
393		Capture::Tiny provides a simple, portable way to capture anything sent to
394		STDOUT or STDERR, regardless of whether it comes from Perl, from XS code or
	429	Capture::Tiny provides a simple, portable way to capture almost anything sent
	430	to STDOUT or STDERR, regardless of whether it comes from Perl, from XS code or
395	431	from an external program. Optionally, output can be teed so that it is
396	432	captured while being passed through to the original handles. Yes, it even
397		works on Windows. Stop guessing which of a dozen capturing modules to use in
398		any particular situation and just use this one.
399
400		This module was heavily inspired by L<IO::CaptureOutput>, which provides
401		similar functionality without the ability to tee output and with more
402		complicated code and API.
	433	works on Windows (usually). Stop guessing which of a dozen capturing modules
	434	to use in any particular situation and just use this one.
403	435
404	436	=head1 USAGE
405	437

407	439
408	440	=head2 capture
409	441
410		($stdout, $stderr) = capture \&code;
	442	($stdout, $stderr, @result) = capture \&code;
411	443	$stdout = capture \&code;
412	444
413	445	The C<<< capture >>> function takes a code reference and returns what is sent to
414		STDOUT and STDERR. In scalar context, it returns only STDOUT. If no output
415		was received, returns an empty string. Regardless of context, all output is
416		captured -- nothing is passed to the existing handles.
	446	STDOUT and STDERR as well as any return values from the code reference. In
	447	scalar context, it returns only STDOUT. If no output was received for a
	448	handle, it returns an empty string for that handle. Regardless of calling
	449	context, all output is captured -- nothing is passed to the existing handles.
417	450
418	451	It is prototyped to take a subroutine reference as an argument. Thus, it
419	452	can be called in block form:

422	455	# your code here ...
423	456	};
424	457
	458	Note that the coderef is evaluated in list context. If you wish to force
	459	scalar context on the return value, you must use the C<<< scalar >>> keyword.
	460
	461	($stdout, $stderr, $count) = capture {
	462	my @list = qw/one two three/;
	463	return scalar @list; # $count will be 3
	464	};
	465
	466	Captures are normally done internally to an anonymous filehandle. To
	467	capture via a named file (e.g. to externally monitor a long-running capture),
	468	provide custom filehandles as a trailing list of option pairs:
	469
	470	my $out_fh = IO::File->new("out.txt", "w+");
	471	my $err_fh = IO::File->new("out.txt", "w+");
	472	capture { ... } stdout => $out_fh, stderr => $err_fh;
	473
	474	The filehandles must be readE<sol>write and seekable and should be empty. Modifying
	475	the files externally during a capture operation will give unpredictable
	476	results. Existing IO layers on them may be changed by the capture.
	477
	478	=head2 capture_stdout
	479
	480	($stdout, @result) = capture_stdout \&code;
	481	$stdout = capture_stdout \&code;
	482
	483	The C<<< capture_stdout >>> function works just like C<<< capture >>> except only
	484	STDOUT is captured. STDERR is not captured.
	485
	486	=head2 capture_stderr
	487
	488	($stderr, @result) = capture_stderr \&code;
	489	$stderr = capture_stderr \&code;
	490
	491	The C<<< capture_stderr >>> function works just like C<<< capture >>> except only
	492	STDERR is captured. STDOUT is not captured.
	493
425	494	=head2 capture_merged
426	495
	496	($merged, @result) = capture_merged \&code;
427	497	$merged = capture_merged \&code;
428	498
429	499	The C<<< capture_merged >>> function works just like C<<< capture >>> except STDOUT and
430	500	STDERR are merged. (Technically, STDERR is redirected to STDOUT before
431		executing the function.) If no output was received, returns an empty string.
432		As with C<<< capture >>> it may be called in block form.
	501	executing the function.)
433	502
434	503	Caution: STDOUT and STDERR output in the merged result are not guaranteed to be
435	504	properly ordered due to buffering.
436	505
437	506	=head2 tee
438	507
439		($stdout, $stderr) = tee \&code;
	508	($stdout, $stderr, @result) = tee \&code;
440	509	$stdout = tee \&code;
441	510
442	511	The C<<< tee >>> function works just like C<<< capture >>>, except that output is captured
443		as well as passed on to the original STDOUT and STDERR. As with C<<< capture >>> it
444		may be called in block form.
	512	as well as passed on to the original STDOUT and STDERR.
	513
	514	=head2 tee_stdout
	515
	516	($stdout, @result) = tee_stdout \&code;
	517	$stdout = tee_stdout \&code;
	518
	519	The C<<< tee_stdout >>> function works just like C<<< tee >>> except only
	520	STDOUT is teed. STDERR is not teed (output goes to STDERR as usual).
	521
	522	=head2 tee_stderr
	523
	524	($stderr, @result) = tee_stderr \&code;
	525	$stderr = tee_stderr \&code;
	526
	527	The C<<< tee_stderr >>> function works just like C<<< tee >>> except only
	528	STDERR is teed. STDOUT is not teed (output goes to STDOUT as usual).
445	529
446	530	=head2 tee_merged
447	531
	532	($merged, @result) = tee_merged \&code;
448	533	$merged = tee_merged \&code;
449	534
450	535	The C<<< tee_merged >>> function works just like C<<< capture_merged >>> except that output
451		is captured as well as passed on to STDOUT. As with C<<< capture >>> it may be called
452		in block form.
	536	is captured as well as passed on to STDOUT.
453	537
454	538	Caution: STDOUT and STDERR output in the merged result are not guaranteed to be
455	539	properly ordered due to buffering.

466	550
467	551	Capture::Tiny does it's best to preserve PerlIO layers such as ':utf8' or
468	552	':crlf' when capturing. Layers should be applied to STDOUT or STDERR I<before>
469		the call to C<<< capture >>> or C<<< tee >>>.
470
471		=head2 Closed STDIN, STDOUT or STDERR
	553	the call to C<<< capture >>> or C<<< tee >>>. This may not work for tied handles (see below).
	554
	555	=head2 Modifying filehandles before capturing
	556
	557	Generally speaking, you should do little or no manipulation of the standard IO
	558	handles prior to using Capture::Tiny. In particular, closing, reopening,
	559	localizing or tying standard handles prior to capture may cause a variety of
	560	unexpected, undesireable andE<sol>or unreliable behaviors, as described below.
	561	Capture::Tiny does its best to compensate for these situations, but the
	562	results may not be what you desire.
	563
	564	B<Closed filehandles>
472	565
473	566	Capture::Tiny will work even if STDIN, STDOUT or STDERR have been previously
474		closed. However, since they may be reopened to capture or tee output, any code
475		within the captured block that depends on finding them closed will, of course,
476		not find them to be closed. If they started closed, Capture::Tiny will reclose
477		them again when the capture block finishes.
478
479		=head2 Scalar filehandles and STDIN, STDOUT or STDERR
	567	closed. However, since they will be reopened to capture or tee output, any
	568	code within the captured block that depends on finding them closed will, of
	569	course, not find them to be closed. If they started closed, Capture::Tiny will
	570	reclose them again when the capture block finishes.
	571
	572	Note that this reopening will happen even for STDIN or a handle not being
	573	captured to ensure that the filehandle used for capture is not opened to file
	574	descriptor 0, as this causes problems on various platforms.
	575
	576	B<Localized filehandles>
	577
	578	If code localizes any of Perl's standard handles before capturing, the capture
	579	will affect the localized handles and not the original ones. External system
	580	calls are not affected by localizing a handle in Perl and will continue
	581	to send output to the original handles (which will thus not be captured).
	582
	583	B<Scalar filehandles>
480	584
481	585	If STDOUT or STDERR are reopened to scalar filehandles prior to the call to
482	586	C<<< capture >>> or C<<< tee >>>, then Capture::Tiny will override the output handle for the

486	590	Capture::Tiny attempts to preserve the semantics of STDIN opened to a scalar
487	591	reference.
488	592
489		=head2 Tied STDIN, STDOUT or STDERR
	593	B<Tied handles>
490	594
491	595	If STDOUT or STDERR are tied prior to the call to C<<< capture >>> or C<<< tee >>>, then
492	596	Capture::Tiny will attempt to override the tie for the duration of the
493	597	C<<< capture >>> or C<<< tee >>> call and then send captured output to the tied handle after
494	598	the capture is complete. (Requires Perl 5.8)
495	599
496		Capture::Tiny does not (yet) support resending utf8 encoded data to a tied
497		STDOUT or STDERR handle. Characters will appear as bytes.
	600	Capture::Tiny may not succeed resending utf8 encoded data to a tied
	601	STDOUT or STDERR handle. Characters may appear as bytes. If the tied handle
	602	is based on L<Tie::StdHandle>, then Capture::Tiny will attempt to determine
	603	appropriate layers like C<<< :utf8 >>> from the underlying handle and do the right
	604	thing.
498	605
499	606	Capture::Tiny attempts to preserve the semantics of tied STDIN, but capturing
500	607	or teeing when STDIN is tied is currently broken on Windows.
501	608
502		=head2 Modifiying STDIN, STDOUT or STDERR during a capture
	609	=head2 Modifiying handles during a capture
503	610
504	611	Attempting to modify STDIN, STDOUT or STDERR I<during> C<<< capture >>> or C<<< tee >>> is
505	612	almost certainly going to cause problems. Don't do that.

529	636
530	637	=head1 SEE ALSO
531	638
532		This is a selection of CPAN modules that provide some sort of output capture,
	639	This module was, inspired by L<IO::CaptureOutput>, which provides
	640	similar functionality without the ability to tee output and with more
	641	complicated code and API. L<IO::CaptureOutput> does not handle layers
	642	or most of the unusual cases described in the L</Limitations> section and
	643	I no longer recommend it.
	644
	645	There are many other CPAN modules that provide some sort of output capture,
533	646	albeit with various limitations that make them appropriate only in particular
534	647	circumstances. I'm probably missing some. The long list is provided to show
535	648	why I felt Capture::Tiny was necessary.

637	750	This is open source software. The code repository is available for
638	751	public review and contribution under the terms of the license.
639	752
640		L<http://github.com/dagolden/capture-tiny/tree>
641
642		git clone git://github.com/dagolden/capture-tiny.git
	753	L<https://github.com/dagolden/capture-tiny>
	754
	755	git clone https://github.com/dagolden/capture-tiny.git
643	756
644	757	=head1 AUTHOR
645	758

+12

-10

t/00-compile.t less more

0	0	#!perl
1		#
2		# This file is part of Capture-Tiny
3		#
4		# This software is Copyright (c) 2009 by David Golden.
5		#
6		# This is free software, licensed under:
7		#
8		# The Apache License, Version 2.0, January 2004
9		#
10	1
11	2	use strict;
12	3	use warnings;

32	23	'lib',
33	24	);
34	25
35		my @scripts = glob "bin/*";
	26	my @scripts;
	27	if ( -d 'bin' ) {
	28	find(
	29	sub {
	30	return unless -f;
	31	my $found = $File::Find::name;
	32	# nothing to skip
	33	push @scripts, $found;
	34	},
	35	'bin',
	36	);
	37	}
36	38
37	39	my $plan = scalar(@modules) + scalar(@scripts);
38	40	$plan ? (plan tests => $plan) : (plan skip_all => "no tests to run");

-0

t/01-Capture-Tiny.t less more

10	10
11	11	my @api = qw(
12	12	capture
	13	capture_stdout
	14	capture_stderr
13	15	capture_merged
14	16	tee
	17	tee_stdout
	18	tee_stderr
15	19	tee_merged
16	20	);
17	21

-0

t/02-capture.t less more

19	19
20	20	run_test('capture');
21	21	run_test('capture_scalar');
	22	run_test('capture_stdout');
	23	run_test('capture_stderr');
22	24	run_test('capture_merged');
23	25
24	26	is( next_fd, $fd, "no file descriptors leaked" );

-0

t/03-tee.t less more

26	26
27	27	run_test('tee');
28	28	run_test('tee_scalar');
	29	run_test('tee_stdout');
	30	run_test('tee_stderr');
29	31	run_test('tee_merged');
30	32
31	33	is( next_fd, $fd, "no file descriptors leaked" );

-0

t/06-stdout-closed.t less more

26	26	run_test($_) for qw(
27	27	capture
28	28	capture_scalar
	29	capture_stdout
	30	capture_stderr
29	31	capture_merged
30	32	);
31	33

33	35	run_test($_) for qw(
34	36	tee
35	37	tee_scalar
	38	tee_stdout
	39	tee_stderr
36	40	tee_merged
37	41	);
38	42	}

-0

t/07-stderr-closed.t less more

26	26	run_test($_) for qw(
27	27	capture
28	28	capture_scalar
	29	capture_stdout
	30	capture_stderr
29	31	capture_merged
30	32	);
31	33

33	35	run_test($_) for qw(
34	36	tee
35	37	tee_scalar
	38	tee_stdout
	39	tee_stderr
36	40	tee_merged
37	41	);
38	42	}

-0

t/08-stdin-closed.t less more

26	26	run_test($_) for qw(
27	27	capture
28	28	capture_scalar
	29	capture_stdout
	30	capture_stderr
29	31	capture_merged
30	32	);
31	33

33	35	run_test($_) for qw(
34	36	tee
35	37	tee_scalar
	38	tee_stdout
	39	tee_stderr
36	40	tee_merged
37	41	);
38	42	}

-0

t/10-stdout-string.t less more

30	30	run_test($_) for qw(
31	31	capture
32	32	capture_scalar
	33	capture_stdout
	34	capture_stderr
33	35	capture_merged
34	36	);
35	37

37	39	run_test($_) for qw(
38	40	tee
39	41	tee_scalar
	42	tee_stdout
	43	tee_stderr
40	44	tee_merged
41	45	);
42	46	}

-0

t/11-stderr-string.t less more

30	30	run_test($_) for qw(
31	31	capture
32	32	capture_scalar
	33	capture_stdout
	34	capture_stderr
33	35	capture_merged
34	36	);
35	37

37	39	run_test($_) for qw(
38	40	tee
39	41	tee_scalar
	42	tee_stdout
	43	tee_stderr
40	44	tee_merged
41	45	);
42	46	}

-0

t/12-stdin-string.t less more

36	36	run_test($_) for qw(
37	37	capture
38	38	capture_scalar
	39	capture_stdout
	40	capture_stderr
39	41	capture_merged
40	42	);
41	43

43	45	run_test($_) for qw(
44	46	tee
45	47	tee_scalar
	48	tee_stdout
	49	tee_stderr
46	50	tee_merged
47	51	);
48	52	}

-4

t/13-stdout-tied.t less more

0	0	# Copyright (c) 2009 by David Golden. All rights reserved.
1	1	# Licensed under Apache License, Version 2.0 (the "License").
2	2	# You may not use this file except in compliance with the License.
3		# A copy of the License was distributed with this file or you may obtain a
	3	# A copy of the License was distributed with this file or you may obtain a
4	4	# copy of the License from http://www.apache.org/licenses/LICENSE-2.0
5	5
6	6	use strict;

26	26	save_std(qw/stdout/);
27	27	tie *STDOUT, 'TieLC', ">&=STDOUT";
28	28	my $orig_tie = tied *STDOUT;
29		ok( $orig_tie, "STDOUT is tied" );
	29	ok( $orig_tie, "STDOUT is tied" );
30	30
31	31	my $fd = next_fd;
32	32
33		run_test($_, 'unicode') for qw(
	33	run_test($_) for qw(
34	34	capture
35	35	capture_scalar
	36	capture_stdout
	37	capture_stderr
36	38	capture_merged
37	39	);
38	40
39	41	if ( ! $no_fork ) {
40		run_test($_, 'unicode') for qw(
	42	run_test($_) for qw(
41	43	tee
42	44	tee_scalar
	45	tee_stdout
	46	tee_stderr
43	47	tee_merged
44	48	);
45	49	}

-2

t/14-stderr-tied.t less more

30	30
31	31	my $fd = next_fd;
32	32
33		run_test($_, 'unicode') for qw(
	33	run_test($_) for qw(
34	34	capture
35	35	capture_scalar
	36	capture_stdout
	37	capture_stderr
36	38	capture_merged
37	39	);
38	40
39	41	if ( ! $no_fork ) {
40		run_test($_, 'unicode') for qw(
	42	run_test($_) for qw(
41	43	tee
42	44	tee_scalar
	45	tee_stdout
	46	tee_stderr
43	47	tee_merged
44	48	);
45	49	}

-0

t/15-stdin-tied.t less more

35	35	run_test($_) for qw(
36	36	capture
37	37	capture_scalar
	38	capture_stdout
	39	capture_stderr
38	40	capture_merged
39	41	);
40	42

42	44	run_test($_) for qw(
43	45	tee
44	46	tee_scalar
	47	tee_stdout
	48	tee_stderr
45	49	tee_merged
46	50	);
47	51	}

+87

-0

t/17-pass-results.t less more

	0	# Copyright (c) 2009 by David Golden. All rights reserved.
	1	# Licensed under Apache License, Version 2.0 (the "License").
	2	# You may not use this file except in compliance with the License.
	3	# A copy of the License was distributed with this file or you may obtain a
	4	# copy of the License from http://www.apache.org/licenses/LICENSE-2.0
	5
	6	use strict;
	7	use warnings;
	8	use Test::More;
	9	use lib 't/lib';
	10	use IO::Handle;
	11	use Utils qw/next_fd sig_num/;
	12	use Capture::Tiny ':all';
	13	use Config;
	14
	15	plan tests => 12;
	16
	17	local $ENV{PERL_CAPTURE_TINY_TIMEOUT} = 0; # no timeouts
	18
	19	my $builder = Test::More->builder;
	20	binmode($builder->failure_output, ':utf8') if $] >= 5.008;
	21
	22	my $fd = next_fd;
	23	my ($out, $err, $res, @res);
	24
	25	#--------------------------------------------------------------------------#
	26	# capture to array
	27	#--------------------------------------------------------------------------#
	28
	29	($out, $err, @res) = capture {
	30	print STDOUT "foo\n";
	31	print STDERR "bar\n";
	32	return qw/one two three/;
	33	};
	34
	35	is( $out, "foo\n", "capture -> STDOUT captured" );
	36	is( $err, "bar\n", "capture -> STDERR captured" );
	37	is_deeply( \@res, [qw/one two three/], "return values -> array" );
	38
	39	#--------------------------------------------------------------------------#
	40	# capture to scalar
	41	#--------------------------------------------------------------------------#
	42
	43	($out, $err, $res) = capture {
	44	print STDOUT "baz\n";
	45	print STDERR "bam\n";
	46	return qw/one two three/;
	47	};
	48
	49	is( $out, "baz\n", "capture -> STDOUT captured" );
	50	is( $err, "bam\n", "capture -> STDERR captured" );
	51	is( $res, "one", "return value -> scalar" );
	52
	53	#--------------------------------------------------------------------------#
	54	# capture_stdout to array
	55	#--------------------------------------------------------------------------#
	56
	57	($out, @res) = capture_stdout {
	58	print STDOUT "foo\n";
	59	return qw/one two three/;
	60	};
	61
	62	is( $out, "foo\n", "capture_stdout -> STDOUT captured" );
	63	is_deeply( \@res, [qw/one two three/], "return values -> array" );
	64
	65	#--------------------------------------------------------------------------#
	66	# capture_merged to array
	67	#--------------------------------------------------------------------------#
	68
	69	($out, $res) = capture_merged {
	70	print STDOUT "baz\n";
	71	print STDERR "bam\n";
	72	return qw/one two three/;
	73	};
	74
	75	like( $out, qr/baz/, "capture_merged -> STDOUT captured" );
	76	like( $out, qr/bam/, "capture_merged -> STDERR captured" );
	77	is( $res, "one", "return value -> scalar" );
	78
	79	#--------------------------------------------------------------------------#
	80	# finish
	81	#--------------------------------------------------------------------------#
	82
	83	is( next_fd, $fd, "no file descriptors leaked" );
	84
	85	exit 0;
	86

+94

-0

t/18-custom-capture.t less more

	0	# Copyright (c) 2009 by David Golden. All rights reserved.
	1	# Licensed under Apache License, Version 2.0 (the "License").
	2	# You may not use this file except in compliance with the License.
	3	# A copy of the License was distributed with this file or you may obtain a
	4	# copy of the License from http://www.apache.org/licenses/LICENSE-2.0
	5
	6	use strict;
	7	use warnings;
	8	use Test::More;
	9	use lib 't/lib';
	10	use IO::Handle;
	11	use IO::File;
	12	use File::Temp qw/tmpnam/;
	13	use Utils qw/next_fd sig_num/;
	14	use Capture::Tiny ':all';
	15	use Config;
	16
	17	plan tests => 9;
	18
	19	local $ENV{PERL_CAPTURE_TINY_TIMEOUT} = 0; # no timeouts
	20
	21	my $builder = Test::More->builder;
	22	binmode($builder->failure_output, ':utf8') if $] >= 5.008;
	23
	24	my $fd = next_fd;
	25	my ($out, $err, $res, @res);
	26
	27	#--------------------------------------------------------------------------#
	28	# capture to array
	29	#--------------------------------------------------------------------------#
	30
	31	my $temp_out = tmpnam();
	32	my $temp_err = tmpnam();
	33
	34	ok( !-e $temp_out, "Temp out '$temp_out' doesn't exist" );
	35	ok( !-e $temp_err, "Temp out '$temp_err' doesn't exist" );
	36
	37	my $out_fh = IO::File->new($temp_out, "w+");
	38	my $err_fh = IO::File->new($temp_err, "w+");
	39
	40	capture {
	41	print STDOUT "foo\n";
	42	print STDERR "bar\n";
	43	} stdout => $out_fh, stderr => $err_fh;
	44
	45	$out_fh->close;
	46	$err_fh->close;
	47
	48	is( scalar do {local (@ARGV,$/) = $temp_out; <>} , "foo\n",
	49	"captured STDOUT to custom handle (IO::File)"
	50	);
	51	is( scalar do {local (@ARGV,$/) = $temp_err; <>} , "bar\n",
	52	"captured STDERR to custom handle (IO::File)"
	53	);
	54
	55	unlink $_ for $temp_out, $temp_err;
	56
	57	#--------------------------------------------------------------------------#
	58
	59	$temp_out = tmpnam();
	60	$temp_err = tmpnam();
	61
	62	ok( !-e $temp_out, "Temp out '$temp_out' doesn't exist" );
	63	ok( !-e $temp_err, "Temp out '$temp_err' doesn't exist" );
	64
	65	open $out_fh, "+>", $temp_out;
	66	open $err_fh, "+>", $temp_err;
	67
	68	capture {
	69	print STDOUT "foo\n";
	70	print STDERR "bar\n";
	71	} stdout => $out_fh, stderr => $err_fh;
	72
	73	$out_fh->close;
	74	$err_fh->close;
	75
	76	is( scalar do {local (@ARGV,$/) = $temp_out; <>} , "foo\n",
	77	"captured STDOUT to custom handle (GLOB)"
	78	);
	79	is( scalar do {local (@ARGV,$/) = $temp_err; <>} , "bar\n",
	80	"captured STDERR to custom handle (GLOB)"
	81	);
	82
	83	unlink $_ for $temp_out, $temp_err;
	84
	85	#--------------------------------------------------------------------------#
	86	# finish
	87	#--------------------------------------------------------------------------#
	88
	89	close ARGV; # opened by reading from <>
	90	is( next_fd, $fd, "no file descriptors leaked" );
	91
	92	exit 0;
	93

+75

-17

t/lib/Cases.pm less more

0		#
1		# This file is part of Capture-Tiny
2		#
3		# This software is Copyright (c) 2009 by David Golden.
4		#
5		# This is free software, licensed under:
6		#
7		# The Apache License, Version 2.0, January 2004
8		#
9	0	package Cases;
10	1	use strict;
11	2	use warnings;

18	9	run_test
19	10	);
20	11
21		my $have_diff = eval {
22		require Test::Differences;
	12	my $have_diff = eval {
	13	require Test::Differences;
23	14	Test::Differences->import;
24	15	$Test::Differences::VERSION < 0.60; # 0.60+ is causing strange failures
25	16	};

39	30	my $t = shift;
40	31	return unless $t eq 'unicode';
41	32	my %seen;
42		my @orig_layers = grep {$_ ne 'unix' and $_ ne 'perlio' and $seen{$_}++} PerlIO::get_layers(\*STDOUT);
43		binmode(STDOUT, ":utf8") if fileno(STDOUT);
44		binmode(STDERR, ":utf8") if fileno(STDERR);
	33	my @orig_layers = (
	34	[ grep {$_ ne 'unix' and $_ ne 'perlio' and $seen{stdout}{$_}++} PerlIO::get_layers(\*STDOUT) ],
	35	[ grep {$_ ne 'unix' and $_ ne 'perlio' and $seen{stderr}{$_}++} PerlIO::get_layers(\*STDERR) ],
	36	);
	37	binmode(STDOUT, ":utf8") if fileno(STDOUT);
	38	binmode(STDERR, ":utf8") if fileno(STDERR);
45	39	return @orig_layers;
46	40	}
47	41
48	42	sub _restore_layers {
49	43	my ($t, @orig_layers) = @_;
50	44	return unless $t eq 'unicode';
51		binmode(STDOUT, join( ":", "", "raw", @orig_layers)) if fileno(STDOUT);
52		binmode(STDERR, join( ":", "", "raw", @orig_layers)) if fileno(STDERR);
	45	binmode(STDOUT, join( ":", "", "raw", @{$orig_layers[0]})) if fileno(STDOUT);
	46	binmode(STDERR, join( ":", "", "raw", @{$orig_layers[1]})) if fileno(STDERR);
53	47	}
54	48
55	49	#--------------------------------------------------------------------------#

112	106	_is_or_diff( $got_out, $expected[0], "$l\|$m\|$c\|$t - got STDOUT" );
113	107	},
114	108	},
	109	capture_stdout => {
	110	cnt => 3,
	111	test => sub {
	112	my ($m, $c, $t, $l) = @_;
	113	my ($inner_out, $inner_err);
	114	my ($outer_out, $outer_err) = capture {
	115	$inner_out = capture_stdout {
	116	$methods{$m}->( $channels{$c}{output}->($t) );
	117	};
	118	};
	119	my @expected = $channels{$c}{expect}->($t);
	120	_is_or_diff( $inner_out, $expected[0], "$l\|$m\|$c\|$t - inner STDOUT" );
	121	_is_or_diff( $outer_out, "", "$l\|$m\|$c\|$t - outer STDOUT" );
	122	_is_or_diff( $outer_err, $expected[1], "$l\|$m\|$c\|$t - outer STDERR" );
	123	},
	124	},
	125	capture_stderr => {
	126	cnt => 3,
	127	test => sub {
	128	my ($m, $c, $t, $l) = @_;
	129	my ($inner_out, $inner_err);
	130	my ($outer_out, $outer_err) = capture {
	131	$inner_err = capture_stderr {
	132	$methods{$m}->( $channels{$c}{output}->($t) );
	133	};
	134	};
	135	my @expected = $channels{$c}{expect}->($t);
	136	_is_or_diff( $inner_err, $expected[1], "$l\|$m\|$c\|$t - inner STDERR" );
	137	_is_or_diff( $outer_out, $expected[0], "$l\|$m\|$c\|$t - outer STDOUT" );
	138	_is_or_diff( $outer_err, "", "$l\|$m\|$c\|$t - outer STDERR" );
	139	},
	140	},
115	141	capture_merged => {
116	142	cnt => 2,
117	143	test => sub {

155	181	_is_or_diff( $got_out, $expected[0], "$l\|$m\|$c\|$t - got STDOUT" );
156	182	_is_or_diff( $tee_out, $expected[0], "$l\|$m\|$c\|$t - tee STDOUT" );
157	183	_is_or_diff( $tee_err, $expected[1], "$l\|$m\|$c\|$t - tee STDERR" );
	184	}
	185	},
	186	tee_stdout => {
	187	cnt => 3,
	188	test => sub {
	189	my ($m, $c, $t, $l) = @_;
	190	my ($inner_out, $inner_err);
	191	my ($tee_out, $tee_err) = capture {
	192	$inner_out = tee_stdout {
	193	$methods{$m}->( $channels{$c}{output}->($t) );
	194	};
	195	};
	196	my @expected = $channels{$c}{expect}->($t);
	197	_is_or_diff( $inner_out, $expected[0], "$l\|$m\|$c\|$t - inner STDOUT" );
	198	_is_or_diff( $tee_out, $expected[0], "$l\|$m\|$c\|$t - teed STDOUT" );
	199	_is_or_diff( $tee_err, $expected[1], "$l\|$m\|$c\|$t - unmodified STDERR" );
	200	}
	201	},
	202	tee_stderr => {
	203	cnt => 3,
	204	test => sub {
	205	my ($m, $c, $t, $l) = @_;
	206	my ($inner_out, $inner_err);
	207	my ($tee_out, $tee_err) = capture {
	208	$inner_err = tee_stderr {
	209	$methods{$m}->( $channels{$c}{output}->($t) );
	210	};
	211	};
	212	my @expected = $channels{$c}{expect}->($t);
	213	_is_or_diff( $inner_err, $expected[1], "$l\|$m\|$c\|$t - inner STDOUT" );
	214	_is_or_diff( $tee_out, $expected[0], "$l\|$m\|$c\|$t - unmodified STDOUT" );
	215	_is_or_diff( $tee_err, $expected[1], "$l\|$m\|$c\|$t - teed STDERR" );
158	216	}
159	217	},
160	218	tee_merged => {

194	252	for my $c ( keys %channels ) {
195	253	for my $t ( keys %texts ) {
196	254	my @orig_layers = _set_utf8($t);
197		local $TODO = "not yet supported"
	255	local $TODO = "not supported on all platforms"
198	256	if $t eq $todo;
199	257	$tests{$test_type}{test}->($m, $c, $t, $test_type);
200	258	_restore_layers($t, @orig_layers);

-9

t/lib/TieLC.pm less more

0		#
1		# This file is part of Capture-Tiny
2		#
3		# This software is Copyright (c) 2009 by David Golden.
4		#
5		# This is free software, licensed under:
6		#
7		# The Apache License, Version 2.0, January 2004
8		#
9	0	package TieLC;
10	1
11	2	sub TIEHANDLE

-9

t/lib/Utils.pm less more

0		#
1		# This file is part of Capture-Tiny
2		#
3		# This software is Copyright (c) 2009 by David Golden.
4		#
5		# This is free software, licensed under:
6		#
7		# The Apache License, Version 2.0, January 2004
8		#
9	0	package Utils;
10	1	use strict;
11	2	use warnings;

-9

xt/release/distmeta.t less more

0	0	#!perl
1		#
2		# This file is part of Capture-Tiny
3		#
4		# This software is Copyright (c) 2009 by David Golden.
5		#
6		# This is free software, licensed under:
7		#
8		# The Apache License, Version 2.0, January 2004
9		#
10	1
11	2	use Test::More;
12	3

-9

xt/release/pod-coverage.t less more

0	0	#!perl
1		#
2		# This file is part of Capture-Tiny
3		#
4		# This software is Copyright (c) 2009 by David Golden.
5		#
6		# This is free software, licensed under:
7		#
8		# The Apache License, Version 2.0, January 2004
9		#
10	1
11	2	use Test::More;
12	3

-9

xt/release/pod-syntax.t less more

0	0	#!perl
1		#
2		# This file is part of Capture-Tiny
3		#
4		# This software is Copyright (c) 2009 by David Golden.
5		#
6		# This is free software, licensed under:
7		#
8		# The Apache License, Version 2.0, January 2004
9		#
10	1	use Test::More;
11	2
12	3	eval "use Test::Pod 1.41";

-9

xt/release/portability.t less more

0	0	#!perl
1		#
2		# This file is part of Capture-Tiny
3		#
4		# This software is Copyright (c) 2009 by David Golden.
5		#
6		# This is free software, licensed under:
7		#
8		# The Apache License, Version 2.0, January 2004
9		#
10	1
11	2	use Test::More;
12	3

+12

-0

xt/release/test-version.t less more

	0	#!/usr/bin/perl
	1	use 5.006;
	2	use strict;
	3	use warnings;
	4	use Test::More;
	5
	6	eval "use Test::Version 0.04";
	7	plan skip_all => "Test::Version 0.04 required for testing versions"
	8	if $@;
	9
	10	version_all_ok();
	11	done_testing;