From: Yves Orton Date: Sun, 2 Mar 2008 18:37:45 +0000 (+0000) Subject: Update ExtUtils::Install to release 1.47 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=546acaf953817e0057123820b511dae1b4e7bafc;p=p5sagit%2Fp5-mst-13.2.git Update ExtUtils::Install to release 1.47 p4raw-id: //depot/perl@33410 --- diff --git a/MANIFEST b/MANIFEST index 4e7a1fd..572dce9 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1825,6 +1825,7 @@ lib/ExtUtils/t/hints.t See if hint files are honored. lib/ExtUtils/t/INSTALL_BASE.t Test INSTALL_BASE in MakeMaker lib/ExtUtils/t/Installed.t See if ExtUtils::Installed works lib/ExtUtils/t/Install.t See if ExtUtils::Install works +lib/ExtUtils/t/Installapi2.t See if new api for ExtUtils::Install::install() works lib/ExtUtils/t/INST_PREFIX.t See if MakeMaker can apply PREFIXs lib/ExtUtils/t/INST.t Check MakeMaker INST_* macros lib/ExtUtils/t/Liblist.t See if ExtUtils::Liblist works diff --git a/lib/ExtUtils/Install.pm b/lib/ExtUtils/Install.pm index 5400b7f..253a258 100644 --- a/lib/ExtUtils/Install.pm +++ b/lib/ExtUtils/Install.pm @@ -1,9 +1,8 @@ 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; @@ -275,55 +274,6 @@ sub _unlink_or_rename { #XXX OS-SPECIFIC =head2 Functions -=over 4 - -=item B - - 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. - -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 @@ -458,29 +408,29 @@ sub _can_write_dir { 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'","$@"); } @@ -493,23 +443,24 @@ sub _mkpath { $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. @@ -517,11 +468,11 @@ 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': $!" ); } @@ -550,14 +501,143 @@ sub _chdir { =end _private +=over 4 + +=item B + + # 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. + +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 + +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 + +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 + +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); @@ -619,6 +699,7 @@ sub install { #XXX OS-SPECIFIC if ( $sourcefile=~/$pat/ ) { print "Skipping $targetfile (filtered)\n" if $verbose>1; + $result->{install_filtered}{$sourcefile} = $pat; return; } } @@ -626,11 +707,12 @@ sub install { #XXX OS-SPECIFIC # 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; @@ -647,9 +729,8 @@ sub install { #XXX OS-SPECIFIC }, $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, @@ -657,32 +738,44 @@ sub install { #XXX OS-SPECIFIC 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. @@ -691,12 +784,13 @@ sub install { #XXX OS-SPECIFIC 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 @@ -862,9 +956,9 @@ without actually doing it. Default is false. =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; @@ -874,16 +968,16 @@ sub uninstall { 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 @@ -892,17 +986,21 @@ occuring when doing an install at reboot. 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'} || ''; @@ -938,7 +1036,8 @@ sub inc_uninstall { $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. @@ -955,8 +1054,10 @@ sub inc_uninstall { 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 { @@ -1152,6 +1253,11 @@ Will prevent the automatic use of INSTALL.SKIP as the install skip file. If there is no INSTALL.SKIP file in the make directory then this value can be used to provide a default. +=item B + +If this environment variable is true then normal install processes will +always overwrite older identical files during the install process. + =back =head1 AUTHOR @@ -1159,7 +1265,7 @@ can be used to provide a default. Original author lost in the mists of time. Probably the same as Makemaker. Production release currently maintained by demerphq C, -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. diff --git a/lib/ExtUtils/t/Installapi2.t b/lib/ExtUtils/t/Installapi2.t new file mode 100644 index 0000000..e5a6516 --- /dev/null +++ b/lib/ExtUtils/t/Installapi2.t @@ -0,0 +1,232 @@ +#!/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) } ; +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