Re: Autoconf: Channels.pm: I'm confused

[Akim Demaille]

 > This looks like a bug in handle_exec_errors.  The call to fatal() should
 > read 

 >            fatal ('', "$command failed with exit status: $status",
 >                   exit_code => $status);

 > not

 >            fatal ("$command failed with exit status: $status",
 >                   exit_code => $status);


 > [...]

Thanks.  I'm installing the following in Autoconf.

Index: ChangeLog
from  Akim Demaille  <address@hidden>

        * bin/autoupdate.in, bin/auheader.in, bin/autoreconf.in,
        * bin/autom4te: Adjust.
        In particular, be Autoconf tools are really silent when properly
        working, bind the verbosity of the 'note' channel to $verbose.
        * lib/Autom4te/General.pm (&find_file, &mtime, &update_file)
        (&xsystem, &contents): Remove, since they are exported by...
        * lib/Autom4te/FileUtils.pm: this.
        More perldoc.
        * lib/Autom4te/General.pm (&up_to_date_p): Move to...
        * lib/Autom4te/FileUtils.pm: here.

Index: bin/autoheader.in
===================================================================
RCS file: /cvsroot/autoconf/autoconf/bin/autoheader.in,v
retrieving revision 1.130
diff -u -u -r1.130 autoheader.in
--- bin/autoheader.in 2 Jun 2003 06:55:04 -0000 1.130
+++ bin/autoheader.in 20 Aug 2003 12:49:47 -0000
@@ -39,6 +39,10 @@
   $ENV{'SHELL'} = '@SHELL@' if ($^O eq 'dos');
 }
 
+use Autom4te::ChannelDefs;
+use Autom4te::Channels;
+use Autom4te::FileUtils;
+use Autom4te::FileUtils;
 use Autom4te::General;
 use Autom4te::XFile;
 use strict;
@@ -113,6 +117,8 @@
   getopt ('I|include=s' => address@hidden,
          'B|prepend-include=s' => address@hidden,
          'W|warnings=s' => address@hidden);
+
+  setup_channel 'note', silent => !$verbose;
 
   if (! @ARGV)
     {
Index: bin/autom4te.in
===================================================================
RCS file: /cvsroot/autoconf/autoconf/bin/autom4te.in,v
retrieving revision 1.84
diff -u -u -r1.84 autom4te.in
--- bin/autom4te.in 20 Jun 2003 07:55:35 -0000 1.84
+++ bin/autom4te.in 20 Aug 2003 12:49:47 -0000
@@ -43,6 +43,7 @@
 package Request;
 
 use Data::Dumper;
+use Autom4te::FileUtils;
 use Autom4te::General;
 use Autom4te::Struct;
 use Autom4te::XFile;
@@ -235,6 +236,7 @@
 
 package Autom4te;
 
+use Autom4te::FileUtils;
 use Autom4te::General;
 use File::Basename;
 use Autom4te::XFile;
Index: bin/autoreconf.in
===================================================================
RCS file: /cvsroot/autoconf/autoconf/bin/autoreconf.in,v
retrieving revision 1.114
diff -u -u -r1.114 autoreconf.in
--- bin/autoreconf.in 16 May 2003 09:54:46 -0000 1.114
+++ bin/autoreconf.in 20 Aug 2003 12:49:47 -0000
@@ -39,6 +39,7 @@
   $ENV{'SHELL'} = '@SHELL@' if ($^O eq 'dos');
 }
 
+use Autom4te::FileUtils;
 use Autom4te::General;
 use Autom4te::XFile;
 # Do not use Cwd::chdir, since it might hang.
Index: bin/autoupdate.in
===================================================================
RCS file: /cvsroot/autoconf/autoconf/bin/autoupdate.in,v
retrieving revision 1.44
diff -u -u -r1.44 autoupdate.in
--- bin/autoupdate.in 21 May 2003 09:46:59 -0000 1.44
+++ bin/autoupdate.in 20 Aug 2003 12:49:47 -0000
@@ -37,9 +37,12 @@
   $ENV{'SHELL'} = '@SHELL@' if ($^O eq 'dos');
 }
 
