#!/usr/bin/perl use strict; use warnings; use constant stdout => 0; use constant stderr => 1; use File::Temp ':POSIX'; use Hook::Output::File; use IO::Capture::Stderr; use IO::Capture::Stdout; use Test::More tests => 24; my $get_file_content = sub { open(my $fh, '<', $_[0]) or die "Cannot open $_[0]: $!\n"; return do { local $/; local $_ = <$fh>; s/\n+$//; $_ }; }; my %handlers = ( stdout => { explicit => sub { print STDOUT $_[0] }, implicit => sub { print $_[0] }}, stderr => { explicit => sub { print STDERR $_[0] }, implicit => sub { warn $_[0], "\n" }}, ); sub test_redirect_both { my ($code, $output_messages, $test_messages) = @_; my $stdout_tmpfile = tmpnam(); my $stderr_tmpfile = tmpnam(); my $hook = Hook::Output::File->redirect( stdout => $stdout_tmpfile, stderr => $stderr_tmpfile, ); $code->[stdout]->($output_messages->[stdout]); $code->[stderr]->($output_messages->[stderr]); undef $hook; is($get_file_content->($stdout_tmpfile), $output_messages->[stdout], "$test_messages->[stdout] [both]"); is($get_file_content->($stderr_tmpfile), $output_messages->[stderr], "$test_messages->[stderr] [both]"); unlink $stdout_tmpfile; unlink $stderr_tmpfile; } test_redirect_both( [ $handlers{stdout}{explicit}, $handlers{stderr}{explicit} ], [ 'explicit stdout (redirected)', 'explicit stderr (redirected)' ], [ 'explicit stdout redirected', 'explicit stderr redirected' ], ); test_redirect_both( [ $handlers{stdout}{implicit}, $handlers{stderr}{implicit} ], [ 'implicit stdout (redirected)', 'implicit stderr (redirected)' ], [ 'implicit stdout redirected', 'implicit stderr redirected' ], ); sub test_redirect_single { my ($stream, $code, $output_message, $test_message) = @_; my $tmpfile = tmpnam(); my $hook = Hook::Output::File->redirect( $stream => $tmpfile, ); $code->($output_message); undef $hook; is($get_file_content->($tmpfile), $output_message, "$test_message [single]"); unlink $tmpfile; } test_redirect_single( 'stdout', $handlers{stdout}{explicit}, 'explicit stdout (redirected)', 'explicit stdout redirected', ); test_redirect_single( 'stderr', $handlers{stderr}{explicit}, 'explicit stderr (redirected)', 'explicit stderr redirected', ); test_redirect_single( 'stdout', $handlers{stdout}{implicit}, 'implicit stdout (redirected)', 'implicit stdout redirected', ); test_redirect_single( 'stderr', $handlers{stderr}{implicit}, 'implicit stderr (redirected)', 'implicit stderr redirected', ); sub test_capture { my ($code, $output_messages, $test_messages) = @_; my $stdout_tmpfile = tmpnam(); my $stderr_tmpfile = tmpnam(); my @descriptors = (1, 2); is(fileno STDOUT, $descriptors[stdout], 'stdout descriptor before'); is(fileno STDERR, $descriptors[stderr], 'stderr descriptor before'); my $hook = Hook::Output::File->redirect( stdout => $stdout_tmpfile, stderr => $stderr_tmpfile, ); isnt(fileno STDOUT, $descriptors[stdout], 'stdout descriptor while'); isnt(fileno STDERR, $descriptors[stderr], 'stderr descriptor while'); undef $hook; is(fileno STDOUT, $descriptors[stdout], 'stdout descriptor after'); is(fileno STDERR, $descriptors[stderr], 'stderr descriptor after'); unlink $stdout_tmpfile; unlink $stderr_tmpfile; my $capture = IO::Capture::Stdout->new; $capture->start; $code->[stdout]->($output_messages->[stdout]); $capture->stop; my @stdout_lines = $capture->read; $capture = IO::Capture::Stderr->new; $capture->start; $code->[stderr]->($output_messages->[stderr]); $capture->stop; my @stderr_lines = $capture->read; chomp @stderr_lines; is_deeply(\@stdout_lines, [ $output_messages->[stdout] ], $test_messages->[stdout]); is_deeply(\@stderr_lines, [ $output_messages->[stderr] ], $test_messages->[stderr]); } test_capture( [ $handlers{stdout}{explicit}, $handlers{stderr}{explicit} ], [ 'explicit stdout (captured)', 'explicit stderr (captured)' ], [ 'explicit stdout captured', 'explicit stderr captured' ], ); test_capture( [ $handlers{stdout}{implicit}, $handlers{stderr}{implicit} ], [ 'implicit stdout (captured)', 'implicit stderr (captured)' ], [ 'implicit stdout captured', 'implicit stderr captured' ], );