replace -t STDERR with a common function that explains the 'no critic' annotation

This commit is contained in:
Johannes 'josch' Schauer 2020-08-19 08:16:19 +02:00
parent cd87402a18
commit 87d383d754
Signed by untrusted user: josch
GPG key ID: F2CBA5C78FBD83E1

View file

@ -94,6 +94,23 @@ my $verbosity_level = 1;
my $is_covering = !!(eval { Devel::Cover::get_coverage() }); my $is_covering = !!(eval { Devel::Cover::get_coverage() });
# the reason why Perl::Critic warns about this is, that it suspects that the
# programmer wants to implement a test whether the terminal is interactive or
# not, in which case, complex interactions with the magic *ARGV indeed make it
# advisable to use IO::Interactive. In our case, we do not want to create an
# interactivity check but just want to check whether STDERR is opened to a tty,
# so our use of -t is fine and not "fragile and complicated" as is written in
# the description of InputOutput::ProhibitInteractiveTest. Also see
# https://github.com/Perl-Critic/Perl-Critic/issues/918
sub stderr_is_tty() {
## no critic (InputOutput::ProhibitInteractiveTest)
if (-t STDERR) {
return 1;
} else {
return 0;
}
}
sub debug { sub debug {
if ($verbosity_level < 3) { if ($verbosity_level < 3) {
return; return;
@ -101,7 +118,7 @@ sub debug {
my $msg = shift; my $msg = shift;
my ($package, $filename, $line) = caller; my ($package, $filename, $line) = caller;
$msg = "D: $PID $line $msg"; $msg = "D: $PID $line $msg";
if (-t STDERR) { ## no critic (InputOutput::ProhibitInteractiveTest) if (stderr_is_tty()) {
$msg = colored($msg, 'clear'); $msg = colored($msg, 'clear');
} }
print STDERR "$msg\n"; print STDERR "$msg\n";
@ -118,7 +135,7 @@ sub info {
$msg = "$PID $line $msg"; $msg = "$PID $line $msg";
} }
$msg = "I: $msg"; $msg = "I: $msg";
if (-t STDERR) { ## no critic (InputOutput::ProhibitInteractiveTest) if (stderr_is_tty()) {
$msg = colored($msg, 'green'); $msg = colored($msg, 'green');
} }
print STDERR "$msg\n"; print STDERR "$msg\n";
@ -131,7 +148,7 @@ sub warning {
} }
my $msg = shift; my $msg = shift;
$msg = "W: $msg"; $msg = "W: $msg";
if (-t STDERR) { ## no critic (InputOutput::ProhibitInteractiveTest) if (stderr_is_tty()) {
$msg = colored($msg, 'bold yellow'); $msg = colored($msg, 'bold yellow');
} }
print STDERR "$msg\n"; print STDERR "$msg\n";
@ -144,7 +161,7 @@ sub error {
# are stripping here # are stripping here
chomp(my $msg = shift); chomp(my $msg = shift);
$msg = "E: $msg"; $msg = "E: $msg";
if (-t STDERR) { ## no critic (InputOutput::ProhibitInteractiveTest) if (stderr_is_tty()) {
$msg = colored($msg, 'bold red'); $msg = colored($msg, 'bold red');
} }
if ($verbosity_level == 3) { if ($verbosity_level == 3) {
@ -569,7 +586,7 @@ sub print_progress {
return; return;
} }
my $perc = shift; my $perc = shift;
if (!-t STDERR) { ## no critic (InputOutput::ProhibitInteractiveTest) if (!stderr_is_tty()) {
return; return;
} }
if ($perc eq "done") { if ($perc eq "done") {
@ -671,8 +688,9 @@ sub run_progress {
if (defined $newstatus) { if (defined $newstatus) {
$status = $newstatus; $status = $newstatus;
} }
## no critic (InputOutput::ProhibitInteractiveTest) if ( defined $status
if (defined $status and $verbosity_level == 1 and -t STDERR) { and $verbosity_level == 1
and stderr_is_tty()) {
# \e[2K clears everything on the current line (i.e. the # \e[2K clears everything on the current line (i.e. the
# progress bar) # progress bar)
print STDERR "\e[2K$status: "; print STDERR "\e[2K$status: ";