Skip to content

Commit f40a0fc

Browse files
committed
Use SIG{__WARN__} when loading Rexfile instead of stderr redirection
1 parent aa078fd commit f40a0fc

File tree

2 files changed

+186
-14
lines changed

2 files changed

+186
-14
lines changed

lib/Rex/CLI.pm

+11-14
Original file line numberDiff line numberDiff line change
@@ -744,14 +744,11 @@ sub load_rexfile {
744744
}
745745
};
746746

747-
my ( $stdout, $stderr, $default_stderr );
748-
open $default_stderr, ">&", STDERR;
749-
750-
# we close STDERR here because we don't want to see the
751-
# normal perl error message on the screen. Instead we print
752-
# the error message in the catch-if below.
753-
local *STDERR;
754-
open( STDERR, ">>", \$stderr );
747+
# we don't want to see the
748+
# normal perl warning message on the screen. Instead we print
749+
# the warning message in the catch-if below
750+
my @warnings;
751+
local $SIG{__WARN__} = sub { push @warnings, $_[0] };
755752

756753
# we can't use $rexfile here, because if the variable contains dots
757754
# the perl interpreter try to load the file directly without using @INC
@@ -761,13 +758,13 @@ sub load_rexfile {
761758
# update %INC so that we can later use it to find the rexfile
762759
$INC{"__Rexfile__.pm"} = $rexfile;
763760

764-
# reopen STDERR
765-
open STDERR, ">&", $default_stderr;
766-
767-
if ($stderr) {
768-
my @lines = split( $/, $stderr );
761+
if (@warnings) {
769762
Rex::Logger::info( "You have some code warnings:", 'warn' );
770-
Rex::Logger::info( "\t$_", 'warn' ) for @lines;
763+
for (@warnings) {
764+
# remove /loader/.../ prefix before filename
765+
s|/loader/[^/]+/||;
766+
Rex::Logger::info( "\t$_", 'warn' );
767+
}
771768
}
772769

773770
1;

t/load_rexfile.t

+175
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,175 @@
1+
use strict;
2+
use warnings;
3+
4+
use Test::More;
5+
use Test::Output;
6+
use File::Temp;
7+
use File::Spec;
8+
9+
use Rex::CLI;
10+
11+
#diag 'create some rexfiles to test...';
12+
my $fh = undef;
13+
my $testdir = File::Temp->newdir('rextest.XXXX', TMPDIR => 1, CLEANUP => 1);
14+
while (<DATA>) {
15+
last if /^__END__$/;
16+
if (/^@@ *(\S+)$/) {
17+
#diag "prepare file $1";
18+
close($fh) if $fh;
19+
open($fh, '>', File::Spec->catfile($testdir, $1)) or die $!;
20+
next;
21+
}
22+
print $fh $_ if $fh;
23+
}
24+
close($fh) if $fh;
25+
26+
our $exit_was_called = undef;
27+
28+
# we must disable Rex::CLI::exit() sub imported from Rex::Commands
29+
no warnings 'redefine';
30+
local *Rex::CLI::exit = sub { $exit_was_called = 1 };
31+
use warnings 'redefine';
32+
33+
#
34+
# enable this to debug!
35+
#
36+
$::QUIET = 1;
37+
38+
#$Rex::Logger::no_color = 1;
39+
my $logfile = File::Spec->catfile($testdir, 'log');
40+
Rex::Config->set_log_filename($logfile);
41+
42+
43+
# NOW TEST
44+
45+
# No Rexfile warning (via Rex::Logger)
46+
Rex::CLI::load_rexfile(File::Spec->catfile($testdir, 'no_Rexfile'));
47+
my $content = _get_log();
48+
like($content, qr/WARN - No Rexfile found/, 'No Rexfile warning (via logger)');
49+
50+
# Valid Rexfile
51+
_reset_test();
52+
output_like {
53+
Rex::CLI::load_rexfile(File::Spec->catfile($testdir, 'Rexfile_noerror'));
54+
} qr/^$/, qr/^$/, 'No stdout/stderr messages on valid Rexfile';
55+
$content = _get_log();
56+
is($content, '', 'No warnings on valid Rexfile (via logger)');
57+
58+
# Rexfile with warnings
59+
_reset_test();
60+
output_like {
61+
Rex::CLI::load_rexfile(File::Spec->catfile($testdir, 'Rexfile_warnings'));
62+
} qr/^$/, qr/^$/, 'No stdout/stderr messages on Rexfile with warnings';
63+
$content = _get_log();
64+
ok(!$exit_was_called, 'sub load_rexfile() not exit');
65+
like($content, qr/WARN - You have some code warnings/, 'Code warnings via logger');
66+
like($content, qr/This is warning/, 'warn() warning via logger');
67+
like($content, qr/Use of uninitialized value \$undef/, 'perl warning via logger');
68+
unlike($content, qr#at /loader/0x#, 'loader prefix is filtered in warnings report');
69+
70+
# Rexfile with fatal errors
71+
_reset_test();
72+
output_like {
73+
Rex::CLI::load_rexfile(File::Spec->catfile($testdir, 'Rexfile_fatal'));
74+
} qr/^$/, qr/^$/, 'No stdout/stderr messages on Rexfile with errors';
75+
$content = _get_log();
76+
ok($exit_was_called, 'sub load_rexfile() aborts');
77+
like($content, qr/ERROR - Compile time errors/, 'Fatal errors via logger');
78+
like($content, qr/syntax error at/, 'syntax error is fatal error via logger');
79+
unlike($content, qr#at /loader/0x#, 'loader prefix is filtered in errors report');
80+
81+
# Now print messages to STDERR/STDOUT
82+
# Valid Rexfile
83+
_reset_test();
84+
output_like {
85+
Rex::CLI::load_rexfile(File::Spec->catfile($testdir, 'Rexfile_noerror_print'));
86+
} qr/^This is STDOUT message$/, qr/^This is STDERR message$/, 'Correct stdout/stderr messages printed from valid Rexfile';
87+
$content = _get_log();
88+
is($content, '', 'No warnings via logger on valid Rexfile that print messages');
89+
90+
# Rexfile with warnings
91+
_reset_test();
92+
output_like {
93+
Rex::CLI::load_rexfile(File::Spec->catfile($testdir, 'Rexfile_warnings_print'));
94+
} qr/^This is STDOUT message$/, qr/^This is STDERR message$/, 'Correct stdout/stderr messages printed from Rexfile with warnings';
95+
$content = _get_log();
96+
like($content, qr/WARN - You have some code warnings/, 'Code warnings exist via logger');
97+
98+
# Rexfile with fatal errors
99+
_reset_test();
100+
output_like {
101+
Rex::CLI::load_rexfile(File::Spec->catfile($testdir, 'Rexfile_fatal_print'));
102+
} qr/^$/, qr/^$/, 'No stdout/stderr messages printed from Rexfile that has errors';
103+
$content = _get_log();
104+
ok($exit_was_called, 'sub load_rexfile() aborts');
105+
like($content, qr/ERROR - Compile time errors/, 'Fatal errors exist via logger');
106+
107+
108+
done_testing;
109+
110+
111+
# from logger.t
112+
sub _get_log {
113+
local $/;
114+
115+
open my $fh, '<', $logfile or die $!;
116+
my $loglines = <$fh>;
117+
close $fh;
118+
119+
return $loglines;
120+
}
121+
122+
sub _reset_test {
123+
$exit_was_called = undef;
124+
# reset log
125+
open my $fh, '>', $logfile or die $!;
126+
close $fh;
127+
# reset require
128+
delete $INC{'__Rexfile__.pm'};
129+
}
130+
131+
__DATA__
132+
@@ Rexfile_noerror
133+
use Rex;
134+
user 'testuser';
135+
task test => sub { say "test1" };
136+
137+
@@ Rexfile_warnings
138+
use Rex;
139+
use warnings;
140+
warn 'This is warning';
141+
my $undef; my $warn = 'warn'.$undef;
142+
user 'testuser';
143+
task test => sub { say "test2" };
144+
145+
@@ Rexfile_fatal
146+
use Rex;
147+
aaaabbbbcccc
148+
task test => sub { say "test3" };
149+
150+
@@ Rexfile_noerror_print
151+
use Rex;
152+
user 'testuser';
153+
print STDERR 'This is STDERR message';
154+
print STDOUT 'This is STDOUT message';
155+
task test2 => sub { say "test4" };
156+
157+
@@ Rexfile_warnings_print
158+
use Rex;
159+
use warnings;
160+
warn 'This is warning';
161+
my $undef; my $warn = 'warn'.$undef;
162+
print STDERR 'This is STDERR message';
163+
print STDOUT 'This is STDOUT message';
164+
user 'testuser';
165+
task test2 => sub { say "test5" };
166+
167+
@@ Rexfile_fatal_print
168+
use Rex;
169+
print STDERR 'This is STDERR message';
170+
print STDOUT 'This is STDOUT message';
171+
aaaabbbbcccc
172+
print STDERR 'This is STDERR message';
173+
print STDOUT 'This is STDOUT message';
174+
task test2 => sub { say "test6" };
175+

0 commit comments

Comments
 (0)