Codebase list libcapture-tiny-perl / d760ca4
fix capture bugs for utf8 if output handles closed David Golden 15 years ago
2 changed file(s) with 43 addition(s) and 6 deletion(s). Raw diff Collapse all Expand all
+13
-2
lib/Capture/Tiny.pm less more
8585 _open $dup{stdin} = IO::Handle->new, "<&=STDIN";
8686 }
8787 $proxies{stdin} = \*STDIN;
88 binmode(STDIN, ':utf8');
8889 }
8990 if ( ! defined fileno STDOUT ) {
9091 $proxy_count{stdout}++;
9899 _open $dup{stdout} = IO::Handle->new, ">&=STDOUT";
99100 }
100101 $proxies{stdout} = \*STDOUT;
102 binmode(STDOUT, ':utf8');
101103 }
102104 if ( ! defined fileno STDERR ) {
103105 $proxy_count{stderr}++;
111113 _open $dup{stderr} = IO::Handle->new, ">&=STDERR";
112114 }
113115 $proxies{stderr} = \*STDERR;
116 binmode(STDERR, ':utf8');
114117 }
115118 return %proxies;
116119 }
234237 local *CT_ORIG_STDIN = *STDIN ;
235238 local *CT_ORIG_STDOUT = *STDOUT;
236239 local *CT_ORIG_STDERR = *STDERR;
240 # find initial layers
237241 my %layers = (
238242 stdin => [PerlIO::get_layers(\*STDIN) ],
239243 stdout => [PerlIO::get_layers(\*STDOUT)],
251255 my %proxy_std = _proxy_std();
252256 _debug( "# proxy std is @{ [%proxy_std] }\n" );
253257 my $stash = { old => _copy_std() };
258 # update layers after any proxying
259 %layers = (
260 stdin => [PerlIO::get_layers(\*STDIN) ],
261 stdout => [PerlIO::get_layers(\*STDOUT)],
262 stderr => [PerlIO::get_layers(\*STDERR)],
263 );
254264 # get handles for capture and apply existing IO layers
255265 $stash->{new}{$_} = $stash->{capture}{$_} = tempfile() for qw/stdout stderr/;
256266 _debug("# will capture $_ on " .fileno($stash->{capture}{$_})."\n" ) for qw/stdout stderr/;
264274 _debug( "# redirecting in parent ...\n" );
265275 _open_std( $stash->{new} );
266276 # execute user provided code
277 my $exit_code;
267278 {
268279 local *STDIN = *CT_ORIG_STDIN if $localize{stdin}; # get original, not proxy STDIN
269280 local *STDERR = *STDOUT if $merge; # minimize buffer mixups during $code
272283 _relayer(\*STDERR, $layers{stderr}) unless $merge;
273284 _debug( "# running code $code ...\n" );
274285 $code->();
275 }
276 my $exit_code = $?; # save this for later
286 $exit_code = $?; # save this for later
287 }
277288 # restore prior filehandles and shut down tees
278289 _debug( "# restoring ...\n" );
279290 _open_std( $stash->{old} );
+30
-4
t/lib/Tests.pm less more
4646 # capture
4747 #--------------------------------------------------------------------------#
4848
49 sub capture_count { 23 }
49 sub capture_count { 25 }
5050 sub capture_tests {
5151 my $sub = 'capture';
5252
113113 _reset;
114114 my %seen;
115115 my @orig_layers = grep {$_ ne 'unix' and $seen{$_}++} PerlIO::get_layers(STDOUT);
116 binmode(STDOUT, ":utf8"); binmode(STDERR, ":utf8");
116 binmode(STDOUT, ":utf8") if fileno(STDOUT);
117 binmode(STDERR, ":utf8") if fileno(STDERR);
117118 ($out, $err) = capture {
118119 print $unicode; print STDERR $unicode;
119120 };
127128 is($out, $unicode, "$label captured stdout");
128129 is($err, $unicode, "$label captured stderr");
129130 }
130 binmode(STDOUT, join( ":", "", "raw", @orig_layers));
131 binmode(STDERR, join( ":", "", "raw", @orig_layers));
131 binmode(STDOUT, join( ":", "", "raw", @orig_layers)) if fileno(STDOUT);
132 binmode(STDERR, join( ":", "", "raw", @orig_layers)) if fileno(STDERR);
132133 }
133134
134135
196197 $label ="[$sub] s-STDOUT/STDERR:";
197198 is($out, "Foo", "$label captured stdout");
198199 is($err, "Bar", "$label captured stderr");
200
201 # Capture STDOUT/STDERR from perl -- unicode line
202 SKIP: {
203 skip "unicode support requires perl 5.8", 2 unless $] >= 5.008;
204 _reset;
205 my %seen;
206 my @orig_layers = grep {$_ ne 'unix' and $seen{$_}++} PerlIO::get_layers(STDOUT);
207 binmode(STDOUT, ":utf8") if fileno(STDOUT);
208 binmode(STDERR, ":utf8") if fileno(STDERR);
209 ($out, $err) = capture {
210 system ($^X, '-e', 'binmode(STDOUT,q{:utf8});binmode(STDERR,q{:utf8});print qq{Hi! \x{263a}\n}; print STDERR qq{Hi! \x{263a}\n}');
211 };
212
213 $label ="[$sub] s-unicode-STDOUT/STDERR:";
214 if ( $have_diff ) {
215 eq_or_diff($out, $unicode, "$label captured stdout");
216 eq_or_diff($err, $unicode, "$label captured stderr");
217 }
218 else {
219 is($out, $unicode, "$label captured stdout");
220 is($err, $unicode, "$label captured stderr");
221 }
222 binmode(STDOUT, join( ":", "", "raw", @orig_layers)) if fileno(STDOUT);
223 binmode(STDERR, join( ":", "", "raw", @orig_layers)) if fileno(STDERR);
224 }
199225
200226 }
201227