[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
FYI: Download files from CVS Automake
From: |
Akim Demaille |
Subject: |
FYI: Download files from CVS Automake |
Date: |
Wed, 20 Aug 2003 09:48:25 +0200 |
User-agent: |
Gnus/5.1002 (Gnus v5.10.2) Emacs/21.3 (gnu/linux) |
Index: ChangeLog
from Akim Demaille <address@hidden>
* lib/Autom4te/Channels.pm, lib/Autom4te/ChannelDefs.pm
* lib/Autom4te/Configure_ac.pm, lib/Autom4te/FileUtils.pm: New,
from CVS Automake.
Index: lib/Autom4te/ChannelDefs.pm
===================================================================
RCS file: lib/Autom4te/ChannelDefs.pm
diff -N lib/Autom4te/ChannelDefs.pm
--- lib/Autom4te/ChannelDefs.pm 1 Jan 1970 00:00:00 -0000
+++ lib/Autom4te/ChannelDefs.pm 20 Aug 2003 06:50:20 -0000
@@ -0,0 +1,401 @@
+# Copyright (C) 2002, 2003 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+# 02111-1307, USA.
+
+package Autom4te::ChannelDefs;
+
+use Autom4te::Channels;
+
+=head1 NAME
+
+Autom4te::ChannelDefs - channel definitions for Automake and helper functions
+
+=head1 SYNOPSIS
+
+ use Autom4te::ChannelDefs;
+
+ Autom4te::ChannelDefs::usage ();
+ prog_error ($MESSAGE, [%OPTIONS]);
+ error ($WHERE, $MESSAGE, [%OPTIONS]);
+ error ($MESSAGE);
+ fatal ($WHERE, $MESSAGE, [%OPTIONS]);
+ fatal ($MESSAGE);
+ verb ($MESSAGE, [%OPTIONS]);
+ switch_warning ($CATEGORY);
+ parse_WARNINGS ();
+ parse_warning ($OPTION, $ARGUMENT);
+ Autom4te::ChannelDefs::set_strictness ($STRICTNESS_NAME);
+
+=head1 DESCRIPTION
+
+This packages defines channels that can be used in Automake to
+output diagnostics and other messages (via C<msg()>). It also defines
+some helper function to enable or disable these channels, and some
+shorthand function to output on specific channels.
+
+=cut
+
+use 5.005;
+use strict;
+use Exporter;
+
+use vars qw (@ISA @EXPORT);
+
address@hidden = qw (Exporter);
address@hidden = 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<Autom4te::Channel::msg>. For some of them we list a shorthand
+function that makes the code more readable.
+
+=over 4
+
+=item C<fatal>
+
+Fatal errors. Use C<&fatal> to send messages over this channel.
+
+=item C<error>
+
+Common errors. Use C<&error> to send messages over this channel.
+
+=item C<error-gnu>
+
+Errors related to GNU Standards.
+
+=item C<error-gnu/warn>
+
+Errors related to GNU Standards that should be warnings in `foreign' mode.
+
+=item C<error-gnits>
+
+Errors related to GNITS Standards (silent by default).
+
+=item C<automake>
+
+Internal errors. Use C<&prog_error> to send messages over this channel.
+
+=item C<gnu>
+
+Warnings related to GNU Coding Standards.
+
+=item C<obsolete>
+
+Warnings about obsolete features (silent by default).
+
+=item C<override>
+
+Warnings about user redefinitions of Automake rules or
+variables (silent by default).
+
+=item C<portability>
+
+Warnings about non-portable constructs.
+
+=item C<syntax>
+
+Warnings about weird syntax, unused variables, typos...
+
+=item C<unsupported>
+
+Warnings about unsupported (or mis-supported) features.
+
+=item C<verb>
+
+Messages output in C<--verbose> mode. Use C<&verb> to send such messages.
+
+=item C<note>
+
+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';
+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 <address@hidden>.";
+
+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;
+register_channel 'note', type => 'debug', silent => 0;
+
+=head2 FUNCTIONS
+
+=over 4
+
+=item C<usage ()>
+
+Display warning categories.
+
+=cut
+
+sub usage ()
+{
+ print "Warning categories include:
+ `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
+ `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<prog_error ($MESSAGE, [%OPTIONS])>
+
+Signal a programming error (on channel C<automake>),
+display C<$MESSAGE>, and exit 1.
+
+=cut
+
+sub prog_error ($;%)
+{
+ my ($msg, %opts) = @_;
+ msg 'automake', '', $msg, %opts;
+}
+
+=item C<error ($WHERE, $MESSAGE, [%OPTIONS])>
+
+=item C<error ($MESSAGE)>
+
+Uncategorized errors.
+
+=cut
+
+sub error ($;$%)
+{
+ my ($where, $msg, %opts) = @_;
+ msg ('error', $where, $msg, %opts);
+}
+
+=item C<fatal ($WHERE, $MESSAGE, [%OPTIONS])>
+
+=item C<fatal ($MESSAGE)>
+
+Fatal errors.
+
+=cut
+
+sub fatal ($;$%)
+{
+ my ($where, $msg, %opts) = @_;
+ msg ('fatal', $where, $msg, %opts);
+}
+
+=item C<verb ($MESSAGE, [%OPTIONS])>
+
+C<--verbose> messages.
+
+=cut
+
+sub verb ($;%)
+{
+ my ($msg, %opts) = @_;
+ msg 'verb', '', $msg, %opts;
+}
+
+=item C<switch_warning ($CATEGORY)>
+
+If C<$CATEGORY> is C<mumble>, turn on channel C<mumble>.
+If it's C<no-mumble>, turn C<mumble> off.
+Else handle C<all> and C<none> 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_WARNINGS ()>
+
+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_warning ($OPTION, $ARGUMENT)>
+
+Parse the argument of C<--warning=CATEGORY> or C<-WCATEGORY>.
+
+C<$OPTIONS> is C<"--warning"> or C<"-W">, C<$ARGUMENT> is C<CATEGORY>.
+
+This is meant to be used as a argument to C<Getopt>.
+
+=cut
+
+sub parse_warnings ($$)
+{
+ my ($opt, $categories) = @_;
+
+ foreach my $cat (split (',', $categories))
+ {
+ msg 'unsupported', "unknown warning category `$cat'"
+ if switch_warning $cat;
+ }
+}
+
+=item C<set_strictness ($STRICTNESS_NAME)>
+
+Configure channels for strictness C<$STRICTNESS_NAME>.
+
+=cut
+
+sub set_strictness ($)
+{
+ my ($name) = @_;
+
+ # FIXME: 'portability' warnings are currently disabled by default.
+ # Eventually we want to turn them on in GNU and GNITS modes, but
+ # we don't do this yet in Automake 1.7 to help the 1.6/1.7 transition.
+ #
+ # Indeed there would be only two ways to get rid of these new warnings:
+ # 1. adjusting Makefile.am
+ # This is not always easy (or wanted). Consider %-rules or
+ # $(function args) variables.
+ # 2. using -Wno-portability
+ # This means there is no way to have the same Makefile.am
+ # working both with Automake 1.6 and 1.7 (since 1.6 does not
+ # understand -Wno-portability).
+ #
+ # In Automake 1.8 (or whatever it is called) we can turn these
+ # warnings on, since -Wno-portability will not be an issue for
+ # the 1.7/1.8 transition.
+
+ 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<Autom4te::Channels>
+
+=head1 HISTORY
+
+Written by Alexandre Duret-Lutz E<lt>F<address@hidden>E<gt>.
+
+=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:
Index: lib/Autom4te/Channels.pm
===================================================================
RCS file: lib/Autom4te/Channels.pm
diff -N lib/Autom4te/Channels.pm
--- lib/Autom4te/Channels.pm 1 Jan 1970 00:00:00 -0000
+++ lib/Autom4te/Channels.pm 20 Aug 2003 06:50:20 -0000
@@ -0,0 +1,701 @@
+# Copyright (C) 2002 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+# 02111-1307, USA.
+
+package Autom4te::Channels;
+
+=head1 NAME
+
+Autom4te::Channels - support functions for error and warning management
+
+=head1 SYNOPSIS
+
+ use Autom4te::Channels;
+
+ # Register a channel to output warnings about unused variables.
+ register_channel 'unused', type => 'warning';
+
+ # Register a channel for system errors.
+ register_channel 'system', type => 'error', exit_code => 4;
+
+ # Output a message on channel 'unused'.
+ msg 'unused', "$file:$line", "unused variable `$var'";
+
+ # Make the 'unused' channel silent.
+ setup_channel 'unused', silent => 1;
+
+ # Turn on all channels of type 'warning'.
+ setup_channel_type 'warning', silent => 0;
+
+ # Treat all warnings as errors.
+ $warnings_are_errors = 1;
+
+ # Exit with the greater exist code encountered so far.
+ exit $exit_code;
+
+=head1 DESCRIPTION
+
+This perl module provides support functions for handling diagnostic
+channels in programs. Channels can be registered to convey fatal,
+error, warning, or debug messages. Each channel has various options
+(e.g. is the channel silent, should duplicate messages be removed,
+etc.) that can also be overridden on a per-message basis.
+
+=cut
+
+use 5.005;
+use strict;
+use Exporter;
+use Carp;
+use File::Basename;
+
+use vars qw (@ISA @EXPORT %channels $me);
+
address@hidden = qw (Exporter);
address@hidden = qw ($exit_code $warnings_are_errors
+ &reset_local_duplicates &reset_global_duplicates
+ ®ister_channel &msg &exists_channel &channel_type
+ &setup_channel &setup_channel_type
+ &dup_channel_setup &drop_channel_setup
+ &buffer_messages &flush_messages
+ US_GLOBAL US_LOCAL
+ UP_NONE UP_TEXT UP_LOC_TEXT);
+
+$me = basename $0;
+
+=head2 Global Variables
+
+=over 4
+
+=item C<$exit_code>
+
+The greatest exit code seen so far. C<$exit_code> is updated from
+the C<exit_code> options of C<fatal> and C<error> channels.
+
+=cut
+
+use vars qw ($exit_code);
+$exit_code = 0;
+
+=item C<$warnings_are_errors>
+
+Set this variable to 1 if warning messages should be treated as
+errors (i.e. if they should update C<$exit_code>).
+
+=cut
+
+use vars qw ($warnings_are_errors);
+$warnings_are_errors = 0;
+
+=back
+
+=head2 Constants
+
+=over 4
+
+=item C<UP_NONE>, C<UP_TEXT>, C<UP_LOC_TEXT>
+
+Possible values for the C<uniq_part> options. This select the part
+of the message that should be considered when filtering out duplicates.
+If C<UP_LOC_TEXT> is used, the location and the explanation message
+are used for filtering. If C<UP_TEXT> is used, only the explanation
+message is used (so the same message will be filtered out if it appears
+at different locations). C<UP_NONE> means that duplicate messages
+should be output.
+
+=cut
+
+use constant UP_NONE => 0;
+use constant UP_TEXT => 1;
+use constant UP_LOC_TEXT => 2;
+
+=item C<US_LOCAL>, C<US_GLOBAL>
+
+Possible values for the C<uniq_scope> options.
+Use C<US_GLOBAL> for error messages that should be printed only
+once in the run of the program, C<US_LOCAL> for message that
+should be printed only once per file. (Actually, C<Channels> does not
+now when files are changed, it relies on you calling C<reset_local_duplicates>
+when this happens.)
+
+=cut
+
+# possible values for uniq_scope
+use constant US_LOCAL => 0;
+use constant US_GLOBAL => 1;
+
+=back
+
+=head2 Options
+
+Channels accept the options described below. These options can be
+passed as a hash to the C<register_channel>, C<setup_channel>, and C<msg>
+functions. The possible keys, with there default value are:
+
+=over
+
+=item C<type =E<gt> 'warning'>
+
+The type of the channel. One of C<'debug'>, C<'warning'>, C<'error'>, or
+C<'fatal'>. Fatal messages abort the program when they are output.
+Error messages update the exit status. Debug and warning messages are
+harmless, except that warnings can be treated as errors of
+C<$warnings_are_errors> is set.
+
+=item C<exit_code =E<gt> 1>
+
+The value to update C<$exit_code> with when a fatal or error message
+is emited. C<$exit_code> is also updated for warnings output
+when @<$warnings_are_errors> is set.
+
+=item C<file =E<gt> \*STDERR>
+
+The file where the error should be output.
+
+=item C<silent =E<gt> 0>
+
+Whether the channel should be silent. Use this do disable a
+category of warning, for instance.
+
+=item C<uniq_part =E<gt> UP_LOC_TEXT>
+
+The part of the message subject to duplicate filtering. See the
+documentation for the C<UP_NONE>, C<UP_TEXT>, and C<UP_LOC_TEXT>
+constants above.
+
+=item C<uniq_scope =E<gt> US_LOCAL>
+
+The scope of duplicate filtering. See the documentation for the
+C<US_LOCAL>, and C<US_GLOBAL> constants above.
+
+=item C<header =E<gt> ''>
+
+A string to prepend to each message emitted through this channel.
+
+=item C<footer =E<gt> ''>
+
+A string to append to each message emitted through this channel.
+
+=item C<backtrace =E<gt> 0>
+
+Die with a stack backtrace after displaying the message.
+
+=item C<partial =E<gt> 0>
+
+When set, indicates a partial message that should
+be output along with the next message with C<partial> unset.
+Several partial messages can be stacked this way.
+
+Duplicate filtering will apply to the I<global> message resulting from
+all I<partial> messages, using the options from the last (non-partial)
+message. Linking associated messages is the main reason to use this
+option.
+
+For instance the following messages
+
+ msg 'channel', 'foo:2', 'redefinition of A ...';
+ msg 'channel', 'foo:1', '... A previously defined here';
+ msg 'channel', 'foo:3', 'redefinition of A ...';
+ msg 'channel', 'foo:1', '... A previously defined here';
+
+will result in
+
+ foo:2: redefinition of A ...
+ foo:1: ... A previously defined here
+ foo:3: redefinition of A ...
+
+where the duplicate "I<... A previously defined here>" has been
+filtered out.
+
+Linking these messages using C<partial> as follows will prevent the
+fourth message to disappear.
+
+ msg 'channel', 'foo:2', 'redefinition of A ...', partial => 1;
+ msg 'channel', 'foo:1', '... A previously defined here';
+ msg 'channel', 'foo:3', 'redefinition of A ...', partial => 1;
+ msg 'channel', 'foo:1', '... A previously defined here';
+
+Note that because the stack of C<partial> messages is printed with the
+first non-C<partial> message, most options of C<partial> messages will
+be ignored.
+
+=back
+
+=cut
+
+use vars qw (%_default_options %_global_duplicate_messages
+ %_local_duplicate_messages);
+
+# Default options for a channel.
+%_default_options =
+ (
+ type => 'warning',
+ exit_code => 1,
+ file => \*STDERR,
+ silent => 0,
+ uniq_scope => US_LOCAL,
+ uniq_part => UP_LOC_TEXT,
+ header => '',
+ footer => '',
+ backtrace => 0,
+ partial => 0,
+ );
+
+# Filled with output messages as keys, to detect duplicates.
+# The value associated to each keys is the number of occurences
+# filtered out.
+%_local_duplicate_messages = ();
+%_global_duplicate_messages = ();
+
+sub _reset_duplicates (\%)
+{
+ my ($ref) = @_;
+ my $dup = 0;
+ foreach my $k (keys %$ref)
+ {
+ $dup += $ref->{$k};
+ }
+ %$ref = ();
+ return $dup;
+}
+
+
+=head2 Functions
+
+=over 4
+
+=item C<reset_local_duplicates ()>
+
+Reset local duplicate messages (see C<US_LOCAL>), and
+return the number of messages that have been filtered out.
+
+=cut
+
+sub reset_local_duplicates ()
+{
+ return _reset_duplicates %_local_duplicate_messages;
+}
+
+=item C<reset_global_duplicates ()>
+
+Reset local duplicate messages (see C<US_GLOBAL>), and
+return the number of messages that have been filtered out.
+
+=cut
+
+sub reset_global_duplicates ()
+{
+ return _reset_duplicates %_global_duplicate_messages;
+}
+
+sub _merge_options (\%%)
+{
+ my ($hash, %options) = @_;
+ local $_;
+
+ foreach (keys %options)
+ {
+ if (exists $hash->{$_})
+ {
+ $hash->{$_} = $options{$_}
+ }
+ else
+ {
+ confess "unknown option `$_'";
+ }
+ }
+}
+
+=item C<register_channel ($name, [%options])>
+
+Declare channel C<$name>, and override the default options
+with those listed in C<%options>.
+
+=cut
+
+sub register_channel ($;%)
+{
+ my ($name, %options) = @_;
+ my %channel_opts = %_default_options;
+ _merge_options %channel_opts, %options;
+ $channels{$name} = \%channel_opts;
+}
+
+=item C<exists_channel ($name)>
+
+Returns true iff channel C<$name> has been registered.
+
+=cut
+
+sub exists_channel ($)
+{
+ my ($name) = @_;
+ return exists $channels{$name};
+}
+
+=item C<channel_type ($name)>
+
+Returns the type of channel C<$name> if it has been registered.
+Returns The empty string otherwise.
+
+=cut
+
+sub channel_type ($)
+{
+ my ($name) = @_;
+ return $channels{$name}{'type'} if exists_channel $name;
+ return '';
+}
+
+# _format_sub_message ($LEADER, $MESSAGE)
+# ---------------------------------------
+# Split $MESSAGE at new lines and add $LEADER to each line.
+sub _format_sub_message ($$)
+{
+ my ($leader, $message) = @_;
+ return $leader . join ("\n" . $leader, split ("\n", $message)) . "\n";
+}
+
+# _format_message ($LOCATION, $MESSAGE, %OPTIONS)
+# -----------------------------------------------
+# Format the message. Return a string ready to print.
+sub _format_message ($$%)
+{
+ my ($location, $message, %opts) = @_;
+ my $msg = '';
+ if (ref $location)
+ {
+ # If $LOCATION is a reference, assume it's an instance of the
+ # Autom4te::Location class and display contexts.
+ my $loc = $location->get || $me;
+ $msg = _format_sub_message ("$loc: ", $opts{'header'}
+ . $message . $opts{'footer'});
+ for my $pair ($location->get_contexts)
+ {
+ $msg .= _format_sub_message ($pair->[0] . ": ", $pair->[1]);
+ }
+ }
+ else
+ {
+ $location ||= $me;
+ $msg = _format_sub_message ("$location: ", $opts{'header'}
+ . $message . $opts{'footer'});
+ }
+ return $msg;
+}
+
+# Store partial messages here. (See the 'partial' option.)
+use vars qw ($partial);
+$partial = '';
+
+# _print_message ($LOCATION, $MESSAGE, %OPTIONS)
+# ----------------------------------------------
+# Format the message, check duplicates, and print it.
+sub _print_message ($$%)
+{
+ my ($location, $message, %opts) = @_;
+
+ return 0 if ($opts{'silent'});
+
+ my $msg = _format_message ($location, $message, %opts);
+ if ($opts{'partial'})
+ {
+ # Incomplete message. Store, don't print.
+ $partial .= $msg;
+ return;
+ }
+ else
+ {
+ # Prefix with any partial message send so far.
+ $msg = $partial . $msg;
+ $partial = '';
+ }
+
+ # Check for duplicate message if requested.
+ if ($opts{'uniq_part'} != UP_NONE)
+ {
+ # Which part of the error should we match?
+ my $to_filter;
+ if ($opts{'uniq_part'} == UP_TEXT)
+ {
+ $to_filter = $message;
+ }
+ elsif ($opts{'uniq_part'} == UP_LOC_TEXT)
+ {
+ $to_filter = $msg;
+ }
+ else
+ {
+ confess "unknown value for uniq_part: " . $opts{'uniq_part'};
+ }
+
+ # Do we want local or global uniqueness?
+ my $dups;
+ if ($opts{'uniq_scope'} == US_LOCAL)
+ {
+ $dups = \%_local_duplicate_messages;
+ }
+ elsif ($opts{'uniq_scope'} == US_GLOBAL)
+ {
+ $dups = \%_global_duplicate_messages;
+ }
+ else
+ {
+ confess "unknown value for uniq_scope: " . $opts{'uniq_scope'};
+ }
+
+ # Update the hash of messages.
+ if (exists $dups->{$to_filter})
+ {
+ ++$dups->{$to_filter};
+ return 0;
+ }
+ else
+ {
+ $dups->{$to_filter} = 0;
+ }
+ }
+ my $file = $opts{'file'};
+ print $file $msg;
+ return 1;
+}
+
+=item C<msg ($channel, $location, $message, [%options])>
+
+Emit a message on C<$channel>, overriding some options of the channel with
+those specified in C<%options>. Obviously C<$channel> must have been
+registered with C<register_channel>.
+
+C<$message> is the text of the message, and C<$location> is a location
+associated to the message.
+
+For instance to complain about some unused variable C<mumble>
+declared at line 10 in F<foo.c>, one could do:
+
+ msg 'unused', 'foo.c:10', "unused variable `mumble'";
+
+If channel C<unused> is not silent (and if this message is not a duplicate),
+the following would be output:
+
+ foo.c:10: unused variable `mumble'
+
+C<$location> can also be an instance of C<Autom4te::Location>. In this
+case the stack of contexts will be displayed in addition.
+
+If C<$message> contains new line caracters, C<$location> is prepended
+to each line. For instance
+
+ msg 'error', 'somewhere', "1st line\n2nd line";
+
+becomes
+
+ somewhere: 1st line
+ somewhere: 2nd line
+
+If C<$location> is an empty string, it is replaced by the name of the
+program. Actually, if you don't use C<%options>, you can even
+elide the empty C<$location>. Thus
+
+ msg 'fatal', '', 'fatal error';
+ msg 'fatal', 'fatal error';
+
+both print
+
+ progname: fatal error
+
+=cut
+
+
+use vars qw (@backlog %buffering @chain);
+
+# See buffer_messages() and flush_messages() below.
+%buffering = (); # The map of channel types to buffer.
address@hidden = (); # The buffer of messages.
+
+sub msg ($$;$%)
+{
+ my ($channel, $location, $message, %options) = @_;
+
+ if (! defined $message)
+ {
+ $message = $location;
+ $location = '';
+ }
+
+ confess "unknown channel $channel" unless exists $channels{$channel};
+
+ my %opts = %{$channels{$channel}};
+ _merge_options (%opts, %options);
+
+ if (exists $buffering{$opts{'type'}})
+ {
+ push @backlog, [$channel, $location->clone, $message, %options];
+ return;
+ }
+
+ # Print the message if needed.
+ if (_print_message ($location, $message, %opts))
+ {
+ # Adjust exit status.
+ if ($opts{'type'} eq 'error'
+ || $opts{'type'} eq 'fatal'
+ || ($opts{'type'} eq 'warning' && $warnings_are_errors))
+ {
+ my $es = $opts{'exit_code'};
+ $exit_code = $es if $es > $exit_code;
+ }
+
+ # Die on fatal messages.
+ confess if $opts{'backtrace'};
+ exit $exit_code if $opts{'type'} eq 'fatal';
+ }
+}
+
+
+=item C<setup_channel ($channel, %options)>
+
+Override the options of C<$channel> with those specified by C<%options>.
+
+=cut
+
+sub setup_channel ($%)
+{
+ my ($name, %opts) = @_;
+ confess "channel $name doesn't exist" unless exists $channels{$name};
+ _merge_options %{$channels{$name}}, %opts;
+}
+
+=item C<setup_channel_type ($type, %options)>
+
+Override the options of any channel of type C<$type>
+with those specified by C<%options>.
+
+=cut
+
+sub setup_channel_type ($%)
+{
+ my ($type, %opts) = @_;
+ foreach my $channel (keys %channels)
+ {
+ setup_channel $channel, %opts
+ if $channels{$channel}{'type'} eq $type;
+ }
+}
+
+=item C<dup_channel_setup ()>, C<drop_channel_setup ()>
+
+Sometimes it is necessary to make temporary modifications to channels.
+For instance one may want to disable a warning while processing a
+particular file, and then restore the initial setup. These two
+functions make it easy: C<dup_channel_setup ()> saves a copy of the
+current configuration for later restoration by
+C<drop_channel_setup ()>.
+
+You can think of this as a stack of configurations whose first entry
+is the active one. C<dup_channel_setup ()> duplicates the first
+entry, while C<drop_channel_setup ()> just deletes it.
+
+=cut
+
+use vars qw (@_saved_channels);
address@hidden = ();
+
+sub dup_channel_setup ()
+{
+ my %channels_copy;
+ foreach my $k1 (keys %channels)
+ {
+ $channels_copy{$k1} = {%{$channels{$k1}}};
+ }
+ push @_saved_channels, \%channels_copy;
+}
+
+sub drop_channel_setup ()
+{
+ my $saved = pop @_saved_channels;
+ %channels = %$saved;
+}
+
+=item C<buffer_messages (@types)>, C<flush_messages ()>
+
+By default, when C<msg> is called, messages are processed immediately.
+
+Sometimes it is necessary to delay the output of messages.
+For instance you might want to make diagnostics before
+channels have been completly configured.
+
+After C<buffer_messages(@types)> has been called, messages sent with
+C<msg> to a channel whose type is listed in C<@types> will be stored in a
+list for later processing.
+
+This backlog of messages is processed when C<flush_messages> is
+called, with the current channel options (not the options in effect,
+at the time of C<msg>). So for instance if some channel was silenced
+in the meantime, messages to this channels will not be print.
+
+C<flush_messages> cancels the effect of C<buffer_messages>. Following
+calls to C<msg> are processed immediately as usual.
+
+=cut
+
+sub buffer_messages (@)
+{
+ foreach my $type (@_)
+ {
+ $buffering{$type} = 1;
+ }
+}
+
+sub flush_messages ()
+{
+ %buffering = ();
+ foreach my $args (@backlog)
+ {
+ &msg (@$args);
+ }
+ @backlog = ();
+}
+
+=back
+
+=head1 SEE ALSO
+
+L<Autom4te::Location>
+
+=head1 HISTORY
+
+Written by Alexandre Duret-Lutz E<lt>F<address@hidden>E<gt>.
+
+=cut
+
+1;
+
+### 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:
Index: lib/Autom4te/Configure_ac.pm
===================================================================
RCS file: lib/Autom4te/Configure_ac.pm
diff -N lib/Autom4te/Configure_ac.pm
--- lib/Autom4te/Configure_ac.pm 1 Jan 1970 00:00:00 -0000
+++ lib/Autom4te/Configure_ac.pm 20 Aug 2003 06:50:20 -0000
@@ -0,0 +1,95 @@
+# Copyright (C) 2003 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+# 02111-1307, USA.
+
+package Autom4te::Configure_ac;
+
+use strict;
+use Exporter;
+use Autom4te::Channels;
+use Autom4te::ChannelDefs;
+
+use vars qw (@ISA @EXPORT);
+
address@hidden = qw (Exporter);
address@hidden = qw ($configure_ac &find_configure_ac &require_configure_ac);
+
+=head1 NAME
+
+Autom4te::Configure_ac - Locate configure.ac or configure.in.
+
+=head1 SYNOPSIS
+
+ use Autom4te::Configure_ac;
+
+ # Try to locate configure.in or configure.ac in the current
+ # directory. It may be absent. Complain if both files exist.
+ my $filename = find_configure_ac;
+
+ # Likewise, but bomb out if the file does not exist.
+ my $filename = require_configure_ac;
+
+In both cases, the name of the file found is also put in the
+C<$configure_ac> global variable.
+
+=cut
+
+use vars '$configure_ac';
+
+sub find_configure_ac ()
+{
+ if (-f 'configure.ac')
+ {
+ if (-f 'configure.in')
+ {
+ msg ('unsupported',
+ "`configure.ac' and `configure.in' both present.\n"
+ . "proceeding with `configure.ac'.");
+ }
+ $configure_ac = 'configure.ac';
+ }
+ elsif (-f 'configure.in')
+ {
+ $configure_ac = 'configure.in';
+ }
+ return $configure_ac;
+}
+
+sub require_configure_ac ()
+{
+ fatal "`configure.ac' or `configure.in' is required"
+ unless find_configure_ac;
+ return $configure_ac;
+}
+
+1;
+
+### 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:
Index: lib/Autom4te/FileUtils.pm
===================================================================
RCS file: lib/Autom4te/FileUtils.pm
diff -N lib/Autom4te/FileUtils.pm
--- lib/Autom4te/FileUtils.pm 1 Jan 1970 00:00:00 -0000
+++ lib/Autom4te/FileUtils.pm 20 Aug 2003 06:50:20 -0000
@@ -0,0 +1,241 @@
+# Copyright (C) 2003 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+# 02111-1307, USA.
+
+package Autom4te::FileUtils;
+
+use strict;
+use Exporter;
+use File::stat;
+use IO::File;
+use Autom4te::Channels;
+use Autom4te::ChannelDefs;
+
+use vars qw (@ISA @EXPORT);
+
address@hidden = qw (Exporter);
address@hidden = qw (&find_file &mtime &update_file &xsystem &contents);
+
+
+# $FILENAME
+# find_file ($FILENAME, @INCLUDE)
+# -------------------------------
+# We match exactly the behavior of GNU m4: first look in the current
+# directory (which includes the case of absolute file names), and, if
+# the file is not absolute, just fail. Otherwise, look in the path.
+#
+# If the file is flagged as optional (ends with `?'), then return undef
+# if absent.
+sub find_file ($@)
+{
+ use File::Spec;
+
+ my ($filename, @include) = @_;
+ my $optional = 0;
+
+ $optional = 1
+ if $filename =~ s/\?$//;
+
+ return File::Spec->canonpath ($filename)
+ if -e $filename;
+
+ if (File::Spec->file_name_is_absolute ($filename))
+ {
+ fatal "$filename: no such file or directory"
+ unless $optional;
+ return undef;
+ }
+
+ foreach my $path (reverse @include)
+ {
+ return File::Spec->canonpath (File::Spec->catfile ($path, $filename))
+ if -e File::Spec->catfile ($path, $filename)
+ }
+
+ fatal "$filename: no such file or directory"
+ unless $optional;
+
+ return undef;
+}
+
+# $MTIME
+# MTIME ($FILE)
+# -------------
+# Return the mtime of $FILE. Missing files, or `-' standing for STDIN
+# or STDOUT are ``obsolete'', i.e., as old as possible.
+sub mtime ($)
+{
+ my ($file) = @_;
+
+ return 0
+ if $file eq '-' || ! -f $file;
+
+ my $stat = stat ($file)
+ or fatal "cannot stat $file: $!";
+
+ return $stat->mtime;
+}
+
+
+# &update_file ($FROM, $TO)
+# -------------------------
+# Rename $FROM as $TO, preserving $TO timestamp if it has not changed.
+# Recognize `$TO = -' standing for stdin.
+sub update_file ($$)
+{
+ my ($from, $to) = @_;
+ my $SIMPLE_BACKUP_SUFFIX = $ENV{'SIMPLE_BACKUP_SUFFIX'} || '~';
+ use File::Compare;
+ use File::Copy;
+
+ if ($to eq '-')
+ {
+ my $in = new IO::File ("$from");
+ my $out = new IO::File (">-");
+ while ($_ = $in->getline)
+ {
+ print $out $_;
+ }
+ $in->close;
+ unlink ($from) || fatal "cannot not remove $from: $!";
+ return;
+ }
+
+ if (-f "$to" && compare ("$from", "$to") == 0)
+ {
+ # File didn't change, so don't update its mod time.
+ msg 'note', "`$to' is unchanged";
+ return
+ }
+
+ if (-f "$to")
+ {
+ # Back up and install the new one.
+ move ("$to", "$to$SIMPLE_BACKUP_SUFFIX")
+ or fatal "cannot not backup $to: $!";
+ move ("$from", "$to")
+ or fatal "cannot not rename $from as $to: $!";
+ msg 'note', "`$to' is updated";
+ }
+ else
+ {
+ move ("$from", "$to")
+ or fatal "cannot not rename $from as $to: $!";
+ msg 'note', "`$to' is created";
+ }
+}
+
+
+# handle_exec_errors ($COMMAND)
+# -----------------------------
+# Display an error message for $COMMAND, based on the content of $? and $!.
+sub handle_exec_errors ($)
+{
+ my ($command) = @_;
+
+ $command = (split (' ', $command))[0];
+ if ($!)
+ {
+ fatal "failed to run $command: $!";
+ }
+ else
+ {
+ use POSIX qw (WIFEXITED WEXITSTATUS WIFSIGNALED WTERMSIG);
+
+ if (WIFEXITED ($?))
+ {
+ my $status = WEXITSTATUS ($?);
+ # Propagate exit codes.
+ fatal ("$command failed with exit status: $status",
+ exit_code => $status);
+ }
+ elsif (WIFSIGNALED ($?))
+ {
+ my $signal = WTERMSIG ($?);
+ fatal "$command terminated by signal: $signal";
+ }
+ else
+ {
+ fatal "$command exited abnormally";
+ }
+ }
+}
+
+# xqx ($COMMAND)
+# --------------
+# Same as `qx' (but in scalar context), but fails on errors.
+sub xqx ($)
+{
+ my ($command) = @_;
+
+ verb "running: $command";
+
+ $! = 0;
+ my $res = `$command`;
+ handle_exec_errors $command
+ if $?;
+
+ return $res;
+}
+
+
+# xsystem ($COMMAND)
+# ------------------
+sub xsystem ($)
+{
+ my ($command) = @_;
+
+ verb "running: $command";
+
+ $! = 0;
+ handle_exec_errors $command
+ if system $command;
+}
+
+
+# contents ($FILENAME)
+# --------------------
+# Swallow the contents of file $FILENAME.
+sub contents ($)
+{
+ my ($file) = @_;
+ verb "reading $file";
+ local $/; # Turn on slurp-mode.
+ my $f = new Autom4te::XFile "< $file";
+ my $contents = $f->getline;
+ $f->close;
+ return $contents;
+}
+
+
+1; # for require
+
+### 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:
Index: lib/Autom4te/Makefile.am
===================================================================
RCS file: /cvsroot/autoconf/autoconf/lib/Autom4te/Makefile.am,v
retrieving revision 1.6
diff -u -u -r1.6 Makefile.am
--- lib/Autom4te/Makefile.am 5 Sep 2001 07:06:40 -0000 1.6
+++ lib/Autom4te/Makefile.am 20 Aug 2003 06:50:20 -0000
@@ -1,7 +1,14 @@
## Process this file with automake to create Makefile.in
perllibdir = $(pkgdatadir)/Autom4te
-dist_perllib_DATA = General.pm Struct.pm XFile.pm
+dist_perllib_DATA = \
+ ChannelDefs.pm \
+ Channels.pm \
+ Configure_ac.pm \
+ FileUtils.pm \
+ General.pm \
+ Struct.pm \
+ XFile.pm
## --------------- ##
Index: lib/Autom4te/Makefile.in
===================================================================
RCS file: /cvsroot/autoconf/autoconf/lib/Autom4te/Makefile.in,v
retrieving revision 1.30
diff -u -u -r1.30 Makefile.in
--- lib/Autom4te/Makefile.in 20 Aug 2003 06:29:56 -0000 1.30
+++ lib/Autom4te/Makefile.in 20 Aug 2003 06:50:20 -0000
@@ -109,7 +109,15 @@
sysconfdir = @sysconfdir@
target_alias = @target_alias@
perllibdir = $(pkgdatadir)/Autom4te
-dist_perllib_DATA = General.pm Struct.pm XFile.pm
+dist_perllib_DATA = \
+ ChannelDefs.pm \
+ Channels.pm \
+ Configure_ac.pm \
+ FileUtils.pm \
+ General.pm \
+ Struct.pm \
+ XFile.pm
+
TAGS_FILES = $(dist_perllib_DATA)
ETAGS_ARGS = --lang=perl
all: all-am
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- FYI: Download files from CVS Automake,
Akim Demaille <=