* 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.
+2003-08-20 Akim Demaille <akim@epita.fr>
+
+ * 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.
+
2003-08-20 Akim Demaille <akim@epita.fr>
* lib/Autom4te/Channels.pm, lib/Autom4te/ChannelDefs.pm
$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;
'B|prepend-include=s' => \@prepend_include,
'W|warnings=s' => \@warning);
+ setup_channel 'note', silent => !$verbose;
+
if (! @ARGV)
{
my $configure_ac = find_configure_ac;
package Request;
use Data::Dumper;
+use Autom4te::FileUtils;
use Autom4te::General;
use Autom4te::Struct;
use Autom4te::XFile;
package Autom4te;
+use Autom4te::FileUtils;
use Autom4te::General;
use File::Basename;
use Autom4te::XFile;
$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.
$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.
'B|prepend-include=s' => \@prepend_include,
'f|force' => \$force);
+ setup_channel 'note', silent => !$verbose;
+
if (! @ARGV)
{
my $configure_ac = find_configure_ac;
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;
use vars qw (@ISA @EXPORT);
@ISA = qw (Exporter);
-@EXPORT = qw (&find_file &mtime &update_file &xsystem &contents);
+@EXPORT = 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;
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) = @_;
}
+=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) = @_;
}
+=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) = @_;
{
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 ($?))
}
}
+=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) = @_;
}
+=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 ($)
}
+=item C<contents ($filename)>
+
+Return the contents of c<$filename>.
+
+=cut
+
# contents ($FILENAME)
# --------------------
-# Swallow the contents of file $FILENAME.
sub contents ($)
{
my ($file) = @_;
use 5.005_03;
use Exporter;
+use Autom4te::ChannelDefs;
use File::Basename;
use File::Spec;
use File::stat;
# 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 =
}
-=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
}
-=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
}
-=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)>
}
-=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
}
-=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>
}
}
-
-=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
=head1 SEE ALSO
projects / thirdparty / autoconf.git / commitdiff