-use File::Basename;
+use Autom4te::ChannelDefs;
+use Autom4te::Channels;
+use Autom4te::FileUtils;
 use Autom4te::General;
 use Autom4te::XFile;
+use File::Basename;
 use strict;
 
 # Lib files.
@@ -100,6 +103,8 @@
   getopt ('I|include=s'         => address@hidden,
          'B|prepend-include=s' => address@hidden,
          'f|force'             => \$force);
+
+  setup_channel 'note', silent => !$verbose;
 
   if (! @ARGV)
     {
Index: lib/Autom4te/FileUtils.pm
===================================================================
RCS file: /cvsroot/autoconf/autoconf/lib/Autom4te/FileUtils.pm,v
retrieving revision 1.1
diff -u -u -r1.1 FileUtils.pm
--- lib/Autom4te/FileUtils.pm 20 Aug 2003 06:51:34 -0000 1.1
+++ lib/Autom4te/FileUtils.pm 20 Aug 2003 12:49:47 -0000
@@ -17,6 +17,20 @@
 
 package Autom4te::FileUtils;
 
+=head1 NAME
+
+Autom4te::FileUtils - handling files
+
+=head1 SYNOPSIS
+
+  use Autom4te::FileUtils
+
+=head1 DESCRIPTION
+
+This perl module provides various general purpose file handling functions.
+
+=cut
+
 use strict;
 use Exporter;
 use File::stat;
@@ -27,18 +41,28 @@
 use vars qw (@ISA @EXPORT);
 
 @ISA = qw (Exporter);
address@hidden = qw (&find_file &mtime &update_file &xsystem &contents);
address@hidden = qw (&contents
+             &find_file &mtime
+             &update_file &up_to_date_p
+             &xsystem &xqx);
+
+
+=item C<find_file ($filename, @include)>
+
+Return the first path for a C<$filename> in the C<include>s.
+
+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 C<@include>.
 
+If the file is flagged as optional (ends with C<?>), then return undef
+if absent, otherwise exit with error.
+
+=cut
 
 # $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;
@@ -71,11 +95,16 @@
   return undef;
 }
 
+=item C<mtime ($file)>
+
+Return the mtime of C<$file>.  Missing files, or C<-> standing for
+C<STDIN> or C<STDOUT> are ``obsolete'', i.e., as old as possible.
+
+=cut
+
 # $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) = @_;
@@ -90,10 +119,16 @@
 }
 
 
+=item C<update_file ($from, $to)>
+
+Rename C<$from> as C<$to>, preserving C<$to> timestamp if it has not
+changed.  Recognize C<$to> = C<-> standing for C<STDIN>.  C<$from> is
+always removed/renamed.
+
+=cut
+
 # &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) = @_;
@@ -139,9 +174,43 @@
 }
 
 
+=item C<up_to_date_p ($file, @dep)>
+
+Is C<$file> more recent than C<@dep>?
+
+=cut
+
+# $BOOLEAN
+# &up_to_date_p ($FILE, @DEP)
+# ---------------------------
+sub up_to_date_p ($@)
+{
+  my ($file, @dep) = @_;
+  my $mtime = mtime ($file);
+
+  foreach my $dep (@dep)
+    {
+      if ($mtime < mtime ($dep))
+       {
+         verb "up_to_date ($file): outdated: $dep";
+         return 0;
+       }
+    }
+
+  verb "up_to_date ($file): up to date";
+  return 1;
+}
+
+
+=item C<handle_exec_errors ($command)>
+
+Display an error message for C<$command>, based on the content of
+C<$?> and C<$!>.
+
+=cut
+
 # handle_exec_errors ($COMMAND)
 # -----------------------------
-# Display an error message for $COMMAND, based on the content of $? and $!.
 sub handle_exec_errors ($)
 {
   my ($command) = @_;
@@ -159,7 +228,8 @@
        {
          my $status = WEXITSTATUS ($?);
          # Propagate exit codes.
-         fatal ("$command failed with exit status: $status",
+         fatal ('',
+                "$command failed with exit status: $status",
                 exit_code => $status);
        }
       elsif (WIFSIGNALED ($?))
@@ -174,9 +244,14 @@
     }
 }
 
