FileUtils.pm (automake-1.16.2.tar.xz) | : | FileUtils.pm (automake-1.16.3.tar.xz) | ||
---|---|---|---|---|
skipping to change at line 39 | skipping to change at line 39 | |||
use Automake::FileUtils | use Automake::FileUtils | |||
=head1 DESCRIPTION | =head1 DESCRIPTION | |||
This perl module provides various general purpose file handling functions. | This perl module provides various general purpose file handling functions. | |||
=cut | =cut | |||
use 5.006; | use 5.006; | |||
use strict; | use strict; | |||
use warnings FATAL => 'all'; | ||||
use Exporter; | use Exporter; | |||
use File::stat; | use File::stat; | |||
use IO::File; | use IO::File; | |||
use Automake::Channels; | use Automake::Channels; | |||
use Automake::ChannelDefs; | use Automake::ChannelDefs; | |||
use vars qw (@ISA @EXPORT); | our @ISA = qw (Exporter); | |||
our @EXPORT = qw (&contents | ||||
&find_file &mtime | ||||
&update_file | ||||
&xsystem &xsystem_hint &xqx | ||||
&dir_has_case_matching_file &reset_dir_cache | ||||
&set_dir_cache_file); | ||||
@ISA = qw (Exporter); | =over 4 | |||
@EXPORT = qw (&contents | ||||
&find_file &mtime | ||||
&update_file &up_to_date_p | ||||
&xsystem &xsystem_hint &xqx | ||||
&dir_has_case_matching_file &reset_dir_cache | ||||
&set_dir_cache_file); | ||||
=item C<find_file ($file_name, @include)> | =item C<find_file ($file_name, @include)> | |||
Return the first path for a C<$file_name> in the C<include>s. | Return the first path for a C<$file_name> in the C<include>s. | |||
We match exactly the behavior of GNU M4: first look in the current | We match exactly the behavior of GNU M4: first look in the current | |||
directory (which includes the case of absolute file names), and then, | directory (which includes the case of absolute file names), and then, | |||
if the file name is not absolute, look in C<@include>. | if the file name is not absolute, look in C<@include>. | |||
If the file is flagged as optional (ends with C<?>), then return undef | If the file is flagged as optional (ends with C<?>), then return undef | |||
skipping to change at line 180 | skipping to change at line 183 | |||
msg 'note', "'$to' is updated"; | msg 'note', "'$to' is updated"; | |||
} | } | |||
else | else | |||
{ | { | |||
move ("$from", "$to") | move ("$from", "$to") | |||
or fatal "cannot rename $from as $to: $!"; | or fatal "cannot rename $from as $to: $!"; | |||
msg 'note', "'$to' is created"; | msg 'note', "'$to' is created"; | |||
} | } | |||
} | } | |||
=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, [$expected_exit_code = 0], [$hint])> | =item C<handle_exec_errors ($command, [$expected_exit_code = 0], [$hint])> | |||
Display an error message for C<$command>, based on the content of | Display an error message for C<$command>, based on the content of | |||
C<$?> and C<$!>. Be quiet if the command exited normally | C<$?> and C<$!>. Be quiet if the command exited normally | |||
with C<$expected_exit_code>. If C<$hint> is given, display that as well | with C<$expected_exit_code>. If C<$hint> is given, display that as well | |||
if the command failed to run at all. | if the command failed to run at all. | |||
=cut | =cut | |||
sub handle_exec_errors ($;$$) | sub handle_exec_errors ($;$$) | |||
skipping to change at line 352 | skipping to change at line 328 | |||
systems (e.g. Mac OS X's HFS+). On such systems C<-f 'Foo'> and C<-f | systems (e.g. Mac OS X's HFS+). On such systems C<-f 'Foo'> and C<-f | |||
'foO'> answer the same thing. Hence if a package distributes its own | 'foO'> answer the same thing. Hence if a package distributes its own | |||
F<CHANGELOG> file, but has no F<ChangeLog> file, automake would still | F<CHANGELOG> file, but has no F<ChangeLog> file, automake would still | |||
try to distribute F<ChangeLog> (because it thinks it exists) in | try to distribute F<ChangeLog> (because it thinks it exists) in | |||
addition to F<CHANGELOG>, although it is impossible for these two | addition to F<CHANGELOG>, although it is impossible for these two | |||
files to be in the same directory (the two file names designate the | files to be in the same directory (the two file names designate the | |||
same file). | same file). | |||
=cut | =cut | |||
use vars '%_directory_cache'; | our %_directory_cache; | |||
sub dir_has_case_matching_file ($$) | sub dir_has_case_matching_file ($$) | |||
{ | { | |||
# Note that print File::Spec->case_tolerant returns 0 even on MacOS | # Note that print File::Spec->case_tolerant returns 0 even on MacOS | |||
# X (with Perl v5.8.1-RC3 at least), so do not try to shortcut this | # X (with Perl v5.8.1-RC3 at least), so do not try to shortcut this | |||
# function using that. | # function using that. | |||
my ($dirname, $file_name) = @_; | my ($dirname, $file_name) = @_; | |||
return 0 unless -f "$dirname/$file_name"; | return 0 unless -f "$dirname/$file_name"; | |||
# The file appears to exist, however it might be a mirage if the | # The file appears to exist, however it might be a mirage if the | |||
skipping to change at line 401 | skipping to change at line 377 | |||
=cut | =cut | |||
sub set_dir_cache_file ($$) | sub set_dir_cache_file ($$) | |||
{ | { | |||
my ($dirname, $file_name) = @_; | my ($dirname, $file_name) = @_; | |||
$_directory_cache{$dirname}{$file_name} = 1 | $_directory_cache{$dirname}{$file_name} = 1 | |||
if exists $_directory_cache{$dirname}; | if exists $_directory_cache{$dirname}; | |||
} | } | |||
=back | ||||
=cut | ||||
1; # for require | 1; # for require | |||
End of changes. 7 change blocks. | ||||
36 lines changed or deleted | 16 lines changed or added |