Koha/misc/translator/VerboseWarnings.pm
James O'Keeffe 2b607d8414 Bug 24000: Some modules do not return 1
This patch adds "1;" to the end of the following perl files:
Koha/Filter/MARC/EmbedItemsAvailability.pm
Koha/Filter/MARC/EmbedSeeFromHeadings.pm
Koha/Filter/MARC/Null.pm
Koha/Item/Search/Field.pm
Koha/SearchEngine.pm
misc/translator/VerboseWarnings.pm
t/lib/Koha/Plugin/Test.pm

This indicates the succesful execution of the initialization code.

Test plan:
Ensure that there are no other perl files that need "1;", but dont have
it.

Signed-off-by: David Nind <david@davidnind.com>

Signed-off-by: Katrin Fischer <katrin.fischer.83@web.de>

Signed-off-by: Jonathan Druart <jonathan.druart@bugs.koha-community.org>
2021-04-06 15:56:30 +02:00

128 lines
3.2 KiB
Perl

package VerboseWarnings;
use Modern::Perl;
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
###############################################################################
=head1 NAME
VerboseWarnings.pm - Verbose warnings for Perl scripts
=head1 DESCRIPTION
Contains convenience functions to construct Unix-style informational,
verbose warnings.
=cut
###############################################################################
@ISA = qw(Exporter);
@EXPORT_OK = qw(
&pedantic_p
&warn_additional
&warn_normal
&warn_pedantic
&error_additional
&error_normal
);
%EXPORT_TAGS = (
'warn' => [ 'warn_additional', 'warn_normal', 'warn_pedantic' ],
'die' => [ 'error_additional', 'error_normal' ],
);
###############################################################################
use vars qw( $appName $input $input_abbr $pedantic_p $pedantic_tag $quiet);
use vars qw( $warned $erred );
sub set_application_name {
my($s) = @_;
$appName = $& if !defined $appName && $s =~ /[^\/]+$/;
}
sub application_name {
return $appName;
}
sub set_input_file_name {
my($s) = @_;
$input = $s;
$input_abbr = $& if defined $s && $s =~ /[^\/]+$/;
}
sub set_pedantic_mode {
my($p) = @_;
$pedantic_p = $p;
$pedantic_tag = $pedantic_p? '': ' (negligible)';
}
sub pedantic_p {
return $pedantic_p;
}
sub construct_warn_prefix {
my($prefix, $lc) = @_;
die "construct_warn_prefix called before set_application_name"
unless defined $appName;
die "construct_warn_prefix called before set_input_file_name"
unless defined $input || !defined $lc; # be a bit lenient
die "construct_warn_prefix called before set_pedantic_mode"
unless defined $pedantic_tag;
# FIXME: The line number is not accurate, but should be "close enough"
# FIXME: This wording is worse than what was there, but it's wrong to
# FIXME: hard-code this thing in each warn statement. Need improvement.
return "$appName: $prefix: " . (defined $lc? "$input_abbr: line $lc: ": defined $input_abbr? "$input_abbr: ": '');
}
sub warn_additional {
my($msg, $lc) = @_;
my $prefix = construct_warn_prefix('Warning', $lc);
$msg .= "\n" unless $msg =~ /\n$/s;
warn "$prefix$msg";
}
sub warn_normal {
my($msg, $lc) = @_;
$warned += 1;
warn_additional($msg, $lc);
}
sub warn_pedantic {
my($msg, $lc, $flag) = @_;
my $prefix = construct_warn_prefix("Warning$pedantic_tag", $lc);
$msg .= "\n" unless $msg =~ /\n$/s;
warn "$prefix$msg" if ($pedantic_p || !$$flag) && $quiet;
if (!$pedantic_p) {
$prefix = construct_warn_prefix("Warning$pedantic_tag", undef);
warn $prefix."Further similar negligible warnings will not be reported, use --pedantic for details\n" unless ($$flag || !$quiet);
$$flag = 1;
}
$warned += 1;
}
sub error_additional {
my($msg, $lc) = @_;
my $prefix = construct_warn_prefix('ERROR', $lc);
$msg .= "\n" unless $msg =~ /\n$/s;
warn "$prefix$msg";
}
sub error_normal {
my($msg, $lc) = @_;
$erred += 1;
error_additional($msg, $lc);
}
sub warned {
return $warned; # number of times warned
}
1;
###############################################################################