Mass Deface
). It also defines
some helper function to enable or disable these channels, and some
shorthand function to output on specific channels.
=cut
use 5.006;
use strict;
use Exporter;
use vars qw (@ISA @EXPORT);
@ISA = qw (Exporter);
@EXPORT = qw (&prog_error &error &fatal &verb
&switch_warning &parse_WARNINGS &parse_warnings);
=head2 CHANNELS
The following channels can be used as the first argument of
C. For some of them we list a shorthand
function that makes the code more readable.
=over 4
=item C
Fatal errors. Use C<&fatal> to send messages over this channel.
=item C
Common errors. Use C<&error> to send messages over this channel.
=item C
Errors related to GNU Standards.
=item C
Errors related to GNU Standards that should be warnings in "foreign" mode.
=item C
Errors related to GNITS Standards (silent by default).
=item C
Internal errors. Use C<&prog_error> to send messages over this channel.
=item C
Constructs compromising the cross-compilation of the package.
=item C
Warnings related to GNU Coding Standards.
=item C
Warnings about obsolete features (silent by default).
=item C
Warnings about user redefinitions of Automake rules or
variables (silent by default).
=item C
Warnings about non-portable constructs.
=item C
Warnings about weird syntax, unused variables, typos ...
=item C
Warnings about unsupported (or mis-supported) features.
=item C
Messages output in C<--verbose> mode. Use C<&verb> to send such messages.
=item C
Informative messages.
=back
=cut
# Initialize our list of error/warning channels.
# Do not forget to update &usage and the manual
# if you add or change a warning channel.
register_channel 'fatal', type => 'fatal', ordered => 0;
register_channel 'error', type => 'error';
register_channel 'error-gnu', type => 'error';
register_channel 'error-gnu/warn', type => 'error';
register_channel 'error-gnits', type => 'error', silent => 1;
register_channel 'automake', type => 'fatal', backtrace => 1,
header => ("####################\n" .
"## Internal Error ##\n" .
"####################\n"),
footer => "\nPlease contact .",
ordered => 0;
register_channel 'cross', type => 'warning', silent => 1;
register_channel 'gnu', type => 'warning';
register_channel 'obsolete', type => 'warning', silent => 1;
register_channel 'override', type => 'warning', silent => 1;
register_channel 'portability', type => 'warning', silent => 1;
register_channel 'syntax', type => 'warning';
register_channel 'unsupported', type => 'warning';
register_channel 'verb', type => 'debug', silent => 1, ordered => 0;
register_channel 'note', type => 'debug', silent => 0;
=head2 FUNCTIONS
=over 4
=item C
Return the warning category descriptions.
=cut
sub usage ()
{
return "Warning categories include:
`cross' cross compilation issues
`gnu' GNU coding standards (default in gnu and gnits modes)
`obsolete' obsolete features or constructions
`override' user redefinitions of Automake rules or variables
`portability' portability issues (default in gnu and gnits modes)
`syntax' dubious syntactic constructs (default)
`unsupported' unsupported or incomplete features (default)
`all' all the warnings
`no-CATEGORY' turn off warnings in CATEGORY
`none' turn off all the warnings
`error' treat warnings as errors";
}
=item C
Signal a programming error (on channel C),
display C<$MESSAGE>, and exit 1.
=cut
sub prog_error ($;%)
{
my ($msg, %opts) = @_;
msg 'automake', '', $msg, %opts;
}
=item C
=item C
Uncategorized errors.
=cut
sub error ($;$%)
{
my ($where, $msg, %opts) = @_;
msg ('error', $where, $msg, %opts);
}
=item C
=item C
Fatal errors.
=cut
sub fatal ($;$%)
{
my ($where, $msg, %opts) = @_;
msg ('fatal', $where, $msg, %opts);
}
=item C
C<--verbose> messages.
=cut
sub verb ($;%)
{
my ($msg, %opts) = @_;
msg 'verb', '', $msg, %opts;
}
=item C
If C<$CATEGORY> is C, turn on channel C.
If it is C, turn C off.
Else handle C and C for completeness.
=cut
sub switch_warning ($)
{
my ($cat) = @_;
my $has_no = 0;
if ($cat =~ /^no-(.*)$/)
{
$cat = $1;
$has_no = 1;
}
if ($cat eq 'all')
{
setup_channel_type 'warning', silent => $has_no;
}
elsif ($cat eq 'none')
{
setup_channel_type 'warning', silent => ! $has_no;
}
elsif ($cat eq 'error')
{
$warnings_are_errors = ! $has_no;
# Set exit code if Perl warns about something
# (like uninitialized variables).
$SIG{"__WARN__"} =
$has_no ? 'DEFAULT' : sub { print STDERR @_; $exit_code = 1; };
}
elsif (channel_type ($cat) eq 'warning')
{
setup_channel $cat, silent => $has_no;
}
else
{
return 1;
}
return 0;
}
=item C
Parse the WARNINGS environment variable.
=cut
sub parse_WARNINGS ()
{
if (exists $ENV{'WARNINGS'})
{
# Ignore unknown categories. This is required because WARNINGS
# should be honored by many tools.
switch_warning $_ foreach (split (',', $ENV{'WARNINGS'}));
}
}
=item C
Parse the argument of C<--warning=CATEGORY> or C<-WCATEGORY>.
C<$OPTIONS> is C<"--warning"> or C<"-W">, C<@ARGUMENT> is a list of
C.
This can be used as an argument to C.
=cut
sub parse_warnings ($@)
{
my ($opt, @categories) = @_;
foreach my $cat (map { split ',' } @categories)
{
msg 'unsupported', "unknown warning category `$cat'"
if switch_warning $cat;
}
}
=item C
Configure channels for strictness C<$STRICTNESS_NAME>.
=cut
sub set_strictness ($)
{
my ($name) = @_;
if ($name eq 'gnu')
{
setup_channel 'error-gnu', silent => 0;
setup_channel 'error-gnu/warn', silent => 0, type => 'error';
setup_channel 'error-gnits', silent => 1;
setup_channel 'portability', silent => 0;
setup_channel 'gnu', silent => 0;
}
elsif ($name eq 'gnits')
{
setup_channel 'error-gnu', silent => 0;
setup_channel 'error-gnu/warn', silent => 0, type => 'error';
setup_channel 'error-gnits', silent => 0;
setup_channel 'portability', silent => 0;
setup_channel 'gnu', silent => 0;
}
elsif ($name eq 'foreign')
{
setup_channel 'error-gnu', silent => 1;
setup_channel 'error-gnu/warn', silent => 0, type => 'warning';
setup_channel 'error-gnits', silent => 1;
setup_channel 'portability', silent => 1;
setup_channel 'gnu', silent => 1;
}
else
{
prog_error "level `$name' not recognized\n";
}
}
=back
=head1 SEE ALSO
L
=head1 HISTORY
Written by Alexandre Duret-Lutz EFE.
=cut
### Setup "GNU" style for perl-mode and cperl-mode.
## Local Variables:
## perl-indent-level: 2
## perl-continued-statement-offset: 2
## perl-continued-brace-offset: 0
## perl-brace-offset: 0
## perl-brace-imaginary-offset: 0
## perl-label-offset: -2
## cperl-indent-level: 2
## cperl-brace-offset: 0
## cperl-continued-brace-offset: 0
## cperl-label-offset: -2
## cperl-extra-newline-before-brace: t
## cperl-merge-trailing-else: nil
## cperl-continued-statement-offset: 2
## End: