<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;"># Copyright (C) 2003-2013 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, see &lt;http://www.gnu.org/licenses/&gt;.

###############################################################
# The main copy of this file is in Automake's git repository. #
# Updates should be sent to automake-patches@gnu.org.         #
###############################################################

package Automake::FileUtils;

=head1 NAME

Automake::FileUtils - handling files

=head1 SYNOPSIS

  use Automake::FileUtils

=head1 DESCRIPTION

This perl module provides various general purpose file handling functions.

=cut

use 5.006;
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 (&amp;contents
	      &amp;find_file &amp;mtime
	      &amp;update_file &amp;up_to_date_p
	      &amp;xsystem &amp;xsystem_hint &amp;xqx
	      &amp;dir_has_case_matching_file &amp;reset_dir_cache
	      &amp;set_dir_cache_file);

=item C&lt;find_file ($file_name, @include)&gt;

Return the first path for a C&lt;$file_name&gt; in the C&lt;include&gt;s.

We match exactly the behavior of GNU M4: first look in the current
directory (which includes the case of absolute file names), and then,
if the file name is not absolute, look in C&lt;@include&gt;.

If the file is flagged as optional (ends with C&lt;?&gt;), then return undef
if absent, otherwise exit with error.

=cut

# $FILE_NAME
# find_file ($FILE_NAME, @INCLUDE)
# --------------------------------
sub find_file ($@)
{
  use File::Spec;

  my ($file_name, @include) = @_;
  my $optional = 0;

  $optional = 1
    if $file_name =~ s/\?$//;

  return File::Spec-&gt;canonpath ($file_name)
    if -e $file_name;

  if (!File::Spec-&gt;file_name_is_absolute ($file_name))
    {
      foreach my $path (@include)
	{
	  return File::Spec-&gt;canonpath (File::Spec-&gt;catfile ($path, $file_name))
	    if -e File::Spec-&gt;catfile ($path, $file_name)
	}
    }

  fatal "$file_name: no such file or directory"
    unless $optional;
  return undef;
}

=item C&lt;mtime ($file)&gt;

Return the mtime of C&lt;$file&gt;.  Missing files, or C&lt;-&gt; standing for
C&lt;STDIN&gt; or C&lt;STDOUT&gt; 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 fatal "cannot stat $file: $!";

  return $stat-&gt;mtime;
}


=item C&lt;update_file ($from, $to, [$force])&gt;

Rename C&lt;$from&gt; as C&lt;$to&gt;, preserving C&lt;$to&gt; timestamp if it has not
changed, unless C&lt;$force&gt; is true (defaults to false).  Recognize
C&lt;$to&gt; = C&lt;-&gt; standing for C&lt;STDIN&gt;.  C&lt;$from&gt; is always
removed/renamed.

=cut

# &amp;update_file ($FROM, $TO; $FORCE)
# ---------------------------------
sub update_file ($$;$)
{
  my ($from, $to, $force) = @_;
  $force = 0
    unless defined $force;
  my $SIMPLE_BACKUP_SUFFIX = $ENV{'SIMPLE_BACKUP_SUFFIX'} || '~';
  use File::Compare;
  use File::Copy;

  if ($to eq '-')
    {
      my $in = new IO::File $from, "&lt;";
      my $out = new IO::File ("&gt;-");
      while ($_ = $in-&gt;getline)
	{
	  print $out $_;
	}
      $in-&gt;close;
      unlink ($from) || fatal "cannot remove $from: $!";
      return;
    }

  if (!$force &amp;&amp; -f "$to" &amp;&amp; compare ("$from", "$to") == 0)
    {
      # File didn't change, so don't update its mod time.
      msg 'note', "'$to' is unchanged";
      unlink ($from)
        or fatal "cannot remove $from: $!";
      return
    }

  if (-f "$to")
    {
      # Back up and install the new one.
      move ("$to",  "$to$SIMPLE_BACKUP_SUFFIX")
	or fatal "cannot backup $to: $!";
      move ("$from", "$to")
	or fatal "cannot rename $from as $to: $!";
      msg 'note', "'$to' is updated";
    }
  else
    {
      move ("$from", "$to")
	or fatal "cannot rename $from as $to: $!";
      msg 'note', "'$to' is created";
    }
}


=item C&lt;up_to_date_p ($file, @dep)&gt;

Is C&lt;$file&gt; more recent than C&lt;@dep&gt;?

=cut

# $BOOLEAN
# &amp;up_to_date_p ($FILE, @DEP)
# ---------------------------
sub up_to_date_p ($@)
{
  my ($file, @dep) = @_;
  my $mtime = mtime ($file);

  foreach my $dep (@dep)
    {
      if ($mtime &lt; mtime ($dep))
	{
	  verb "up_to_date ($file): outdated: $dep";
	  return 0;
	}
    }

  verb "up_to_date ($file): up to date";
  return 1;
}


=item C&lt;handle_exec_errors ($command, [$expected_exit_code = 0], [$hint])&gt;

Display an error message for C&lt;$command&gt;, based on the content of
C&lt;$?&gt; and C&lt;$!&gt;.  Be quiet if the command exited normally
with C&lt;$expected_exit_code&gt;.  If C&lt;$hint&gt; is given, display that as well
if the command failed to run at all.

=cut

sub handle_exec_errors ($;$$)
{
  my ($command, $expected, $hint) = @_;
  $expected = 0 unless defined $expected;
  if (defined $hint)
    {
      $hint = "\n" . $hint;
    }
  else
    {
      $hint = '';
    }

  $command = (split (' ', $command))[0];
  if ($!)
    {
      fatal "failed to run $command: $!" . $hint;
    }
  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 =&gt; $status)
	    unless $status == $expected;
	}
      elsif (WIFSIGNALED ($?))
	{
	  my $signal = WTERMSIG ($?);
	  fatal "$command terminated by signal: $signal";
	}
      else
	{
	  fatal "$command exited abnormally";
	}
    }
}

=item C&lt;xqx ($command)&gt;

Same as C&lt;qx&gt; (but in scalar context), but fails on errors.

=cut

# xqx ($COMMAND)
# --------------
sub xqx ($)
{
  my ($command) = @_;

  verb "running: $command";

  $! = 0;
  my $res = `$command`;
  handle_exec_errors $command
    if $?;

  return $res;
}


=item C&lt;xsystem (@argv)&gt;

Same as C&lt;system&gt;, but fails on errors, and reports the C&lt;@argv&gt;
in verbose mode.

=cut

sub xsystem (@)
{
  my (@command) = @_;

  verb "running: @command";

  $! = 0;
  handle_exec_errors "@command"
    if system @command;
}


=item C&lt;xsystem_hint ($msg, @argv)&gt;

Same as C&lt;xsystem&gt;, but allows to pass a hint that will be displayed
in case the command failed to run at all.

=cut

sub xsystem_hint (@)
{
  my ($hint, @command) = @_;

  verb "running: @command";

  $! = 0;
  handle_exec_errors "@command", 0, $hint
    if system @command;
}


=item C&lt;contents ($file_name)&gt;

Return the contents of C&lt;$file_name&gt;.

=cut

# contents ($FILE_NAME)
# ---------------------
sub contents ($)
{
  my ($file) = @_;
  verb "reading $file";
  local $/;			# Turn on slurp-mode.
  my $f = new Automake::XFile $file, "&lt;";
  my $contents = $f-&gt;getline;
  $f-&gt;close;
  return $contents;
}


=item C&lt;dir_has_case_matching_file ($DIRNAME, $FILE_NAME)&gt;

Return true iff $DIR contains a file name that matches $FILE_NAME case
insensitively.

We need to be cautious on case-insensitive case-preserving file
systems (e.g. Mac OS X's HFS+).  On such systems C&lt;-f 'Foo'&gt; and C&lt;-f
'foO'&gt; answer the same thing.  Hence if a package distributes its own
F&lt;CHANGELOG&gt; file, but has no F&lt;ChangeLog&gt; file, automake would still
try to distribute F&lt;ChangeLog&gt; (because it thinks it exists) in
addition to F&lt;CHANGELOG&gt;, although it is impossible for these two
files to be in the same directory (the two file names designate the
same file).

=cut

use vars '%_directory_cache';
sub dir_has_case_matching_file ($$)
{
  # Note that print File::Spec-&gt;case_tolerant returns 0 even on MacOS
  # X (with Perl v5.8.1-RC3 at least), so do not try to shortcut this
  # function using that.

  my ($dirname, $file_name) = @_;
  return 0 unless -f "$dirname/$file_name";

  # The file appears to exist, however it might be a mirage if the
  # system is case insensitive.  Let's browse the directory and check
  # whether the file is really in.  We maintain a cache of directories
  # so Automake doesn't spend all its time reading the same directory
  # again and again.
  if (!exists $_directory_cache{$dirname})
    {
      error "failed to open directory '$dirname'"
	unless opendir (DIR, $dirname);
      $_directory_cache{$dirname} = { map { $_ =&gt; 1 } readdir (DIR) };
      closedir (DIR);
    }
  return exists $_directory_cache{$dirname}{$file_name};
}

=item C&lt;reset_dir_cache ($dirname)&gt;

Clear C&lt;dir_has_case_matching_file&gt;'s cache for C&lt;$dirname&gt;.

=cut

sub reset_dir_cache ($)
{
  delete $_directory_cache{$_[0]};
}

=item C&lt;set_dir_cache_file ($dirname, $file_name)&gt;

State that C&lt;$dirname&gt; contains C&lt;$file_name&gt; now.

=cut

sub set_dir_cache_file ($$)
{
  my ($dirname, $file_name) = @_;
  $_directory_cache{$dirname}{$file_name} = 1
    if exists $_directory_cache{$dirname};
}

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:
</pre></body></html>