Merge remote branch 'kc/new/for-3.4/spelling' into kcmaster

[koha_fer] / misc / translator / VerboseWarnings.pm

diff --git a/misc/translator/VerboseWarnings.pm b/misc/translator/VerboseWarnings.pm
index 2b79fb0..e2d57dd 100644 (file)
--- a/misc/translator/VerboseWarnings.pm
+++ b/misc/translator/VerboseWarnings.pm
@@ -1,6 +1,7 @@
 package VerboseWarnings;
 
 use strict;
+#use warnings; FIXME - Bug 2505
 require Exporter;
 
 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
@@ -24,28 +25,36 @@ $VERSION = 0.01;
 
 @ISA = qw(Exporter);
 @EXPORT_OK = qw(
-    &set_application_name
-    &set_input_file_name
-    &set_pedantic_mode
     &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 );
+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 $input && defined $s && $s =~ /[^\/]+$/;
+    $input_abbr = $& if defined $s && $s =~ /[^\/]+$/;
 }
 
 sub set_pedantic_mode ($) {
@@ -63,40 +72,57 @@ sub construct_warn_prefix ($$) {
     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;
+           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: ": "$input_abbr: ");
+    return "$appName: $prefix: " . (defined $lc? "$input_abbr: line $lc: ": defined $input_abbr? "$input_abbr: ": '');
 }
 
-sub warn_normal ($$) {
+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;
+    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;
+       warn $prefix."Further similar negligible warnings will not be reported, use --pedantic for details\n" unless ($$flag || !$quiet);
        $$flag = 1;
     }
+    $warned += 1;
 }
 
-sub error_normal ($$) {
+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
+}
+
 ###############################################################################