1 package ExtUtils::Install;
5 use vars qw(@ISA @EXPORT $VERSION $MUST_REBOOT %Config);
7 $VERSION = eval $VERSION;
11 use Config qw(%Config);
14 use ExtUtils::Packlist;
15 use File::Basename qw(dirname);
16 use File::Compare qw(compare);
18 use File::Find qw(find);
24 @EXPORT = ('install','uninstall','pm_to_blib', 'install_default');
28 ExtUtils::Install - install files from here to there
32 use ExtUtils::Install;
34 install({ 'blib/lib' => 'some/install/dir' } );
38 pm_to_blib({ 'lib/Foo/Bar.pm' => 'blib/lib/Foo/Bar.pm' });
42 Handles the installing and uninstalling of perl modules, scripts, man
45 Both install() and uninstall() are specific to the way
46 ExtUtils::MakeMaker handles the installation and deinstallation of
47 perl modules. They are not designed as general purpose tools.
49 On some operating systems such as Win32 installation may not be possible
50 until after a reboot has occured. This can have varying consequences:
51 removing an old DLL does not impact programs using the new one, but if
52 a new DLL cannot be installed properly until reboot then anything
53 depending on it must wait. The package variable
55 $ExtUtils::Install::MUST_REBOOT
57 is used to store this status.
59 If this variable is true then such an operation has occured and
60 anything depending on this module cannot proceed until a reboot
63 If this value is defined but false then such an operation has
64 ocurred, but should not impact later operations.
70 Wrapper to chmod() for debugging and error trapping.
74 Warns about something only once.
78 Dies with a special message.
84 my $Is_VMS = $^O eq 'VMS';
85 my $Is_MacPerl = $^O eq 'MacOS';
86 my $Is_Win32 = $^O eq 'MSWin32';
87 my $Is_cygwin = $^O eq 'cygwin';
88 my $CanMoveAtBoot = ($Is_Win32 || $Is_cygwin);
90 # *note* CanMoveAtBoot is only incidentally the same condition as below
91 # this needs not hold true in the future.
92 my $Has_Win32API_File = ($Is_Win32 || $Is_cygwin)
93 ? (eval {require Win32API::File; 1} || 0)
97 my $Inc_uninstall_warn_handler;
99 # install relative to here
101 my $INSTALL_ROOT = $ENV{PERL_INSTALL_ROOT};
103 my $Curdir = File::Spec->curdir;
104 my $Updir = File::Spec->updir;
107 return join "\n",'!' x 72,@_,'!' x 72,'';
113 my $msg=_estr "WARNING: $first",@_;
114 warn $msg unless $warned{$msg}++;
119 my $msg=_estr "ERROR: $first",@_;
125 my ( $mode, $item, $verbose )=@_;
127 if (chmod $mode, $item) {
128 print "chmod($mode, $item)\n" if $verbose > 1;
131 _warnonce "WARNING: Failed chmod($mode, $item): $err\n"
138 =item _move_file_at_boot( $file, $target, $moan )
140 OS-Specific, Win32/Cygwin
142 Schedules a file to be moved/renamed/deleted at next boot.
143 $file should be a filespec of an existing file
144 $target should be a ref to an array if the file is to be deleted
145 otherwise it should be a filespec for a rename. If the file is existing
148 Sets $MUST_REBOOT to 0 to indicate a deletion operation has occured
149 and sets it to 1 to indicate that a move operation has been requested.
151 returns 1 on success, on failure if $moan is false errors are fatal.
152 If $moan is true then returns 0 on error and warns instead of dies.
160 sub _move_file_at_boot { #XXX OS-SPECIFIC
161 my ( $file, $target, $moan )= @_;
162 Carp::confess("Panic: Can't _move_file_at_boot on this platform!")
163 unless $CanMoveAtBoot;
165 my $descr= ref $target
166 ? "'$file' for deletion"
167 : "'$file' for installation as '$target'";
169 if ( ! $Has_Win32API_File ) {
172 "Cannot schedule $descr at reboot.",
173 "Try installing Win32API::File to allow operations on locked files",
174 "to be scheduled during reboot. Or try to perform the operation by",
175 "hand yourself. (You may need to close other perl processes first)"
177 if ( $moan ) { _warnonce(@msg) } else { _choke(@msg) }
180 my $opts= Win32API::File::MOVEFILE_DELAY_UNTIL_REBOOT();
181 $opts= $opts | Win32API::File::MOVEFILE_REPLACE_EXISTING()
184 _chmod( 0666, $file );
185 _chmod( 0666, $target ) unless ref $target;
187 if (Win32API::File::MoveFileEx( $file, $target, $opts )) {
188 $MUST_REBOOT ||= ref $target ? 0 : 1;
192 "MoveFileEx $descr at reboot failed: $^E",
193 "You may try to perform the operation by hand yourself. ",
194 "(You may need to close other perl processes first).",
196 if ( $moan ) { _warnonce(@msg) } else { _choke(@msg) }
204 =item _unlink_or_rename( $file, $tryhard, $installing )
206 OS-Specific, Win32/Cygwin
208 Tries to get a file out of the way by unlinking it or renaming it. On
209 some OS'es (Win32 based) DLL files can end up locked such that they can
210 be renamed but not deleted. Likewise sometimes a file can be locked such
211 that it cant even be renamed or changed except at reboot. To handle
212 these cases this routine finds a tempfile name that it can either rename
213 the file out of the way or use as a proxy for the install so that the
214 rename can happen later (at reboot).
216 $file : the file to remove.
217 $tryhard : should advanced tricks be used for deletion
218 $installing : we are not merely deleting but we want to overwrite
220 When $tryhard is not true if the unlink fails its fatal. When $tryhard
221 is true then the file is attempted to be renamed. The renamed file is
222 then scheduled for deletion. If the rename fails then $installing
223 governs what happens. If it is false the failure is fatal. If it is true
224 then an attempt is made to schedule installation at boot using a
225 temporary file to hold the new file. If this fails then a fatal error is
226 thrown, if it succeeds it returns the temporary file name (which will be
227 a derivative of the original in the same directory) so that the caller can
228 use it to install under. In all other cases of success returns $file.
229 On failure throws a fatal error.
237 sub _unlink_or_rename { #XXX OS-SPECIFIC
238 my ( $file, $tryhard, $installing )= @_;
240 _chmod( 0666, $file );
245 _choke("Cannot unlink '$file': $!")
246 unless $CanMoveAtBoot && $tryhard;
249 ++$tmp while -e "$file.$tmp";
252 warn "WARNING: Unable to unlink '$file': $error\n",
253 "Going to try to rename it to '$tmp'.\n";
255 if ( rename $file, $tmp ) {
256 warn "Rename succesful. Scheduling '$tmp'\nfor deletion at reboot.\n";
257 # when $installing we can set $moan to true.
258 # IOW, if we cant delete the renamed file at reboot its
259 # not the end of the world. The other cases are more serious
260 # and need to be fatal.
261 _move_file_at_boot( $tmp, [], $installing );
263 } elsif ( $installing ) {
264 _warnonce("Rename failed: $!. Scheduling '$tmp'\nfor".
265 " installation as '$file' at reboot.\n");
266 _move_file_at_boot( $tmp, $file );
269 _choke("Rename failed:$!", "Cannot procede.");
283 install(\%from_to, $verbose, $dont_execute, $uninstall_shadows, $skip);
285 Copies each directory tree of %from_to to its corresponding value
286 preserving timestamps and permissions.
288 There are two keys with a special meaning in the hash: "read" and
289 "write". These contain packlist files. After the copying is done,
290 install() will write the list of target files to $from_to{write}. If
291 $from_to{read} is given the contents of this file will be merged into
292 the written file. The read and the written file may be identical, but
293 on AFS it is quite likely that people are installing to a different
294 directory than the one where the files later appear.
296 If $verbose is true, will print out each file removed. Default is
297 false. This is "make install VERBINST=1". $verbose values going
298 up to 5 show increasingly more diagnostics output.
300 If $dont_execute is true it will only print what it was going to do
301 without actually doing it. Default is false.
303 If $uninstall_shadows is true any differing versions throughout @INC
304 will be uninstalled. This is "make install UNINST=1"
306 As of 1.37_02 install() supports the use of a list of patterns to filter
307 out files that shouldn't be installed. If $skip is omitted or undefined
308 then install will try to read the list from INSTALL.SKIP in the CWD.
309 This file is a list of regular expressions and is just like the
310 MANIFEST.SKIP file used by L<ExtUtils::Manifest>.
312 A default site INSTALL.SKIP may be provided by setting then environment
313 variable EU_INSTALL_SITE_SKIPFILE, this will only be used when there
314 isn't a distribution specific INSTALL.SKIP. If the environment variable
315 EU_INSTALL_IGNORE_SKIP is true then no install file filtering will be
318 If $skip is undefined then the skip file will be autodetected and used if it
319 is found. If $skip is a reference to an array then it is assumed
320 the array contains the list of patterns, if $skip is a true non reference it is
321 assumed to be the filename holding the list of patterns, any other value of
322 $skip is taken to mean that no install filtering should occur.
329 =item _get_install_skip
331 Handles loading the INSTALL.SKIP file. Returns an array of patterns to use.
337 sub _get_install_skip {
338 my ( $skip, $verbose )= @_;
339 if ($ENV{EU_INSTALL_IGNORE_SKIP}) {
340 print "EU_INSTALL_IGNORE_SKIP is set, ignore skipfile settings\n"
344 if ( ! defined $skip ) {
345 print "Looking for install skip list\n"
347 for my $file ( 'INSTALL.SKIP', $ENV{EU_INSTALL_SITE_SKIPFILE} ) {
349 print "\tChecking for $file\n"
357 if ($skip && !ref $skip) {
358 print "Reading skip patterns from '$skip'.\n"
360 if (open my $fh,$skip ) {
364 next if /^\s*(?:#|$)/;
365 print "\tSkip pattern: $_\n" if $verbose>3;
370 warn "Can't read skip file:'$skip':$!\n";
373 } elsif ( UNIVERSAL::isa($skip,'ARRAY') ) {
374 print "Using array for skip list\n"
377 print "No skip list found.\n"
381 warn "Got @{[0+@$skip]} skip patterns.\n"
386 =item _have_write_access
388 Abstract a -w check that tries to use POSIX::access() if possible.
395 sub _have_write_access {
397 if (!defined $has_posix) {
398 $has_posix=eval "require POSIX; 1" || 0;
401 return POSIX::access($dir, POSIX::W_OK());
409 =item _can_write_dir(C<$dir>)
411 Checks whether a given directory is writable, taking account
412 the possibility that the directory might not exist and would have to
415 Returns a list, containing: C<($writable, $determined_by, @create)>
417 C<$writable> says whether whether the directory is (hypothetically) writable
419 C<$determined_by> is the directory the status was determined from. It will be
420 either the C<$dir>, or one of its parents.
422 C<@create> is a list of directories that would probably have to be created
423 to make the requested directory. It may not actually be correct on
424 relative paths with C<..> in them. But for our purposes it should work ok
432 unless defined $dir and length $dir;
434 my @dirs=File::Spec->splitdir(File::Spec->rel2abs($dir));
438 $dir=File::Spec->catdir(@dirs);
439 next if ( $dir eq $path );
444 if ( _have_write_access($dir) ) {
455 =item _mkpath($dir,$show,$mode,$verbose,$fake)
457 Wrapper around File::Path::mkpath() to handle errors.
459 If $verbose is true and >1 then additional diagnostics will be produced, also
460 this will force $show to true.
462 If $fake is true then the directory will not be created but a check will be
463 made to see whether it would be possible to write to the directory, or that
464 it would be possible to create the directory.
466 If $fake is not true dies if the directory can not be created or is not
472 my ($dir,$show,$mode,$verbose,$fake)=@_;
473 if ( $verbose && $verbose > 1 && ! -d $dir) {
475 printf "mkpath(%s,%d,%#o)\n", $dir, $show, $mode;
478 if ( ! eval { File::Path::mkpath($dir,$show,$mode); 1 } ) {
479 _choke("Can't create '$dir'","$@");
483 my ($can,$root,@make)=_can_write_dir($dir);
486 "Can't create '$dir'",
487 $root ? "Do not have write permissions on '$root'"
495 } elsif ($show and $fake) {
496 print "$_\n" for @make;
500 =item _copy($from,$to,$verbose,$fake)
502 Wrapper around File::Copy::copy to handle errors.
504 If $verbose is true and >1 then additional dignostics will be emitted.
506 If $fake is true then the copy will not actually occur.
508 Dies if the copy fails.
514 my ( $from, $to, $verbose, $nonono)=@_;
515 if ($verbose && $verbose>1) {
516 printf "copy(%s,%s)\n", $from, $to;
519 File::Copy::copy($from,$to)
520 or Carp::croak( _estr "ERROR: Cannot copy '$from' to '$to': $!" );
526 Wrapper around chdir to catch errors.
528 If not called in void context returns the cwd from before the chdir.
537 if (defined wantarray) {
541 or _choke("Couldn't chdir to '$dir': $!");
549 sub install { #XXX OS-SPECIFIC
550 my($from_to,$verbose,$nonono,$inc_uninstall,$skip) = @_;
554 $skip= _get_install_skip($skip,$verbose);
556 my(%from_to) = %$from_to;
557 my(%pack, $dir, %warned);
558 my($packlist) = ExtUtils::Packlist->new();
561 for (qw/read write/) {
562 $pack{$_}=$from_to{$_};
565 my($source_dir_or_file);
567 foreach $source_dir_or_file (sort keys %from_to) {
568 #Check if there are files, and if yes, look if the corresponding
569 #target directory is writable for us
570 opendir DIR, $source_dir_or_file or next;
572 next if $_ eq $Curdir || $_ eq $Updir || $_ eq ".exists";
573 my $targetdir = install_rooted_dir($from_to{$source_dir_or_file});
574 _mkpath( $targetdir, 0, 0755, $verbose, $nonono );
578 my $tmpfile = install_rooted_file($pack{"read"});
579 $packlist->read($tmpfile) if (-f $tmpfile);
582 MOD_INSTALL: foreach my $source (sort keys %from_to) {
583 #copy the tree to the target directory without altering
584 #timestamp and permission and remember for the .packlist
585 #file. The packlist file contains the absolute paths of the
586 #install locations. AFS users may call this a bug. We'll have
587 #to reconsider how to add the means to satisfy AFS users also.
589 #October 1997: we want to install .pm files into archlib if
590 #there are any files in arch. So we depend on having ./blib/arch
593 my $targetroot = install_rooted_dir($from_to{$source});
595 my $blib_lib = File::Spec->catdir('blib', 'lib');
596 my $blib_arch = File::Spec->catdir('blib', 'arch');
597 if ($source eq $blib_lib and
598 exists $from_to{$blib_arch} and
599 directory_not_empty($blib_arch)
601 $targetroot = install_rooted_dir($from_to{$blib_arch});
602 print "Files found in $blib_arch: installing files in $blib_lib into architecture dependent library tree\n";
605 next unless -d $source;
609 my ($mode,$size,$atime,$mtime) = (stat)[2,7,8,9];
614 return if $origfile eq ".exists";
615 my $targetdir = File::Spec->catdir($targetroot, $File::Find::dir);
616 my $targetfile = File::Spec->catfile($targetdir, $origfile);
617 my $sourcedir = File::Spec->catdir($source, $File::Find::dir);
618 my $sourcefile = File::Spec->catfile($sourcedir, $origfile);
620 for my $pat (@$skip) {
621 if ( $sourcefile=~/$pat/ ) {
622 print "Skipping $targetfile (filtered)\n"
628 # 5.5.3's File::Find missing no_chdir option.
629 my $save_cwd = _chdir($cwd); # in case the target is relative
632 if ( -f $targetfile && -s _ == $size) {
633 # We have a good chance, we can skip this one
634 $diff = compare($sourcefile, $targetfile);
638 print "$sourcefile differs\n" if $diff && $verbose>1;
639 my $realtarget= $targetfile;
641 if (-f $targetfile) {
642 print "_unlink_or_rename($targetfile)\n" if $verbose>1;
643 $targetfile= _unlink_or_rename( $targetfile, 'tryhard', 'install' )
645 } elsif ( ! -d $targetdir ) {
646 _mkpath( $targetdir, 0, 0755, $verbose, $nonono );
648 print "Installing $targetfile\n";
649 _copy( $sourcefile, $targetfile, $verbose, $nonono, );
651 print "utime($atime,$mtime,$targetfile)\n" if $verbose>1;
652 utime($atime,$mtime + $Is_VMS,$targetfile) unless $nonono>1;
655 $mode = 0444 | ( $mode & 0111 ? 0111 : 0 );
657 if $realtarget ne $targetfile;
658 _chmod( $mode, $targetfile, $verbose );
662 print "Skipping $targetfile (unchanged)\n" if $verbose;
665 if ( defined $inc_uninstall ) {
666 inc_uninstall($sourcefile,$File::Find::dir,$verbose,
667 $inc_uninstall ? 0 : 1,
668 $realtarget ne $targetfile ? $realtarget : "");
671 # Record the full pathname.
672 $packlist->{$targetfile}++;
674 # File::Find can get confused if you chdir in here.
677 # File::Find seems to always be Unixy except on MacPerl :(
678 }, $Is_MacPerl ? $Curdir : '.' ); #END SUB -- XXX OS-SPECIFIC
682 if ($pack{'write'}) {
683 $dir = install_rooted_dir(dirname($pack{'write'}));
684 _mkpath( $dir, 0, 0755, $verbose, $nonono );
685 print "Writing $pack{'write'}\n";
686 $packlist->write(install_rooted_file($pack{'write'})) unless $nonono;
689 _do_cleanup($verbose);
696 Standardize finish event for after another instruction has occured.
697 Handles converting $MUST_REBOOT to a die for instance.
706 die _estr "Operation not completed! ",
707 "You must reboot to complete the installation.",
709 } elsif (defined $MUST_REBOOT & $verbose) {
710 warn _estr "Installation will be completed at the next reboot.\n",
711 "However it is not necessary to reboot immediately.\n";
717 =item install_rooted_file( $file )
719 Returns $file, or catfile($INSTALL_ROOT,$file) if $INSTALL_ROOT
722 =item install_rooted_dir( $dir )
724 Returns $dir, or catdir($INSTALL_ROOT,$dir) if $INSTALL_ROOT
732 sub install_rooted_file {
733 if (defined $INSTALL_ROOT) {
734 File::Spec->catfile($INSTALL_ROOT, $_[0]);
741 sub install_rooted_dir {
742 if (defined $INSTALL_ROOT) {
743 File::Spec->catdir($INSTALL_ROOT, $_[0]);
751 =item forceunlink( $file, $tryhard )
753 Tries to delete a file. If $tryhard is true then we will use whatever
754 devious tricks we can to delete the file. Currently this only applies to
755 Win32 in that it will try to use Win32API::File to schedule a delete at
756 reboot. A wrapper for _unlink_or_rename().
764 my ( $file, $tryhard )= @_; #XXX OS-SPECIFIC
765 _unlink_or_rename( $file, $tryhard );
770 =item directory_not_empty( $dir )
772 Returns 1 if there is an .exists file somewhere in a directory tree.
773 Returns 0 if there is not.
779 sub directory_not_empty ($) {
783 return if $_ eq ".exists";
785 $File::Find::prune++;
793 =item B<install_default> I<DISCOURAGED>
796 install_default($fullext);
798 Calls install() with arguments to copy a module from blib/ to the
799 default site installation location.
801 $fullext is the name of the module converted to a directory
802 (ie. Foo::Bar would be Foo/Bar). If $fullext is not specified, it
803 will attempt to read it from @ARGV.
805 This is primarily useful for install scripts.
807 B<NOTE> This function is not really useful because of the hard-coded
808 install location with no way to control site vs core vs vendor
809 directories and the strange way in which the module name is given.
810 Consider its use discouraged.
814 sub install_default {
815 @_ < 2 or Carp::croak("install_default should be called with 0 or 1 argument");
816 my $FULLEXT = @_ ? shift : $ARGV[0];
817 defined $FULLEXT or die "Do not know to where to write install log";
818 my $INST_LIB = File::Spec->catdir($Curdir,"blib","lib");
819 my $INST_ARCHLIB = File::Spec->catdir($Curdir,"blib","arch");
820 my $INST_BIN = File::Spec->catdir($Curdir,'blib','bin');
821 my $INST_SCRIPT = File::Spec->catdir($Curdir,'blib','script');
822 my $INST_MAN1DIR = File::Spec->catdir($Curdir,'blib','man1');
823 my $INST_MAN3DIR = File::Spec->catdir($Curdir,'blib','man3');
825 read => "$Config{sitearchexp}/auto/$FULLEXT/.packlist",
826 write => "$Config{installsitearch}/auto/$FULLEXT/.packlist",
827 $INST_LIB => (directory_not_empty($INST_ARCHLIB)) ?
828 $Config{installsitearch} :
829 $Config{installsitelib},
830 $INST_ARCHLIB => $Config{installsitearch},
831 $INST_BIN => $Config{installbin} ,
832 $INST_SCRIPT => $Config{installscript},
833 $INST_MAN1DIR => $Config{installman1dir},
834 $INST_MAN3DIR => $Config{installman3dir},
841 uninstall($packlist_file);
842 uninstall($packlist_file, $verbose, $dont_execute);
844 Removes the files listed in a $packlist_file.
846 If $verbose is true, will print out each file removed. Default is
849 If $dont_execute is true it will only print what it was going to do
850 without actually doing it. Default is false.
855 my($fil,$verbose,$nonono) = @_;
859 die _estr "ERROR: no packlist file found: '$fil'"
861 # my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
862 # require $my_req; # Hairy, but for the first
863 my ($packlist) = ExtUtils::Packlist->new($fil);
864 foreach (sort(keys(%$packlist))) {
866 print "unlink $_\n" if $verbose;
867 forceunlink($_,'tryhard') unless $nonono;
869 print "unlink $fil\n" if $verbose;
870 forceunlink($fil, 'tryhard') unless $nonono;
871 _do_cleanup($verbose);
876 =item inc_uninstall($filepath,$libdir,$verbose,$nonono,$ignore)
878 Remove shadowed files. If $ignore is true then it is assumed to hold
879 a filename to ignore. This is used to prevent spurious warnings from
880 occuring when doing an install at reboot.
887 my($filepath,$libdir,$verbose,$nonono,$ignore) = @_;
890 my $file = (File::Spec->splitpath($filepath))[2];
893 my @PERL_ENV_LIB = split $Config{path_sep}, defined $ENV{'PERL5LIB'}
894 ? $ENV{'PERL5LIB'} : $ENV{'PERLLIB'} || '';
896 foreach $dir (@INC, @PERL_ENV_LIB, @Config{qw(archlibexp
900 my $canonpath = File::Spec->canonpath($dir);
901 next if $canonpath eq $Curdir;
902 next if $seen_dir{$canonpath}++;
903 my $targetfile = File::Spec->catfile($canonpath,$libdir,$file);
904 next unless -f $targetfile;
906 # The reason why we compare file's contents is, that we cannot
907 # know, which is the file we just installed (AFS). So we leave
908 # an identical file in place
910 if ( -f $targetfile && -s _ == -s $filepath) {
911 # We have a good chance, we can skip this one
912 $diff = compare($filepath,$targetfile);
916 print "#$file and $targetfile differ\n" if $diff && $verbose > 1;
918 next if !$diff or $targetfile eq $ignore;
921 $Inc_uninstall_warn_handler ||= ExtUtils::Install::Warn->new();
922 $libdir =~ s|^\./||s ; # That's just cosmetics, no need to port. It looks prettier.
923 $Inc_uninstall_warn_handler->add(
924 File::Spec->catfile($libdir, $file),
928 # if not verbose, we just say nothing
930 print "Unlinking $targetfile (shadowing?)\n";
931 forceunlink($targetfile,'tryhard');
938 =item run_filter($cmd,$src,$dest)
940 Filter $src using $cmd into $dest.
947 my ($cmd, $src, $dest) = @_;
949 open(CMD, "|$cmd >$dest") || die "Cannot fork: $!";
950 open(SRC, $src) || die "Cannot open $src: $!";
953 while (my $len = sysread(SRC, $buf, $sz)) {
954 syswrite(CMD, $buf, $len);
957 close CMD or die "Filter command '$cmd' failed for $src";
963 pm_to_blib(\%from_to, $autosplit_dir);
964 pm_to_blib(\%from_to, $autosplit_dir, $filter_cmd);
966 Copies each key of %from_to to its corresponding value efficiently.
967 Filenames with the extension .pm are autosplit into the $autosplit_dir.
968 Any destination directories are created.
970 $filter_cmd is an optional shell command to run each .pm file through
971 prior to splitting and copying. Input is the contents of the module,
972 output the new module contents.
974 You can have an environment variable PERL_INSTALL_ROOT set which will
975 be prepended as a directory to each installed file (and directory).
980 my($fromto,$autodir,$pm_filter) = @_;
982 _mkpath($autodir,0,0755);
983 while(my($from, $to) = each %$fromto) {
984 if( -f $to && -s $from == -s $to && -M $to < -M $from ) {
985 print "Skip $to (unchanged)\n";
989 # When a pm_filter is defined, we need to pre-process the source first
990 # to determine whether it has changed or not. Therefore, only perform
991 # the comparison check when there's no filter to be ran.
994 my $need_filtering = defined $pm_filter && length $pm_filter &&
997 if (!$need_filtering && 0 == compare($from,$to)) {
998 print "Skip $to (unchanged)\n";
1002 # we wont try hard here. its too likely to mess things up.
1005 _mkpath(dirname($to),0,0755);
1007 if ($need_filtering) {
1008 run_filter($pm_filter, $from, $to);
1009 print "$pm_filter <$from >$to\n";
1011 _copy( $from, $to );
1012 print "cp $from $to\n";
1014 my($mode,$atime,$mtime) = (stat $from)[2,8,9];
1015 utime($atime,$mtime+$Is_VMS,$to);
1016 _chmod(0444 | ( $mode & 0111 ? 0111 : 0 ),$to);
1017 next unless $from =~ /\.pm$/;
1018 _autosplit($to,$autodir);
1027 From 1.0307 back, AutoSplit will sometimes leave an open filehandle to
1028 the file being split. This causes problems on systems with mandatory
1029 locking (ie. Windows). So we wrap it and close the filehandle.
1035 sub _autosplit { #XXX OS-SPECIFIC
1036 my $retval = autosplit(@_);
1037 close *AutoSplit::IN if defined *AutoSplit::IN{IO};
1043 package ExtUtils::Install::Warn;
1045 sub new { bless {}, shift }
1048 my($self,$file,$targetfile) = @_;
1049 push @{$self->{$file}}, $targetfile;
1053 unless(defined $INSTALL_ROOT) {
1055 my($file,$i,$plural);
1056 foreach $file (sort keys %$self) {
1057 $plural = @{$self->{$file}} > 1 ? "s" : "";
1058 print "## Differing version$plural of $file found. You might like to\n";
1059 for (0..$#{$self->{$file}}) {
1060 print "rm ", $self->{$file}[$_], "\n";
1064 $plural = $i>1 ? "all those files" : "this file";
1065 my $inst = (_invokant() eq 'ExtUtils::MakeMaker')
1066 ? ( $Config::Config{make} || 'make' ).' install UNINST=1'
1067 : './Build install uninst=1';
1068 print "## Running '$inst' will unlink $plural for you.\n";
1076 Does a heuristic on the stack to see who called us for more intelligent
1077 error messages. Currently assumes we will be called only by Module::Build
1078 or by ExtUtils::MakeMaker.
1087 while (my $file = (caller($frame++))[1]) {
1088 push @stack, (File::Spec->splitpath($file))[2];
1092 my $top = pop @stack;
1093 if ($top =~ /^Build/i || exists($INC{'Module/Build.pm'})) {
1094 $builder = 'Module::Build';
1096 $builder = 'ExtUtils::MakeMaker';
1108 =item B<PERL_INSTALL_ROOT>
1110 Will be prepended to each install path.
1112 =item B<EU_INSTALL_IGNORE_SKIP>
1114 Will prevent the automatic use of INSTALL.SKIP as the install skip file.
1116 =item B<EU_INSTALL_SITE_SKIPFILE>
1118 If there is no INSTALL.SKIP file in the make directory then this value
1119 can be used to provide a default.
1125 Original author lost in the mists of time. Probably the same as Makemaker.
1127 Production release currently maintained by demerphq C<yves at cpan.org>
1129 Send bug reports via http://rt.cpan.org/. Please send your
1130 generated Makefile along with your report.
1134 This program is free software; you can redistribute it and/or
1135 modify it under the same terms as Perl itself.
1137 See L<http://www.perl.com/perl/misc/Artistic.html>