1 package ExtUtils::Install;
4 use vars qw(@ISA @EXPORT $VERSION $MUST_REBOOT %Config);
8 use Config qw(%Config);
11 use ExtUtils::Packlist;
12 use File::Basename qw(dirname);
13 use File::Compare qw(compare);
15 use File::Find qw(find);
21 @EXPORT = ('install','uninstall','pm_to_blib', 'install_default');
27 ExtUtils::Install - install files from here to there
31 use ExtUtils::Install;
33 install({ 'blib/lib' => 'some/install/dir' } );
37 pm_to_blib({ 'lib/Foo/Bar.pm' => 'blib/lib/Foo/Bar.pm' });
46 $VERSION = eval $VERSION;
52 Handles the installing and uninstalling of perl modules, scripts, man
55 Both install() and uninstall() are specific to the way
56 ExtUtils::MakeMaker handles the installation and deinstallation of
57 perl modules. They are not designed as general purpose tools.
59 On some operating systems such as Win32 installation may not be possible
60 until after a reboot has occured. This can have varying consequences:
61 removing an old DLL does not impact programs using the new one, but if
62 a new DLL cannot be installed properly until reboot then anything
63 depending on it must wait. The package variable
65 $ExtUtils::Install::MUST_REBOOT
67 is used to store this status.
69 If this variable is true then such an operation has occured and
70 anything depending on this module cannot proceed until a reboot
73 If this value is defined but false then such an operation has
74 ocurred, but should not impact later operations.
80 Wrapper to chmod() for debugging and error trapping.
84 Warns about something only once.
88 Dies with a special message.
94 my $Is_VMS = $^O eq 'VMS';
95 my $Is_VMS_noefs = $Is_VMS;
96 my $Is_MacPerl = $^O eq 'MacOS';
97 my $Is_Win32 = $^O eq 'MSWin32';
98 my $Is_cygwin = $^O eq 'cygwin';
99 my $CanMoveAtBoot = ($Is_Win32 || $Is_cygwin);
106 if (eval { local $SIG{__DIE__}; require VMS::Feature; }) {
107 $vms_unix_rpt = VMS::Feature::current("filename_unix_report");
108 $vms_efs = VMS::Feature::current("efs_charset");
109 $vms_case = VMS::Feature::current("efs_case_preserve");
111 my $unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';
112 my $efs_charset = $ENV{'DECC$EFS_CHARSET'} || '';
113 my $efs_case = $ENV{'DECC$EFS_CASE_PRESERVE'} || '';
114 $vms_unix_rpt = $unix_rpt =~ /^[ET1]/i;
115 $vms_efs = $efs_charset =~ /^[ET1]/i;
116 $vms_case = $efs_case =~ /^[ET1]/i;
118 $Is_VMS_noefs = 0 if ($vms_efs);
123 # *note* CanMoveAtBoot is only incidentally the same condition as below
124 # this needs not hold true in the future.
125 my $Has_Win32API_File = ($Is_Win32 || $Is_cygwin)
126 ? (eval {require Win32API::File; 1} || 0)
130 my $Inc_uninstall_warn_handler;
132 # install relative to here
134 my $INSTALL_ROOT = $ENV{PERL_INSTALL_ROOT};
136 my $Curdir = File::Spec->curdir;
137 my $Updir = File::Spec->updir;
140 return join "\n",'!' x 72,@_,'!' x 72,'';
146 my $msg=_estr "WARNING: $first",@_;
147 warn $msg unless $warned{$msg}++;
152 my $msg=_estr "ERROR: $first",@_;
158 my ( $mode, $item, $verbose )=@_;
160 if (chmod $mode, $item) {
161 print "chmod($mode, $item)\n" if $verbose > 1;
164 _warnonce "WARNING: Failed chmod($mode, $item): $err\n"
171 =item _move_file_at_boot( $file, $target, $moan )
173 OS-Specific, Win32/Cygwin
175 Schedules a file to be moved/renamed/deleted at next boot.
176 $file should be a filespec of an existing file
177 $target should be a ref to an array if the file is to be deleted
178 otherwise it should be a filespec for a rename. If the file is existing
181 Sets $MUST_REBOOT to 0 to indicate a deletion operation has occured
182 and sets it to 1 to indicate that a move operation has been requested.
184 returns 1 on success, on failure if $moan is false errors are fatal.
185 If $moan is true then returns 0 on error and warns instead of dies.
193 sub _move_file_at_boot { #XXX OS-SPECIFIC
194 my ( $file, $target, $moan )= @_;
195 Carp::confess("Panic: Can't _move_file_at_boot on this platform!")
196 unless $CanMoveAtBoot;
198 my $descr= ref $target
199 ? "'$file' for deletion"
200 : "'$file' for installation as '$target'";
202 if ( ! $Has_Win32API_File ) {
205 "Cannot schedule $descr at reboot.",
206 "Try installing Win32API::File to allow operations on locked files",
207 "to be scheduled during reboot. Or try to perform the operation by",
208 "hand yourself. (You may need to close other perl processes first)"
210 if ( $moan ) { _warnonce(@msg) } else { _choke(@msg) }
213 my $opts= Win32API::File::MOVEFILE_DELAY_UNTIL_REBOOT();
214 $opts= $opts | Win32API::File::MOVEFILE_REPLACE_EXISTING()
217 _chmod( 0666, $file );
218 _chmod( 0666, $target ) unless ref $target;
220 if (Win32API::File::MoveFileEx( $file, $target, $opts )) {
221 $MUST_REBOOT ||= ref $target ? 0 : 1;
225 "MoveFileEx $descr at reboot failed: $^E",
226 "You may try to perform the operation by hand yourself. ",
227 "(You may need to close other perl processes first).",
229 if ( $moan ) { _warnonce(@msg) } else { _choke(@msg) }
237 =item _unlink_or_rename( $file, $tryhard, $installing )
239 OS-Specific, Win32/Cygwin
241 Tries to get a file out of the way by unlinking it or renaming it. On
242 some OS'es (Win32 based) DLL files can end up locked such that they can
243 be renamed but not deleted. Likewise sometimes a file can be locked such
244 that it cant even be renamed or changed except at reboot. To handle
245 these cases this routine finds a tempfile name that it can either rename
246 the file out of the way or use as a proxy for the install so that the
247 rename can happen later (at reboot).
249 $file : the file to remove.
250 $tryhard : should advanced tricks be used for deletion
251 $installing : we are not merely deleting but we want to overwrite
253 When $tryhard is not true if the unlink fails its fatal. When $tryhard
254 is true then the file is attempted to be renamed. The renamed file is
255 then scheduled for deletion. If the rename fails then $installing
256 governs what happens. If it is false the failure is fatal. If it is true
257 then an attempt is made to schedule installation at boot using a
258 temporary file to hold the new file. If this fails then a fatal error is
259 thrown, if it succeeds it returns the temporary file name (which will be
260 a derivative of the original in the same directory) so that the caller can
261 use it to install under. In all other cases of success returns $file.
262 On failure throws a fatal error.
270 sub _unlink_or_rename { #XXX OS-SPECIFIC
271 my ( $file, $tryhard, $installing )= @_;
273 _chmod( 0666, $file );
274 my $unlink_count = 0;
275 while (unlink $file) { $unlink_count++; }
276 return $file if $unlink_count > 0;
279 _choke("Cannot unlink '$file': $!")
280 unless $CanMoveAtBoot && $tryhard;
283 ++$tmp while -e "$file.$tmp";
286 warn "WARNING: Unable to unlink '$file': $error\n",
287 "Going to try to rename it to '$tmp'.\n";
289 if ( rename $file, $tmp ) {
290 warn "Rename succesful. Scheduling '$tmp'\nfor deletion at reboot.\n";
291 # when $installing we can set $moan to true.
292 # IOW, if we cant delete the renamed file at reboot its
293 # not the end of the world. The other cases are more serious
294 # and need to be fatal.
295 _move_file_at_boot( $tmp, [], $installing );
297 } elsif ( $installing ) {
298 _warnonce("Rename failed: $!. Scheduling '$tmp'\nfor".
299 " installation as '$file' at reboot.\n");
300 _move_file_at_boot( $tmp, $file );
303 _choke("Rename failed:$!", "Cannot procede.");
315 =item _get_install_skip
317 Handles loading the INSTALL.SKIP file. Returns an array of patterns to use.
323 sub _get_install_skip {
324 my ( $skip, $verbose )= @_;
325 if ($ENV{EU_INSTALL_IGNORE_SKIP}) {
326 print "EU_INSTALL_IGNORE_SKIP is set, ignore skipfile settings\n"
330 if ( ! defined $skip ) {
331 print "Looking for install skip list\n"
333 for my $file ( 'INSTALL.SKIP', $ENV{EU_INSTALL_SITE_SKIPFILE} ) {
335 print "\tChecking for $file\n"
343 if ($skip && !ref $skip) {
344 print "Reading skip patterns from '$skip'.\n"
346 if (open my $fh,$skip ) {
350 next if /^\s*(?:#|$)/;
351 print "\tSkip pattern: $_\n" if $verbose>3;
356 warn "Can't read skip file:'$skip':$!\n";
359 } elsif ( UNIVERSAL::isa($skip,'ARRAY') ) {
360 print "Using array for skip list\n"
363 print "No skip list found.\n"
367 warn "Got @{[0+@$skip]} skip patterns.\n"
374 =item _have_write_access
376 Abstract a -w check that tries to use POSIX::access() if possible.
382 sub _have_write_access {
384 unless (defined $has_posix) {
385 $has_posix= (!$Is_cygwin && !$Is_Win32
386 && eval 'local $^W; require POSIX; 1') || 0;
389 return POSIX::access($dir, POSIX::W_OK());
398 =item _can_write_dir(C<$dir>)
400 Checks whether a given directory is writable, taking account
401 the possibility that the directory might not exist and would have to
404 Returns a list, containing: C<($writable, $determined_by, @create)>
406 C<$writable> says whether whether the directory is (hypothetically) writable
408 C<$determined_by> is the directory the status was determined from. It will be
409 either the C<$dir>, or one of its parents.
411 C<@create> is a list of directories that would probably have to be created
412 to make the requested directory. It may not actually be correct on
413 relative paths with C<..> in them. But for our purposes it should work ok
421 unless defined $dir and length $dir;
423 my ($vol, $dirs, $file) = File::Spec->splitpath($dir,1);
424 my @dirs = File::Spec->splitdir($dirs);
425 unshift @dirs, File::Spec->curdir
426 unless File::Spec->file_name_is_absolute($dir);
432 # There is a bug in catdir that is fixed when the EFS character
433 # set is enabled, which requires this VMS specific code.
434 $dir = File::Spec->catdir($vol,@dirs);
437 $dir = File::Spec->catdir(@dirs);
438 $dir = File::Spec->catpath($vol,$dir,'')
439 if defined $vol and length $vol;
441 next if ( $dir eq $path );
446 if ( _have_write_access($dir) ) {
459 =item _mkpath($dir,$show,$mode,$verbose,$dry_run)
461 Wrapper around File::Path::mkpath() to handle errors.
463 If $verbose is true and >1 then additional diagnostics will be produced, also
464 this will force $show to true.
466 If $dry_run is true then the directory will not be created but a check will be
467 made to see whether it would be possible to write to the directory, or that
468 it would be possible to create the directory.
470 If $dry_run is not true dies if the directory can not be created or is not
476 my ($dir,$show,$mode,$verbose,$dry_run)=@_;
477 if ( $verbose && $verbose > 1 && ! -d $dir) {
479 printf "mkpath(%s,%d,%#o)\n", $dir, $show, $mode;
482 if ( ! eval { File::Path::mkpath($dir,$show,$mode); 1 } ) {
483 _choke("Can't create '$dir'","$@");
487 my ($can,$root,@make)=_can_write_dir($dir);
490 "Can't create '$dir'",
491 $root ? "Do not have write permissions on '$root'"
499 } elsif ($show and $dry_run) {
500 print "$_\n" for @make;
507 =item _copy($from,$to,$verbose,$dry_run)
509 Wrapper around File::Copy::copy to handle errors.
511 If $verbose is true and >1 then additional dignostics will be emitted.
513 If $dry_run is true then the copy will not actually occur.
515 Dies if the copy fails.
521 my ( $from, $to, $verbose, $dry_run)=@_;
522 if ($verbose && $verbose>1) {
523 printf "copy(%s,%s)\n", $from, $to;
526 File::Copy::copy($from,$to)
527 or Carp::croak( _estr "ERROR: Cannot copy '$from' to '$to': $!" );
535 Wrapper around chdir to catch errors.
537 If not called in void context returns the cwd from before the chdir.
546 if (defined wantarray) {
550 or _choke("Couldn't chdir to '$dir': $!");
564 install(\%from_to, $verbose, $dry_run, $uninstall_shadows,
565 $skip, $always_copy, \%result);
567 # recommended form as of 1.47
569 from_to => \%from_to,
572 uninstall_shadows => 1,
575 result => \%install_results,
579 Copies each directory tree of %from_to to its corresponding value
580 preserving timestamps and permissions.
582 There are two keys with a special meaning in the hash: "read" and
583 "write". These contain packlist files. After the copying is done,
584 install() will write the list of target files to $from_to{write}. If
585 $from_to{read} is given the contents of this file will be merged into
586 the written file. The read and the written file may be identical, but
587 on AFS it is quite likely that people are installing to a different
588 directory than the one where the files later appear.
590 If $verbose is true, will print out each file removed. Default is
591 false. This is "make install VERBINST=1". $verbose values going
592 up to 5 show increasingly more diagnostics output.
594 If $dry_run is true it will only print what it was going to do
595 without actually doing it. Default is false.
597 If $uninstall_shadows is true any differing versions throughout @INC
598 will be uninstalled. This is "make install UNINST=1"
600 As of 1.37_02 install() supports the use of a list of patterns to filter out
601 files that shouldn't be installed. If $skip is omitted or undefined then
602 install will try to read the list from INSTALL.SKIP in the CWD. This file is
603 a list of regular expressions and is just like the MANIFEST.SKIP file used
604 by L<ExtUtils::Manifest>.
606 A default site INSTALL.SKIP may be provided by setting then environment
607 variable EU_INSTALL_SITE_SKIPFILE, this will only be used when there isn't a
608 distribution specific INSTALL.SKIP. If the environment variable
609 EU_INSTALL_IGNORE_SKIP is true then no install file filtering will be
612 If $skip is undefined then the skip file will be autodetected and used if it
613 is found. If $skip is a reference to an array then it is assumed the array
614 contains the list of patterns, if $skip is a true non reference it is
615 assumed to be the filename holding the list of patterns, any other value of
616 $skip is taken to mean that no install filtering should occur.
618 B<Changes As of Version 1.47>
620 As of version 1.47 the following additions were made to the install interface.
621 Note that the new argument style and use of the %result hash is recommended.
623 The $always_copy parameter which when true causes files to be updated
624 regardles as to whether they have changed, if it is defined but false then
625 copies are made only if the files have changed, if it is undefined then the
626 value of the environment variable EU_INSTALL_ALWAYS_COPY is used as default.
628 The %result hash will be populated with the various keys/subhashes reflecting
629 the install. Currently these keys and their structure are:
631 install => { $target => $source },
632 install_fail => { $target => $source },
633 install_unchanged => { $target => $source },
635 install_filtered => { $source => $pattern },
637 uninstall => { $uninstalled => $source },
638 uninstall_fail => { $uninstalled => $source },
640 where C<$source> is the filespec of the file being installed. C<$target> is where
641 it is being installed to, and C<$uninstalled> is any shadow file that is in C<@INC>
642 or C<$ENV{PERL5LIB}> or other standard locations, and C<$pattern> is the pattern that
643 caused a source file to be skipped. In future more keys will be added, such as to
644 show created directories, however this requires changes in other modules and must
647 These keys will be populated before any exceptions are thrown should there be an
650 Note that all updates of the %result are additive, the hash will not be
651 cleared before use, thus allowing status results of many installs to be easily
654 B<NEW ARGUMENT STYLE>
656 If there is only one argument and it is a reference to an array then
657 the array is assumed to contain a list of key-value pairs specifying
658 the options. In this case the option "from_to" is mandatory. This style
659 means that you dont have to supply a cryptic list of arguments and can
660 use a self documenting argument list that is easier to understand.
662 This is now the recommended interface to install().
666 If all actions were successful install will return a hashref of the results
667 as described above for the $result parameter. If any action is a failure
668 then install will die, therefore it is recommended to pass in the $result
669 parameter instead of using the return value. If the result parameter is
670 provided then the returned hashref will be the passed in hashref.
674 sub install { #XXX OS-SPECIFIC
675 my($from_to,$verbose,$dry_run,$uninstall_shadows,$skip,$always_copy,$result) = @_;
676 if (@_==1 and eval { 1+@$from_to }) {
677 my %opts = @$from_to;
678 $from_to = $opts{from_to}
679 or Carp::confess("from_to is a mandatory parameter");
680 $verbose = $opts{verbose};
681 $dry_run = $opts{dry_run};
682 $uninstall_shadows = $opts{uninstall_shadows};
684 $always_copy = $opts{always_copy};
685 $result = $opts{result};
692 $skip= _get_install_skip($skip,$verbose);
693 $always_copy = $ENV{EU_INSTALL_ALWAYS_COPY}
694 || $ENV{EU_ALWAYS_COPY}
696 unless defined $always_copy;
698 my(%from_to) = %$from_to;
699 my(%pack, $dir, %warned);
700 my($packlist) = ExtUtils::Packlist->new();
703 for (qw/read write/) {
704 $pack{$_}=$from_to{$_};
707 my $tmpfile = install_rooted_file($pack{"read"});
708 $packlist->read($tmpfile) if (-f $tmpfile);
713 MOD_INSTALL: foreach my $source (sort keys %from_to) {
714 #copy the tree to the target directory without altering
715 #timestamp and permission and remember for the .packlist
716 #file. The packlist file contains the absolute paths of the
717 #install locations. AFS users may call this a bug. We'll have
718 #to reconsider how to add the means to satisfy AFS users also.
720 #October 1997: we want to install .pm files into archlib if
721 #there are any files in arch. So we depend on having ./blib/arch
724 my $targetroot = install_rooted_dir($from_to{$source});
726 my $blib_lib = File::Spec->catdir('blib', 'lib');
727 my $blib_arch = File::Spec->catdir('blib', 'arch');
728 if ($source eq $blib_lib and
729 exists $from_to{$blib_arch} and
730 directory_not_empty($blib_arch)
732 $targetroot = install_rooted_dir($from_to{$blib_arch});
733 print "Files found in $blib_arch: installing files in $blib_lib into architecture dependent library tree\n";
736 next unless -d $source;
738 # 5.5.3's File::Find missing no_chdir option
740 # File::Find seems to always be Unixy except on MacPerl :(
741 my $current_directory= $Is_MacPerl ? $Curdir : '.';
743 my ($mode,$size,$atime,$mtime) = (stat)[2,7,8,9];
748 return if $origfile eq ".exists";
749 my $targetdir = File::Spec->catdir($targetroot, $File::Find::dir);
750 my $targetfile = File::Spec->catfile($targetdir, $origfile);
751 my $sourcedir = File::Spec->catdir($source, $File::Find::dir);
752 my $sourcefile = File::Spec->catfile($sourcedir, $origfile);
754 for my $pat (@$skip) {
755 if ( $sourcefile=~/$pat/ ) {
756 print "Skipping $targetfile (filtered)\n"
758 $result->{install_filtered}{$sourcefile} = $pat;
762 # we have to do this for back compat with old File::Finds
763 # and because the target is relative
764 my $save_cwd = _chdir($cwd);
766 # XXX: I wonder how useful this logic is actually -- demerphq
767 if ( $always_copy or !-f $targetfile or -s $targetfile != $size) {
770 # we might not need to copy this file
771 $diff = compare($sourcefile, $targetfile);
773 $check_dirs{$targetdir}++
774 unless -w $targetfile;
777 [ $diff, $File::Find::dir, $origfile,
778 $mode, $size, $atime, $mtime,
779 $targetdir, $targetfile, $sourcedir, $sourcefile,
782 #restore the original directory we were in when File::Find
783 #called us so that it doesnt get horribly confused.
785 }, $current_directory );
788 foreach my $targetdir (sort keys %check_dirs) {
789 _mkpath( $targetdir, 0, 0755, $verbose, $dry_run );
791 foreach my $found (@found_files) {
792 my ($diff, $ffd, $origfile, $mode, $size, $atime, $mtime,
793 $targetdir, $targetfile, $sourcedir, $sourcefile)= @$found;
795 my $realtarget= $targetfile;
798 if (-f $targetfile) {
799 print "_unlink_or_rename($targetfile)\n" if $verbose>1;
800 $targetfile= _unlink_or_rename( $targetfile, 'tryhard', 'install' )
802 } elsif ( ! -d $targetdir ) {
803 _mkpath( $targetdir, 0, 0755, $verbose, $dry_run );
805 print "Installing $targetfile\n";
807 _copy( $sourcefile, $targetfile, $verbose, $dry_run, );
811 print "utime($atime,$mtime,$targetfile)\n" if $verbose>1;
812 utime($atime,$mtime + $Is_VMS,$targetfile) unless $dry_run>1;
815 $mode = 0444 | ( $mode & 0111 ? 0111 : 0 );
817 if $realtarget ne $targetfile;
818 _chmod( $mode, $targetfile, $verbose );
819 $result->{install}{$targetfile} = $sourcefile;
822 $result->{install_fail}{$targetfile} = $sourcefile;
826 $result->{install_unchanged}{$targetfile} = $sourcefile;
827 print "Skipping $targetfile (unchanged)\n" if $verbose;
830 if ( $uninstall_shadows ) {
831 inc_uninstall($sourcefile,$ffd, $verbose,
833 $realtarget ne $targetfile ? $realtarget : "",
837 # Record the full pathname.
838 $packlist->{$targetfile}++;
841 if ($pack{'write'}) {
842 $dir = install_rooted_dir(dirname($pack{'write'}));
843 _mkpath( $dir, 0, 0755, $verbose, $dry_run );
844 print "Writing $pack{'write'}\n" if $verbose;
845 $packlist->write(install_rooted_file($pack{'write'})) unless $dry_run;
848 _do_cleanup($verbose);
856 Standardize finish event for after another instruction has occured.
857 Handles converting $MUST_REBOOT to a die for instance.
866 die _estr "Operation not completed! ",
867 "You must reboot to complete the installation.",
869 } elsif (defined $MUST_REBOOT & $verbose) {
870 warn _estr "Installation will be completed at the next reboot.\n",
871 "However it is not necessary to reboot immediately.\n";
877 =item install_rooted_file( $file )
879 Returns $file, or catfile($INSTALL_ROOT,$file) if $INSTALL_ROOT
882 =item install_rooted_dir( $dir )
884 Returns $dir, or catdir($INSTALL_ROOT,$dir) if $INSTALL_ROOT
892 sub install_rooted_file {
893 if (defined $INSTALL_ROOT) {
894 File::Spec->catfile($INSTALL_ROOT, $_[0]);
901 sub install_rooted_dir {
902 if (defined $INSTALL_ROOT) {
903 File::Spec->catdir($INSTALL_ROOT, $_[0]);
911 =item forceunlink( $file, $tryhard )
913 Tries to delete a file. If $tryhard is true then we will use whatever
914 devious tricks we can to delete the file. Currently this only applies to
915 Win32 in that it will try to use Win32API::File to schedule a delete at
916 reboot. A wrapper for _unlink_or_rename().
924 my ( $file, $tryhard )= @_; #XXX OS-SPECIFIC
925 _unlink_or_rename( $file, $tryhard, not("installing") );
930 =item directory_not_empty( $dir )
932 Returns 1 if there is an .exists file somewhere in a directory tree.
933 Returns 0 if there is not.
939 sub directory_not_empty ($) {
943 return if $_ eq ".exists";
945 $File::Find::prune++;
954 =item B<install_default> I<DISCOURAGED>
957 install_default($fullext);
959 Calls install() with arguments to copy a module from blib/ to the
960 default site installation location.
962 $fullext is the name of the module converted to a directory
963 (ie. Foo::Bar would be Foo/Bar). If $fullext is not specified, it
964 will attempt to read it from @ARGV.
966 This is primarily useful for install scripts.
968 B<NOTE> This function is not really useful because of the hard-coded
969 install location with no way to control site vs core vs vendor
970 directories and the strange way in which the module name is given.
971 Consider its use discouraged.
975 sub install_default {
976 @_ < 2 or Carp::croak("install_default should be called with 0 or 1 argument");
977 my $FULLEXT = @_ ? shift : $ARGV[0];
978 defined $FULLEXT or die "Do not know to where to write install log";
979 my $INST_LIB = File::Spec->catdir($Curdir,"blib","lib");
980 my $INST_ARCHLIB = File::Spec->catdir($Curdir,"blib","arch");
981 my $INST_BIN = File::Spec->catdir($Curdir,'blib','bin');
982 my $INST_SCRIPT = File::Spec->catdir($Curdir,'blib','script');
983 my $INST_MAN1DIR = File::Spec->catdir($Curdir,'blib','man1');
984 my $INST_MAN3DIR = File::Spec->catdir($Curdir,'blib','man3');
987 if($Config{installhtmldir}) {
988 my $INST_HTMLDIR = File::Spec->catdir($Curdir,'blib','html');
989 @INST_HTML = ($INST_HTMLDIR => $Config{installhtmldir});
993 read => "$Config{sitearchexp}/auto/$FULLEXT/.packlist",
994 write => "$Config{installsitearch}/auto/$FULLEXT/.packlist",
995 $INST_LIB => (directory_not_empty($INST_ARCHLIB)) ?
996 $Config{installsitearch} :
997 $Config{installsitelib},
998 $INST_ARCHLIB => $Config{installsitearch},
999 $INST_BIN => $Config{installbin} ,
1000 $INST_SCRIPT => $Config{installscript},
1001 $INST_MAN1DIR => $Config{installman1dir},
1002 $INST_MAN3DIR => $Config{installman3dir},
1010 uninstall($packlist_file);
1011 uninstall($packlist_file, $verbose, $dont_execute);
1013 Removes the files listed in a $packlist_file.
1015 If $verbose is true, will print out each file removed. Default is
1018 If $dont_execute is true it will only print what it was going to do
1019 without actually doing it. Default is false.
1024 my($fil,$verbose,$dry_run) = @_;
1028 die _estr "ERROR: no packlist file found: '$fil'"
1030 # my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
1031 # require $my_req; # Hairy, but for the first
1032 my ($packlist) = ExtUtils::Packlist->new($fil);
1033 foreach (sort(keys(%$packlist))) {
1035 print "unlink $_\n" if $verbose;
1036 forceunlink($_,'tryhard') unless $dry_run;
1038 print "unlink $fil\n" if $verbose;
1039 forceunlink($fil, 'tryhard') unless $dry_run;
1040 _do_cleanup($verbose);
1043 =begin _undocumented
1045 =item inc_uninstall($filepath,$libdir,$verbose,$dry_run,$ignore,$results)
1047 Remove shadowed files. If $ignore is true then it is assumed to hold
1048 a filename to ignore. This is used to prevent spurious warnings from
1049 occuring when doing an install at reboot.
1051 We now only die when failing to remove a file that has precedence over
1052 our own, when our install has precedence we only warn.
1054 $results is assumed to contain a hashref which will have the keys
1055 'uninstall' and 'uninstall_fail' populated with keys for the files
1056 removed and values of the source files they would shadow.
1063 my($filepath,$libdir,$verbose,$dry_run,$ignore,$results) = @_;
1066 my $file = (File::Spec->splitpath($filepath))[2];
1069 my @PERL_ENV_LIB = split $Config{path_sep}, defined $ENV{'PERL5LIB'}
1070 ? $ENV{'PERL5LIB'} : $ENV{'PERLLIB'} || '';
1072 my @dirs=( @PERL_ENV_LIB,
1074 @Config{qw(archlibexp
1079 #warn join "\n","---",@dirs,"---";
1081 foreach $dir ( @dirs ) {
1082 my $canonpath = $Is_VMS ? $dir : File::Spec->canonpath($dir);
1083 next if $canonpath eq $Curdir;
1084 next if $seen_dir{$canonpath}++;
1085 my $targetfile = File::Spec->catfile($canonpath,$libdir,$file);
1086 next unless -f $targetfile;
1088 # The reason why we compare file's contents is, that we cannot
1089 # know, which is the file we just installed (AFS). So we leave
1090 # an identical file in place
1092 if ( -f $targetfile && -s _ == -s $filepath) {
1093 # We have a good chance, we can skip this one
1094 $diff = compare($filepath,$targetfile);
1098 print "#$file and $targetfile differ\n" if $diff && $verbose > 1;
1100 if (!$diff or $targetfile eq $ignore) {
1105 $results->{uninstall}{$targetfile} = $filepath;
1107 $Inc_uninstall_warn_handler ||= ExtUtils::Install::Warn->new();
1108 $libdir =~ s|^\./||s ; # That's just cosmetics, no need to port. It looks prettier.
1109 $Inc_uninstall_warn_handler->add(
1110 File::Spec->catfile($libdir, $file),
1114 # if not verbose, we just say nothing
1116 print "Unlinking $targetfile (shadowing?)\n" if $verbose;
1118 die "Fake die for testing"
1119 if $ExtUtils::Install::Testing and
1120 ucase(File::Spec->canonpath($ExtUtils::Install::Testing)) eq ucase($targetfile);
1121 forceunlink($targetfile,'tryhard');
1122 $results->{uninstall}{$targetfile} = $filepath;
1125 $results->{fail_uninstall}{$targetfile} = $filepath;
1127 warn "Failed to remove probably harmless shadow file '$targetfile'\n";
1136 =begin _undocumented
1138 =item run_filter($cmd,$src,$dest)
1140 Filter $src using $cmd into $dest.
1147 my ($cmd, $src, $dest) = @_;
1149 open(CMD, "|$cmd >$dest") || die "Cannot fork: $!";
1150 open(SRC, $src) || die "Cannot open $src: $!";
1153 while (my $len = sysread(SRC, $buf, $sz)) {
1154 syswrite(CMD, $buf, $len);
1157 close CMD or die "Filter command '$cmd' failed for $src";
1164 pm_to_blib(\%from_to, $autosplit_dir);
1165 pm_to_blib(\%from_to, $autosplit_dir, $filter_cmd);
1167 Copies each key of %from_to to its corresponding value efficiently.
1168 Filenames with the extension .pm are autosplit into the $autosplit_dir.
1169 Any destination directories are created.
1171 $filter_cmd is an optional shell command to run each .pm file through
1172 prior to splitting and copying. Input is the contents of the module,
1173 output the new module contents.
1175 You can have an environment variable PERL_INSTALL_ROOT set which will
1176 be prepended as a directory to each installed file (and directory).
1181 my($fromto,$autodir,$pm_filter) = @_;
1183 _mkpath($autodir,0,0755);
1184 while(my($from, $to) = each %$fromto) {
1185 if( -f $to && -s $from == -s $to && -M $to < -M $from ) {
1186 print "Skip $to (unchanged)\n";
1190 # When a pm_filter is defined, we need to pre-process the source first
1191 # to determine whether it has changed or not. Therefore, only perform
1192 # the comparison check when there's no filter to be ran.
1193 # -- RAM, 03/01/2001
1195 my $need_filtering = defined $pm_filter && length $pm_filter &&
1198 if (!$need_filtering && 0 == compare($from,$to)) {
1199 print "Skip $to (unchanged)\n";
1203 # we wont try hard here. its too likely to mess things up.
1206 _mkpath(dirname($to),0,0755);
1208 if ($need_filtering) {
1209 run_filter($pm_filter, $from, $to);
1210 print "$pm_filter <$from >$to\n";
1212 _copy( $from, $to );
1213 print "cp $from $to\n";
1215 my($mode,$atime,$mtime) = (stat $from)[2,8,9];
1216 utime($atime,$mtime+$Is_VMS,$to);
1217 _chmod(0444 | ( $mode & 0111 ? 0111 : 0 ),$to);
1218 next unless $from =~ /\.pm$/;
1219 _autosplit($to,$autodir);
1228 From 1.0307 back, AutoSplit will sometimes leave an open filehandle to
1229 the file being split. This causes problems on systems with mandatory
1230 locking (ie. Windows). So we wrap it and close the filehandle.
1236 sub _autosplit { #XXX OS-SPECIFIC
1237 my $retval = autosplit(@_);
1238 close *AutoSplit::IN if defined *AutoSplit::IN{IO};
1244 package ExtUtils::Install::Warn;
1246 sub new { bless {}, shift }
1249 my($self,$file,$targetfile) = @_;
1250 push @{$self->{$file}}, $targetfile;
1254 unless(defined $INSTALL_ROOT) {
1256 my($file,$i,$plural);
1257 foreach $file (sort keys %$self) {
1258 $plural = @{$self->{$file}} > 1 ? "s" : "";
1259 print "## Differing version$plural of $file found. You might like to\n";
1260 for (0..$#{$self->{$file}}) {
1261 print "rm ", $self->{$file}[$_], "\n";
1265 $plural = $i>1 ? "all those files" : "this file";
1266 my $inst = (_invokant() eq 'ExtUtils::MakeMaker')
1267 ? ( $Config::Config{make} || 'make' ).' install'
1268 . ( $Is_VMS ? '/MACRO="UNINST"=1' : ' UNINST=1' )
1269 : './Build install uninst=1';
1270 print "## Running '$inst' will unlink $plural for you.\n";
1278 Does a heuristic on the stack to see who called us for more intelligent
1279 error messages. Currently assumes we will be called only by Module::Build
1280 or by ExtUtils::MakeMaker.
1289 while (my $file = (caller($frame++))[1]) {
1290 push @stack, (File::Spec->splitpath($file))[2];
1294 my $top = pop @stack;
1295 if ($top =~ /^Build/i || exists($INC{'Module/Build.pm'})) {
1296 $builder = 'Module::Build';
1298 $builder = 'ExtUtils::MakeMaker';
1311 =item B<PERL_INSTALL_ROOT>
1313 Will be prepended to each install path.
1315 =item B<EU_INSTALL_IGNORE_SKIP>
1317 Will prevent the automatic use of INSTALL.SKIP as the install skip file.
1319 =item B<EU_INSTALL_SITE_SKIPFILE>
1321 If there is no INSTALL.SKIP file in the make directory then this value
1322 can be used to provide a default.
1324 =item B<EU_INSTALL_ALWAYS_COPY>
1326 If this environment variable is true then normal install processes will
1327 always overwrite older identical files during the install process.
1329 Note that the alias EU_ALWAYS_COPY will be supported if EU_INSTALL_ALWAYS_COPY
1330 is not defined until at least the 1.50 release. Please ensure you use the
1331 correct EU_INSTALL_ALWAYS_COPY.
1337 Original author lost in the mists of time. Probably the same as Makemaker.
1339 Production release currently maintained by demerphq C<yves at cpan.org>,
1340 extensive changes by Michael G. Schwern.
1342 Send bug reports via http://rt.cpan.org/. Please send your
1343 generated Makefile along with your report.
1347 This program is free software; you can redistribute it and/or
1348 modify it under the same terms as Perl itself.
1350 See L<http://www.perl.com/perl/misc/Artistic.html>