+=item C<xqx ($command)>
+
+Same as C<qx> (but in scalar context), but fails on errors.
+
+=cut
+
 # xqx ($COMMAND)
 # --------------
-# Same as `qx' (but in scalar context), but fails on errors.
 sub xqx ($)
 {
   my ($command) = @_;
@@ -192,6 +267,13 @@
 }
 
 
+=item C<xsystem ($command)>
+
+Same as C<system>, but fails on errors, and reports the C<$command>
+in verbose mode.
+
+=cut
+
 # xsystem ($COMMAND)
 # ------------------
 sub xsystem ($)
@@ -206,9 +288,14 @@
 }
 
 
+=item C<contents ($filename)>
+
+Return the contents of c<$filename>.
+
+=cut
+
 # contents ($FILENAME)
 # --------------------
-# Swallow the contents of file $FILENAME.
 sub contents ($)
 {
   my ($file) = @_;
Index: lib/Autom4te/General.pm
===================================================================
RCS file: /cvsroot/autoconf/autoconf/lib/Autom4te/General.pm,v
retrieving revision 1.28
diff -u -u -r1.28 General.pm
--- lib/Autom4te/General.pm 2 Jun 2003 06:56:51 -0000 1.28
+++ lib/Autom4te/General.pm 20 Aug 2003 12:49:48 -0000
@@ -35,6 +35,7 @@
 
 use 5.005_03;
 use Exporter;
+use Autom4te::ChannelDefs;
 use File::Basename;
 use File::Spec;
 use File::stat;
@@ -52,10 +53,10 @@
 
 # Functions we define and export.
 my @export_subs =
-  qw (&catfile &canonpath &contents &debug &error
-      &file_name_is_absolute &find_configure_ac &find_file
-      &getopt &mktmpdir &mtime
-      &uniq &update_file &up_to_date_p &verbose &xsystem &xqx);
+  qw (&catfile &canonpath &debug &error
+      &file_name_is_absolute &find_configure_ac
+      &getopt &mktmpdir
+      &uniq &verbose);
 
 # Functions we forward (coming from modules we use).
 my @export_forward_subs =
@@ -266,27 +267,6 @@
 }
 
 
-=item C<contents ($filename)>
-
-Return the contents of c<$filename>.  Exit with diagnostic on failure.
-
-=cut
-
-# &contents ($FILENAME)
-# ---------------------
-# Swallow the contents of file $FILENAME.
-sub contents ($)
-{
-  my ($file) = @_;
-  verbose "reading $file";
-  local $/;                    # Turn on slurp-mode.
-  my $f = new Autom4te::XFile "< $file";
-  my $contents = $f->getline;
-  $f->close;
-  return $contents;
-}
-
-
 =item C<debug (@message)>
 
 If the debug mode is enabled (C<$debug> and C<$verbose>), report the
@@ -304,30 +284,6 @@
 }
 
 
-=item C<error (@message)>
-
-Report the C<@message> on C<STDERR>, signed with the name of the
-program, and exit with failure.  If the debug mode is enabled
-(C<$debug>), then in addition dump the call stack.
-
-=cut
-
-# &error (@MESSAGE)
-# -----------------
-# Same as die or confess, depending on $debug.
-sub error (@)
-{
-  if ($debug)
-    {
-      confess "$me: ", @_, "\n";
-    }
-  else
-    {
-      die "$me: ", @_, "\n";
-    }
-}
-
-
 =item C<file_name_is_absolute ($filename)>
 
 Wrapper around C<File::Spec->file_name_is_absolute>.  Return true iff
@@ -380,51 +336,6 @@
 }
 
 
