1 package VerboseWarnings;
5 ###############################################################################
9 VerboseWarnings.pm - Verbose warnings for Perl scripts
13 Contains convenience functions to construct Unix-style informational,
18 ###############################################################################
20 our (@ISA, @EXPORT_OK);
34 ###############################################################################
36 use vars qw( $appName $input $input_abbr $pedantic_p $pedantic_tag $quiet);
37 use vars qw( $warned $erred );
39 sub set_application_name {
41 $appName = $& if !defined $appName && $s =~ /[^\/]+$/;
44 sub application_name {
48 sub set_input_file_name {
51 $input_abbr = $& if defined $s && $s =~ /[^\/]+$/;
54 sub set_pedantic_mode {
57 $pedantic_tag = $pedantic_p? '': ' (negligible)';
64 sub construct_warn_prefix {
65 my($prefix, $lc) = @_;
66 die "construct_warn_prefix called before set_application_name"
67 unless defined $appName;
68 die "construct_warn_prefix called before set_input_file_name"
69 unless defined $input || !defined $lc; # be a bit lenient
70 die "construct_warn_prefix called before set_pedantic_mode"
71 unless defined $pedantic_tag;
73 # FIXME: The line number is not accurate, but should be "close enough"
74 # FIXME: This wording is worse than what was there, but it's wrong to
75 # FIXME: hard-code this thing in each warn statement. Need improvement.
76 return "$appName: $prefix: " . (defined $lc? "$input_abbr: line $lc: ": defined $input_abbr? "$input_abbr: ": '');
81 my $prefix = construct_warn_prefix('Warning', $lc);
82 $msg .= "\n" unless $msg =~ /\n$/s;
89 warn_additional($msg, $lc);
93 my($msg, $lc, $flag) = @_;
94 my $prefix = construct_warn_prefix("Warning$pedantic_tag", $lc);
95 $msg .= "\n" unless $msg =~ /\n$/s;
96 warn "$prefix$msg" if ($pedantic_p || !$$flag) && $quiet;
98 $prefix = construct_warn_prefix("Warning$pedantic_tag", undef);
99 warn $prefix."Further similar negligible warnings will not be reported, use --pedantic for details\n" unless ($$flag || !$quiet);
105 sub error_additional {
107 my $prefix = construct_warn_prefix('ERROR', $lc);
108 $msg .= "\n" unless $msg =~ /\n$/s;
115 error_additional($msg, $lc);
119 return $warned; # number of times warned
124 ###############################################################################