package ExtUtils::Install;
-use 5.00503;
use strict;
use vars qw(@ISA @EXPORT $VERSION $MUST_REBOOT %Config);
-$VERSION = '1.46';
+$VERSION = '1.47';
$VERSION = eval $VERSION;
use AutoSplit;
=head2 Functions
-=over 4
-
-=item B<install>
-
- install(\%from_to);
- install(\%from_to, $verbose, $dont_execute, $uninstall_shadows, $skip);
-
-Copies each directory tree of %from_to to its corresponding value
-preserving timestamps and permissions.
-
-There are two keys with a special meaning in the hash: "read" and
-"write". These contain packlist files. After the copying is done,
-install() will write the list of target files to $from_to{write}. If
-$from_to{read} is given the contents of this file will be merged into
-the written file. The read and the written file may be identical, but
-on AFS it is quite likely that people are installing to a different
-directory than the one where the files later appear.
-
-If $verbose is true, will print out each file removed. Default is
-false. This is "make install VERBINST=1". $verbose values going
-up to 5 show increasingly more diagnostics output.
-
-If $dont_execute is true it will only print what it was going to do
-without actually doing it. Default is false.
-
-If $uninstall_shadows is true any differing versions throughout @INC
-will be uninstalled. This is "make install UNINST=1"
-
-As of 1.37_02 install() supports the use of a list of patterns to filter
-out files that shouldn't be installed. If $skip is omitted or undefined
-then install will try to read the list from INSTALL.SKIP in the CWD.
-This file is a list of regular expressions and is just like the
-MANIFEST.SKIP file used by L<ExtUtils::Manifest>.
-
-A default site INSTALL.SKIP may be provided by setting then environment
-variable EU_INSTALL_SITE_SKIPFILE, this will only be used when there
-isn't a distribution specific INSTALL.SKIP. If the environment variable
-EU_INSTALL_IGNORE_SKIP is true then no install file filtering will be
-performed.
-
-If $skip is undefined then the skip file will be autodetected and used if it
-is found. If $skip is a reference to an array then it is assumed
-the array contains the list of patterns, if $skip is a true non reference it is
-assumed to be the filename holding the list of patterns, any other value of
-$skip is taken to mean that no install filtering should occur.
-
-
-=cut
-
=begin _private
=item _get_install_skip
return 0;
}
-=item _mkpath($dir,$show,$mode,$verbose,$fake)
+=item _mkpath($dir,$show,$mode,$verbose,$dry_run)
Wrapper around File::Path::mkpath() to handle errors.
If $verbose is true and >1 then additional diagnostics will be produced, also
this will force $show to true.
-If $fake is true then the directory will not be created but a check will be
+If $dry_run is true then the directory will not be created but a check will be
made to see whether it would be possible to write to the directory, or that
it would be possible to create the directory.
-If $fake is not true dies if the directory can not be created or is not
+If $dry_run is not true dies if the directory can not be created or is not
writable.
=cut
sub _mkpath {
- my ($dir,$show,$mode,$verbose,$fake)=@_;
+ my ($dir,$show,$mode,$verbose,$dry_run)=@_;
if ( $verbose && $verbose > 1 && ! -d $dir) {
$show= 1;
printf "mkpath(%s,%d,%#o)\n", $dir, $show, $mode;
}
- if (!$fake) {
+ if (!$dry_run) {
if ( ! eval { File::Path::mkpath($dir,$show,$mode); 1 } ) {
_choke("Can't create '$dir'","$@");
}
$root ? "Do not have write permissions on '$root'"
: "Unknown Error"
);
- if ($fake) {
+ if ($dry_run) {
_warnonce @msg;
} else {
_choke @msg;
}
- } elsif ($show and $fake) {
+ } elsif ($show and $dry_run) {
print "$_\n" for @make;
}
+
}
-=item _copy($from,$to,$verbose,$fake)
+=item _copy($from,$to,$verbose,$dry_run)
Wrapper around File::Copy::copy to handle errors.
If $verbose is true and >1 then additional dignostics will be emitted.
-If $fake is true then the copy will not actually occur.
+If $dry_run is true then the copy will not actually occur.
Dies if the copy fails.
sub _copy {
- my ( $from, $to, $verbose, $nonono)=@_;
+ my ( $from, $to, $verbose, $dry_run)=@_;
if ($verbose && $verbose>1) {
printf "copy(%s,%s)\n", $from, $to;
}
- if (!$nonono) {
+ if (!$dry_run) {
File::Copy::copy($from,$to)
or Carp::croak( _estr "ERROR: Cannot copy '$from' to '$to': $!" );
}
=end _private
+=over 4
+
+=item B<install>
+
+ # deprecated forms
+ install(\%from_to);
+ install(\%from_to, $verbose, $dry_run, $uninstall_shadows,
+ $skip, $always_copy, \%result);
+
+ # recommended form as of 1.47
+ install([
+ from_to => \%from_to,
+ verbose => 1,
+ dry_run => 0,
+ uninstall_shadows => 1,
+ skip => undef,
+ always_copy => 1,
+ result => \%install_results,
+ ]);
+
+
+Copies each directory tree of %from_to to its corresponding value
+preserving timestamps and permissions.
+
+There are two keys with a special meaning in the hash: "read" and
+"write". These contain packlist files. After the copying is done,
+install() will write the list of target files to $from_to{write}. If
+$from_to{read} is given the contents of this file will be merged into
+the written file. The read and the written file may be identical, but
+on AFS it is quite likely that people are installing to a different
+directory than the one where the files later appear.
+
+If $verbose is true, will print out each file removed. Default is
+false. This is "make install VERBINST=1". $verbose values going
+up to 5 show increasingly more diagnostics output.
+
+If $dry_run is true it will only print what it was going to do
+without actually doing it. Default is false.
+
+If $uninstall_shadows is true any differing versions throughout @INC
+will be uninstalled. This is "make install UNINST=1"
+
+As of 1.37_02 install() supports the use of a list of patterns to filter out
+files that shouldn't be installed. If $skip is omitted or undefined then
+install will try to read the list from INSTALL.SKIP in the CWD. This file is
+a list of regular expressions and is just like the MANIFEST.SKIP file used
+by L<ExtUtils::Manifest>.
+
+A default site INSTALL.SKIP may be provided by setting then environment
+variable EU_INSTALL_SITE_SKIPFILE, this will only be used when there isn't a
+distribution specific INSTALL.SKIP. If the environment variable
+EU_INSTALL_IGNORE_SKIP is true then no install file filtering will be
+performed.
+
+If $skip is undefined then the skip file will be autodetected and used if it
+is found. If $skip is a reference to an array then it is assumed the array
+contains the list of patterns, if $skip is a true non reference it is
+assumed to be the filename holding the list of patterns, any other value of
+$skip is taken to mean that no install filtering should occur.
+
+B<Changes As of Version 1.47>
+
+As of version 1.47 the following additions were made to the install interface.
+Note that the new argument style and use of the %result hash is recommended.
+
+The $always_copy parameter which when true causes files to be updated
+regardles as to whether they have changed, if it is defined but false then
+copies are made only if the files have changed, if it is undefined then the
+value of the environment variable EU_ALWAYS_COPY is used as default.
+
+The %result hash will be populated with the various keys/subhashes reflecting
+the install. Currently these keys and their structure are:
+
+ install => { $target => $source },
+ install_fail => { $target => $source },
+ install_unchanged => { $target => $source },
+
+ install_filtered => { $source => $pattern },
+
+ uninstall => { $uninstalled => $source },
+ uninstall_fail => { $uninstalled => $source },
+
+where C<$source> is the filespec of the file being installed. C<$target> is where
+it is being installed to, and C<$uninstalled> is any shadow file that is in C<@INC>
+or C<$ENV{PERL5LIB}> or other standard locations, and C<$pattern> is the pattern that
+caused a source file to be skipped. In future more keys will be added, such as to
+show created directories, however this requires changes in other modules and must
+therefore wait.
+
+These keys will be populated before any exceptions are thrown should there be an
+error.
+
+Note that all updates of the %result are additive, the hash will not be
+cleared before use, thus allowing status results of many installs to be easily
+aggregated.
+
+B<NEW ARGUMENT STYLE>
+
+If there is only one argument and it is a reference to an array then
+the array is assumed to contain a list of key-value pairs specifying
+the options. In this case the option "from_to" is mandatory. This style
+means that you dont have to supply a cryptic list of arguments and can
+use a self documenting argument list that is easier to understand.
+
+This is now the recommended interface to install().
+
+B<RETURN>
+
+If all actions were successful install will return a hashref of the results
+as described above for the $result parameter. If any action is a failure
+then install will die, therefore it is recommended to pass in the $result
+parameter instead of using the return value. If the result parameter is
+provided then the returned hashref will be the passed in hashref.
+
=cut
sub install { #XXX OS-SPECIFIC
- my($from_to,$verbose,$nonono,$inc_uninstall,$skip) = @_;
+ my($from_to,$verbose,$dry_run,$uninstall_shadows,$skip,$always_copy,$result) = @_;
+ if (@_==1 and eval { 1+@$from_to }) {
+ my %opts = @$from_to;
+ $from_to = $opts{from_to}
+ or Carp::confess("from_to is a mandatory parameter");
+ $verbose = $opts{verbose};
+ $dry_run = $opts{dry_run};
+ $uninstall_shadows = $opts{uninstall_shadows};
+ $skip = $opts{skip};
+ $always_copy = $opts{always_copy};
+ $result = $opts{result};
+ }
+
+ $result ||= {};
$verbose ||= 0;
- $nonono ||= 0;
+ $dry_run ||= 0;
$skip= _get_install_skip($skip,$verbose);
+ $always_copy = $ENV{EU_ALWAYS_COPY}||0
+ unless defined $always_copy;
my(%from_to) = %$from_to;
my(%pack, $dir, %warned);
if ( $sourcefile=~/$pat/ ) {
print "Skipping $targetfile (filtered)\n"
if $verbose>1;
+ $result->{install_filtered}{$sourcefile} = $pat;
return;
}
}
# and because the target is relative
my $save_cwd = _chdir($cwd);
my $diff = 0;
- if ( -f $targetfile && -s _ == $size) {
- # We have a good chance, we can skip this one
- $diff = compare($sourcefile, $targetfile);
- } else {
+ # 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);
}
$check_dirs{$targetdir}++
unless -w $targetfile;
}, $current_directory );
_chdir($cwd);
}
-
foreach my $targetdir (sort keys %check_dirs) {
- _mkpath( $targetdir, 0, 0755, $verbose, $nonono );
+ _mkpath( $targetdir, 0, 0755, $verbose, $dry_run );
}
foreach my $found (@found_files) {
my ($diff, $ffd, $origfile, $mode, $size, $atime, $mtime,
my $realtarget= $targetfile;
if ($diff) {
- if (-f $targetfile) {
- print "_unlink_or_rename($targetfile)\n" if $verbose>1;
- $targetfile= _unlink_or_rename( $targetfile, 'tryhard', 'install' )
- unless $nonono;
- } elsif ( ! -d $targetdir ) {
- _mkpath( $targetdir, 0, 0755, $verbose, $nonono );
- }
- print "Installing $targetfile\n";
- _copy( $sourcefile, $targetfile, $verbose, $nonono, );
- #XXX OS-SPECIFIC
- print "utime($atime,$mtime,$targetfile)\n" if $verbose>1;
- utime($atime,$mtime + $Is_VMS,$targetfile) unless $nonono>1;
-
-
- $mode = 0444 | ( $mode & 0111 ? 0111 : 0 );
- $mode = $mode | 0222
- if $realtarget ne $targetfile;
- _chmod( $mode, $targetfile, $verbose );
+ eval {
+ if (-f $targetfile) {
+ print "_unlink_or_rename($targetfile)\n" if $verbose>1;
+ $targetfile= _unlink_or_rename( $targetfile, 'tryhard', 'install' )
+ unless $dry_run;
+ } elsif ( ! -d $targetdir ) {
+ _mkpath( $targetdir, 0, 0755, $verbose, $dry_run );
+ }
+ print "Installing $targetfile\n";
+
+ _copy( $sourcefile, $targetfile, $verbose, $dry_run, );
+
+
+ #XXX OS-SPECIFIC
+ print "utime($atime,$mtime,$targetfile)\n" if $verbose>1;
+ utime($atime,$mtime + $Is_VMS,$targetfile) unless $dry_run>1;
+
+
+ $mode = 0444 | ( $mode & 0111 ? 0111 : 0 );
+ $mode = $mode | 0222
+ if $realtarget ne $targetfile;
+ _chmod( $mode, $targetfile, $verbose );
+ $result->{install}{$targetfile} = $sourcefile;
+ 1
+ } or do {
+ $result->{install_fail}{$targetfile} = $sourcefile;
+ die $@;
+ };
} else {
+ $result->{install_unchanged}{$targetfile} = $sourcefile;
print "Skipping $targetfile (unchanged)\n" if $verbose;
}
- if ( $inc_uninstall ) {
+ if ( $uninstall_shadows ) {
inc_uninstall($sourcefile,$ffd, $verbose,
- $nonono,
- $realtarget ne $targetfile ? $realtarget : "");
+ $dry_run,
+ $realtarget ne $targetfile ? $realtarget : "",
+ $result);
}
# Record the full pathname.
if ($pack{'write'}) {
$dir = install_rooted_dir(dirname($pack{'write'}));
- _mkpath( $dir, 0, 0755, $verbose, $nonono );
+ _mkpath( $dir, 0, 0755, $verbose, $dry_run );
print "Writing $pack{'write'}\n";
- $packlist->write(install_rooted_file($pack{'write'})) unless $nonono;
+ $packlist->write(install_rooted_file($pack{'write'})) unless $dry_run;
}
_do_cleanup($verbose);
+ return $result;
}
=begin _private
=cut
sub uninstall {
- my($fil,$verbose,$nonono) = @_;
+ my($fil,$verbose,$dry_run) = @_;
$verbose ||= 0;
- $nonono ||= 0;
+ $dry_run ||= 0;
die _estr "ERROR: no packlist file found: '$fil'"
unless -f $fil;
foreach (sort(keys(%$packlist))) {
chomp;
print "unlink $_\n" if $verbose;
- forceunlink($_,'tryhard') unless $nonono;
+ forceunlink($_,'tryhard') unless $dry_run;
}
print "unlink $fil\n" if $verbose;
- forceunlink($fil, 'tryhard') unless $nonono;
+ forceunlink($fil, 'tryhard') unless $dry_run;
_do_cleanup($verbose);
}
=begin _undocumented
-=item inc_uninstall($filepath,$libdir,$verbose,$nonono,$ignore)
+=item 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
We now only die when failing to remove a file that has precedence over
our own, when our install has precedence we only warn.
+$results is assumed to contain a hashref which will have the keys
+'uninstall' and 'uninstall_fail' populated with keys for the files
+removed and values of the source files they would shadow.
+
=end _undocumented
=cut
sub inc_uninstall {
- my($filepath,$libdir,$verbose,$nonono,$ignore) = @_;
+ my($filepath,$libdir,$verbose,$dry_run,$ignore,$results) = @_;
my($dir);
$ignore||="";
my $file = (File::Spec->splitpath($filepath))[2];
my %seen_dir = ();
-
+
my @PERL_ENV_LIB = split $Config{path_sep}, defined $ENV{'PERL5LIB'}
? $ENV{'PERL5LIB'} : $ENV{'PERLLIB'} || '';
$seen_ours = 1;
next;
}
- if ($nonono) {
+ if ($dry_run) {
+ $results->{uninstall}{$targetfile} = $filepath;
if ($verbose) {
$Inc_uninstall_warn_handler ||= ExtUtils::Install::Warn->new();
$libdir =~ s|^\./||s ; # That's just cosmetics, no need to port. It looks prettier.
if $ExtUtils::Install::Testing and
File::Spec->canonpath($ExtUtils::Install::Testing) eq $targetfile;
forceunlink($targetfile,'tryhard');
+ $results->{uninstall}{$targetfile} = $filepath;
1;
} or do {
+ $results->{fail_uninstall}{$targetfile} = $filepath;
if ($seen_ours) {
warn "Failed to remove probably harmless shadow file '$targetfile'\n";
} else {
If there is no INSTALL.SKIP file in the make directory then this value
can be used to provide a default.
+=item B<EU_ALWAYS_COPY>
+
+If this environment variable is true then normal install processes will
+always overwrite older identical files during the install process.
+
=back
=head1 AUTHOR
Original author lost in the mists of time. Probably the same as Makemaker.
Production release currently maintained by demerphq C<yves at cpan.org>,
-extensive changes by Michael Schwern.
+extensive changes by Michael G. Schwern.
Send bug reports via http://rt.cpan.org/. Please send your
generated Makefile along with your report.
--- /dev/null
+#!/usr/bin/perl -w
+
+# Test ExtUtils::Install.
+
+BEGIN {
+ if( $ENV{PERL_CORE} ) {
+ @INC = ('../../lib', '../lib', 'lib');
+ }
+ else {
+ unshift @INC, 't/lib';
+ }
+}
+chdir 't';
+
+use strict;
+use TieOut;
+use File::Path;
+use File::Spec;
+
+use Test::More tests => 70;
+
+use MakeMaker::Test::Setup::BFD;
+
+BEGIN { use_ok('ExtUtils::Install') }
+
+# Check exports.
+foreach my $func (qw(install uninstall pm_to_blib install_default)) {
+ can_ok(__PACKAGE__, $func);
+}
+
+
+ok( setup_recurs(), 'setup' );
+END {
+ ok( chdir File::Spec->updir );
+ ok( teardown_recurs(), 'teardown' );
+}
+
+chdir 'Big-Dummy';
+
+my $stdout = tie *STDOUT, 'TieOut';
+pm_to_blib( { 'lib/Big/Dummy.pm' => 'blib/lib/Big/Dummy.pm' },
+ 'blib/lib/auto'
+ );
+END { rmtree 'blib' }
+
+ok( -d 'blib/lib', 'pm_to_blib created blib dir' );
+ok( -r 'blib/lib/Big/Dummy.pm', ' copied .pm file' );
+ok( -r 'blib/lib/auto', ' created autosplit dir' );
+is( $stdout->read, "cp lib/Big/Dummy.pm blib/lib/Big/Dummy.pm\n" );
+
+pm_to_blib( { 'lib/Big/Dummy.pm' => 'blib/lib/Big/Dummy.pm' },
+ 'blib/lib/auto'
+ );
+ok( -d 'blib/lib', 'second run, blib dir still there' );
+ok( -r 'blib/lib/Big/Dummy.pm', ' .pm file still there' );
+ok( -r 'blib/lib/auto', ' autosplit still there' );
+is( $stdout->read, "Skip blib/lib/Big/Dummy.pm (unchanged)\n" );
+
+install( [
+ from_to=>{ 'blib/lib' => 'install-test/lib/perl',
+ read => 'install-test/packlist',
+ write => 'install-test/packlist'
+ },
+ dry_run=>1]);
+ok( ! -d 'install-test/lib/perl', 'install made dir (dry run)');
+ok( ! -r 'install-test/lib/perl/Big/Dummy.pm',
+ ' .pm file installed (dry run)');
+ok( ! -r 'install-test/packlist', ' packlist exists (dry run)');
+
+install([ from_to=> { 'blib/lib' => 'install-test/lib/perl',
+ read => 'install-test/packlist',
+ write => 'install-test/packlist'
+ } ]);
+ok( -d 'install-test/lib/perl', 'install made dir' );
+ok( -r 'install-test/lib/perl/Big/Dummy.pm', ' .pm file installed' );
+ok(!-r 'install-test/lib/perl/Big/Dummy.SKIP', ' ignored .SKIP file' );
+ok( -r 'install-test/packlist', ' packlist exists' );
+
+open(PACKLIST, 'install-test/packlist' );
+my %packlist = map { chomp; ($_ => 1) } <PACKLIST>;
+close PACKLIST;
+
+# On case-insensitive filesystems (ie. VMS), the keys of the packlist might
+# be lowercase. :(
+my $native_dummy = File::Spec->catfile(qw(install-test lib perl Big Dummy.pm));
+is( keys %packlist, 1 );
+is( lc((keys %packlist)[0]), lc $native_dummy, 'packlist written' );
+
+
+# Test UNINST=1 preserving same versions in other dirs.
+install([from_to=> { 'blib/lib' => 'install-test/other_lib/perl',
+ read => 'install-test/packlist',
+ write => 'install-test/packlist'
+ },uninstall_shadows=>1]);
+ok( -d 'install-test/other_lib/perl', 'install made other dir' );
+ok( -r 'install-test/other_lib/perl/Big/Dummy.pm', ' .pm file installed' );
+ok( -r 'install-test/packlist', ' packlist exists' );
+ok( -r 'install-test/lib/perl/Big/Dummy.pm', ' UNINST=1 preserved same' );
+
+
+chmod 0644, 'blib/lib/Big/Dummy.pm' or die $!;
+open(DUMMY, ">>blib/lib/Big/Dummy.pm") or die $!;
+print DUMMY "Extra stuff\n";
+close DUMMY;
+
+
+# Test UNINST=0 does not remove other versions in other dirs.
+{
+ ok( -r 'install-test/lib/perl/Big/Dummy.pm', 'different install exists' );
+
+ local @INC = ('install-test/lib/perl');
+ local $ENV{PERL5LIB} = '';
+ install([from_to=> { 'blib/lib' => 'install-test/other_lib/perl',
+ read => 'install-test/packlist',
+ write => 'install-test/packlist'
+ }]);
+ ok( -d 'install-test/other_lib/perl', 'install made other dir' );
+ ok( -r 'install-test/other_lib/perl/Big/Dummy.pm', ' .pm file installed' );
+ ok( -r 'install-test/packlist', ' packlist exists' );
+ ok( -r 'install-test/lib/perl/Big/Dummy.pm',
+ ' UNINST=0 left different' );
+}
+
+# Test UNINST=1 only warning when failing to remove an irrelevent shadow file
+{
+ my $tfile='install-test/lib/perl/Big/Dummy.pm';
+ local $ExtUtils::Install::Testing = $tfile;
+ local @INC = ('install-test/other_lib/perl','install-test/lib/perl');
+ local $ENV{PERL5LIB} = '';
+ ok( -r $tfile, 'different install exists' );
+ my @warn;
+ local $SIG{__WARN__}=sub { push @warn, @_; return };
+ my $ok=eval {
+ install([from_to=> { 'blib/lib' => 'install-test/other_lib/perl',
+ read => 'install-test/packlist',
+ write => 'install-test/packlist'
+ },
+ uninstall_shadows=>1]);
+ 1
+ };
+ ok($ok,' we didnt die');
+ ok(0+@warn," we did warn");
+ ok( -d 'install-test/other_lib/perl', 'install made other dir' );
+ ok( -r 'install-test/other_lib/perl/Big/Dummy.pm', ' .pm file installed' );
+ ok( -r 'install-test/packlist', ' packlist exists' );
+ ok( -r $tfile, ' UNINST=1 failed to remove different' );
+
+}
+
+# Test UNINST=1 dieing when failing to remove an relevent shadow file
+{
+ my $tfile='install-test/lib/perl/Big/Dummy.pm';
+ local $ExtUtils::Install::Testing = $tfile;
+ local @INC = ('install-test/lib/perl','install-test/other_lib/perl');
+ local $ENV{PERL5LIB} = '';
+ ok( -r $tfile, 'different install exists' );
+ my @warn;
+ local $SIG{__WARN__}=sub { push @warn,@_; return };
+ my $ok=eval {
+ install([from_to=> { 'blib/lib' => 'install-test/other_lib/perl',
+ read => 'install-test/packlist',
+ write => 'install-test/packlist'
+ },uninstall_shadows=>1]);
+ 1
+ };
+ ok(!$ok,' we did die');
+ ok(!@warn," we didnt warn");
+ ok( -d 'install-test/other_lib/perl', 'install made other dir' );
+ ok( -r 'install-test/other_lib/perl/Big/Dummy.pm', ' .pm file installed' );
+ ok( -r 'install-test/packlist', ' packlist exists' );
+ ok( -r $tfile,' UNINST=1 failed to remove different' );
+}
+
+# Test UNINST=1 removing other versions in other dirs.
+{
+ local @INC = ('install-test/lib/perl');
+ local $ENV{PERL5LIB} = '';
+ ok( -r 'install-test/lib/perl/Big/Dummy.pm','different install exists' );
+ install([from_to=>{ 'blib/lib' => 'install-test/other_lib/perl',
+ read => 'install-test/packlist',
+ write => 'install-test/packlist'
+ },uninstall_shadows=>1]);
+ ok( -d 'install-test/other_lib/perl', 'install made other dir' );
+ ok( -r 'install-test/other_lib/perl/Big/Dummy.pm', ' .pm file installed' );
+ ok( -r 'install-test/packlist', ' packlist exists' );
+ ok( !-r 'install-test/lib/perl/Big/Dummy.pm',
+ ' UNINST=1 removed different' );
+}
+
+# Test EU_ALWAYS_COPY triggers copy.
+{
+ local @INC = ('install-test/lib/perl');
+ local $ENV{PERL5LIB} = '';
+ local $ENV{EU_ALWAYS_COPY}=1;
+ my $tfile='install-test/other_lib/perl/Big/Dummy.pm';
+ my $sfile='blib/lib/Big/Dummy.pm';
+ ok(-r $tfile,"install file already exists");
+ ok(-r $sfile,"source file already exists");
+ utime time-600, time-600, $sfile or die "utime '$sfile' failed:$!";
+ ok( (stat $tfile)[9]!=(stat $sfile)[9],' Times are different');
+ install([from_to=>{ 'blib/lib' => 'install-test/other_lib/perl',
+ read => 'install-test/packlist',
+ write => 'install-test/packlist'
+ },result=>\my %result]);
+ ok( -d 'install-test/other_lib/perl', 'install made other dir' );
+ ok( -r 'install-test/other_lib/perl/Big/Dummy.pm', ' .pm file installed' );
+ ok( -r 'install-test/packlist', ' packlist exists' );
+ ok( (stat $tfile)[9]==(stat$sfile)[9],' Times are same');
+ ok( !$result{install_unchanged},' $result{install_unchanged} should be empty');
+}
+# Test nothing is copied.
+{
+ local @INC = ('install-test/lib/perl');
+ local $ENV{PERL5LIB} = '';
+ local $ENV{EU_ALWAYS_COPY}=0;
+ my $tfile='install-test/other_lib/perl/Big/Dummy.pm';
+ my $sfile='blib/lib/Big/Dummy.pm';
+ ok(-r $tfile,"install file already exists");
+ ok(-r $sfile,"source file already exists");
+ utime time-1200, time-1200, $sfile or die "utime '$sfile' failed:$!";
+ ok( (stat $tfile)[9]!=(stat $sfile)[9],' Times are different');
+ install([from_to=>{ 'blib/lib' => 'install-test/other_lib/perl',
+ read => 'install-test/packlist',
+ write => 'install-test/packlist'
+ },result=>\my %result]);
+ ok( -d 'install-test/other_lib/perl', 'install made other dir' );
+ ok( -r 'install-test/other_lib/perl/Big/Dummy.pm', ' .pm file installed' );
+ ok( -r 'install-test/packlist', ' packlist exists' );
+ ok( (stat $tfile)[9]!=(stat$sfile)[9],' Times are different');
+ ok( !$result{install},' nothing should have been installed');
+ ok( $result{install_unchanged},' install_unchanged should be populated');
+}
\ No newline at end of file
projects / p5sagit/p5-mst-13.2.git / commitdiff