summaryrefslogtreecommitdiff
path: root/lib/ExtUtils
diff options
context:
space:
mode:
authorNicholas Clark <nick@ccl4.org>2009-09-10 11:08:39 +0100
committerNicholas Clark <nick@ccl4.org>2009-09-10 11:33:22 +0100
commitfb78ba4be2872a911ecd409537deabc67447f706 (patch)
treec434778421c491bbbd130340ab745f57e6da2d6a /lib/ExtUtils
parent2db10ba327c7c0a1b993bf71c5feb22a2044498a (diff)
downloadperl-fb78ba4be2872a911ecd409537deabc67447f706.tar.gz
Move ExtUtils::Install from lib to ext.
Diffstat (limited to 'lib/ExtUtils')
-rw-r--r--lib/ExtUtils/Changes_EU-Install327
-rw-r--r--lib/ExtUtils/Install.pm1356
-rw-r--r--lib/ExtUtils/Installed.pm462
-rw-r--r--lib/ExtUtils/Packlist.pm348
-rw-r--r--lib/ExtUtils/t/Install.t194
-rw-r--r--lib/ExtUtils/t/InstallWithMM.t95
-rw-r--r--lib/ExtUtils/t/Installapi2.t238
-rw-r--r--lib/ExtUtils/t/Installed.t313
-rw-r--r--lib/ExtUtils/t/Packlist.t174
-rw-r--r--lib/ExtUtils/t/can_write_dir.t61
10 files changed, 0 insertions, 3568 deletions
diff --git a/lib/ExtUtils/Changes_EU-Install b/lib/ExtUtils/Changes_EU-Install
deleted file mode 100644
index 55c60134f6..0000000000
--- a/lib/ExtUtils/Changes_EU-Install
+++ /dev/null
@@ -1,327 +0,0 @@
-Revision history for ExtUtils-Install
-
-1.54
-
-This is a "no-change" version bump because I pushed the v1.53 change
-and then realized that MakeMaker.t was a bad name for a file that would
-end up in core where the EUMM tests and the EUI tests are in the same
-directory. This renames it to InstallWithMM.t.
-
-1.53
-
-Final stage of the divorce from EUMM. Now the EUMM related tests are no
-longer shared. Build.pl and Build.t go, and there shall be peace on earth.
-At least until somebody patches EUMM/t/basic.t for something EUI related...
-
-Thanks to M. Schwern for helping me work this one out. Cheers man.
-
-1.52_03
-
-Missed the t/Installed.t test from core. Bumped version number to allow
-a new distro to be released.
-
-1.52_02
-
-Make _chmod verbose message use octal modes, thanks to BDFOY
-
-Further changes from core, including lastest test file infrastructure
-from EUMM.
-
-Fixed a number of problems in ExtUtils::Installed, for various reasons
-this includes a version bump to 1.999_001, which will eventually become
-version 2.0. These problems related to finding modules that were installed
-with either INSTALL_BASE or PREFIX. Hopefully this resolves these issues.
-
-1.52_01 (core only release)
-
-Changes from Core:
-
-commit 3d55b451d9544fbd4c27c33287b76bee30328830
-Author: John Malmberg
-Date: Sun Feb 15 09:25:10 2009 -0600
-
- ExtUtils::Install VMS extended character set support
-
- Preview from https://rt.cpan.org/Ticket/Display.html?id=42149
-
-
-1.52
-
-Production rerelease of 1.51 to make the CPAN indexer happy about permissions
-(hopefully).
-
-SVN Revision 44.
-
-1.51
-
-Production release of 1.50_05. No other changes.
-
-SVN revision 43.
-
-1.50_05
-
-SVN revision 42.
-
-Fix broken test as reported by Craig Berry.
-
-1.50_04
-
-SVN revision 41.
-
-Restructure tests to make it easier to maintain given it is distributed in various
-ways in three different packages.
-
-1.50_03
-
-SVN revision 40.
-
-Sigh, just after i released 1.50_02 I noticed that a test modified in it will fail
-under VMS. So this is a fixup release for that alone.
-
-1.50_02
-
-SVN revision 39.
-
-Synchronize with the changes that were made in blead perl
-patch #33567. VMS changes by Craig Berry. See
-
-http://public.activestate.com/cgi-bin/perlbrowse/p/33567
-
-This was marked in the pod as 1.51 but not actually version bumped.
-
-So I've marked it as 1.50_02 as a test release prior to putting it out
-as the real 1.51
-
-This release also restores the missing installed.t which was accidentally
-missed by the MANIFEST having a duplicate entry for install.t instead.
-Probably something should have warned about this, but I haven't worked out
-what.
-
-Includes changes from Activestate/ActivePerl:
-
-- To make installation less chatty when not under verbose mode. See
-
-http://rt.cpan.org/Public/Bug/Display.html?id=5903
-
-- To install HTML documentation files under builds that set $Config{installhtmldir}
-(and presumably also create HTML versions of the pod -- which is quite nice actually :-)
-
-http://rt.cpan.org/Ticket/Display.html?id=37727
-
-1.50_01
-
-Version only released as part of bleadperl added in revision #33566.
-Cygwin related changes by Steve Hay, and others, see
-
-http://public.activestate.com/cgi-bin/perlbrowse/p/33566
-
-and discussion at
-
-http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2008-03/msg00056.html
-
-1.50
-
-Previous patches to _have_write_access() were causing problems
-on Cygwin. So now we skip using POSIX::access under cygwin.
-Also added some =pod directives to make my favorite editor
-highlight the pod properly.
-
-1.49
-
-Turns out that the new can_write_dir.t doesnt work properly under root
-as root can read the files regardless as to their mode. So we skip those
-tests when the effective UID is 0 indicating root.
-
-1.48
-
-We were getting N/A test results from CPAN testers due to the
-presence of Config in the prequisities list. This has been corrected.
-
-Also it was pointed out that EU_ALWAYS_COPY did not follow the naming
-convention of other ExtUtils::Install environment variables. It has
-been renamed EU_INSTALL_ALWAYS_COPY. Support remains for the original
-deprecated environment variable but it will be removed in 1.50.
-
-1.47
-
-Fix build process so a new META.YML is produced each time. Also
-add support for a new argument syntax to install() as well as
-support for always copying installed files even when the old
-file was identical. This is needed for some bundling mechanisms
-and can be activated by setting the environment variable EU_ALWAYS_COPY
-before the install process starts.
-
-Add a newer cleaner interface to install() to allow named parameters
-and easier external monitoring of what transpired.
-
-1.46 2008-03-01 12:42:35
-
-Apply patches from Michael G. Schwern (rt #33688, rt #31429, rt #31248)
-and from Slaven Rezic (rt #33290). Also implemented the suggestion from
-Schwern about not dieing when failing to remove a shadow file that is
-later on in INC than the installed version. (rt #2928)
-
-1.45 2008-02-27 13:55:27
-
-Fix rt.cpan.org #32813, use catpath() to attach volume name
-to dirs in _can_write_dir() when necessary to avoid cygwin
-builds doing a hostname lookup.
-
-1.44 2007-09-09 23:12:25
-
-by Schwern
-
-*** MAJOR BUG FIX ***
-
-install() would always try to uninstall different versions of the
-installed files when $uninstall_shadows was given whether it was true or false.
-This meant "make install" and "Build install" would both always try to uninstall
-differing versions of the modules. [rt.cpan.org 28672]
-
-1.43 2007-07-21 00:09:24
-
-Turns out some recent version, I haven't figured out which, causes
-ExtUtils::MakeMaker to fail test. The failure is actually bogus, EUMM
-is testing for output that we stopped producing except under verbose,
-however it is a pain, so this release fixes the problem. It also adds
-a new test file, a stripped down version of ExtUtils::MakeMakers
-t/basic.t.
-
-1.42 2007-07-20 22:43:04
-
-This is just 1.41_04 as a production release.
-
-1.41_04 2007-07-07 16:52:40
-
-Reorganize how things work in Install so that we don't try to create
-directories which exist but are not writable to us when they contain
-files which we want to install which are writable by us.
-http://rt.cpan.org/Public/Bug/Display.html?id=25627
-
-Also fix a VMS issue as recommended by Craig Berry.
-http://rt.cpan.org/Public/Bug/Display.html?id=22157
-
-1.41_03 2007-02-11 15:13
-
-Add an extra_libs parameter to ExtUtils::Installed->new() which allows
-one to specify additional libs to search for installed modules.
-
-Additional code cleanup and tweaks.
-
-1.41_02 2007-02-03 21:10
-
-Fix bug in _can_write_file().
-
-1.41_01 2007-02-02 21:03
-
-Integrated changes from
-
-1. Steffen Mueller: make ExtUtils::Installed respect PERL5LIB and allow
-overriding the current config and inc with something else.
-
-2. Michael Schwern (RT#21949, RT#21948): Fix use lib and installdirs
-and other EU::MakeMaker related changes.
-
-3. ActiveState (RT#5903): Reduce install verbosity.
-
-4. Craig Berry (RT#22157): Fix VMS related install failure.
-
-5. Ken Williams (RT#16225): Make fake uninstall actually fake.
-
-
-1.41 2006-07-02 16:09
-
-Integrated ExtUtils::Packlist changes from Nicholas Clark to allow for
-relocatable perls. Bumped version numbers on all files.
-
-1.40 2006-04-30 15:04
-
-Enhanced errorcatching and reporting. Fixed a problem with the INSTALL.SKIP
-file. Changed the Makefile.PL so that when installing it would not use the same
-stuff it was replacing. This doesn't affect building with Module::Build
-currently.
-
-Removed META.yml from distribution.
-
-1.39 2006-04-14 18:53
-
-- Fixed problem with the META.yml file being produced from a Win32 point of view.
-IMO this is an error/failing in the design of the META.yml process. META.yml should
-be created on the client side not on the distributor side. Now produces a
-platform agnostic (ie UNIXy) META.yml.
-
-- Reversed order of change file so newest entries go on top.
-
-
-1.38 2006-04-02 17:31
-
-- Removed MANIFEST.SKIP support (INSTALL.SKIP still supported), and
-added support for providing a fallback skip file by using
-ENV{EU_INSTALL_SITE_SKIP} as a fallback if there is not a distribution
-specific skip file.
-
-- Released under the ExtUtils-Install-1.38 Name
-
-
-1.3702 2006-03-19 16:54
-
-- Added support for skipping files during install based on a set of filter
-rules. If there is an INSTALL.SKIP in the current directory when doing an
-install then it is loaded, otherwise if there is a MANIFEST.SKIP then it is
-loaded. If neither exists then no filtration occurs. The env variable
-EU_INSTALL_IGNORE_SKIP may be set to a true value to override this behaviour.
-This means that you can make .svn directories be ignored on install.
-
-1.3701 2006-03-13 20:00
-
-- Integrated patch from Randy Sims.
-
- 1. Fixes error during `perl Makefile.PL` because it MakeMaker can't
- find the NAME section describing DISTNAME (which has the 'ex-'
- prefix).
-
- 2. Win32API::File is recommended on MSWin32 && cygwin.
-
- 3. Under Perl5.005, ExtUtils::MM is not present in the version of
- MakeMaker included. I don't know what version first includes it.
- Needs research or better: eliminate need for it.
-
- 4. Test::More is bundled with the distro for its test suite. This
- would be needed on Perl5.005, for example. It was listed as a
- requirement, but the directory it's bundled in is not in @INC when
- prereqs are checked. I removed the prereq from Build.PL &
- Makefile.PL. Other options: 1) fixup @INC to include t/lib; or 2)
- unbundle and add back to prereqs.
-
- 4. Update t/pod.t t/pod-coverage fixup of @INC so it can find
- bundled Test::More.
-
-- Fixed pod/coverage related issues.
-
-- When trying to schedule a delete at reboot after renaming a dll out of
-the way no error occurs if Win32API::File isn't available. Instead it
-merely warns that the file should be hand deleted.
-
-- Fixed install at reboot behaviour by making sure the temporar file is
-writable after install (normally files installed are readonly)
-
-1.37 2006-03-12 23:20
-
-- Refactored reboot support. Integrated changes from Randy Sims
-in p5p message 4413F4E9.7090802@thepierianspring.org
-
-
-1.36 2006-03-11 12:42
-
-- Extended Win32 support. Added ExtUtils::Install::MUST_REBOOT to
-handle such scenario when rebooting.
-
-- Released as ex-ExtUtils-Install by demerphq
-
-1.35 Wed Feb 1 23:00:00 CST 2006
-
- - First independent release; Extracted ExtUtils::Install,
- ExtUtils::Installed, & ExtUtils::Packlist from MakeMaker.
-
- - Changed the $VERSION of all modules to the same version number, a
- number higher than all $VERSIONs.
diff --git a/lib/ExtUtils/Install.pm b/lib/ExtUtils/Install.pm
deleted file mode 100644
index c886c69bf2..0000000000
--- a/lib/ExtUtils/Install.pm
+++ /dev/null
@@ -1,1356 +0,0 @@
-package ExtUtils::Install;
-use strict;
-
-use vars qw(@ISA @EXPORT $VERSION $MUST_REBOOT %Config);
-
-use AutoSplit;
-use Carp ();
-use Config qw(%Config);
-use Cwd qw(cwd);
-use Exporter;
-use ExtUtils::Packlist;
-use File::Basename qw(dirname);
-use File::Compare qw(compare);
-use File::Copy;
-use File::Find qw(find);
-use File::Path;
-use File::Spec;
-
-
-@ISA = ('Exporter');
-@EXPORT = ('install','uninstall','pm_to_blib', 'install_default');
-
-=pod
-
-=head1 NAME
-
-ExtUtils::Install - install files from here to there
-
-=head1 SYNOPSIS
-
- use ExtUtils::Install;
-
- install({ 'blib/lib' => 'some/install/dir' } );
-
- uninstall($packlist);
-
- pm_to_blib({ 'lib/Foo/Bar.pm' => 'blib/lib/Foo/Bar.pm' });
-
-=head1 VERSION
-
-1.54
-
-=cut
-
-$VERSION = '1.54'; # <---- dont forget to update the POD section just above this line!
-$VERSION = eval $VERSION;
-
-=pod
-
-=head1 DESCRIPTION
-
-Handles the installing and uninstalling of perl modules, scripts, man
-pages, etc...
-
-Both install() and uninstall() are specific to the way
-ExtUtils::MakeMaker handles the installation and deinstallation of
-perl modules. They are not designed as general purpose tools.
-
-On some operating systems such as Win32 installation may not be possible
-until after a reboot has occured. This can have varying consequences:
-removing an old DLL does not impact programs using the new one, but if
-a new DLL cannot be installed properly until reboot then anything
-depending on it must wait. The package variable
-
- $ExtUtils::Install::MUST_REBOOT
-
-is used to store this status.
-
-If this variable is true then such an operation has occured and
-anything depending on this module cannot proceed until a reboot
-has occured.
-
-If this value is defined but false then such an operation has
-ocurred, but should not impact later operations.
-
-=begin _private
-
-=item _chmod($$;$)
-
-Wrapper to chmod() for debugging and error trapping.
-
-=item _warnonce(@)
-
-Warns about something only once.
-
-=item _choke(@)
-
-Dies with a special message.
-
-=end _private
-
-=cut
-
-my $Is_VMS = $^O eq 'VMS';
-my $Is_VMS_noefs = $Is_VMS;
-my $Is_MacPerl = $^O eq 'MacOS';
-my $Is_Win32 = $^O eq 'MSWin32';
-my $Is_cygwin = $^O eq 'cygwin';
-my $CanMoveAtBoot = ($Is_Win32 || $Is_cygwin);
-
- if( $Is_VMS ) {
- my $vms_unix_rpt;
- my $vms_efs;
- my $vms_case;
-
- if (eval { local $SIG{__DIE__}; require VMS::Feature; }) {
- $vms_unix_rpt = VMS::Feature::current("filename_unix_report");
- $vms_efs = VMS::Feature::current("efs_charset");
- $vms_case = VMS::Feature::current("efs_case_preserve");
- } else {
- my $unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';
- my $efs_charset = $ENV{'DECC$EFS_CHARSET'} || '';
- my $efs_case = $ENV{'DECC$EFS_CASE_PRESERVE'} || '';
- $vms_unix_rpt = $unix_rpt =~ /^[ET1]/i;
- $vms_efs = $efs_charset =~ /^[ET1]/i;
- $vms_case = $efs_case =~ /^[ET1]/i;
- }
- $Is_VMS_noefs = 0 if ($vms_efs);
- }
-
-
-
-# *note* CanMoveAtBoot is only incidentally the same condition as below
-# this needs not hold true in the future.
-my $Has_Win32API_File = ($Is_Win32 || $Is_cygwin)
- ? (eval {require Win32API::File; 1} || 0)
- : 0;
-
-
-my $Inc_uninstall_warn_handler;
-
-# install relative to here
-
-my $INSTALL_ROOT = $ENV{PERL_INSTALL_ROOT};
-
-my $Curdir = File::Spec->curdir;
-my $Updir = File::Spec->updir;
-
-sub _estr(@) {
- return join "\n",'!' x 72,@_,'!' x 72,'';
-}
-
-{my %warned;
-sub _warnonce(@) {
- my $first=shift;
- my $msg=_estr "WARNING: $first",@_;
- warn $msg unless $warned{$msg}++;
-}}
-
-sub _choke(@) {
- my $first=shift;
- my $msg=_estr "ERROR: $first",@_;
- Carp::croak($msg);
-}
-
-
-sub _chmod($$;$) {
- my ( $mode, $item, $verbose )=@_;
- $verbose ||= 0;
- if (chmod $mode, $item) {
- printf "chmod(0%o, %s)\n",$mode, $item if $verbose > 1;
- } else {
- my $err="$!";
- _warnonce sprintf "WARNING: Failed chmod(0%o, %s): %s\n",
- $mode, $item, $err
- if -e $item;
- }
-}
-
-=begin _private
-
-=item _move_file_at_boot( $file, $target, $moan )
-
-OS-Specific, Win32/Cygwin
-
-Schedules a file to be moved/renamed/deleted at next boot.
-$file should be a filespec of an existing file
-$target should be a ref to an array if the file is to be deleted
-otherwise it should be a filespec for a rename. If the file is existing
-it will be replaced.
-
-Sets $MUST_REBOOT to 0 to indicate a deletion operation has occured
-and sets it to 1 to indicate that a move operation has been requested.
-
-returns 1 on success, on failure if $moan is false errors are fatal.
-If $moan is true then returns 0 on error and warns instead of dies.
-
-=end _private
-
-=cut
-
-
-
-sub _move_file_at_boot { #XXX OS-SPECIFIC
- my ( $file, $target, $moan )= @_;
- Carp::confess("Panic: Can't _move_file_at_boot on this platform!")
- unless $CanMoveAtBoot;
-
- my $descr= ref $target
- ? "'$file' for deletion"
- : "'$file' for installation as '$target'";
-
- if ( ! $Has_Win32API_File ) {
-
- my @msg=(
- "Cannot schedule $descr at reboot.",
- "Try installing Win32API::File to allow operations on locked files",
- "to be scheduled during reboot. Or try to perform the operation by",
- "hand yourself. (You may need to close other perl processes first)"
- );
- if ( $moan ) { _warnonce(@msg) } else { _choke(@msg) }
- return 0;
- }
- my $opts= Win32API::File::MOVEFILE_DELAY_UNTIL_REBOOT();
- $opts= $opts | Win32API::File::MOVEFILE_REPLACE_EXISTING()
- unless ref $target;
-
- _chmod( 0666, $file );
- _chmod( 0666, $target ) unless ref $target;
-
- if (Win32API::File::MoveFileEx( $file, $target, $opts )) {
- $MUST_REBOOT ||= ref $target ? 0 : 1;
- return 1;
- } else {
- my @msg=(
- "MoveFileEx $descr at reboot failed: $^E",
- "You may try to perform the operation by hand yourself. ",
- "(You may need to close other perl processes first).",
- );
- if ( $moan ) { _warnonce(@msg) } else { _choke(@msg) }
- }
- return 0;
-}
-
-
-=begin _private
-
-=item _unlink_or_rename( $file, $tryhard, $installing )
-
-OS-Specific, Win32/Cygwin
-
-Tries to get a file out of the way by unlinking it or renaming it. On
-some OS'es (Win32 based) DLL files can end up locked such that they can
-be renamed but not deleted. Likewise sometimes a file can be locked such
-that it cant even be renamed or changed except at reboot. To handle
-these cases this routine finds a tempfile name that it can either rename
-the file out of the way or use as a proxy for the install so that the
-rename can happen later (at reboot).
-
- $file : the file to remove.
- $tryhard : should advanced tricks be used for deletion
- $installing : we are not merely deleting but we want to overwrite
-
-When $tryhard is not true if the unlink fails its fatal. When $tryhard
-is true then the file is attempted to be renamed. The renamed file is
-then scheduled for deletion. If the rename fails then $installing
-governs what happens. If it is false the failure is fatal. If it is true
-then an attempt is made to schedule installation at boot using a
-temporary file to hold the new file. If this fails then a fatal error is
-thrown, if it succeeds it returns the temporary file name (which will be
-a derivative of the original in the same directory) so that the caller can
-use it to install under. In all other cases of success returns $file.
-On failure throws a fatal error.
-
-=end _private
-
-=cut
-
-
-
-sub _unlink_or_rename { #XXX OS-SPECIFIC
- my ( $file, $tryhard, $installing )= @_;
-
- _chmod( 0666, $file );
- my $unlink_count = 0;
- while (unlink $file) { $unlink_count++; }
- return $file if $unlink_count > 0;
- my $error="$!";
-
- _choke("Cannot unlink '$file': $!")
- unless $CanMoveAtBoot && $tryhard;
-
- my $tmp= "AAA";
- ++$tmp while -e "$file.$tmp";
- $tmp= "$file.$tmp";
-
- warn "WARNING: Unable to unlink '$file': $error\n",
- "Going to try to rename it to '$tmp'.\n";
-
- if ( rename $file, $tmp ) {
- warn "Rename succesful. Scheduling '$tmp'\nfor deletion at reboot.\n";
- # when $installing we can set $moan to true.
- # IOW, if we cant delete the renamed file at reboot its
- # not the end of the world. The other cases are more serious
- # and need to be fatal.
- _move_file_at_boot( $tmp, [], $installing );
- return $file;
- } elsif ( $installing ) {
- _warnonce("Rename failed: $!. Scheduling '$tmp'\nfor".
- " installation as '$file' at reboot.\n");
- _move_file_at_boot( $tmp, $file );
- return $tmp;
- } else {
- _choke("Rename failed:$!", "Cannot procede.");
- }
-
-}
-
-
-=pod
-
-=head2 Functions
-
-=begin _private
-
-=item _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}) {
- print "EU_INSTALL_IGNORE_SKIP is set, ignore skipfile settings\n"
- if $verbose>2;
- return [];
- }
- if ( ! defined $skip ) {
- print "Looking for install skip list\n"
- if $verbose>2;
- for my $file ( 'INSTALL.SKIP', $ENV{EU_INSTALL_SITE_SKIPFILE} ) {
- next unless $file;
- print "\tChecking for $file\n"
- if $verbose>2;
- if (-e $file) {
- $skip= $file;
- last;
- }
- }
- }
- if ($skip && !ref $skip) {
- print "Reading skip patterns from '$skip'.\n"
- if $verbose;
- if (open my $fh,$skip ) {
- my @patterns;
- while (<$fh>) {
- chomp;
- next if /^\s*(?:#|$)/;
- print "\tSkip pattern: $_\n" if $verbose>3;
- push @patterns, $_;
- }
- $skip= \@patterns;
- } else {
- warn "Can't read skip file:'$skip':$!\n";
- $skip=[];
- }
- } elsif ( UNIVERSAL::isa($skip,'ARRAY') ) {
- print "Using array for skip list\n"
- if $verbose>2;
- } elsif ($verbose) {
- print "No skip list found.\n"
- if $verbose>1;
- $skip= [];
- }
- warn "Got @{[0+@$skip]} skip patterns.\n"
- if $verbose>3;
- return $skip
-}
-
-=pod
-
-=item _have_write_access
-
-Abstract a -w check that tries to use POSIX::access() if possible.
-
-=cut
-
-{
- my $has_posix;
- sub _have_write_access {
- my $dir=shift;
- unless (defined $has_posix) {
- $has_posix= (!$Is_cygwin && !$Is_Win32
- && eval 'local $^W; require POSIX; 1') || 0;
- }
- if ($has_posix) {
- return POSIX::access($dir, POSIX::W_OK());
- } else {
- return -w $dir;
- }
- }
-}
-
-=pod
-
-=item _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
-be created first.
-
-Returns a list, containing: C<($writable, $determined_by, @create)>
-
-C<$writable> says whether whether the directory is (hypothetically) writable
-
-C<$determined_by> is the directory the status was determined from. It will be
-either the C<$dir>, or one of its parents.
-
-C<@create> is a list of directories that would probably have to be created
-to make the requested directory. It may not actually be correct on
-relative paths with C<..> in them. But for our purposes it should work ok
-
-=cut
-
-
-sub _can_write_dir {
- my $dir=shift;
- return
- unless defined $dir and length $dir;
-
- my ($vol, $dirs, $file) = File::Spec->splitpath($dir,1);
- my @dirs = File::Spec->splitdir($dirs);
- unshift @dirs, File::Spec->curdir
- unless File::Spec->file_name_is_absolute($dir);
-
- my $path='';
- my @make;
- while (@dirs) {
- if ($Is_VMS_noefs) {
- # There is a bug in catdir that is fixed when the EFS character
- # set is enabled, which requires this VMS specific code.
- $dir = File::Spec->catdir($vol,@dirs);
- }
- else {
- $dir = File::Spec->catdir(@dirs);
- $dir = File::Spec->catpath($vol,$dir,'')
- if defined $vol and length $vol;
- }
- next if ( $dir eq $path );
- if ( ! -e $dir ) {
- unshift @make,$dir;
- next;
- }
- if ( _have_write_access($dir) ) {
- return 1,$dir,@make
- } else {
- return 0,$dir,@make
- }
- } continue {
- pop @dirs;
- }
- return 0;
-}
-
-=pod
-
-=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 $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 $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,$dry_run)=@_;
- if ( $verbose && $verbose > 1 && ! -d $dir) {
- $show= 1;
- 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 ($can,$root,@make)=_can_write_dir($dir);
- if (!$can) {
- my @msg=(
- "Can't create '$dir'",
- $root ? "Do not have write permissions on '$root'"
- : "Unknown Error"
- );
- if ($dry_run) {
- _warnonce @msg;
- } else {
- _choke @msg;
- }
- } elsif ($show and $dry_run) {
- print "$_\n" for @make;
- }
-
-}
-
-=pod
-
-=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 $dry_run is true then the copy will not actually occur.
-
-Dies if the copy fails.
-
-=cut
-
-
-sub _copy {
- my ( $from, $to, $verbose, $dry_run)=@_;
- if ($verbose && $verbose>1) {
- printf "copy(%s,%s)\n", $from, $to;
- }
- if (!$dry_run) {
- File::Copy::copy($from,$to)
- or Carp::croak( _estr "ERROR: Cannot copy '$from' to '$to': $!" );
- }
-}
-
-=pod
-
-=item _chdir($from)
-
-Wrapper around chdir to catch errors.
-
-If not called in void context returns the cwd from before the chdir.
-
-dies on error.
-
-=cut
-
-sub _chdir {
- my ($dir)= @_;
- my $ret;
- if (defined wantarray) {
- $ret= cwd;
- }
- chdir $dir
- or _choke("Couldn't chdir to '$dir': $!");
- return $ret;
-}
-
-=pod
-
-=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_INSTALL_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,$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;
- $dry_run ||= 0;
-
- $skip= _get_install_skip($skip,$verbose);
- $always_copy = $ENV{EU_INSTALL_ALWAYS_COPY}
- || $ENV{EU_ALWAYS_COPY}
- || 0
- unless defined $always_copy;
-
- my(%from_to) = %$from_to;
- my(%pack, $dir, %warned);
- my($packlist) = ExtUtils::Packlist->new();
-
- local(*DIR);
- for (qw/read write/) {
- $pack{$_}=$from_to{$_};
- delete $from_to{$_};
- }
- my $tmpfile = install_rooted_file($pack{"read"});
- $packlist->read($tmpfile) if (-f $tmpfile);
- my $cwd = cwd();
- my @found_files;
- my %check_dirs;
-
- MOD_INSTALL: foreach my $source (sort keys %from_to) {
- #copy the tree to the target directory without altering
- #timestamp and permission and remember for the .packlist
- #file. The packlist file contains the absolute paths of the
- #install locations. AFS users may call this a bug. We'll have
- #to reconsider how to add the means to satisfy AFS users also.
-
- #October 1997: we want to install .pm files into archlib if
- #there are any files in arch. So we depend on having ./blib/arch
- #hardcoded here.
-
- my $targetroot = install_rooted_dir($from_to{$source});
-
- my $blib_lib = File::Spec->catdir('blib', 'lib');
- my $blib_arch = File::Spec->catdir('blib', 'arch');
- if ($source eq $blib_lib and
- exists $from_to{$blib_arch} and
- directory_not_empty($blib_arch)
- ){
- $targetroot = install_rooted_dir($from_to{$blib_arch});
- print "Files found in $blib_arch: installing files in $blib_lib into architecture dependent library tree\n";
- }
-
- next unless -d $source;
- _chdir($source);
- # 5.5.3's File::Find missing no_chdir option
- # XXX OS-SPECIFIC
- # File::Find seems to always be Unixy except on MacPerl :(
- my $current_directory= $Is_MacPerl ? $Curdir : '.';
- find(sub {
- my ($mode,$size,$atime,$mtime) = (stat)[2,7,8,9];
-
- return if !-f _;
- my $origfile = $_;
-
- return if $origfile eq ".exists";
- my $targetdir = File::Spec->catdir($targetroot, $File::Find::dir);
- my $targetfile = File::Spec->catfile($targetdir, $origfile);
- my $sourcedir = File::Spec->catdir($source, $File::Find::dir);
- my $sourcefile = File::Spec->catfile($sourcedir, $origfile);
-
- for my $pat (@$skip) {
- if ( $sourcefile=~/$pat/ ) {
- print "Skipping $targetfile (filtered)\n"
- if $verbose>1;
- $result->{install_filtered}{$sourcefile} = $pat;
- return;
- }
- }
- # 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);
- }
- $check_dirs{$targetdir}++
- unless -w $targetfile;
-
- push @found_files,
- [ $diff, $File::Find::dir, $origfile,
- $mode, $size, $atime, $mtime,
- $targetdir, $targetfile, $sourcedir, $sourcefile,
-
- ];
- #restore the original directory we were in when File::Find
- #called us so that it doesnt get horribly confused.
- _chdir($save_cwd);
- }, $current_directory );
- _chdir($cwd);
- }
- foreach my $targetdir (sort keys %check_dirs) {
- _mkpath( $targetdir, 0, 0755, $verbose, $dry_run );
- }
- foreach my $found (@found_files) {
- my ($diff, $ffd, $origfile, $mode, $size, $atime, $mtime,
- $targetdir, $targetfile, $sourcedir, $sourcefile)= @$found;
-
- my $realtarget= $targetfile;
- if ($diff) {
- 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 ( $uninstall_shadows ) {
- inc_uninstall($sourcefile,$ffd, $verbose,
- $dry_run,
- $realtarget ne $targetfile ? $realtarget : "",
- $result);
- }
-
- # Record the full pathname.
- $packlist->{$targetfile}++;
- }
-
- if ($pack{'write'}) {
- $dir = install_rooted_dir(dirname($pack{'write'}));
- _mkpath( $dir, 0, 0755, $verbose, $dry_run );
- print "Writing $pack{'write'}\n" if $verbose;
- $packlist->write(install_rooted_file($pack{'write'})) unless $dry_run;
- }
-
- _do_cleanup($verbose);
- return $result;
-}
-
-=begin _private
-
-=item _do_cleanup
-
-Standardize finish event for after another instruction has occured.
-Handles converting $MUST_REBOOT to a die for instance.
-
-=end _private
-
-=cut
-
-sub _do_cleanup {
- my ($verbose) = @_;
- if ($MUST_REBOOT) {
- die _estr "Operation not completed! ",
- "You must reboot to complete the installation.",
- "Sorry.";
- } elsif (defined $MUST_REBOOT & $verbose) {
- warn _estr "Installation will be completed at the next reboot.\n",
- "However it is not necessary to reboot immediately.\n";
- }
-}
-
-=begin _undocumented
-
-=item install_rooted_file( $file )
-
-Returns $file, or catfile($INSTALL_ROOT,$file) if $INSTALL_ROOT
-is defined.
-
-=item install_rooted_dir( $dir )
-
-Returns $dir, or catdir($INSTALL_ROOT,$dir) if $INSTALL_ROOT
-is defined.
-
-=end _undocumented
-
-=cut
-
-
-sub install_rooted_file {
- if (defined $INSTALL_ROOT) {
- File::Spec->catfile($INSTALL_ROOT, $_[0]);
- } else {
- $_[0];
- }
-}
-
-
-sub install_rooted_dir {
- if (defined $INSTALL_ROOT) {
- File::Spec->catdir($INSTALL_ROOT, $_[0]);
- } else {
- $_[0];
- }
-}
-
-=begin _undocumented
-
-=item 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
-Win32 in that it will try to use Win32API::File to schedule a delete at
-reboot. A wrapper for _unlink_or_rename().
-
-=end _undocumented
-
-=cut
-
-
-sub forceunlink {
- my ( $file, $tryhard )= @_; #XXX OS-SPECIFIC
- _unlink_or_rename( $file, $tryhard, not("installing") );
-}
-
-=begin _undocumented
-
-=item directory_not_empty( $dir )
-
-Returns 1 if there is an .exists file somewhere in a directory tree.
-Returns 0 if there is not.
-
-=end _undocumented
-
-=cut
-
-sub directory_not_empty ($) {
- my($dir) = @_;
- my $files = 0;
- find(sub {
- return if $_ eq ".exists";
- if (-f) {
- $File::Find::prune++;
- $files = 1;
- }
- }, $dir);
- return $files;
-}
-
-=pod
-
-=item B<install_default> I<DISCOURAGED>
-
- install_default();
- install_default($fullext);
-
-Calls install() with arguments to copy a module from blib/ to the
-default site installation location.
-
-$fullext is the name of the module converted to a directory
-(ie. Foo::Bar would be Foo/Bar). If $fullext is not specified, it
-will attempt to read it from @ARGV.
-
-This is primarily useful for install scripts.
-
-B<NOTE> This function is not really useful because of the hard-coded
-install location with no way to control site vs core vs vendor
-directories and the strange way in which the module name is given.
-Consider its use discouraged.
-
-=cut
-
-sub install_default {
- @_ < 2 or Carp::croak("install_default should be called with 0 or 1 argument");
- my $FULLEXT = @_ ? shift : $ARGV[0];
- defined $FULLEXT or die "Do not know to where to write install log";
- my $INST_LIB = File::Spec->catdir($Curdir,"blib","lib");
- my $INST_ARCHLIB = File::Spec->catdir($Curdir,"blib","arch");
- my $INST_BIN = File::Spec->catdir($Curdir,'blib','bin');
- my $INST_SCRIPT = File::Spec->catdir($Curdir,'blib','script');
- my $INST_MAN1DIR = File::Spec->catdir($Curdir,'blib','man1');
- my $INST_MAN3DIR = File::Spec->catdir($Curdir,'blib','man3');
-
- my @INST_HTML;
- if($Config{installhtmldir}) {
- my $INST_HTMLDIR = File::Spec->catdir($Curdir,'blib','html');
- @INST_HTML = ($INST_HTMLDIR => $Config{installhtmldir});
- }
-
- install({
- read => "$Config{sitearchexp}/auto/$FULLEXT/.packlist",
- write => "$Config{installsitearch}/auto/$FULLEXT/.packlist",
- $INST_LIB => (directory_not_empty($INST_ARCHLIB)) ?
- $Config{installsitearch} :
- $Config{installsitelib},
- $INST_ARCHLIB => $Config{installsitearch},
- $INST_BIN => $Config{installbin} ,
- $INST_SCRIPT => $Config{installscript},
- $INST_MAN1DIR => $Config{installman1dir},
- $INST_MAN3DIR => $Config{installman3dir},
- @INST_HTML,
- },1,0,0);
-}
-
-
-=item B<uninstall>
-
- uninstall($packlist_file);
- uninstall($packlist_file, $verbose, $dont_execute);
-
-Removes the files listed in a $packlist_file.
-
-If $verbose is true, will print out each file removed. Default is
-false.
-
-If $dont_execute is true it will only print what it was going to do
-without actually doing it. Default is false.
-
-=cut
-
-sub uninstall {
- my($fil,$verbose,$dry_run) = @_;
- $verbose ||= 0;
- $dry_run ||= 0;
-
- die _estr "ERROR: no packlist file found: '$fil'"
- unless -f $fil;
- # my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
- # require $my_req; # Hairy, but for the first
- my ($packlist) = ExtUtils::Packlist->new($fil);
- foreach (sort(keys(%$packlist))) {
- chomp;
- print "unlink $_\n" if $verbose;
- forceunlink($_,'tryhard') unless $dry_run;
- }
- print "unlink $fil\n" if $verbose;
- forceunlink($fil, 'tryhard') unless $dry_run;
- _do_cleanup($verbose);
-}
-
-=begin _undocumented
-
-=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
-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,$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'} || '';
-
- my @dirs=( @PERL_ENV_LIB,
- @INC,
- @Config{qw(archlibexp
- privlibexp
- sitearchexp
- sitelibexp)});
-
- #warn join "\n","---",@dirs,"---";
- my $seen_ours;
- foreach $dir ( @dirs ) {
- my $canonpath = $Is_VMS ? $dir : File::Spec->canonpath($dir);
- next if $canonpath eq $Curdir;
- next if $seen_dir{$canonpath}++;
- my $targetfile = File::Spec->catfile($canonpath,$libdir,$file);
- next unless -f $targetfile;
-
- # 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++;
- }
- print "#$file and $targetfile differ\n" if $diff && $verbose > 1;
-
- if (!$diff or $targetfile eq $ignore) {
- $seen_ours = 1;
- next;
- }
- 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.
- $Inc_uninstall_warn_handler->add(
- File::Spec->catfile($libdir, $file),
- $targetfile
- );
- }
- # if not verbose, we just say nothing
- } else {
- print "Unlinking $targetfile (shadowing?)\n" if $verbose;
- eval {
- die "Fake die for testing"
- if $ExtUtils::Install::Testing and
- ucase(File::Spec->canonpath($ExtUtils::Install::Testing)) eq ucase($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 {
- die "$@\n";
- }
- };
- }
- }
-}
-
-=begin _undocumented
-
-=item run_filter($cmd,$src,$dest)
-
-Filter $src using $cmd into $dest.
-
-=end _undocumented
-
-=cut
-
-sub run_filter {
- my ($cmd, $src, $dest) = @_;
- local(*CMD, *SRC);
- open(CMD, "|$cmd >$dest") || die "Cannot fork: $!";
- open(SRC, $src) || die "Cannot open $src: $!";
- my $buf;
- my $sz = 1024;
- while (my $len = sysread(SRC, $buf, $sz)) {
- syswrite(CMD, $buf, $len);
- }
- close SRC;
- close CMD or die "Filter command '$cmd' failed for $src";
-}
-
-=pod
-
-=item B<pm_to_blib>
-
- pm_to_blib(\%from_to, $autosplit_dir);
- pm_to_blib(\%from_to, $autosplit_dir, $filter_cmd);
-
-Copies each key of %from_to to its corresponding value efficiently.
-Filenames with the extension .pm are autosplit into the $autosplit_dir.
-Any destination directories are created.
-
-$filter_cmd is an optional shell command to run each .pm file through
-prior to splitting and copying. Input is the contents of the module,
-output the new module contents.
-
-You can have an environment variable PERL_INSTALL_ROOT set which will
-be prepended as a directory to each installed file (and directory).
-
-=cut
-
-sub pm_to_blib {
- my($fromto,$autodir,$pm_filter) = @_;
-
- _mkpath($autodir,0,0755);
- while(my($from, $to) = each %$fromto) {
- if( -f $to && -s $from == -s $to && -M $to < -M $from ) {
- print "Skip $to (unchanged)\n";
- next;
- }
-
- # When a pm_filter is defined, we need to pre-process the source first
- # to determine whether it has changed or not. Therefore, only perform
- # the comparison check when there's no filter to be ran.
- # -- RAM, 03/01/2001
-
- my $need_filtering = defined $pm_filter && length $pm_filter &&
- $from =~ /\.pm$/;
-
- if (!$need_filtering && 0 == compare($from,$to)) {
- print "Skip $to (unchanged)\n";
- next;
- }
- if (-f $to){
- # we wont try hard here. its too likely to mess things up.
- forceunlink($to);
- } else {
- _mkpath(dirname($to),0,0755);
- }
- if ($need_filtering) {
- run_filter($pm_filter, $from, $to);
- print "$pm_filter <$from >$to\n";
- } else {
- _copy( $from, $to );
- print "cp $from $to\n";
- }
- my($mode,$atime,$mtime) = (stat $from)[2,8,9];
- utime($atime,$mtime+$Is_VMS,$to);
- _chmod(0444 | ( $mode & 0111 ? 0111 : 0 ),$to);
- next unless $from =~ /\.pm$/;
- _autosplit($to,$autodir);
- }
-}
-
-
-=begin _private
-
-=item _autosplit
-
-From 1.0307 back, AutoSplit will sometimes leave an open filehandle to
-the file being split. This causes problems on systems with mandatory
-locking (ie. Windows). So we wrap it and close the filehandle.
-
-=end _private
-
-=cut
-
-sub _autosplit { #XXX OS-SPECIFIC
- my $retval = autosplit(@_);
- close *AutoSplit::IN if defined *AutoSplit::IN{IO};
-
- return $retval;
-}
-
-
-package ExtUtils::Install::Warn;
-
-sub new { bless {}, shift }
-
-sub add {
- my($self,$file,$targetfile) = @_;
- push @{$self->{$file}}, $targetfile;
-}
-
-sub DESTROY {
- unless(defined $INSTALL_ROOT) {
- my $self = shift;
- my($file,$i,$plural);
- foreach $file (sort keys %$self) {
- $plural = @{$self->{$file}} > 1 ? "s" : "";
- print "## Differing version$plural of $file found. You might like to\n";
- for (0..$#{$self->{$file}}) {
- print "rm ", $self->{$file}[$_], "\n";
- $i++;
- }
- }
- $plural = $i>1 ? "all those files" : "this file";
- my $inst = (_invokant() eq 'ExtUtils::MakeMaker')
- ? ( $Config::Config{make} || 'make' ).' install'
- . ( $Is_VMS ? '/MACRO="UNINST"=1' : ' UNINST=1' )
- : './Build install uninst=1';
- print "## Running '$inst' will unlink $plural for you.\n";
- }
-}
-
-=begin _private
-
-=item _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
-or by ExtUtils::MakeMaker.
-
-=end _private
-
-=cut
-
-sub _invokant {
- my @stack;
- my $frame = 0;
- while (my $file = (caller($frame++))[1]) {
- push @stack, (File::Spec->splitpath($file))[2];
- }
-
- my $builder;
- my $top = pop @stack;
- if ($top =~ /^Build/i || exists($INC{'Module/Build.pm'})) {
- $builder = 'Module::Build';
- } else {
- $builder = 'ExtUtils::MakeMaker';
- }
- return $builder;
-}
-
-=pod
-
-=back
-
-=head1 ENVIRONMENT
-
-=over 4
-
-=item B<PERL_INSTALL_ROOT>
-
-Will be prepended to each install path.
-
-=item B<EU_INSTALL_IGNORE_SKIP>
-
-Will prevent the automatic use of INSTALL.SKIP as the install skip file.
-
-=item B<EU_INSTALL_SITE_SKIPFILE>
-
-If there is no INSTALL.SKIP file in the make directory then this value
-can be used to provide a default.
-
-=item B<EU_INSTALL_ALWAYS_COPY>
-
-If this environment variable is true then normal install processes will
-always overwrite older identical files during the install process.
-
-Note that the alias EU_ALWAYS_COPY will be supported if EU_INSTALL_ALWAYS_COPY
-is not defined until at least the 1.50 release. Please ensure you use the
-correct EU_INSTALL_ALWAYS_COPY.
-
-=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 G. Schwern.
-
-Send bug reports via http://rt.cpan.org/. Please send your
-generated Makefile along with your report.
-
-=head1 LICENSE
-
-This program is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
-
-See L<http://www.perl.com/perl/misc/Artistic.html>
-
-
-=cut
-
-1;
diff --git a/lib/ExtUtils/Installed.pm b/lib/ExtUtils/Installed.pm
deleted file mode 100644
index 9cb1fc10d7..0000000000
--- a/lib/ExtUtils/Installed.pm
+++ /dev/null
@@ -1,462 +0,0 @@
-package ExtUtils::Installed;
-
-use 5.00503;
-use strict;
-#use warnings; # XXX requires 5.6
-use Carp qw();
-use ExtUtils::Packlist;
-use ExtUtils::MakeMaker;
-use Config;
-use File::Find;
-use File::Basename;
-use File::Spec;
-
-my $Is_VMS = $^O eq 'VMS';
-my $DOSISH = ($^O =~ /^(MSWin\d\d|os2|dos|mint)$/);
-
-require VMS::Filespec if $Is_VMS;
-
-use vars qw($VERSION);
-$VERSION = '1.999_001';
-$VERSION = eval $VERSION;
-
-sub _is_prefix {
- my ($self, $path, $prefix) = @_;
- return unless defined $prefix && defined $path;
-
- if( $Is_VMS ) {
- $prefix = VMS::Filespec::unixify($prefix);
- $path = VMS::Filespec::unixify($path);
- }
-
- # Unix path normalization.
- $prefix = File::Spec->canonpath($prefix);
-
- return 1 if substr($path, 0, length($prefix)) eq $prefix;
-
- if ($DOSISH) {
- $path =~ s|\\|/|g;
- $prefix =~ s|\\|/|g;
- return 1 if $path =~ m{^\Q$prefix\E}i;
- }
- return(0);
-}
-
-sub _is_doc {
- my ($self, $path) = @_;
-
- my $man1dir = $self->{':private:'}{Config}{man1direxp};
- my $man3dir = $self->{':private:'}{Config}{man3direxp};
- return(($man1dir && $self->_is_prefix($path, $man1dir))
- ||
- ($man3dir && $self->_is_prefix($path, $man3dir))
- ? 1 : 0)
-}
-
-sub _is_type {
- my ($self, $path, $type) = @_;
- return 1 if $type eq "all";
-
- return($self->_is_doc($path)) if $type eq "doc";
- my $conf= $self->{':private:'}{Config};
- if ($type eq "prog") {
- return($self->_is_prefix($path, $conf->{prefix} || $conf->{prefixexp})
- && !($self->_is_doc($path)) ? 1 : 0);
- }
- return(0);
-}
-
-sub _is_under {
- my ($self, $path, @under) = @_;
- $under[0] = "" if (! @under);
- foreach my $dir (@under) {
- return(1) if ($self->_is_prefix($path, $dir));
- }
-
- return(0);
-}
-
-sub _fix_dirs {
- my ($self, @dirs)= @_;
- # File::Find does not know how to deal with VMS filepaths.
- if( $Is_VMS ) {
- $_ = VMS::Filespec::unixify($_)
- for @dirs;
- }
-
- if ($DOSISH) {
- s|\\|/|g for @dirs;
- }
- return wantarray ? @dirs : $dirs[0];
-}
-
-sub _make_entry {
- my ($self, $module, $packlist_file, $modfile)= @_;
-
- my $data= {
- module => $module,
- packlist => scalar(ExtUtils::Packlist->new($packlist_file)),
- packlist_file => $packlist_file,
- };
-
- if (!$modfile) {
- $data->{version} = $self->{':private:'}{Config}{version};
- } else {
- $data->{modfile} = $modfile;
- # Find the top-level module file in @INC
- $data->{version} = '';
- foreach my $dir (@{$self->{':private:'}{INC}}) {
- my $p = File::Spec->catfile($dir, $modfile);
- if (-r $p) {
- $module = _module_name($p, $module) if $Is_VMS;
-
- $data->{version} = MM->parse_version($p);
- $data->{version_from} = $p;
- $data->{packlist_valid} = exists $data->{packlist}{$p};
- last;
- }
- }
- }
- $self->{$module}= $data;
-}
-
-our $INSTALLED;
-sub new {
- my ($class) = shift(@_);
- $class = ref($class) || $class;
-
- my %args = @_;
-
- return $INSTALLED if $INSTALLED and ($args{default_get} || $args{default});
-
- my $self = bless {}, $class;
-
- $INSTALLED= $self if $args{default_set} || $args{default};
-
-
- if ($args{config_override}) {
- eval {
- $self->{':private:'}{Config} = { %{$args{config_override}} };
- } or Carp::croak(
- "The 'config_override' parameter must be a hash reference."
- );
- }
- else {
- $self->{':private:'}{Config} = \%Config;
- }
-
- for my $tuple ([inc_override => INC => [ @INC ] ],
- [ extra_libs => EXTRA => [] ])
- {
- my ($arg,$key,$val)=@$tuple;
- if ( $args{$arg} ) {
- eval {
- $self->{':private:'}{$key} = [ @{$args{$arg}} ];
- } or Carp::croak(
- "The '$arg' parameter must be an array reference."
- );
- }
- elsif ($val) {
- $self->{':private:'}{$key} = $val;
- }
- }
- {
- my %dupe;
- @{$self->{':private:'}{LIBDIRS}} = grep { -e $_ && !$dupe{$_}++ }
- @{$self->{':private:'}{EXTRA}}, @{$self->{':private:'}{INC}};
- }
-
- my @dirs= $self->_fix_dirs(@{$self->{':private:'}{LIBDIRS}});
-
- # Read the core packlist
- my $archlib = $self->_fix_dirs($self->{':private:'}{Config}{archlibexp});
- $self->_make_entry("Perl",File::Spec->catfile($archlib, '.packlist'));
-
- my $root;
- # Read the module packlists
- my $sub = sub {
- # Only process module .packlists
- return if $_ ne ".packlist" || $File::Find::dir eq $archlib;
-
- # Hack of the leading bits of the paths & convert to a module name
- my $module = $File::Find::name;
- my $found = $module =~ s!^.*?/auto/(.*)/.packlist!$1!s
- or do {
- # warn "Woah! \$_=$_\n\$module=$module\n\$File::Find::dir=$File::Find::dir\n",
- # join ("\n",@dirs);
- return;
- };
-
- my $modfile = "$module.pm";
- $module =~ s!/!::!g;
-
- return if $self->{$module}; #shadowing?
- $self->_make_entry($module,$File::Find::name,$modfile);
- };
- while (@dirs) {
- $root= shift @dirs;
- next if !-d $root;
- find($sub,$root);
- }
-
- return $self;
-}
-
-# VMS's non-case preserving file-system means the package name can't
-# be reconstructed from the filename.
-sub _module_name {
- my($file, $orig_module) = @_;
-
- my $module = '';
- if (open PACKFH, $file) {
- while (<PACKFH>) {
- if (/package\s+(\S+)\s*;/) {
- my $pack = $1;
- # Make a sanity check, that lower case $module
- # is identical to lowercase $pack before
- # accepting it
- if (lc($pack) eq lc($orig_module)) {
- $module = $pack;
- last;
- }
- }
- }
- close PACKFH;
- }
-
- print STDERR "Couldn't figure out the package name for $file\n"
- unless $module;
-
- return $module;
-}
-
-sub modules {
- my ($self) = @_;
- $self= $self->new(default=>1) if !ref $self;
-
- # Bug/feature of sort in scalar context requires this.
- return wantarray
- ? sort grep { not /^:private:$/ } keys %$self
- : grep { not /^:private:$/ } keys %$self;
-}
-
-sub files {
- my ($self, $module, $type, @under) = @_;
- $self= $self->new(default=>1) if !ref $self;
-
- # Validate arguments
- Carp::croak("$module is not installed") if (! exists($self->{$module}));
- $type = "all" if (! defined($type));
- Carp::croak('type must be "all", "prog" or "doc"')
- if ($type ne "all" && $type ne "prog" && $type ne "doc");
-
- my (@files);
- foreach my $file (keys(%{$self->{$module}{packlist}})) {
- push(@files, $file)
- if ($self->_is_type($file, $type) &&
- $self->_is_under($file, @under));
- }
- return(@files);
-}
-
-sub directories {
- my ($self, $module, $type, @under) = @_;
- $self= $self->new(default=>1) if !ref $self;
- my (%dirs);
- foreach my $file ($self->files($module, $type, @under)) {
- $dirs{dirname($file)}++;
- }
- return sort keys %dirs;
-}
-
-sub directory_tree {
- my ($self, $module, $type, @under) = @_;
- $self= $self->new(default=>1) if !ref $self;
- my (%dirs);
- foreach my $dir ($self->directories($module, $type, @under)) {
- $dirs{$dir}++;
- my ($last) = ("");
- while ($last ne $dir) {
- $last = $dir;
- $dir = dirname($dir);
- last if !$self->_is_under($dir, @under);
- $dirs{$dir}++;
- }
- }
- return(sort(keys(%dirs)));
-}
-
-sub validate {
- my ($self, $module, $remove) = @_;
- $self= $self->new(default=>1) if !ref $self;
- Carp::croak("$module is not installed") if (! exists($self->{$module}));
- return($self->{$module}{packlist}->validate($remove));
-}
-
-sub packlist {
- my ($self, $module) = @_;
- $self= $self->new(default=>1) if !ref $self;
- Carp::croak("$module is not installed") if (! exists($self->{$module}));
- return($self->{$module}{packlist});
-}
-
-sub version {
- my ($self, $module) = @_;
- $self= $self->new(default=>1) if !ref $self;
- Carp::croak("$module is not installed") if (! exists($self->{$module}));
- return($self->{$module}{version});
-}
-
-sub debug_dump {
- my ($self, $module) = @_;
- $self= $self->new(default=>1) if !ref $self;
- local $self->{":private:"}{Config};
- require Data::Dumper;
- print Data::Dumper->new([$self])->Sortkeys(1)->Indent(1)->Dump();
-}
-
-
-1;
-
-__END__
-
-=head1 NAME
-
-ExtUtils::Installed - Inventory management of installed modules
-
-=head1 SYNOPSIS
-
- use ExtUtils::Installed;
- my ($inst) = ExtUtils::Installed->new();
- my (@modules) = $inst->modules();
- my (@missing) = $inst->validate("DBI");
- my $all_files = $inst->files("DBI");
- my $files_below_usr_local = $inst->files("DBI", "all", "/usr/local");
- my $all_dirs = $inst->directories("DBI");
- my $dirs_below_usr_local = $inst->directory_tree("DBI", "prog");
- my $packlist = $inst->packlist("DBI");
-
-=head1 DESCRIPTION
-
-ExtUtils::Installed provides a standard way to find out what core and module
-files have been installed. It uses the information stored in .packlist files
-created during installation to provide this information. In addition it
-provides facilities to classify the installed files and to extract directory
-information from the .packlist files.
-
-=head1 USAGE
-
-The new() function searches for all the installed .packlists on the system, and
-stores their contents. The .packlists can be queried with the functions
-described below. Where it searches by default is determined by the settings found
-in C<%Config::Config>, and what the value is of the PERL5LIB environment variable.
-
-=head1 METHODS
-
-Unless specified otherwise all method can be called as class methods, or as object
-methods. If called as class methods then the "default" object will be used, and if
-necessary created using the current processes %Config and @INC. See the
-'default' option to new() for details.
-
-
-=over 4
-
-=item new()
-
-This takes optional named parameters. Without parameters, this
-searches for all the installed .packlists on the system using
-information from C<%Config::Config> and the default module search
-paths C<@INC>. The packlists are read using the
-L<ExtUtils::Packlist> module.
-
-If the named parameter C<config_override> is specified,
-it should be a reference to a hash which contains all information
-usually found in C<%Config::Config>. For example, you can obtain
-the configuration information for a separate perl installation and
-pass that in.
-
- my $yoda_cfg = get_fake_config('yoda');
- my $yoda_inst = ExtUtils::Installed->new(config_override=>$yoda_cfg);
-
-Similarly, the parameter C<inc_override> may be a reference to an
-array which is used in place of the default module search paths
-from C<@INC>.
-
- use Config;
- my @dirs = split(/\Q$Config{path_sep}\E/, $ENV{PERL5LIB});
- my $p5libs = ExtUtils::Installed->new(inc_override=>\@dirs);
-
-B<Note>: You probably do not want to use these options alone, almost always
-you will want to set both together.
-
-The parameter c<extra_libs> can be used to specify B<additional> paths to
-search for installed modules. For instance
-
- my $installed = ExtUtils::Installed->new(extra_libs=>["/my/lib/path"]);
-
-This should only be necessary if C</my/lib/path> is not in PERL5LIB.
-
-Finally there is the 'default', and the related 'default_get' and 'default_set'
-options. These options control the "default" object which is provided by the
-class interface to the methods. Setting C<default_get> to true tells the constructor
-to return the default object if it is defined. Setting C<default_set> to true tells
-the constructor to make the default object the constructed object. Setting the
-C<default> option is like setting both to true. This is used primarily internally
-and probably isn't interesting to any real user.
-
-=item modules()
-
-This returns a list of the names of all the installed modules. The perl 'core'
-is given the special name 'Perl'.
-
-=item files()
-
-This takes one mandatory parameter, the name of a module. It returns a list of
-all the filenames from the package. To obtain a list of core perl files, use
-the module name 'Perl'. Additional parameters are allowed. The first is one
-of the strings "prog", "doc" or "all", to select either just program files,
-just manual files or all files. The remaining parameters are a list of
-directories. The filenames returned will be restricted to those under the
-specified directories.
-
-=item directories()
-
-This takes one mandatory parameter, the name of a module. It returns a list of
-all the directories from the package. Additional parameters are allowed. The
-first is one of the strings "prog", "doc" or "all", to select either just
-program directories, just manual directories or all directories. The remaining
-parameters are a list of directories. The directories returned will be
-restricted to those under the specified directories. This method returns only
-the leaf directories that contain files from the specified module.
-
-=item directory_tree()
-
-This is identical in operation to directories(), except that it includes all the
-intermediate directories back up to the specified directories.
-
-=item validate()
-
-This takes one mandatory parameter, the name of a module. It checks that all
-the files listed in the modules .packlist actually exist, and returns a list of
-any missing files. If an optional second argument which evaluates to true is
-given any missing files will be removed from the .packlist
-
-=item packlist()
-
-This returns the ExtUtils::Packlist object for the specified module.
-
-=item version()
-
-This returns the version number for the specified module.
-
-=back
-
-=head1 EXAMPLE
-
-See the example in L<ExtUtils::Packlist>.
-
-=head1 AUTHOR
-
-Alan Burlison <Alan.Burlison@uk.sun.com>
-
-=cut
diff --git a/lib/ExtUtils/Packlist.pm b/lib/ExtUtils/Packlist.pm
deleted file mode 100644
index 04f267a0a3..0000000000
--- a/lib/ExtUtils/Packlist.pm
+++ /dev/null
@@ -1,348 +0,0 @@
-package ExtUtils::Packlist;
-
-use 5.00503;
-use strict;
-use Carp qw();
-use Config;
-use vars qw($VERSION $Relocations);
-$VERSION = '1.43';
-$VERSION = eval $VERSION;
-
-# Used for generating filehandle globs. IO::File might not be available!
-my $fhname = "FH1";
-
-=begin _undocumented
-
-=item mkfh()
-
-Make a filehandle. Same kind of idea as Symbol::gensym().
-
-=cut
-
-sub mkfh()
-{
-no strict;
-my $fh = \*{$fhname++};
-use strict;
-return($fh);
-}
-
-=item __find_relocations
-
-Works out what absolute paths in the configuration have been located at run
-time relative to $^X, and generates a regexp that matches them
-
-=end _undocumented
-
-=cut
-
-sub __find_relocations
-{
- my %paths;
- while (my ($raw_key, $raw_val) = each %Config) {
- my $exp_key = $raw_key . "exp";
- next unless exists $Config{$exp_key};
- next unless $raw_val =~ m!\.\.\./!;
- $paths{$Config{$exp_key}}++;
- }
- # Longest prefixes go first in the alternatives
- my $alternations = join "|", map {quotemeta $_}
- sort {length $b <=> length $a} keys %paths;
- qr/^($alternations)/o;
-}
-
-sub new($$)
-{
-my ($class, $packfile) = @_;
-$class = ref($class) || $class;
-my %self;
-tie(%self, $class, $packfile);
-return(bless(\%self, $class));
-}
-
-sub TIEHASH
-{
-my ($class, $packfile) = @_;
-my $self = { packfile => $packfile };
-bless($self, $class);
-$self->read($packfile) if (defined($packfile) && -f $packfile);
-return($self);
-}
-
-sub STORE
-{
-$_[0]->{data}->{$_[1]} = $_[2];
-}
-
-sub FETCH
-{
-return($_[0]->{data}->{$_[1]});
-}
-
-sub FIRSTKEY
-{
-my $reset = scalar(keys(%{$_[0]->{data}}));
-return(each(%{$_[0]->{data}}));
-}
-
-sub NEXTKEY
-{
-return(each(%{$_[0]->{data}}));
-}
-
-sub EXISTS
-{
-return(exists($_[0]->{data}->{$_[1]}));
-}
-
-sub DELETE
-{
-return(delete($_[0]->{data}->{$_[1]}));
-}
-
-sub CLEAR
-{
-%{$_[0]->{data}} = ();
-}
-
-sub DESTROY
-{
-}
-
-sub read($;$)
-{
-my ($self, $packfile) = @_;
-$self = tied(%$self) || $self;
-
-if (defined($packfile)) { $self->{packfile} = $packfile; }
-else { $packfile = $self->{packfile}; }
-Carp::croak("No packlist filename specified") if (! defined($packfile));
-my $fh = mkfh();
-open($fh, "<$packfile") || Carp::croak("Can't open file $packfile: $!");
-$self->{data} = {};
-my ($line);
-while (defined($line = <$fh>))
- {
- chomp $line;
- my ($key, $data) = $line;
- if ($key =~ /^(.*?)( \w+=.*)$/)
- {
- $key = $1;
- $data = { map { split('=', $_) } split(' ', $2)};
-
- if ($Config{userelocatableinc} && $data->{relocate_as})
- {
- require File::Spec;
- require Cwd;
- my ($vol, $dir) = File::Spec->splitpath($packfile);
- my $newpath = File::Spec->catpath($vol, $dir, $data->{relocate_as});
- $key = Cwd::realpath($newpath);
- }
- }
- $key =~ s!/\./!/!g; # Some .packlists have spurious '/./' bits in the paths
- $self->{data}->{$key} = $data;
- }
-close($fh);
-}
-
-sub write($;$)
-{
-my ($self, $packfile) = @_;
-$self = tied(%$self) || $self;
-if (defined($packfile)) { $self->{packfile} = $packfile; }
-else { $packfile = $self->{packfile}; }
-Carp::croak("No packlist filename specified") if (! defined($packfile));
-my $fh = mkfh();
-open($fh, ">$packfile") || Carp::croak("Can't open file $packfile: $!");
-foreach my $key (sort(keys(%{$self->{data}})))
- {
- my $data = $self->{data}->{$key};
- if ($Config{userelocatableinc}) {
- $Relocations ||= __find_relocations();
- if ($packfile =~ $Relocations) {
- # We are writing into a subdirectory of a run-time relocated
- # path. Figure out if the this file is also within a subdir.
- my $prefix = $1;
- if (File::Spec->no_upwards(File::Spec->abs2rel($key, $prefix)))
- {
- # The relocated path is within the found prefix
- my $packfile_prefix;
- (undef, $packfile_prefix)
- = File::Spec->splitpath($packfile);
-
- my $relocate_as
- = File::Spec->abs2rel($key, $packfile_prefix);
-
- if (!ref $data) {
- $data = {};
- }
- $data->{relocate_as} = $relocate_as;
- }
- }
- }
- print $fh ("$key");
- if (ref($data))
- {
- foreach my $k (sort(keys(%$data)))
- {
- print $fh (" $k=$data->{$k}");
- }
- }
- print $fh ("\n");
- }
-close($fh);
-}
-
-sub validate($;$)
-{
-my ($self, $remove) = @_;
-$self = tied(%$self) || $self;
-my @missing;
-foreach my $key (sort(keys(%{$self->{data}})))
- {
- if (! -e $key)
- {
- push(@missing, $key);
- delete($self->{data}{$key}) if ($remove);
- }
- }
-return(@missing);
-}
-
-sub packlist_file($)
-{
-my ($self) = @_;
-$self = tied(%$self) || $self;
-return($self->{packfile});
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-ExtUtils::Packlist - manage .packlist files
-
-=head1 SYNOPSIS
-
- use ExtUtils::Packlist;
- my ($pl) = ExtUtils::Packlist->new('.packlist');
- $pl->read('/an/old/.packlist');
- my @missing_files = $pl->validate();
- $pl->write('/a/new/.packlist');
-
- $pl->{'/some/file/name'}++;
- or
- $pl->{'/some/other/file/name'} = { type => 'file',
- from => '/some/file' };
-
-=head1 DESCRIPTION
-
-ExtUtils::Packlist provides a standard way to manage .packlist files.
-Functions are provided to read and write .packlist files. The original
-.packlist format is a simple list of absolute pathnames, one per line. In
-addition, this package supports an extended format, where as well as a filename
-each line may contain a list of attributes in the form of a space separated
-list of key=value pairs. This is used by the installperl script to
-differentiate between files and links, for example.
-
-=head1 USAGE
-
-The hash reference returned by the new() function can be used to examine and
-modify the contents of the .packlist. Items may be added/deleted from the
-.packlist by modifying the hash. If the value associated with a hash key is a
-scalar, the entry written to the .packlist by any subsequent write() will be a
-simple filename. If the value is a hash, the entry written will be the
-filename followed by the key=value pairs from the hash. Reading back the
-.packlist will recreate the original entries.
-
-=head1 FUNCTIONS
-
-=over 4
-
-=item new()
-
-This takes an optional parameter, the name of a .packlist. If the file exists,
-it will be opened and the contents of the file will be read. The new() method
-returns a reference to a hash. This hash holds an entry for each line in the
-.packlist. In the case of old-style .packlists, the value associated with each
-key is undef. In the case of new-style .packlists, the value associated with
-each key is a hash containing the key=value pairs following the filename in the
-.packlist.
-
-=item read()
-
-This takes an optional parameter, the name of the .packlist to be read. If
-no file is specified, the .packlist specified to new() will be read. If the
-.packlist does not exist, Carp::croak will be called.
-
-=item write()
-
-This takes an optional parameter, the name of the .packlist to be written. If
-no file is specified, the .packlist specified to new() will be overwritten.
-
-=item validate()
-
-This checks that every file listed in the .packlist actually exists. If an
-argument which evaluates to true is given, any missing files will be removed
-from the internal hash. The return value is a list of the missing files, which
-will be empty if they all exist.
-
-=item packlist_file()
-
-This returns the name of the associated .packlist file
-
-=back
-
-=head1 EXAMPLE
-
-Here's C<modrm>, a little utility to cleanly remove an installed module.
-
- #!/usr/local/bin/perl -w
-
- use strict;
- use IO::Dir;
- use ExtUtils::Packlist;
- use ExtUtils::Installed;
-
- sub emptydir($) {
- my ($dir) = @_;
- my $dh = IO::Dir->new($dir) || return(0);
- my @count = $dh->read();
- $dh->close();
- return(@count == 2 ? 1 : 0);
- }
-
- # Find all the installed packages
- print("Finding all installed modules...\n");
- my $installed = ExtUtils::Installed->new();
-
- foreach my $module (grep(!/^Perl$/, $installed->modules())) {
- my $version = $installed->version($module) || "???";
- print("Found module $module Version $version\n");
- print("Do you want to delete $module? [n] ");
- my $r = <STDIN>; chomp($r);
- if ($r && $r =~ /^y/i) {
- # Remove all the files
- foreach my $file (sort($installed->files($module))) {
- print("rm $file\n");
- unlink($file);
- }
- my $pf = $installed->packlist($module)->packlist_file();
- print("rm $pf\n");
- unlink($pf);
- foreach my $dir (sort($installed->directory_tree($module))) {
- if (emptydir($dir)) {
- print("rmdir $dir\n");
- rmdir($dir);
- }
- }
- }
- }
-
-=head1 AUTHOR
-
-Alan Burlison <Alan.Burlison@uk.sun.com>
-
-=cut
diff --git a/lib/ExtUtils/t/Install.t b/lib/ExtUtils/t/Install.t
deleted file mode 100644
index a30515ea94..0000000000
--- a/lib/ExtUtils/t/Install.t
+++ /dev/null
@@ -1,194 +0,0 @@
-#!/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 => 52;
-
-use MakeMaker::Test::Setup::BFD;
-
-BEGIN { use_ok('ExtUtils::Install') }
-# ensure the env doesnt pollute our tests
-local $ENV{EU_INSTALL_ALWAYS_COPY};
-local $ENV{EU_ALWAYS_COPY};
-
-# 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( { 'blib/lib' => 'install-test/lib/perl',
- read => 'install-test/packlist',
- write => 'install-test/packlist'
- },
- 0, 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( { '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( { 'blib/lib' => 'install-test/other_lib/perl',
- read => 'install-test/packlist',
- write => 'install-test/packlist'
- },
- 0, 0, 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( { 'blib/lib' => 'install-test/other_lib/perl',
- read => 'install-test/packlist',
- write => 'install-test/packlist'
- },
- 0, 0, 0);
- 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( { 'blib/lib' => 'install-test/other_lib/perl',
- read => 'install-test/packlist',
- write => 'install-test/packlist'
- },
- 0, 0, 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( { 'blib/lib' => 'install-test/other_lib/perl',
- read => 'install-test/packlist',
- write => 'install-test/packlist'
- },
- 0, 0, 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} = '';
- install( { 'blib/lib' => 'install-test/other_lib/perl',
- read => 'install-test/packlist',
- write => 'install-test/packlist'
- },
- 0, 0, 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' );
-}
-
diff --git a/lib/ExtUtils/t/InstallWithMM.t b/lib/ExtUtils/t/InstallWithMM.t
deleted file mode 100644
index 354b8f4d35..0000000000
--- a/lib/ExtUtils/t/InstallWithMM.t
+++ /dev/null
@@ -1,95 +0,0 @@
-#!/usr/bin/perl -w
-
-# Make sure EUI works with MakeMaker
-
-BEGIN {
- if( $ENV{PERL_CORE} ) {
- chdir 't' if -d 't';
- @INC = ('../lib', 'lib');
- }
- else {
- unshift @INC, 't/lib';
- }
-}
-
-use strict;
-use Config;
-use ExtUtils::MakeMaker;
-
-use Test::More tests => 15;
-use MakeMaker::Test::Utils;
-use MakeMaker::Test::Setup::BFD;
-use File::Find;
-use File::Spec;
-use File::Path;
-
-my $make = make_run();
-
-# Environment variables which interfere with our testing.
-delete @ENV{qw(PREFIX LIB MAKEFLAGS)};
-
-# Run Makefile.PL
-{
- my $perl = which_perl();
- my $Is_VMS = $^O eq 'VMS';
-
- chdir 't';
-
- perl_lib;
-
- my $Touch_Time = calibrate_mtime();
-
- $| = 1;
-
- ok( setup_recurs(), 'setup' );
- END {
- ok( chdir File::Spec->updir );
- ok( teardown_recurs(), 'teardown' );
- }
-
- ok( chdir('Big-Dummy'), "chdir'd to Big-Dummy" ) ||
- diag("chdir failed: $!");
-
- my @mpl_out = run(qq{$perl Makefile.PL "PREFIX=../dummy-install"});
- END { rmtree '../dummy-install'; }
-
- cmp_ok( $?, '==', 0, 'Makefile.PL exited with zero' ) ||
- diag(@mpl_out);
-
- END { unlink makefile_name(), makefile_backup() }
-}
-
-
-# make
-{
- my $make_out = run($make);
- is( $?, 0, 'make ran ok' ) ||
- diag($make_out);
-}
-
-
-# Test 'make install VERBINST=1'
-{
- my $make_install_verbinst = make_macro($make, 'install', VERBINST => 1);
- my $install_out = run($make_install_verbinst);
- is( $?, 0, 'install' ) || diag $install_out;
- like( $install_out, qr/^Installing /m );
- like( $install_out, qr/^Writing /m );
-
- ok( -r '../dummy-install', ' install dir created' );
- my %files = ();
- find( sub {
- # do it case-insensitive for non-case preserving OSs
- my $file = lc $_;
-
- # VMS likes to put dots on the end of things that don't have them.
- $file =~ s/\.$// if $Is_VMS;
-
- $files{$file} = $File::Find::name;
- }, '../dummy-install' );
- ok( $files{'dummy.pm'}, ' Dummy.pm installed' );
- ok( $files{'liar.pm'}, ' Liar.pm installed' );
- ok( $files{'program'}, ' program installed' );
- ok( $files{'.packlist'}, ' packlist created' );
- ok( $files{'perllocal.pod'},' perllocal.pod created' );
-}
diff --git a/lib/ExtUtils/t/Installapi2.t b/lib/ExtUtils/t/Installapi2.t
deleted file mode 100644
index c59b8abb38..0000000000
--- a/lib/ExtUtils/t/Installapi2.t
+++ /dev/null
@@ -1,238 +0,0 @@
-#!/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' );
-}
-# ensure the env doesnt pollute our tests
-local $ENV{EU_INSTALL_ALWAYS_COPY};
-local $ENV{EU_ALWAYS_COPY};
-
-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_INSTALL_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' );
-SKIP: {
- skip "Times not preserved during copy by default", 1 if $^O eq 'VMS';
- 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_INSTALL_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');
-}
diff --git a/lib/ExtUtils/t/Installed.t b/lib/ExtUtils/t/Installed.t
deleted file mode 100644
index dd492c2d1d..0000000000
--- a/lib/ExtUtils/t/Installed.t
+++ /dev/null
@@ -1,313 +0,0 @@
-#!/usr/bin/perl -w
-
-BEGIN {
- if( $ENV{PERL_CORE} ) {
- chdir 't' if -d 't';
- @INC = '../lib';
- }
- else {
- unshift @INC, 't/lib/';
- }
-}
-chdir 't';
-
-my $Is_VMS = $^O eq 'VMS';
-
-use strict;
-
-use Config;
-use Cwd;
-use File::Path;
-use File::Basename;
-use File::Spec;
-
-use Test::More tests => 63;
-
-BEGIN { use_ok( 'ExtUtils::Installed' ) }
-
-my $mandirs = !!$Config{man1direxp} + !!$Config{man3direxp};
-
-# saves having to qualify package name for class methods
-my $ei = bless( {}, 'ExtUtils::Installed' );
-
-# Make sure meta info is available
-$ei->{':private:'}{Config} = \%Config;
-$ei->{':private:'}{INC} = \@INC;
-
-# _is_prefix
-ok( $ei->_is_prefix('foo/bar', 'foo'),
- '_is_prefix() should match valid path prefix' );
-ok( !$ei->_is_prefix('\foo\bar', '\bar'),
- '... should not match wrong prefix' );
-
-# _is_type
-ok( $ei->_is_type(0, 'all'), '_is_type() should be true for type of "all"' );
-
-foreach my $path (qw( man1dir man3dir )) {
- SKIP: {
- my $dir = File::Spec->canonpath($Config{$path.'exp'});
- skip("no man directory $path on this system", 2 ) unless $dir;
-
- my $file = $dir . '/foo';
- ok( $ei->_is_type($file, 'doc'), "... should find doc file in $path" );
- ok( !$ei->_is_type($file, 'prog'), "... but not prog file in $path" );
- }
-}
-
-# VMS 5.6.1 doesn't seem to have $Config{prefixexp}
-my $prefix = $Config{prefix} || $Config{prefixexp};
-
-# You can concatenate /foo but not foo:, which defaults in the current
-# directory
-$prefix = VMS::Filespec::unixify($prefix) if $Is_VMS;
-
-# ActivePerl 5.6.1/631 has $Config{prefixexp} as 'p:' for some reason
-$prefix = $Config{prefix} if $prefix eq 'p:' && $^O eq 'MSWin32';
-
-ok( $ei->_is_type( File::Spec->catfile($prefix, 'bar'), 'prog'),
- "... should find prog file under $prefix" );
-
-SKIP: {
- skip('no man directories on this system', 1) unless $mandirs;
- is( $ei->_is_type('bar', 'doc'), 0,
- '... should not find doc file outside path' );
-}
-
-ok( !$ei->_is_type('bar', 'prog'),
- '... nor prog file outside path' );
-ok( !$ei->_is_type('whocares', 'someother'), '... nor other type anywhere' );
-
-# _is_under
-ok( $ei->_is_under('foo'), '_is_under() should return true with no dirs' );
-
-my @under = qw( boo bar baz );
-ok( !$ei->_is_under('foo', @under), '... should find no file not under dirs');
-ok( $ei->_is_under('baz', @under), '... should find file under dir' );
-
-
-rmtree 'auto/FakeMod';
-ok( mkpath('auto/FakeMod') );
-END { rmtree 'auto' }
-
-ok(open(PACKLIST, '>auto/FakeMod/.packlist'));
-print PACKLIST 'list';
-close PACKLIST;
-
-ok(open(FAKEMOD, '>auto/FakeMod/FakeMod.pm'));
-
-print FAKEMOD <<'FAKE';
-package FakeMod;
-use vars qw( $VERSION );
-$VERSION = '1.1.1';
-1;
-FAKE
-
-close FAKEMOD;
-
-my $fake_mod_dir = File::Spec->catdir(cwd(), 'auto', 'FakeMod');
-{
- # avoid warning and death by localizing glob
- local *ExtUtils::Installed::Config;
- %ExtUtils::Installed::Config = (
- %Config,
- archlibexp => cwd(),
- sitearchexp => $fake_mod_dir,
- );
-
- # necessary to fool new()
- push @INC, $fake_mod_dir;
-
- my $realei = ExtUtils::Installed->new();
- isa_ok( $realei, 'ExtUtils::Installed' );
- isa_ok( $realei->{Perl}{packlist}, 'ExtUtils::Packlist' );
- is( $realei->{Perl}{version}, $Config{version},
- 'new() should set Perl version from %Config' );
-
- ok( exists $realei->{FakeMod}, 'new() should find modules with .packlists');
- isa_ok( $realei->{FakeMod}{packlist}, 'ExtUtils::Packlist' );
- is( $realei->{FakeMod}{version}, '1.1.1',
- '... should find version in modules' );
-}
-
-# Now try this using PERL5LIB
-{
- local $ENV{PERL5LIB} = join $Config{path_sep}, $fake_mod_dir;
- local *ExtUtils::Installed::Config;
- %ExtUtils::Installed::Config = (
- %Config,
- archlibexp => cwd(),
- sitearchexp => cwd(),
- );
-
- my $realei = ExtUtils::Installed->new();
- isa_ok( $realei, 'ExtUtils::Installed' );
- isa_ok( $realei->{Perl}{packlist}, 'ExtUtils::Packlist' );
- is( $realei->{Perl}{version}, $Config{version},
- 'new() should set Perl version from %Config' );
-
- ok( exists $realei->{FakeMod},
- 'new() should find modules with .packlists using PERL5LIB'
- );
- isa_ok( $realei->{FakeMod}{packlist}, 'ExtUtils::Packlist' );
- is( $realei->{FakeMod}{version}, '1.1.1',
- '... should find version in modules' );
-}
-
-# Do the same thing as the last block, but with overrides for
-# %Config and @INC.
-{
- my $config_override = { %Config::Config };
- $config_override->{archlibexp} = cwd();
- $config_override->{sitearchexp} = $fake_mod_dir;
- $config_override->{version} = 'fake_test_version';
-
- my @inc_override = (@INC, $fake_mod_dir);
-
- my $realei = ExtUtils::Installed->new(
- 'config_override' => $config_override,
- 'inc_override' => \@inc_override,
- );
- isa_ok( $realei, 'ExtUtils::Installed' );
- isa_ok( $realei->{Perl}{packlist}, 'ExtUtils::Packlist' );
- is( $realei->{Perl}{version}, 'fake_test_version',
- 'new(config_override => HASH) overrides %Config' );
-
- ok( exists $realei->{FakeMod}, 'new() with overrides should find modules with .packlists');
- isa_ok( $realei->{FakeMod}{packlist}, 'ExtUtils::Packlist' );
- is( $realei->{FakeMod}{version}, '1.1.1',
- '... should find version in modules' );
-}
-
-# Check if extra_libs works.
-{
- my $realei = ExtUtils::Installed->new(
- 'extra_libs' => [ cwd() ],
- );
- isa_ok( $realei, 'ExtUtils::Installed' );
- isa_ok( $realei->{Perl}{packlist}, 'ExtUtils::Packlist' );
- ok( exists $realei->{FakeMod},
- 'new() with extra_libs should find modules with .packlists');
-
- #{ use Data::Dumper; local $realei->{':private:'}{Config};
- # warn Dumper($realei); }
-
- isa_ok( $realei->{FakeMod}{packlist}, 'ExtUtils::Packlist' );
- is( $realei->{FakeMod}{version}, '1.1.1',
- '... should find version in modules' );
-}
-
-# modules
-$ei->{$_} = 1 for qw( abc def ghi );
-is( join(' ', $ei->modules()), 'abc def ghi',
- 'modules() should return sorted keys' );
-
-# This didn't work for a long time due to a sort in scalar context oddity.
-is( $ei->modules, 3, 'modules() in scalar context' );
-
-# files
-$ei->{goodmod} = {
- packlist => {
- ($Config{man1direxp} ?
- (File::Spec->catdir($Config{man1direxp}, 'foo') => 1) :
- ()),
- ($Config{man3direxp} ?
- (File::Spec->catdir($Config{man3direxp}, 'bar') => 1) :
- ()),
- File::Spec->catdir($prefix, 'foobar') => 1,
- foobaz => 1,
- },
-};
-
-eval { $ei->files('badmod') };
-like( $@, qr/badmod is not installed/,'files() should croak given bad modname');
-eval { $ei->files('goodmod', 'badtype' ) };
-like( $@, qr/type must be/,'files() should croak given bad type' );
-
-my @files;
-SKIP: {
- skip('no man directory man1dir on this system', 2)
- unless $Config{man1direxp};
- @files = $ei->files('goodmod', 'doc', $Config{man1direxp});
- is( scalar @files, 1, '... should find doc file under given dir' );
- is( (grep { /foo$/ } @files), 1, '... checking file name' );
-}
-SKIP: {
- skip('no man directories on this system', 1) unless $mandirs;
- @files = $ei->files('goodmod', 'doc');
- is( scalar @files, $mandirs, '... should find all doc files with no dir' );
-}
-
-@files = $ei->files('goodmod', 'prog', 'fake', 'fake2');
-is( scalar @files, 0, '... should find no doc files given wrong dirs' );
-@files = $ei->files('goodmod', 'prog');
-is( scalar @files, 1, '... should find doc file in correct dir' );
-like( $files[0], qr/foobar[>\]]?$/, '... checking file name' );
-@files = $ei->files('goodmod');
-is( scalar @files, 2 + $mandirs, '... should find all files with no type specified' );
-my %dirnames = map { lc($_) => dirname($_) } @files;
-
-# directories
-my @dirs = $ei->directories('goodmod', 'prog', 'fake');
-is( scalar @dirs, 0, 'directories() should return no dirs if no files found' );
-
-SKIP: {
- skip('no man directories on this system', 1) unless $mandirs;
- @dirs = $ei->directories('goodmod', 'doc');
- is( scalar @dirs, $mandirs, '... should find all files files() would' );
-}
-@dirs = $ei->directories('goodmod');
-is( scalar @dirs, 2 + $mandirs, '... should find all files files() would, again' );
-@files = sort map { exists $dirnames{lc($_)} ? $dirnames{lc($_)} : '' } @files;
-is( join(' ', @files), join(' ', @dirs), '... should sort output' );
-
-# directory_tree
-my $expectdirs =
- ($mandirs == 2) &&
- (dirname($Config{man1direxp}) eq dirname($Config{man3direxp}))
- ? 3 : 2;
-
-SKIP: {
- skip('no man directories on this system', 1) unless $mandirs;
- @dirs = $ei->directory_tree('goodmod', 'doc', $Config{man1direxp} ?
- dirname($Config{man1direxp}) : dirname($Config{man3direxp}));
- is( scalar @dirs, $expectdirs,
- 'directory_tree() should report intermediate dirs to those requested' );
-}
-
-my $fakepak = Fakepak->new(102);
-
-$ei->{yesmod} = {
- version => 101,
- packlist => $fakepak,
-};
-
-# these should all croak
-foreach my $sub (qw( validate packlist version )) {
- eval { $ei->$sub('nomod') };
- like( $@, qr/nomod is not installed/,
- "$sub() should croak when asked about uninstalled module" );
-}
-
-# validate
-is( $ei->validate('yesmod'), 'validated',
- 'validate() should return results of packlist validate() call' );
-
-# packlist
-is( ${ $ei->packlist('yesmod') }, 102,
- 'packlist() should report installed mod packlist' );
-
-# version
-is( $ei->version('yesmod'), 101,
- 'version() should report installed mod version' );
-
-
-package Fakepak;
-
-sub new {
- my $class = shift;
- bless(\(my $scalar = shift), $class);
-}
-
-sub validate {
- return 'validated'
-}
diff --git a/lib/ExtUtils/t/Packlist.t b/lib/ExtUtils/t/Packlist.t
deleted file mode 100644
index cb73e00d14..0000000000
--- a/lib/ExtUtils/t/Packlist.t
+++ /dev/null
@@ -1,174 +0,0 @@
-#!/usr/bin/perl -w
-
-BEGIN {
- if( $ENV{PERL_CORE} ) {
- chdir 't' if -d 't';
- @INC = '../lib';
- }
- else {
- unshift @INC, 't/lib';
- }
-}
-chdir 't';
-
-use Test::More tests => 34;
-
-use_ok( 'ExtUtils::Packlist' );
-
-is( ref(ExtUtils::Packlist::mkfh()), 'GLOB', 'mkfh() should return a FH' );
-
-# new calls tie()
-my $pl = ExtUtils::Packlist->new();
-isa_ok( $pl, 'ExtUtils::Packlist' );
-is( ref tied %$pl, 'ExtUtils::Packlist', 'obj should be tied underneath' );
-
-
-$pl = ExtUtils::Packlist::TIEHASH( 'tieclass', 'packfile' );
-is( ref($pl), 'tieclass', 'TIEHASH() should bless into class' );
-is( $pl->{packfile}, 'packfile', 'TIEHASH() should store packfile name' );
-
-
-ExtUtils::Packlist::STORE($pl, 'key', 'value');
-is( $pl->{data}{key}, 'value', 'STORE() should stuff stuff in data member' );
-
-
-$pl->{data}{foo} = 'bar';
-is( ExtUtils::Packlist::FETCH($pl, 'foo'), 'bar', 'check FETCH()' );
-
-
-# test FIRSTKEY and NEXTKEY
-SKIP: {
- $pl->{data}{bar} = 'baz';
- skip('not enough keys to test FIRSTKEY', 2)
- unless keys %{ $pl->{data} } > 2;
-
- # get the first and second key
- my ($first, $second) = keys %{ $pl->{data} };
-
- # now get a couple of extra keys, to mess with the hash iterator
- my $i = 0;
- for (keys %{ $pl->{data} } ) {
- last if $i++;
- }
-
- # finally, see if it really can get the first key again
- is( ExtUtils::Packlist::FIRSTKEY($pl), $first,
- 'FIRSTKEY() should be consistent' );
-
- is( ExtUtils::Packlist::NEXTKEY($pl), $second,
- 'and NEXTKEY() should also be consistent' );
-}
-
-
-ok( ExtUtils::Packlist::EXISTS($pl, 'bar'), 'EXISTS() should find keys' );
-
-
-ExtUtils::Packlist::DELETE($pl, 'bar');
-ok( !(exists $pl->{data}{bar}), 'DELETE() should delete cleanly' );
-
-
-ExtUtils::Packlist::CLEAR($pl);
-is( keys %{ $pl->{data} }, 0, 'CLEAR() should wipe out data' );
-
-
-# DESTROY does nothing...
-can_ok( 'ExtUtils::Packlist', 'DESTROY' );
-
-
-# write is a little more complicated
-eval { ExtUtils::Packlist::write({}) };
-like( $@, qr/No packlist filename/, 'write() should croak without packfile' );
-
-eval { ExtUtils::Packlist::write({}, 'eplist') };
-my $file_is_ready = $@ ? 0 : 1;
-ok( $file_is_ready, 'write() can write a file' );
-
-local *IN;
-
-SKIP: {
- skip('cannot write files, some tests difficult', 3) unless $file_is_ready;
-
- # set this file to read-only
- chmod 0444, 'eplist';
-
- SKIP: {
- skip("cannot write readonly files", 1) if -w 'eplist';
-
- eval { ExtUtils::Packlist::write({}, 'eplist') };
- like( $@, qr/Can't open file/, 'write() should croak on open failure' );
- }
-
- #'now set it back (tick here fixes vim syntax highlighting ;)
- chmod 0777, 'eplist';
-
- # and some test data to be read
- $pl->{data} = {
- single => 1,
- hash => {
- foo => 'bar',
- baz => 'bup',
- },
- '/./abc' => '',
- };
- eval { ExtUtils::Packlist::write($pl, 'eplist') };
- is( $@, '', 'write() should normally succeed' );
- is( $pl->{packfile}, 'eplist', 'write() should set packfile name' );
-
- $file_is_ready = open(IN, 'eplist');
-}
-
-
-eval { ExtUtils::Packlist::read({}) };
-like( $@, qr/^No packlist filename/, 'read() should croak without packfile' );
-
-
-eval { ExtUtils::Packlist::read({}, 'abadfilename') };
-like( $@, qr/^Can't open file/, 'read() should croak with bad packfile name' );
-#'open packfile for reading
-
-
-# and more read() tests
-SKIP: {
- skip("cannot open file for reading: $!", 5) unless $file_is_ready;
- my $file = do { local $/ = <IN> };
-
- like( $file, qr/single\n/, 'key with value should be available' );
- like( $file, qr!/\./abc\n!, 'key with no value should also be present' );
- like( $file, qr/hash.+baz=bup/, 'key with hash value should be present' );
- like( $file, qr/hash.+foo=bar/, 'second embedded hash value should appear');
- close IN;
-
- eval{ ExtUtils::Packlist::read($pl, 'eplist') };
- is( $@, '', 'read() should normally succeed' );
- is( $pl->{data}{single}, undef, 'single keys should have undef value' );
- is( ref($pl->{data}{hash}), 'HASH', 'multivalue keys should become hashes');
-
- is( $pl->{data}{hash}{foo}, 'bar', 'hash values should be set' );
- ok( exists $pl->{data}{'/abc'}, 'read() should resolve /./ to / in keys' );
-
- # give validate a valid and an invalid file to find
- $pl->{data} = {
- eplist => 1,
- fake => undef,
- };
-
- is( ExtUtils::Packlist::validate($pl), 1,
- 'validate() should find missing files' );
- ExtUtils::Packlist::validate($pl, 1);
- ok( !exists $pl->{data}{fake},
- 'validate() should remove missing files when prompted' );
-
- # one more new() test, to see if it calls read() successfully
- $pl = ExtUtils::Packlist->new('eplist');
-}
-
-
-# packlist_file, $pl should be set from write test
-is( ExtUtils::Packlist::packlist_file({ packfile => 'pl' }), 'pl',
- 'packlist_file() should fetch packlist from passed hash' );
-is( ExtUtils::Packlist::packlist_file($pl), 'eplist',
- 'packlist_file() should fetch packlist from ExtUtils::Packlist object' );
-
-END {
- 1 while unlink qw( eplist );
-}
diff --git a/lib/ExtUtils/t/can_write_dir.t b/lib/ExtUtils/t/can_write_dir.t
deleted file mode 100644
index be6fb1896d..0000000000
--- a/lib/ExtUtils/t/can_write_dir.t
+++ /dev/null
@@ -1,61 +0,0 @@
-#!/usr/bin/perl -w
-
-# Test the private _can_write_dir() function.
-
-use strict;
-use ExtUtils::Install;
-use File::Spec;
-{ package FS; our @ISA = qw(File::Spec); }
-
-# Alias it for easier access
-*can_write_dir = \&ExtUtils::Install::_can_write_dir;
-
-use Test::More 'no_plan';
-
-
-my $dne = FS->catdir(qw(does not exist));
-ok ! -e $dne;
-is_deeply [can_write_dir($dne)],
- [1,
- FS->curdir,
- FS->catdir('does'),
- FS->catdir('does', 'not'),
- FS->catdir('does', 'not', 'exist')
- ];
-
-
-my $abs_dne = FS->rel2abs($dne);
-ok ! -e $abs_dne;
-is_deeply [can_write_dir($abs_dne)],
- [1,
- FS->rel2abs(FS->curdir),
- FS->rel2abs(FS->catdir('does')),
- FS->rel2abs(FS->catdir('does', 'not')),
- FS->rel2abs(FS->catdir('does', 'not', 'exist')),
- ];
-
-SKIP: {
- my $exists = FS->catdir(qw(exists));
- my $subdir = FS->catdir(qw(exists subdir));
-
-
- ok mkdir $exists;
- END { rmdir $exists }
-
- ok chmod 0555, $exists, 'make read only';
-
- skip "Current user or OS cannot create directories that they cannot read", 6
- if -w $exists; # these tests require a directory we cant read
-
- is_deeply [can_write_dir($exists)], [0, $exists];
- is_deeply [can_write_dir($subdir)], [0, $exists, $subdir];
-
- ok chmod 0777, $exists, 'make writable';
- ok -w $exists;
- is_deeply [can_write_dir($exists)], [1, $exists];
- is_deeply [can_write_dir($subdir)],
- [1,
- $exists,
- $subdir
- ];
-} \ No newline at end of file
View Lorry Controller Status