From e8cab8eac2c39fcee782e2d17b60239852d0ee3e Mon Sep 17 00:00:00 2001 From: Alexandre Duret-Lutz Date: Wed, 9 Jul 2003 22:09:27 +0000 Subject: [PATCH] * 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. --- ChangeLog | 14 ++ aclocal.in | 19 ++- automake.in | 1 + lib/Automake/FileUtils.pm | 241 ++++++++++++++++++++++++++++++++++ lib/Automake/General.pm | 267 +------------------------------------- lib/Automake/Makefile.am | 1 + lib/Automake/Makefile.in | 1 + 7 files changed, 278 insertions(+), 266 deletions(-) create mode 100644 lib/Automake/FileUtils.pm diff --git a/ChangeLog b/ChangeLog index 7910cabe..5dd1774e 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,19 @@ 2003-07-09 Alexandre Duret-Lutz + * 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. diff --git a/aclocal.in b/aclocal.in index 3c87fdc1..0db058dd 100644 --- a/aclocal.in +++ b/aclocal.in @@ -36,6 +36,7 @@ BEGIN use Automake::General; use Automake::Configure_ac; use Automake::XFile; +use Automake::FileUtils; use File::stat; # Some constants. @@ -183,7 +184,8 @@ sub parse_arguments (@) } 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); @@ -238,8 +240,11 @@ sub scan_configure () { 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; @@ -305,8 +310,12 @@ sub scan_m4_files (@) 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))) { diff --git a/automake.in b/automake.in index a9c705ea..3b31fee6 100755 --- a/automake.in +++ b/automake.in @@ -126,6 +126,7 @@ use Automake::XFile; 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; diff --git a/lib/Automake/FileUtils.pm b/lib/Automake/FileUtils.pm new file mode 100644 index 00000000..d40d4b8b --- /dev/null +++ b/lib/Automake/FileUtils.pm @@ -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 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: diff --git a/lib/Automake/General.pm b/lib/Automake/General.pm index 79a39d61..7ea242aa 100644 --- a/lib/Automake/General.pm +++ b/lib/Automake/General.pm @@ -18,198 +18,34 @@ 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; } @@ -233,97 +69,6 @@ sub uniq (@) } -# &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. diff --git a/lib/Automake/Makefile.am b/lib/Automake/Makefile.am index 4f5ea1e0..75eefac7 100644 --- a/lib/Automake/Makefile.am +++ b/lib/Automake/Makefile.am @@ -26,6 +26,7 @@ dist_perllib_DATA = \ Condition.pm \ Configure_ac.pm \ DisjConditions.pm \ + FileUtils.pm \ General.pm \ Location.pm \ Struct.pm \ diff --git a/lib/Automake/Makefile.in b/lib/Automake/Makefile.in index e95d7846..c51b35c9 100644 --- a/lib/Automake/Makefile.in +++ b/lib/Automake/Makefile.in @@ -135,6 +135,7 @@ dist_perllib_DATA = \ Condition.pm \ Configure_ac.pm \ DisjConditions.pm \ + FileUtils.pm \ General.pm \ Location.pm \ Struct.pm \ -- 2.43.5