2003-07-09 Alexandre Duret-Lutz <adl@gnu.org>
+ * aclocal.in: Use Automake::FileUtils.
+ (parse_arguments, scan_configure, scan_m4_files): Never call
+ "die" to print an error message. Use print and exit.
+ * automake.in: Use Automake::FileUtils.
+ * lib/Automake/General.pm ($debug, $help, $tmp, $verbose,
+ $version, &debug, &getopt, &mktmpdir, &verbose): Remove.
+ (END): Do not massage Perl's exit code. Do not clean any temporary
+ directory.
+ (find_file, mtime, update_file, xsystem, contents): Move to ...
+ * lib/Automake/FileUtils.pm: ... this new file. Adjust to
+ report errors using Channels.
+ (handle_exec_errors, xqx): New functions, from Autoconf.
+ * lib/Automake/Makefile.am (dist_perllib_DATA): Add FileUtils.pm.
+
* lib/Automake/Variable.pm (_traverse_variable_recursively_worker):
Return the empty list on recursively defined variable. This
supersedes my change of 2003-07-02.
use Automake::General;
use Automake::Configure_ac;
use Automake::XFile;
+use Automake::FileUtils;
use File::stat;
# Some constants.
}
else
{
- die "aclocal: unrecognized option -- `$arglist[0]'\nTry `aclocal --help' for more information.\n";
+ print STDERR "aclocal: unrecognized option -- `$arglist[0]'\nTry `aclocal --help' for more information.\n";
+ exit 1;
}
shift (@arglist);
{
require_configure_ac;
- open (CONFIGURE, $configure_ac)
- || die "aclocal: couldn't open `$configure_ac': $!\n";
+ if (! open (CONFIGURE, $configure_ac))
+ {
+ print STDERR "aclocal: couldn't open `$configure_ac': $!\n";
+ exit 1;
+ }
my $mtime = mtime $configure_ac;
$greatest_mtime = $mtime if $greatest_mtime < $mtime;
local ($m4dir);
foreach $m4dir (@dirlist)
{
- opendir (DIR, $m4dir)
- || die "aclocal: couldn't open directory `$m4dir': $!\n";
+ if (! opendir (DIR, $m4dir))
+ {
+ print STDERR "aclocal: couldn't open directory `$m4dir': $!\n";
+ exit 1;
+ }
+
local ($file, $fullfile);
foreach $file (sort grep (! /^\./, readdir (DIR)))
{
use Automake::Channels;
use Automake::ChannelDefs;
use Automake::Configure_ac;
+use Automake::FileUtils;
use Automake::Location;
use Automake::Condition qw/TRUE FALSE/;
use Automake::DisjConditions;
--- /dev/null
+# 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 Automake::FileUtils;
+
+use strict;
+use Exporter;
+use File::stat;
+use IO::File;
+use Automake::Channels;
+use Automake::ChannelDefs;
+
+use vars qw (@ISA @EXPORT);
+
+@ISA = qw (Exporter);
+@EXPORT = 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 Automake::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:
package Automake::General;
use 5.005;
+use strict;
use Exporter;
use File::Basename;
-use File::stat;
-use IO::File;
-use Carp;
-use strict;
use vars qw (@ISA @EXPORT);
@ISA = qw (Exporter);
-@EXPORT = qw (&debug &find_file &getopt &mktmpdir &mtime
- &uniq &update_file &verbose &xsystem &contents
- $debug $help $me $tmp $verbose $version);
+@EXPORT = qw (&uniq $me);
# Variable we share with the main package. Be sure to have a single
# copy of them: using `my' together with multiple inclusion of this
# package would introduce several copies.
-use vars qw ($debug);
-$debug = 0;
-
-use vars qw ($help);
-$help = undef;
-
use vars qw ($me);
$me = basename ($0);
-# Our tmp dir.
-use vars qw ($tmp);
-$tmp = undef;
-
-use vars qw ($verbose);
-$verbose = 0;
-
-use vars qw ($version);
-$version = undef;
-
-
# END
# ---
# Exit nonzero whenever closing STDOUT fails.
-# Ideally we should `exit ($? >> 8)', unfortunately, for some reason
-# I don't understand, whenever we `exit (1)' somewhere in the code,
-# we arrive here with `$? = 29'. I suspect some low level END routine
-# might be responsible. In this case, be sure to exit 1, not 29.
sub END
{
- my $exit_status = $? ? 1 : 0;
-
- use POSIX qw (_exit);
-
- if (!$debug && defined $tmp && -d $tmp)
- {
- if (<$tmp/*>)
- {
- unlink <$tmp/*>
- or carp ("$me: cannot empty $tmp: $!\n"), _exit (1);
- }
- rmdir $tmp
- or carp ("$me: cannot remove $tmp: $!\n"), _exit (1);
- }
-
# This is required if the code might send any output to stdout
# E.g., even --version or --help. So it's best to do it unconditionally.
- close STDOUT
- or (carp "$me: closing standard output: $!\n"), _exit (1);
-
- _exit ($exit_status);
-}
-
-
-# debug(@MESSAGE)
-# ---------------
-# Messages displayed only if $DEBUG and $VERBOSE.
-sub debug (@)
-{
- print STDERR "$me: ", @_, "\n"
- if $verbose && $debug;
-}
-
-
-# $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))
+ if (! close STDOUT)
{
- die "$me: no such file or directory: $filename\n"
- 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)
- }
-
- die "$me: no such file or directory: $filename\n"
- unless $optional;
-
- return undef;
-}
-
-
-# getopt (%OPTION)
-# ----------------
-# Handle the %OPTION, plus all the common options.
-# Work around Getopt bugs wrt `-'.
-sub getopt (%)
-{
- my (%option) = @_;
- use Getopt::Long;
-
- # F*k. Getopt seems bogus and dies when given `-' with `bundling'.
- # If fixed some day, use this: '' => sub { push @ARGV, "-" }
- my $stdin = grep /^-$/, @ARGV;
- @ARGV = grep !/^-$/, @ARGV;
- %option = (%option,
- "h|help" => sub { print $help; exit 0 },
- "V|version" => sub { print $version; exit 0 },
-
- "v|verbose" => \$verbose,
- "d|debug" => \$debug,
- );
- Getopt::Long::Configure ("bundling");
- GetOptions (%option)
- or exit 1;
-
- push @ARGV, '-'
- if $stdin;
-}
-
-
-# mktmpdir ($SIGNATURE)
-# ---------------------
-# Create a temporary directory which name is based on $SIGNATURE.
-sub mktmpdir ($)
-{
- my ($signature) = @_;
- my $TMPDIR = $ENV{'TMPDIR'} || '/tmp';
-
- # If mktemp supports dirs, use it.
- $tmp = `(umask 077 &&
- mktemp -d -q "$TMPDIR/${signature}XXXXXX") 2>/dev/null`;
- chomp $tmp;
-
- if (!$tmp || ! -d $tmp)
- {
- $tmp = "$TMPDIR/$signature" . int (rand 10000) . ".$$";
- mkdir $tmp, 0700
- or croak "$me: cannot create $tmp: $!\n";
+ print STDERR "$me: closing standard output: $!\n";
+ $? = 74; # EX_IOERR
+ return;
}
-
- print STDERR "$me:$$: working in $tmp\n"
- if $debug;
-}
-
-
-# $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 croak "$me: cannot stat $file: $!\n";
-
- 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)
- or die "$me: cannot not remove $from: $!\n";
- return;
- }
-
- if (-f "$to" && compare ("$from", "$to") == 0)
- {
- # File didn't change, so don't update its mod time.
- print STDERR "$me: `$to' is unchanged\n";
- return
- }
-
- if (-f "$to")
- {
- # Back up and install the new one.
- move ("$to", "$to$SIMPLE_BACKUP_SUFFIX")
- or die "$me: cannot not backup $to: $!\n";
- move ("$from", "$to")
- or die "$me: cannot not rename $from as $to: $!\n";
- print STDERR "$me: `$to' is updated\n";
- }
- else
- {
- move ("$from", "$to")
- or die "$me: cannot not rename $from as $to: $!\n";
- print STDERR "$me: `$to' is created\n";
- }
-}
-
-
-# verbose(@MESSAGE)
-# -----------------
-sub verbose (@)
-{
- print STDERR "$me: ", @_, "\n"
- if $verbose;
-}
-
-
-# xsystem ($COMMAND)
-# ------------------
-sub xsystem ($)
-{
- my ($command) = @_;
-
- verbose "running: $command";
-
- (system $command) == 0
- or croak ("$me: "
- . (split (' ', $command))[0]
- . " failed with exit status: "
- . ($? >> 8)
- . "\n");
-}
-
-
-# contents ($FILENAME)
-# --------------------
-# Swallow the contents of file $FILENAME.
-sub contents ($)
-{
- my ($file) = @_;
- print STDERR "$me: reading $file\n" if $verbose;
- local $/; # Turn on slurp-mode.
- my $f = new Automake::XFile "< $file";
- my $contents = $f->getline;
- $f->close;
- return $contents;
-}
-
-
1; # for require
### Setup "GNU" style for perl-mode and cperl-mode.
Condition.pm \
Configure_ac.pm \
DisjConditions.pm \
+ FileUtils.pm \
General.pm \
Location.pm \
Struct.pm \
Condition.pm \
Configure_ac.pm \
DisjConditions.pm \
+ FileUtils.pm \
General.pm \
Location.pm \
Struct.pm \
git://sourceware.org / automake.git / commitdiff