1 package VerboseWarnings
;
6 use vars
qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
8 ###############################################################################
12 VerboseWarnings.pm - Verbose warnings for Perl scripts
16 Contains convenience functions to construct Unix-style informational,
21 ###############################################################################
34 'warn' => [ 'warn_additional', 'warn_normal', 'warn_pedantic' ],
35 'die' => [ 'error_additional', 'error_normal' ],
38 ###############################################################################
40 use vars
qw( $appName $input $input_abbr $pedantic_p $pedantic_tag $quiet);
41 use vars qw( $warned $erred );
43 sub set_application_name ($) {
45 $appName = $& if !defined $appName && $s =~ /[^\/]+$/;
48 sub application_name () {
52 sub set_input_file_name ($) {
55 $input_abbr = $& if defined $s && $s =~ /[^\/]+$/;
58 sub set_pedantic_mode ($) {
61 $pedantic_tag = $pedantic_p? '': ' (negligible)';
68 sub construct_warn_prefix ($$) {
69 my($prefix, $lc) = @_;
70 die "construct_warn_prefix called before set_application_name"
71 unless defined $appName;
72 die "construct_warn_prefix called before set_input_file_name"
73 unless defined $input || !defined $lc; # be a bit lenient
74 die "construct_warn_prefix called before set_pedantic_mode"
75 unless defined $pedantic_tag;
77 # FIXME: The line number is not accurate, but should be "close enough"
78 # FIXME: This wording is worse than what was there, but it's wrong to
79 # FIXME: hard-code this thing in each warn statement. Need improvement.
80 return "$appName: $prefix: " . (defined $lc? "$input_abbr: line $lc: ": defined $input_abbr? "$input_abbr: ": '');
83 sub warn_additional ($$) {
85 my $prefix = construct_warn_prefix('Warning', $lc);
86 $msg .= "\n" unless $msg =~ /\n$/s;
90 sub warn_normal ($$) {
93 warn_additional($msg, $lc);
96 sub warn_pedantic ($$$) {
97 my($msg, $lc, $flag) = @_;
98 my $prefix = construct_warn_prefix("Warning$pedantic_tag", $lc);
99 $msg .= "\n" unless $msg =~ /\n$/s;
100 warn "$prefix$msg" if ($pedantic_p || !$$flag) && $quiet;
102 $prefix = construct_warn_prefix("Warning$pedantic_tag", undef);
103 warn $prefix."Further similar negligible warnings will not be reported, use --pedantic for details\n" unless ($$flag || !$quiet);
109 sub error_additional ($$) {
111 my $prefix = construct_warn_prefix('ERROR', $lc);
112 $msg .= "\n" unless $msg =~ /\n$/s;
116 sub error_normal ($$) {
119 error_additional($msg, $lc);
123 return $warned; # number of times warned
126 ###############################################################################