some General.pm and exit code clean up

[Alexandre Duret-Lutz]

This remove many die & croak from aclocal and General.pm.
I've moved some file-handling-related functions from
General.pm to FileUtils.pm, and delete a few other.

Amongst the deletions
 * &verbose, &error, $debug, $verbose, etc. are obviously
   obsoleted by Channels/ChannelDefs
 * $tmp, &mktmpdir, and the relevant portion of END would
   better be placed in their own package.  (Automake doesn't
   need them so I've simply deleted them.)

I've not yet applied the patch in case as I suspect someone
can suggest different names or organization.

Now that exit code handling seems clean, my next step will be to
turn Perl's warnings into an error code greater that 1.  I'll
do that separately because I think it might reveal a few issues.

Presently requir.test fails due to a "use strict" error (I've
removed the "smash all exit code to 1" snippet there was, and
apparently `use strict' exits with $? = 2 here).  I'll look
at fixing this tomorrow.

2003-07-07  Alexandre Duret-Lutz  <address@hidden>

        * 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.

Index: aclocal.in
===================================================================
RCS file: /cvs/automake/automake/aclocal.in,v
retrieving revision 1.81
diff -u -r1.81 aclocal.in
--- aclocal.in  3 Jun 2003 21:09:22 -0000       1.81
+++ aclocal.in  7 Jul 2003 21:50:09 -0000
@@ -36,6 +36,7 @@
 use Automake::General;
 use Automake::Configure_ac;
 use Automake::XFile;
+use Automake::FileUtils;
 use File::stat;
 
 # Some constants.
@@ -183,7 +184,8 @@
        }
        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 @@
 {
     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 @@
     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)))
        {
Index: automake.in
===================================================================
RCS file: /cvs/automake/automake/automake.in,v
retrieving revision 1.1479
diff -u -r1.1479 automake.in
--- automake.in 6 Jul 2003 23:48:09 -0000       1.1479
+++ automake.in 7 Jul 2003 21:50:13 -0000
@@ -126,6 +126,7 @@
 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;
Index: lib/Automake/FileUtils.pm
===================================================================
RCS file: lib/Automake/FileUtils.pm
diff -N lib/Automake/FileUtils.pm
--- /dev/null   1 Jan 1970 00:00:00 -0000
+++ lib/Automake/FileUtils.pm   7 Jul 2003 21:50:15 -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 Automake::FileUtils;
+
+use strict;
+use Exporter;
+use File::stat;
+use IO::File;
+use Automake::Channels;
+use Automake::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 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:
Index: lib/Automake/General.pm
===================================================================
RCS file: /cvs/automake/automake/lib/Automake/General.pm,v
retrieving revision 1.3
diff -u -r1.3 General.pm
--- lib/Automake/General.pm     2 Jun 2003 23:34:59 -0000       1.3
+++ lib/Automake/General.pm     7 Jul 2003 21:50:15 -0000
@@ -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);
address@hidden = qw (&debug &find_file &getopt &mktmpdir &mtime
-              &uniq &update_file &verbose &xsystem &contents
-             $debug $help $me $tmp $verbose $version);
address@hidden = 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;
 }
 
 
@@ -230,97 +66,6 @@
         }
      }
    return wantarray ? @res : "@res";
-}
-
-
-# &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;
 }
 
 
Index: lib/Automake/Makefile.am
===================================================================
RCS file: /cvs/automake/automake/lib/Automake/Makefile.am,v
retrieving revision 1.14
diff -u -r1.14 Makefile.am
--- lib/Automake/Makefile.am    2 Jun 2003 23:34:59 -0000       1.14
+++ lib/Automake/Makefile.am    7 Jul 2003 21:50:15 -0000
@@ -26,6 +26,7 @@
   Condition.pm \
   Configure_ac.pm \
   DisjConditions.pm \
+  FileUtils.pm \
   General.pm \
   Location.pm \
   Struct.pm \
-- 
Alexandre Duret-Lutz