From f40a0fc93aac59074736460dfc6a49417b5ae9c1 Mon Sep 17 00:00:00 2001 From: uralm1 Date: Thu, 3 Feb 2022 10:30:37 +0500 Subject: [PATCH] Use SIG{__WARN__} when loading Rexfile instead of stderr redirection --- lib/Rex/CLI.pm | 25 +++---- t/load_rexfile.t | 175 +++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 186 insertions(+), 14 deletions(-) create mode 100644 t/load_rexfile.t diff --git a/lib/Rex/CLI.pm b/lib/Rex/CLI.pm index 6a15a9fd0..c849b72e5 100644 --- a/lib/Rex/CLI.pm +++ b/lib/Rex/CLI.pm @@ -744,14 +744,11 @@ sub load_rexfile { } }; - my ( $stdout, $stderr, $default_stderr ); - open $default_stderr, ">&", STDERR; - - # we close STDERR here because we don't want to see the - # normal perl error message on the screen. Instead we print - # the error message in the catch-if below. - local *STDERR; - open( STDERR, ">>", \$stderr ); + # we don't want to see the + # normal perl warning message on the screen. Instead we print + # the warning message in the catch-if below + my @warnings; + local $SIG{__WARN__} = sub { push @warnings, $_[0] }; # we can't use $rexfile here, because if the variable contains dots # the perl interpreter try to load the file directly without using @INC @@ -761,13 +758,13 @@ sub load_rexfile { # update %INC so that we can later use it to find the rexfile $INC{"__Rexfile__.pm"} = $rexfile; - # reopen STDERR - open STDERR, ">&", $default_stderr; - - if ($stderr) { - my @lines = split( $/, $stderr ); + if (@warnings) { Rex::Logger::info( "You have some code warnings:", 'warn' ); - Rex::Logger::info( "\t$_", 'warn' ) for @lines; + for (@warnings) { + # remove /loader/.../ prefix before filename + s|/loader/[^/]+/||; + Rex::Logger::info( "\t$_", 'warn' ); + } } 1; diff --git a/t/load_rexfile.t b/t/load_rexfile.t new file mode 100644 index 000000000..daf3d9b52 --- /dev/null +++ b/t/load_rexfile.t @@ -0,0 +1,175 @@ +use strict; +use warnings; + +use Test::More; +use Test::Output; +use File::Temp; +use File::Spec; + +use Rex::CLI; + +#diag 'create some rexfiles to test...'; +my $fh = undef; +my $testdir = File::Temp->newdir('rextest.XXXX', TMPDIR => 1, CLEANUP => 1); +while () { + last if /^__END__$/; + if (/^@@ *(\S+)$/) { + #diag "prepare file $1"; + close($fh) if $fh; + open($fh, '>', File::Spec->catfile($testdir, $1)) or die $!; + next; + } + print $fh $_ if $fh; +} +close($fh) if $fh; + +our $exit_was_called = undef; + +# we must disable Rex::CLI::exit() sub imported from Rex::Commands +no warnings 'redefine'; +local *Rex::CLI::exit = sub { $exit_was_called = 1 }; +use warnings 'redefine'; + +# +# enable this to debug! +# +$::QUIET = 1; + +#$Rex::Logger::no_color = 1; +my $logfile = File::Spec->catfile($testdir, 'log'); +Rex::Config->set_log_filename($logfile); + + +# NOW TEST + +# No Rexfile warning (via Rex::Logger) +Rex::CLI::load_rexfile(File::Spec->catfile($testdir, 'no_Rexfile')); +my $content = _get_log(); +like($content, qr/WARN - No Rexfile found/, 'No Rexfile warning (via logger)'); + +# Valid Rexfile +_reset_test(); +output_like { + Rex::CLI::load_rexfile(File::Spec->catfile($testdir, 'Rexfile_noerror')); +} qr/^$/, qr/^$/, 'No stdout/stderr messages on valid Rexfile'; +$content = _get_log(); +is($content, '', 'No warnings on valid Rexfile (via logger)'); + +# Rexfile with warnings +_reset_test(); +output_like { + Rex::CLI::load_rexfile(File::Spec->catfile($testdir, 'Rexfile_warnings')); +} qr/^$/, qr/^$/, 'No stdout/stderr messages on Rexfile with warnings'; +$content = _get_log(); +ok(!$exit_was_called, 'sub load_rexfile() not exit'); +like($content, qr/WARN - You have some code warnings/, 'Code warnings via logger'); +like($content, qr/This is warning/, 'warn() warning via logger'); +like($content, qr/Use of uninitialized value \$undef/, 'perl warning via logger'); +unlike($content, qr#at /loader/0x#, 'loader prefix is filtered in warnings report'); + +# Rexfile with fatal errors +_reset_test(); +output_like { + Rex::CLI::load_rexfile(File::Spec->catfile($testdir, 'Rexfile_fatal')); +} qr/^$/, qr/^$/, 'No stdout/stderr messages on Rexfile with errors'; +$content = _get_log(); +ok($exit_was_called, 'sub load_rexfile() aborts'); +like($content, qr/ERROR - Compile time errors/, 'Fatal errors via logger'); +like($content, qr/syntax error at/, 'syntax error is fatal error via logger'); +unlike($content, qr#at /loader/0x#, 'loader prefix is filtered in errors report'); + +# Now print messages to STDERR/STDOUT +# Valid Rexfile +_reset_test(); +output_like { + Rex::CLI::load_rexfile(File::Spec->catfile($testdir, 'Rexfile_noerror_print')); +} qr/^This is STDOUT message$/, qr/^This is STDERR message$/, 'Correct stdout/stderr messages printed from valid Rexfile'; +$content = _get_log(); +is($content, '', 'No warnings via logger on valid Rexfile that print messages'); + +# Rexfile with warnings +_reset_test(); +output_like { + Rex::CLI::load_rexfile(File::Spec->catfile($testdir, 'Rexfile_warnings_print')); +} qr/^This is STDOUT message$/, qr/^This is STDERR message$/, 'Correct stdout/stderr messages printed from Rexfile with warnings'; +$content = _get_log(); +like($content, qr/WARN - You have some code warnings/, 'Code warnings exist via logger'); + +# Rexfile with fatal errors +_reset_test(); +output_like { + Rex::CLI::load_rexfile(File::Spec->catfile($testdir, 'Rexfile_fatal_print')); +} qr/^$/, qr/^$/, 'No stdout/stderr messages printed from Rexfile that has errors'; +$content = _get_log(); +ok($exit_was_called, 'sub load_rexfile() aborts'); +like($content, qr/ERROR - Compile time errors/, 'Fatal errors exist via logger'); + + +done_testing; + + +# from logger.t +sub _get_log { + local $/; + + open my $fh, '<', $logfile or die $!; + my $loglines = <$fh>; + close $fh; + + return $loglines; +} + +sub _reset_test { + $exit_was_called = undef; + # reset log + open my $fh, '>', $logfile or die $!; + close $fh; + # reset require + delete $INC{'__Rexfile__.pm'}; +} + +__DATA__ +@@ Rexfile_noerror +use Rex; +user 'testuser'; +task test => sub { say "test1" }; + +@@ Rexfile_warnings +use Rex; +use warnings; +warn 'This is warning'; +my $undef; my $warn = 'warn'.$undef; +user 'testuser'; +task test => sub { say "test2" }; + +@@ Rexfile_fatal +use Rex; +aaaabbbbcccc +task test => sub { say "test3" }; + +@@ Rexfile_noerror_print +use Rex; +user 'testuser'; +print STDERR 'This is STDERR message'; +print STDOUT 'This is STDOUT message'; +task test2 => sub { say "test4" }; + +@@ Rexfile_warnings_print +use Rex; +use warnings; +warn 'This is warning'; +my $undef; my $warn = 'warn'.$undef; +print STDERR 'This is STDERR message'; +print STDOUT 'This is STDOUT message'; +user 'testuser'; +task test2 => sub { say "test5" }; + +@@ Rexfile_fatal_print +use Rex; +print STDERR 'This is STDERR message'; +print STDOUT 'This is STDOUT message'; +aaaabbbbcccc +print STDERR 'This is STDERR message'; +print STDOUT 'This is STDOUT message'; +task test2 => sub { say "test6" }; +