=head1 VERSION
-2.18
+2.20
=cut
-our $VERSION = '2.18'; # <-- do not forget to update the POD section just above this line!
+our $VERSION = '2.20'; # <-- do not forget to update the POD section just above this line!
$VERSION = eval $VERSION;
=pod
has occurred.
If this value is defined but false then such an operation has
-ocurred, but should not impact later operations.
-
-=over
+occurred, but should not impact later operations.
=begin _private
-=item _chmod($$;$)
+=head2 _chmod($$;$)
Wrapper to chmod() for debugging and error trapping.
-=item _warnonce(@)
+=head2 _warnonce(@)
Warns about something only once.
-=item _choke(@)
+=head2 _choke(@)
Dies with a special message.
-=back
-
=end _private
=cut
}
sub _compare {
- require File::Compare;
- File::Compare::compare(@_);
+ # avoid loading File::Compare in the common case
+ if (-f $_[1] && -s _ == -s $_[0]) {
+ require File::Compare;
+ return File::Compare::compare(@_);
+ }
+ return 1;
}
=begin _private
-=over
-
-=item _move_file_at_boot( $file, $target, $moan )
+=head2 _move_file_at_boot( $file, $target, $moan )
OS-Specific, Win32/Cygwin
=begin _private
-
-=item _unlink_or_rename( $file, $tryhard, $installing )
+=head2 _unlink_or_rename( $file, $tryhard, $installing )
OS-Specific, Win32/Cygwin
=cut
-
-
sub _unlink_or_rename { #XXX OS-SPECIFIC
my ( $file, $tryhard, $installing )= @_;
}
-
-=pod
-
-=back
-
-=head2 Functions
+=head1 Functions
=begin _private
-=over
-
-=item _get_install_skip
+=head2 _get_install_skip
Handles loading the INSTALL.SKIP file. Returns an array of patterns to use.
=cut
-
-
sub _get_install_skip {
my ( $skip, $verbose )= @_;
if ($ENV{EU_INSTALL_IGNORE_SKIP}) {
return $skip
}
-=pod
-
-=item _have_write_access
+=head2 _have_write_access
Abstract a -w check that tries to use POSIX::access() if possible.
}
}
-=pod
-
-=item _can_write_dir(C<$dir>)
+=head2 _can_write_dir(C<$dir>)
Checks whether a given directory is writable, taking account
the possibility that the directory might not exist and would have to
=cut
-
sub _can_write_dir {
my $dir=shift;
return
return 0;
}
-=pod
-
-=item _mkpath($dir,$show,$mode,$verbose,$dry_run)
+=head2 _mkpath($dir,$show,$mode,$verbose,$dry_run)
Wrapper around File::Path::mkpath() to handle errors.
printf "mkpath(%s,%d,%#o)\n", $dir, $show, $mode;
}
if (!$dry_run) {
- if ( ! eval { File::Path::mkpath($dir,$show,$mode); 1 } ) {
- _choke("Can't create '$dir'","$@");
+ my @created;
+ eval {
+ @created = File::Path::mkpath($dir,$show,$mode);
+ 1;
+ } or _choke("Can't create '$dir'","$@");
+ # if we created any directories, we were able to write and don't need
+ # extra checks
+ if (@created) {
+ return;
}
-
}
my ($can,$root,@make)=_can_write_dir($dir);
if (!$can) {
}
-=pod
-
-=item _copy($from,$to,$verbose,$dry_run)
+=head2 _copy($from,$to,$verbose,$dry_run)
Wrapper around File::Copy::copy to handle errors.
=cut
-
sub _copy {
my ( $from, $to, $verbose, $dry_run)=@_;
if ($verbose && $verbose>1) {
=pod
-=item _chdir($from)
+=head2 _chdir($from)
Wrapper around chdir to catch errors.
return $ret;
}
-=pod
-
-=back
-
=end _private
-=over
-
-=item B<install>
+=head2 install
# deprecated forms
install(\%from_to);
}
# we have to do this for back compat with old File::Finds
# and because the target is relative
- my $save_cwd = _chdir($cwd);
- my $diff = 0;
- # XXX: I wonder how useful this logic is actually -- demerphq
- if ( $always_copy or !-f $targetfile or -s $targetfile != $size) {
- $diff++;
- } else {
- # we might not need to copy this file
- $diff = _compare($sourcefile, $targetfile);
- }
+ my $save_cwd = File::Spec->catfile($cwd, $sourcedir);
+ _chdir($cwd);
+ my $diff = $always_copy || _compare($sourcefile, $targetfile);
$check_dirs{$targetdir}++
unless -w $targetfile;
=begin _private
-=item _do_cleanup
+=head2 _do_cleanup
Standardize finish event for after another instruction has occurred.
Handles converting $MUST_REBOOT to a die for instance.
=begin _undocumented
-=item install_rooted_file( $file )
+=head2 install_rooted_file( $file )
Returns $file, or catfile($INSTALL_ROOT,$file) if $INSTALL_ROOT
is defined.
-=item install_rooted_dir( $dir )
+=head2 install_rooted_dir( $dir )
Returns $dir, or catdir($INSTALL_ROOT,$dir) if $INSTALL_ROOT
is defined.
=cut
-
sub install_rooted_file {
if (defined $INSTALL_ROOT) {
File::Spec->catfile($INSTALL_ROOT, $_[0]);
=begin _undocumented
-=item forceunlink( $file, $tryhard )
+=head2 forceunlink( $file, $tryhard )
Tries to delete a file. If $tryhard is true then we will use whatever
devious tricks we can to delete the file. Currently this only applies to
=cut
-
sub forceunlink {
my ( $file, $tryhard )= @_; #XXX OS-SPECIFIC
_unlink_or_rename( $file, $tryhard, not("installing") );
=begin _undocumented
-=item directory_not_empty( $dir )
+=head2 directory_not_empty( $dir )
Returns 1 if there is an .exists file somewhere in a directory tree.
Returns 0 if there is not.
return $files;
}
-=pod
+=head2 install_default
-=item B<install_default> I<DISCOURAGED>
+I<DISCOURAGED>
install_default();
install_default($fullext);
}
-=item B<uninstall>
+=head2 uninstall
uninstall($packlist_file);
uninstall($packlist_file, $verbose, $dont_execute);
=begin _undocumented
-=item inc_uninstall($filepath,$libdir,$verbose,$dry_run,$ignore,$results)
+=head2 inc_uninstall($filepath,$libdir,$verbose,$dry_run,$ignore,$results)
Remove shadowed files. If $ignore is true then it is assumed to hold
a filename to ignore. This is used to prevent spurious warnings from
# The reason why we compare file's contents is, that we cannot
# know, which is the file we just installed (AFS). So we leave
# an identical file in place
- my $diff = 0;
- if ( -f $targetfile && -s _ == -s $filepath) {
- # We have a good chance, we can skip this one
- $diff = _compare($filepath,$targetfile);
- } else {
- $diff++;
- }
+ my $diff = _compare($filepath,$targetfile);
+
print "#$file and $targetfile differ\n" if $diff && $verbose > 1;
if (!$diff or $targetfile eq $ignore) {
=begin _undocumented
-=item run_filter($cmd,$src,$dest)
+=head2 run_filter($cmd,$src,$dest)
Filter $src using $cmd into $dest.
close CMD or die "Filter command '$cmd' failed for $src";
}
-=pod
-
-=item B<pm_to_blib>
+=head2 pm_to_blib
pm_to_blib(\%from_to);
pm_to_blib(\%from_to, $autosplit_dir);
sub pm_to_blib {
my($fromto,$autodir,$pm_filter) = @_;
+ my %dirs;
_mkpath($autodir,0,0755) if defined $autodir;
while(my($from, $to) = each %$fromto) {
if( -f $to && -s $from == -s $to && -M $to < -M $from ) {
my $need_filtering = defined $pm_filter && length $pm_filter &&
$from =~ /\.pm$/;
- if (!$need_filtering && 0 == _compare($from,$to)) {
+ if (!$need_filtering && !_compare($from,$to)) {
print "Skip $to (unchanged)\n" unless $INSTALL_QUIET;
next;
}
# we wont try hard here. its too likely to mess things up.
forceunlink($to);
} else {
- _mkpath(dirname($to),0,0755);
+ my $dirname = dirname($to);
+ if (!$dirs{$dirname}++) {
+ _mkpath($dirname,0,0755);
+ }
}
if ($need_filtering) {
run_filter($pm_filter, $from, $to);
}
}
-
=begin _private
-=item _autosplit
+=head2 _autosplit
From 1.0307 back, AutoSplit will sometimes leave an open filehandle to
the file being split. This causes problems on systems with mandatory
=begin _private
-=item _invokant
+=head2 _invokant
Does a heuristic on the stack to see who called us for more intelligent
error messages. Currently assumes we will be called only by Module::Build
return $builder;
}
-=pod
-
-=back
-
=head1 ENVIRONMENT
=over 4
https://perl5.git.perl.org / perl5.git / commitdiff