-=item C<find_file ($filename, @include)>
-
-Return the first path for a C<$filename> in the C<include>s.
-
-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 C<@include>.
-
-If the file is flagged as optional (ends with C<?>), then return undef
-if absent, otherwise exit with error.
-
-=cut
-
-# $FILENAME
-# find_file ($FILENAME, @INCLUDE)
-# -------------------------------
-sub find_file ($@)
-{
-  my ($filename, @include) = @_;
-  my $optional = 0;
-
-  $optional = 1
-    if $filename =~ s/\?$//;
-
-  return canonpath ($filename)
-    if -e $filename;
-
-  if (file_name_is_absolute ($filename))
-    {
-      error "no such file or directory: $filename"
-       unless $optional;
-      return undef;
-    }
-
-  foreach my $path (@include)
-    {
-      return canonpath (catfile ($path, $filename))
-       if -e catfile ($path, $filename);
-    }
-
-  error "no such file or directory: $filename"
-    unless $optional;
-
-  return undef;
-}
 
 
 =item C<getopt (%option)>
@@ -508,30 +419,6 @@
 }
 
 
-=item C<mtime ($file)>
-
-Return the mtime of C<$file>.  Missing files, or C<-> standing for
-C<STDIN> or C<STDOUT> are ``obsolete'', i.e., as old as possible.
-
-=cut
-
-# $MTIME
-# MTIME ($FILE)
-# -------------
-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;
-}
-
-
 =item C<uniq (@list)>
 
 Return C<@list> with no duplicates, keeping only the first
@@ -558,92 +445,6 @@
 }
 
 
-=item C<up_to_date_p ($file, @dep)>
-
-Is C<$file> more recent than C<@dep>?
-
-=cut
-
-# $BOOLEAN
-# &up_to_date_p ($FILE, @DEP)
-# ---------------------------
-sub up_to_date_p ($@)
-{
-  my ($file, @dep) = @_;
-  my $mtime = mtime ($file);
-
-  foreach my $dep (@dep)
-    {
-      if ($mtime < mtime ($dep))
-       {
-         debug "up_to_date ($file): outdated: $dep";
-         return 0;
-       }
-    }
-
-  debug "up_to_date ($file): up to date";
-  return 1;
-}
-
-
-=item C<update_file ($from, $to)>
-
-Rename C<$from> as C<$to>, preserving C<$to> timestamp if it has not
-changed.  Recognize C<$to> = C<-> standing for C<STDIN>.  C<$from> is
-always removed/renamed.
-
-=cut
-
-# &update_file ($FROM, $TO)
-# -------------------------
-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 error "cannot not remove $from: $!";
-      return;
-    }
-
-  if (-f "$to" && compare ("$from", "$to") == 0)
-    {
-      # File didn't change, so don't update its mod time.
-      verbose "`$to' is unchanged";
-      unlink ($from)
-       or error "cannot not remove $from: $!";
-      return
-    }
-
-  if (-f "$to")
-    {
-      # Back up and install the new one.
-      move ("$to",  "$to$SIMPLE_BACKUP_SUFFIX")
-       or error "cannot not backup $to: $!";
-      move ("$from", "$to")
-       or error "cannot not rename $from as $to: $!";
-      verbose "`$to' is updated";
-    }
-  else
-    {
-      move ("$from", "$to")
-       or error "cannot not rename $from as $to: $!";
-      verbose "`$to' is created";
-    }
-}
-
-
 =item C<verbose (@message)>
 
 If the verbose mode is enabled (C<$verbose>), report the C<@message>
@@ -705,50 +506,6 @@
          error "$command exited abnormally";
        }
     }
-}
-
-
-=item C<xqx ($command)>
-
-Same as C<qx> (but in scalar context), but fails on errors.
-
-=cut
-
-# xqx ($COMMAND)
-# --------------
-sub xqx ($)
-{
-  my ($command) = @_;
-
-  verbose "running: $command";
-
-  $! = 0;
-  my $res = `$command`;
-  handle_exec_errors $command
-    if $?;
-
-  return $res;
-}
-
-
-=item C<xqx ($command)>
-
-Same as C<xsystem>, but fails on errors, and reports the C<$command>
-in verbose mode.
-
-=cut
-
-# xsystem ($COMMAND)
-# ------------------
-sub xsystem ($)
-{
-  my ($command) = @_;
-
-  verbose "running: $command";
-
-  $! = 0;
-  handle_exec_errors $command
-    if system $command;
 }
 
 =back