Commit 1df4b729963fe6caf7aae9348aa4f037e61cab12 - libcapture-tiny-perl

Add support for custom capture handles David Golden 12 years ago

5 changed file(s) with 133 addition(s) and 6 deletion(s). Raw diff Collapse all Expand all

-0

Changes less more

8	8
9	9	- Capture functions also returns the return values from the executed
10	10	coderef [rt.cpan.org #61794, adapted from patch by Christian Walde]
	11
	12	- Capture functions take optional custom filehandles for capturing
	13	via named files instead of anonymous ones [inspired by Christian Walde]
11	14
12	15	Fixed:
13	16

-0

META.json less more

46	46	"requires" : {
47	47	"Config" : 0,
48	48	"File::Find" : 0,
	49	"IO::File" : 0,
49	50	"Test::More" : "0.62"
50	51	}
51	52	}

+12

-0

README.pod less more

66	66	return scalar @list; # $count will be 3
67	67	};
68	68
	69	Captures are normally done internally to an anonymous filehandle. To
	70	capture via a named file (e.g. to externally monitor a long-running capture),
	71	provide custom filehandles as a trailing list of option pairs:
	72
	73	my $out_fh = IO::File->new("out.txt", "w+");
	74	my $err_fh = IO::File->new("out.txt", "w+");
	75	capture { ... } stdout => $out_fh, stderr => $err_fh;
	76
	77	The filehandles must be readE<sol>write and seekable and should be empty. Modifying
	78	the files externally during a capture operation will give unpredictable
	79	results. Existing IO layers on them may be changed by the capture.
	80
69	81	=head2 capture_stdout
70	82
71	83	($stdout, @result) = capture_stdout \&code;

+26

-6

lib/Capture/Tiny.pm less more

7	7	use IO::Handle ();
8	8	use File::Spec ();
9	9	use File::Temp qw/tempfile tmpnam/;
10		use Scalar::Util qw/reftype/;
	10	use Scalar::Util qw/reftype blessed/;
11	11	# Get PerlIO or fake it
12	12	BEGIN {
13	13	local $@;

33	33
34	34	for my $sub ( keys %api ) {
35	35	my $args = join q{, }, @{$api{$sub}};
36		eval "sub $sub(&) {unshift \@_, $args; goto \\&_capture_tee;}"; ## no critic
	36	eval "sub $sub(&;@) {unshift \@_, $args; goto \\&_capture_tee;}"; ## no critic
37	37	}
38	38
39	39	our @ISA = qw/Exporter/;

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

323	331	$layers{stderr} = [PerlIO::get_layers(\*STDERR)] if $proxy_std{stderr};
324	332	_debug( "# post-proxy layers for $_\: @{$layers{$_}}\n" ) for qw/stdin stdout stderr/;
325	333	# store old handles and setup handles for capture
326		my $stash = { old => _copy_std() };
	334	$stash->{old} = _copy_std();
327	335	$stash->{new} = { %{$stash->{old}} }; # default to originals
328		$stash->{new}{stdout} = $stash->{capture}{stdout} = File::Temp->new if $do_stdout;
329		$stash->{new}{stderr} = $stash->{capture}{stderr} = File::Temp->new if $do_stderr;
	336	$stash->{new}{stdout} = ($stash->{capture}{stdout} \|\|= File::Temp->new) if $do_stdout;
	337	$stash->{new}{stderr} = ($stash->{capture}{stderr} \|\|= File::Temp->new) if $do_stderr;
330	338	_debug("# will capture stdout on " . fileno($stash->{capture}{stdout})."\n" ) if $do_stdout;
331	339	_debug("# will capture stderr on " . fileno($stash->{capture}{stderr})."\n" ) if $do_stderr;
332	340	# get handles for capture and apply existing IO layers

446	454	return scalar @list; # $count will be 3
447	455	};
448	456
	457	Captures are normally done internally to an anonymous filehandle. To
	458	capture via a named file (e.g. to externally monitor a long-running capture),
	459	provide custom filehandles as a trailing list of option pairs:
	460
	461	my $out_fh = IO::File->new("out.txt", "w+");
	462	my $err_fh = IO::File->new("out.txt", "w+");
	463	capture { ... } stdout => $out_fh, stderr => $err_fh;
	464
	465	The filehandles must be read/write and seekable and should be empty. Modifying
	466	the files externally during a capture operation will give unpredictable
	467	results. Existing IO layers on them may be changed by the capture.
	468
449	469	== capture_stdout
450	470
451	471	($stdout, @result) = capture_stdout \&code;

+91

-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	ok( !-e $temp_out, "Temp out '$temp_out' doesn't exist" );
	60	ok( !-e $temp_err, "Temp out '$temp_err' doesn't exist" );
	61
	62	open $out_fh, "+>", $temp_out;
	63	open $err_fh, "+>", $temp_err;
	64
	65	capture {
	66	print STDOUT "foo\n";
	67	print STDERR "bar\n";
	68	} stdout => $out_fh, stderr => $err_fh;
	69
	70	$out_fh->close;
	71	$err_fh->close;
	72
	73	is( scalar do {local (@ARGV,$/) = $temp_out; <>} , "foo\n",
	74	"captured STDOUT to custom handle (GLOB)"
	75	);
	76	is( scalar do {local (@ARGV,$/) = $temp_err; <>} , "bar\n",
	77	"captured STDERR to custom handle (GLOB)"
	78	);
	79
	80	unlink $_ for $temp_out, $temp_err;
	81
	82	#--------------------------------------------------------------------------#
	83	# finish
	84	#--------------------------------------------------------------------------#
	85
	86	close ARGV; # opened by reading from <>
	87	is( next_fd, $fd, "no file descriptors leaked" );
	88
	89	exit 0;
	90