This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Bumping version of ExtUtils::Install per porting/cmpVERSION.pl
[perl5.git] / dist / ExtUtils-Install / lib / ExtUtils / Install.pm
CommitLineData
4b6d56d3 1package ExtUtils::Install;
3a465856
SP
2use strict;
3
4use vars qw(@ISA @EXPORT $VERSION $MUST_REBOOT %Config);
f1387719 5
dc7d4075 6use AutoSplit;
08ad6bd5 7use Carp ();
c3648e42 8use Config qw(%Config);
dc7d4075
SP
9use Cwd qw(cwd);
10use Exporter;
11use ExtUtils::Packlist;
12use File::Basename qw(dirname);
13use File::Compare qw(compare);
14use File::Copy;
15use File::Find qw(find);
16use File::Path;
17use File::Spec;
18
3a465856 19
4b6d56d3 20@ISA = ('Exporter');
c3648e42 21@EXPORT = ('install','uninstall','pm_to_blib', 'install_default');
a9d83807 22
16f0d0fc 23=pod
3f6d40bd 24
479d2113 25=head1 NAME
a9d83807 26
479d2113 27ExtUtils::Install - install files from here to there
4b6d56d3 28
479d2113
MS
29=head1 SYNOPSIS
30
31 use ExtUtils::Install;
32
33 install({ 'blib/lib' => 'some/install/dir' } );
34
35 uninstall($packlist);
36
37 pm_to_blib({ 'lib/Foo/Bar.pm' => 'blib/lib/Foo/Bar.pm' });
16f0d0fc 38
3f6d40bd
SH
39=head1 VERSION
40
75fc7c36 411.55
3f6d40bd
SH
42
43=cut
44
1c6b243a 45$VERSION = '1.56'; # <---- dont forget to update the POD section just above this line!
3f6d40bd
SH
46$VERSION = eval $VERSION;
47
48=pod
479d2113 49
479d2113
MS
50=head1 DESCRIPTION
51
52Handles the installing and uninstalling of perl modules, scripts, man
53pages, etc...
54
55Both install() and uninstall() are specific to the way
56ExtUtils::MakeMaker handles the installation and deinstallation of
57perl modules. They are not designed as general purpose tools.
58
3a465856
SP
59On some operating systems such as Win32 installation may not be possible
60until after a reboot has occured. This can have varying consequences:
61removing an old DLL does not impact programs using the new one, but if
62a new DLL cannot be installed properly until reboot then anything
63depending on it must wait. The package variable
64
65 $ExtUtils::Install::MUST_REBOOT
66
67is used to store this status.
68
69If this variable is true then such an operation has occured and
70anything depending on this module cannot proceed until a reboot
71has occured.
72
73If this value is defined but false then such an operation has
74ocurred, but should not impact later operations.
75
76=begin _private
77
345e2394
JV
78=over
79
3a465856
SP
80=item _chmod($$;$)
81
82Wrapper to chmod() for debugging and error trapping.
83
dc7d4075
SP
84=item _warnonce(@)
85
86Warns about something only once.
87
88=item _choke(@)
89
90Dies with a special message.
91
345e2394
JV
92=back
93
3a465856
SP
94=end _private
95
96=cut
97
dc7d4075 98my $Is_VMS = $^O eq 'VMS';
3d55b451 99my $Is_VMS_noefs = $Is_VMS;
dc7d4075
SP
100my $Is_MacPerl = $^O eq 'MacOS';
101my $Is_Win32 = $^O eq 'MSWin32';
102my $Is_cygwin = $^O eq 'cygwin';
103my $CanMoveAtBoot = ($Is_Win32 || $Is_cygwin);
104
3d55b451
JM
105 if( $Is_VMS ) {
106 my $vms_unix_rpt;
107 my $vms_efs;
108 my $vms_case;
109
110 if (eval { local $SIG{__DIE__}; require VMS::Feature; }) {
111 $vms_unix_rpt = VMS::Feature::current("filename_unix_report");
112 $vms_efs = VMS::Feature::current("efs_charset");
113 $vms_case = VMS::Feature::current("efs_case_preserve");
114 } else {
115 my $unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';
116 my $efs_charset = $ENV{'DECC$EFS_CHARSET'} || '';
117 my $efs_case = $ENV{'DECC$EFS_CASE_PRESERVE'} || '';
16f0d0fc 118 $vms_unix_rpt = $unix_rpt =~ /^[ET1]/i;
3d55b451
JM
119 $vms_efs = $efs_charset =~ /^[ET1]/i;
120 $vms_case = $efs_case =~ /^[ET1]/i;
121 }
16f0d0fc 122 $Is_VMS_noefs = 0 if ($vms_efs);
3d55b451
JM
123 }
124
125
126
dc7d4075
SP
127# *note* CanMoveAtBoot is only incidentally the same condition as below
128# this needs not hold true in the future.
129my $Has_Win32API_File = ($Is_Win32 || $Is_cygwin)
130 ? (eval {require Win32API::File; 1} || 0)
131 : 0;
132
133
134my $Inc_uninstall_warn_handler;
135
136# install relative to here
137
138my $INSTALL_ROOT = $ENV{PERL_INSTALL_ROOT};
139
140my $Curdir = File::Spec->curdir;
141my $Updir = File::Spec->updir;
142
143sub _estr(@) {
144 return join "\n",'!' x 72,@_,'!' x 72,'';
145}
146
147{my %warned;
148sub _warnonce(@) {
149 my $first=shift;
150 my $msg=_estr "WARNING: $first",@_;
151 warn $msg unless $warned{$msg}++;
152}}
153
154sub _choke(@) {
155 my $first=shift;
156 my $msg=_estr "ERROR: $first",@_;
157 Carp::croak($msg);
158}
159
3a465856
SP
160
161sub _chmod($$;$) {
162 my ( $mode, $item, $verbose )=@_;
163 $verbose ||= 0;
164 if (chmod $mode, $item) {
dcd43ceb 165 printf "chmod(0%o, %s)\n",$mode, $item if $verbose > 1;
3a465856
SP
166 } else {
167 my $err="$!";
dcd43ceb
YO
168 _warnonce sprintf "WARNING: Failed chmod(0%o, %s): %s\n",
169 $mode, $item, $err
3a465856
SP
170 if -e $item;
171 }
172}
173
174=begin _private
175
345e2394
JV
176=over
177
3a465856
SP
178=item _move_file_at_boot( $file, $target, $moan )
179
180OS-Specific, Win32/Cygwin
181
182Schedules a file to be moved/renamed/deleted at next boot.
183$file should be a filespec of an existing file
184$target should be a ref to an array if the file is to be deleted
185otherwise it should be a filespec for a rename. If the file is existing
186it will be replaced.
187
188Sets $MUST_REBOOT to 0 to indicate a deletion operation has occured
189and sets it to 1 to indicate that a move operation has been requested.
190
191returns 1 on success, on failure if $moan is false errors are fatal.
192If $moan is true then returns 0 on error and warns instead of dies.
193
194=end _private
195
196=cut
197
198
199
200sub _move_file_at_boot { #XXX OS-SPECIFIC
201 my ( $file, $target, $moan )= @_;
202 Carp::confess("Panic: Can't _move_file_at_boot on this platform!")
203 unless $CanMoveAtBoot;
204
205 my $descr= ref $target
206 ? "'$file' for deletion"
207 : "'$file' for installation as '$target'";
208
209 if ( ! $Has_Win32API_File ) {
dc7d4075
SP
210
211 my @msg=(
212 "Cannot schedule $descr at reboot.",
3a465856
SP
213 "Try installing Win32API::File to allow operations on locked files",
214 "to be scheduled during reboot. Or try to perform the operation by",
dc7d4075
SP
215 "hand yourself. (You may need to close other perl processes first)"
216 );
217 if ( $moan ) { _warnonce(@msg) } else { _choke(@msg) }
3a465856
SP
218 return 0;
219 }
220 my $opts= Win32API::File::MOVEFILE_DELAY_UNTIL_REBOOT();
221 $opts= $opts | Win32API::File::MOVEFILE_REPLACE_EXISTING()
222 unless ref $target;
223
224 _chmod( 0666, $file );
225 _chmod( 0666, $target ) unless ref $target;
226
227 if (Win32API::File::MoveFileEx( $file, $target, $opts )) {
228 $MUST_REBOOT ||= ref $target ? 0 : 1;
229 return 1;
230 } else {
dc7d4075
SP
231 my @msg=(
232 "MoveFileEx $descr at reboot failed: $^E",
3a465856
SP
233 "You may try to perform the operation by hand yourself. ",
234 "(You may need to close other perl processes first).",
dc7d4075
SP
235 );
236 if ( $moan ) { _warnonce(@msg) } else { _choke(@msg) }
3a465856
SP
237 }
238 return 0;
239}
240
241
242=begin _private
243
345e2394 244
3a465856
SP
245=item _unlink_or_rename( $file, $tryhard, $installing )
246
247OS-Specific, Win32/Cygwin
248
249Tries to get a file out of the way by unlinking it or renaming it. On
250some OS'es (Win32 based) DLL files can end up locked such that they can
251be renamed but not deleted. Likewise sometimes a file can be locked such
252that it cant even be renamed or changed except at reboot. To handle
253these cases this routine finds a tempfile name that it can either rename
254the file out of the way or use as a proxy for the install so that the
255rename can happen later (at reboot).
256
257 $file : the file to remove.
258 $tryhard : should advanced tricks be used for deletion
259 $installing : we are not merely deleting but we want to overwrite
260
261When $tryhard is not true if the unlink fails its fatal. When $tryhard
262is true then the file is attempted to be renamed. The renamed file is
263then scheduled for deletion. If the rename fails then $installing
264governs what happens. If it is false the failure is fatal. If it is true
265then an attempt is made to schedule installation at boot using a
266temporary file to hold the new file. If this fails then a fatal error is
267thrown, if it succeeds it returns the temporary file name (which will be
268a derivative of the original in the same directory) so that the caller can
269use it to install under. In all other cases of success returns $file.
270On failure throws a fatal error.
271
345e2394
JV
272=back
273
3a465856
SP
274=end _private
275
276=cut
277
278
279
280sub _unlink_or_rename { #XXX OS-SPECIFIC
281 my ( $file, $tryhard, $installing )= @_;
282
283 _chmod( 0666, $file );
553b5000
NC
284 my $unlink_count = 0;
285 while (unlink $file) { $unlink_count++; }
286 return $file if $unlink_count > 0;
3a465856
SP
287 my $error="$!";
288
dc7d4075 289 _choke("Cannot unlink '$file': $!")
3a465856
SP
290 unless $CanMoveAtBoot && $tryhard;
291
292 my $tmp= "AAA";
293 ++$tmp while -e "$file.$tmp";
294 $tmp= "$file.$tmp";
295
296 warn "WARNING: Unable to unlink '$file': $error\n",
297 "Going to try to rename it to '$tmp'.\n";
298
299 if ( rename $file, $tmp ) {
c4a6f826 300 warn "Rename successful. Scheduling '$tmp'\nfor deletion at reboot.\n";
3a465856
SP
301 # when $installing we can set $moan to true.
302 # IOW, if we cant delete the renamed file at reboot its
303 # not the end of the world. The other cases are more serious
304 # and need to be fatal.
305 _move_file_at_boot( $tmp, [], $installing );
060fb22c 306 return $file;
3a465856 307 } elsif ( $installing ) {
dc7d4075
SP
308 _warnonce("Rename failed: $!. Scheduling '$tmp'\nfor".
309 " installation as '$file' at reboot.\n");
3a465856
SP
310 _move_file_at_boot( $tmp, $file );
311 return $tmp;
312 } else {
c4a6f826 313 _choke("Rename failed:$!", "Cannot proceed.");
3a465856
SP
314 }
315
316}
317
dc7d4075 318
3f6d40bd 319=pod
dc7d4075 320
479d2113
MS
321=head2 Functions
322
dc7d4075
SP
323=begin _private
324
345e2394
JV
325=over
326
dc7d4075
SP
327=item _get_install_skip
328
329Handles loading the INSTALL.SKIP file. Returns an array of patterns to use.
330
331=cut
332
333
334
3a465856
SP
335sub _get_install_skip {
336 my ( $skip, $verbose )= @_;
337 if ($ENV{EU_INSTALL_IGNORE_SKIP}) {
338 print "EU_INSTALL_IGNORE_SKIP is set, ignore skipfile settings\n"
339 if $verbose>2;
340 return [];
341 }
342 if ( ! defined $skip ) {
343 print "Looking for install skip list\n"
344 if $verbose>2;
345 for my $file ( 'INSTALL.SKIP', $ENV{EU_INSTALL_SITE_SKIPFILE} ) {
346 next unless $file;
347 print "\tChecking for $file\n"
348 if $verbose>2;
349 if (-e $file) {
350 $skip= $file;
351 last;
352 }
353 }
354 }
355 if ($skip && !ref $skip) {
356 print "Reading skip patterns from '$skip'.\n"
357 if $verbose;
358 if (open my $fh,$skip ) {
359 my @patterns;
360 while (<$fh>) {
361 chomp;
362 next if /^\s*(?:#|$)/;
363 print "\tSkip pattern: $_\n" if $verbose>3;
364 push @patterns, $_;
365 }
366 $skip= \@patterns;
367 } else {
368 warn "Can't read skip file:'$skip':$!\n";
369 $skip=[];
370 }
371 } elsif ( UNIVERSAL::isa($skip,'ARRAY') ) {
372 print "Using array for skip list\n"
373 if $verbose>2;
374 } elsif ($verbose) {
375 print "No skip list found.\n"
376 if $verbose>1;
377 $skip= [];
378 }
379 warn "Got @{[0+@$skip]} skip patterns.\n"
380 if $verbose>3;
381 return $skip
382}
383
3f6d40bd
SH
384=pod
385
dc7d4075
SP
386=item _have_write_access
387
388Abstract a -w check that tries to use POSIX::access() if possible.
389
390=cut
391
dc7d4075
SP
392{
393 my $has_posix;
394 sub _have_write_access {
395 my $dir=shift;
3f6d40bd 396 unless (defined $has_posix) {
038ae9a4 397 $has_posix= (!$Is_cygwin && !$Is_Win32
16f0d0fc 398 && eval 'local $^W; require POSIX; 1') || 0;
dc7d4075
SP
399 }
400 if ($has_posix) {
401 return POSIX::access($dir, POSIX::W_OK());
402 } else {
403 return -w $dir;
404 }
405 }
406}
407
3f6d40bd 408=pod
dc7d4075
SP
409
410=item _can_write_dir(C<$dir>)
411
412Checks whether a given directory is writable, taking account
413the possibility that the directory might not exist and would have to
414be created first.
415
416Returns a list, containing: C<($writable, $determined_by, @create)>
417
418C<$writable> says whether whether the directory is (hypothetically) writable
419
420C<$determined_by> is the directory the status was determined from. It will be
421either the C<$dir>, or one of its parents.
422
423C<@create> is a list of directories that would probably have to be created
424to make the requested directory. It may not actually be correct on
425relative paths with C<..> in them. But for our purposes it should work ok
426
427=cut
428
429
430sub _can_write_dir {
431 my $dir=shift;
432 return
433 unless defined $dir and length $dir;
434
f6d658cc 435 my ($vol, $dirs, $file) = File::Spec->splitpath($dir,1);
060fb22c 436 my @dirs = File::Spec->splitdir($dirs);
f6d658cc
YO
437 unshift @dirs, File::Spec->curdir
438 unless File::Spec->file_name_is_absolute($dir);
439
dc7d4075
SP
440 my $path='';
441 my @make;
442 while (@dirs) {
3d55b451
JM
443 if ($Is_VMS_noefs) {
444 # There is a bug in catdir that is fixed when the EFS character
445 # set is enabled, which requires this VMS specific code.
553b5000
NC
446 $dir = File::Spec->catdir($vol,@dirs);
447 }
448 else {
449 $dir = File::Spec->catdir(@dirs);
450 $dir = File::Spec->catpath($vol,$dir,'')
451 if defined $vol and length $vol;
452 }
dc7d4075
SP
453 next if ( $dir eq $path );
454 if ( ! -e $dir ) {
455 unshift @make,$dir;
456 next;
457 }
458 if ( _have_write_access($dir) ) {
459 return 1,$dir,@make
460 } else {
461 return 0,$dir,@make
462 }
463 } continue {
464 pop @dirs;
465 }
466 return 0;
467}
468
3f6d40bd
SH
469=pod
470
546acaf9 471=item _mkpath($dir,$show,$mode,$verbose,$dry_run)
dc7d4075
SP
472
473Wrapper around File::Path::mkpath() to handle errors.
474
475If $verbose is true and >1 then additional diagnostics will be produced, also
476this will force $show to true.
477
546acaf9 478If $dry_run is true then the directory will not be created but a check will be
dc7d4075
SP
479made to see whether it would be possible to write to the directory, or that
480it would be possible to create the directory.
481
546acaf9 482If $dry_run is not true dies if the directory can not be created or is not
dc7d4075
SP
483writable.
484
485=cut
486
487sub _mkpath {
546acaf9 488 my ($dir,$show,$mode,$verbose,$dry_run)=@_;
dc7d4075
SP
489 if ( $verbose && $verbose > 1 && ! -d $dir) {
490 $show= 1;
491 printf "mkpath(%s,%d,%#o)\n", $dir, $show, $mode;
492 }
546acaf9 493 if (!$dry_run) {
dc7d4075
SP
494 if ( ! eval { File::Path::mkpath($dir,$show,$mode); 1 } ) {
495 _choke("Can't create '$dir'","$@");
496 }
497
498 }
499 my ($can,$root,@make)=_can_write_dir($dir);
500 if (!$can) {
501 my @msg=(
502 "Can't create '$dir'",
503 $root ? "Do not have write permissions on '$root'"
504 : "Unknown Error"
505 );
546acaf9 506 if ($dry_run) {
dc7d4075
SP
507 _warnonce @msg;
508 } else {
509 _choke @msg;
510 }
546acaf9 511 } elsif ($show and $dry_run) {
dc7d4075
SP
512 print "$_\n" for @make;
513 }
16f0d0fc 514
dc7d4075
SP
515}
516
3f6d40bd
SH
517=pod
518
546acaf9 519=item _copy($from,$to,$verbose,$dry_run)
dc7d4075
SP
520
521Wrapper around File::Copy::copy to handle errors.
522
c4a6f826 523If $verbose is true and >1 then additional diagnostics will be emitted.
dc7d4075 524
546acaf9 525If $dry_run is true then the copy will not actually occur.
dc7d4075
SP
526
527Dies if the copy fails.
528
529=cut
530
531
532sub _copy {
546acaf9 533 my ( $from, $to, $verbose, $dry_run)=@_;
dc7d4075
SP
534 if ($verbose && $verbose>1) {
535 printf "copy(%s,%s)\n", $from, $to;
536 }
546acaf9 537 if (!$dry_run) {
dc7d4075
SP
538 File::Copy::copy($from,$to)
539 or Carp::croak( _estr "ERROR: Cannot copy '$from' to '$to': $!" );
540 }
541}
542
3f6d40bd
SH
543=pod
544
dc7d4075
SP
545=item _chdir($from)
546
547Wrapper around chdir to catch errors.
548
549If not called in void context returns the cwd from before the chdir.
550
551dies on error.
552
553=cut
554
555sub _chdir {
556 my ($dir)= @_;
557 my $ret;
558 if (defined wantarray) {
559 $ret= cwd;
560 }
561 chdir $dir
562 or _choke("Couldn't chdir to '$dir': $!");
563 return $ret;
564}
565
3f6d40bd
SH
566=pod
567
dc7d4075
SP
568=end _private
569
546acaf9
YO
570=item B<install>
571
572 # deprecated forms
573 install(\%from_to);
16f0d0fc 574 install(\%from_to, $verbose, $dry_run, $uninstall_shadows,
546acaf9
YO
575 $skip, $always_copy, \%result);
576
16f0d0fc
YO
577 # recommended form as of 1.47
578 install([
546acaf9 579 from_to => \%from_to,
16f0d0fc 580 verbose => 1,
546acaf9
YO
581 dry_run => 0,
582 uninstall_shadows => 1,
583 skip => undef,
584 always_copy => 1,
585 result => \%install_results,
586 ]);
16f0d0fc 587
546acaf9
YO
588
589Copies each directory tree of %from_to to its corresponding value
590preserving timestamps and permissions.
591
592There are two keys with a special meaning in the hash: "read" and
593"write". These contain packlist files. After the copying is done,
594install() will write the list of target files to $from_to{write}. If
595$from_to{read} is given the contents of this file will be merged into
596the written file. The read and the written file may be identical, but
597on AFS it is quite likely that people are installing to a different
598directory than the one where the files later appear.
599
600If $verbose is true, will print out each file removed. Default is
601false. This is "make install VERBINST=1". $verbose values going
602up to 5 show increasingly more diagnostics output.
603
604If $dry_run is true it will only print what it was going to do
605without actually doing it. Default is false.
606
607If $uninstall_shadows is true any differing versions throughout @INC
608will be uninstalled. This is "make install UNINST=1"
609
16f0d0fc
YO
610As of 1.37_02 install() supports the use of a list of patterns to filter out
611files that shouldn't be installed. If $skip is omitted or undefined then
612install will try to read the list from INSTALL.SKIP in the CWD. This file is
613a list of regular expressions and is just like the MANIFEST.SKIP file used
546acaf9
YO
614by L<ExtUtils::Manifest>.
615
16f0d0fc
YO
616A default site INSTALL.SKIP may be provided by setting then environment
617variable EU_INSTALL_SITE_SKIPFILE, this will only be used when there isn't a
618distribution specific INSTALL.SKIP. If the environment variable
619EU_INSTALL_IGNORE_SKIP is true then no install file filtering will be
546acaf9
YO
620performed.
621
16f0d0fc
YO
622If $skip is undefined then the skip file will be autodetected and used if it
623is found. If $skip is a reference to an array then it is assumed the array
624contains the list of patterns, if $skip is a true non reference it is
625assumed to be the filename holding the list of patterns, any other value of
546acaf9
YO
626$skip is taken to mean that no install filtering should occur.
627
628B<Changes As of Version 1.47>
629
630As of version 1.47 the following additions were made to the install interface.
631Note that the new argument style and use of the %result hash is recommended.
632
16f0d0fc
YO
633The $always_copy parameter which when true causes files to be updated
634regardles as to whether they have changed, if it is defined but false then
635copies are made only if the files have changed, if it is undefined then the
3f6d40bd 636value of the environment variable EU_INSTALL_ALWAYS_COPY is used as default.
546acaf9 637
16f0d0fc 638The %result hash will be populated with the various keys/subhashes reflecting
546acaf9
YO
639the install. Currently these keys and their structure are:
640
641 install => { $target => $source },
642 install_fail => { $target => $source },
643 install_unchanged => { $target => $source },
16f0d0fc 644
546acaf9 645 install_filtered => { $source => $pattern },
16f0d0fc 646
546acaf9
YO
647 uninstall => { $uninstalled => $source },
648 uninstall_fail => { $uninstalled => $source },
16f0d0fc 649
546acaf9
YO
650where C<$source> is the filespec of the file being installed. C<$target> is where
651it is being installed to, and C<$uninstalled> is any shadow file that is in C<@INC>
652or C<$ENV{PERL5LIB}> or other standard locations, and C<$pattern> is the pattern that
653caused a source file to be skipped. In future more keys will be added, such as to
16f0d0fc 654show created directories, however this requires changes in other modules and must
546acaf9 655therefore wait.
16f0d0fc
YO
656
657These keys will be populated before any exceptions are thrown should there be an
658error.
546acaf9
YO
659
660Note that all updates of the %result are additive, the hash will not be
661cleared before use, thus allowing status results of many installs to be easily
662aggregated.
663
664B<NEW ARGUMENT STYLE>
665
666If there is only one argument and it is a reference to an array then
16f0d0fc 667the array is assumed to contain a list of key-value pairs specifying
546acaf9
YO
668the options. In this case the option "from_to" is mandatory. This style
669means that you dont have to supply a cryptic list of arguments and can
670use a self documenting argument list that is easier to understand.
671
672This is now the recommended interface to install().
673
674B<RETURN>
675
16f0d0fc
YO
676If all actions were successful install will return a hashref of the results
677as described above for the $result parameter. If any action is a failure
678then install will die, therefore it is recommended to pass in the $result
679parameter instead of using the return value. If the result parameter is
546acaf9
YO
680provided then the returned hashref will be the passed in hashref.
681
dc7d4075 682=cut
3a465856
SP
683
684sub install { #XXX OS-SPECIFIC
546acaf9
YO
685 my($from_to,$verbose,$dry_run,$uninstall_shadows,$skip,$always_copy,$result) = @_;
686 if (@_==1 and eval { 1+@$from_to }) {
687 my %opts = @$from_to;
16f0d0fc 688 $from_to = $opts{from_to}
546acaf9
YO
689 or Carp::confess("from_to is a mandatory parameter");
690 $verbose = $opts{verbose};
691 $dry_run = $opts{dry_run};
692 $uninstall_shadows = $opts{uninstall_shadows};
693 $skip = $opts{skip};
694 $always_copy = $opts{always_copy};
695 $result = $opts{result};
696 }
16f0d0fc 697
546acaf9 698 $result ||= {};
4b6d56d3 699 $verbose ||= 0;
546acaf9 700 $dry_run ||= 0;
08ad6bd5 701
3a465856 702 $skip= _get_install_skip($skip,$verbose);
3f6d40bd 703 $always_copy = $ENV{EU_INSTALL_ALWAYS_COPY}
16f0d0fc 704 || $ENV{EU_ALWAYS_COPY}
3f6d40bd 705 || 0
546acaf9 706 unless defined $always_copy;
3a465856 707
479d2113 708 my(%from_to) = %$from_to;
dc7d4075 709 my(%pack, $dir, %warned);
354f3b56 710 my($packlist) = ExtUtils::Packlist->new();
dc7d4075 711
354f3b56 712 local(*DIR);
4b6d56d3 713 for (qw/read write/) {
060fb22c
YO
714 $pack{$_}=$from_to{$_};
715 delete $from_to{$_};
4b6d56d3 716 }
a9d83807
BC
717 my $tmpfile = install_rooted_file($pack{"read"});
718 $packlist->read($tmpfile) if (-f $tmpfile);
4b6d56d3 719 my $cwd = cwd();
060fb22c
YO
720 my @found_files;
721 my %check_dirs;
16f0d0fc 722
479d2113 723 MOD_INSTALL: foreach my $source (sort keys %from_to) {
060fb22c
YO
724 #copy the tree to the target directory without altering
725 #timestamp and permission and remember for the .packlist
726 #file. The packlist file contains the absolute paths of the
727 #install locations. AFS users may call this a bug. We'll have
728 #to reconsider how to add the means to satisfy AFS users also.
456e5c25 729
060fb22c
YO
730 #October 1997: we want to install .pm files into archlib if
731 #there are any files in arch. So we depend on having ./blib/arch
732 #hardcoded here.
a9d83807 733
060fb22c 734 my $targetroot = install_rooted_dir($from_to{$source});
a9d83807 735
479d2113
MS
736 my $blib_lib = File::Spec->catdir('blib', 'lib');
737 my $blib_arch = File::Spec->catdir('blib', 'arch');
060fb22c
YO
738 if ($source eq $blib_lib and
739 exists $from_to{$blib_arch} and
740 directory_not_empty($blib_arch)
741 ){
742 $targetroot = install_rooted_dir($from_to{$blib_arch});
479d2113 743 print "Files found in $blib_arch: installing files in $blib_lib into architecture dependent library tree\n";
060fb22c 744 }
479d2113 745
dc7d4075
SP
746 next unless -d $source;
747 _chdir($source);
060fb22c
YO
748 # 5.5.3's File::Find missing no_chdir option
749 # XXX OS-SPECIFIC
750 # File::Find seems to always be Unixy except on MacPerl :(
751 my $current_directory= $Is_MacPerl ? $Curdir : '.';
752 find(sub {
753 my ($mode,$size,$atime,$mtime) = (stat)[2,7,8,9];
3a465856 754
060fb22c 755 return if !-f _;
1df8d179 756 my $origfile = $_;
3a465856 757
060fb22c
YO
758 return if $origfile eq ".exists";
759 my $targetdir = File::Spec->catdir($targetroot, $File::Find::dir);
760 my $targetfile = File::Spec->catfile($targetdir, $origfile);
479d2113 761 my $sourcedir = File::Spec->catdir($source, $File::Find::dir);
1df8d179 762 my $sourcefile = File::Spec->catfile($sourcedir, $origfile);
479d2113 763
3a465856
SP
764 for my $pat (@$skip) {
765 if ( $sourcefile=~/$pat/ ) {
766 print "Skipping $targetfile (filtered)\n"
767 if $verbose>1;
546acaf9 768 $result->{install_filtered}{$sourcefile} = $pat;
060fb22c
YO
769 return;
770 }
771 }
772 # we have to do this for back compat with old File::Finds
773 # and because the target is relative
16f0d0fc 774 my $save_cwd = _chdir($cwd);
060fb22c 775 my $diff = 0;
546acaf9
YO
776 # XXX: I wonder how useful this logic is actually -- demerphq
777 if ( $always_copy or !-f $targetfile or -s $targetfile != $size) {
060fb22c 778 $diff++;
546acaf9
YO
779 } else {
780 # we might not need to copy this file
781 $diff = compare($sourcefile, $targetfile);
060fb22c 782 }
16f0d0fc 783 $check_dirs{$targetdir}++
060fb22c 784 unless -w $targetfile;
16f0d0fc 785
060fb22c
YO
786 push @found_files,
787 [ $diff, $File::Find::dir, $origfile,
788 $mode, $size, $atime, $mtime,
789 $targetdir, $targetfile, $sourcedir, $sourcefile,
16f0d0fc
YO
790
791 ];
060fb22c 792 #restore the original directory we were in when File::Find
c4a6f826 793 #called us so that it doesn't get horribly confused.
16f0d0fc
YO
794 _chdir($save_cwd);
795 }, $current_directory );
060fb22c 796 _chdir($cwd);
16f0d0fc 797 }
060fb22c 798 foreach my $targetdir (sort keys %check_dirs) {
546acaf9 799 _mkpath( $targetdir, 0, 0755, $verbose, $dry_run );
060fb22c
YO
800 }
801 foreach my $found (@found_files) {
802 my ($diff, $ffd, $origfile, $mode, $size, $atime, $mtime,
803 $targetdir, $targetfile, $sourcedir, $sourcefile)= @$found;
16f0d0fc 804
060fb22c
YO
805 my $realtarget= $targetfile;
806 if ($diff) {
546acaf9
YO
807 eval {
808 if (-f $targetfile) {
809 print "_unlink_or_rename($targetfile)\n" if $verbose>1;
810 $targetfile= _unlink_or_rename( $targetfile, 'tryhard', 'install' )
811 unless $dry_run;
812 } elsif ( ! -d $targetdir ) {
813 _mkpath( $targetdir, 0, 0755, $verbose, $dry_run );
814 }
815 print "Installing $targetfile\n";
16f0d0fc 816
546acaf9 817 _copy( $sourcefile, $targetfile, $verbose, $dry_run, );
16f0d0fc
YO
818
819
546acaf9
YO
820 #XXX OS-SPECIFIC
821 print "utime($atime,$mtime,$targetfile)\n" if $verbose>1;
822 utime($atime,$mtime + $Is_VMS,$targetfile) unless $dry_run>1;
16f0d0fc
YO
823
824
546acaf9
YO
825 $mode = 0444 | ( $mode & 0111 ? 0111 : 0 );
826 $mode = $mode | 0222
827 if $realtarget ne $targetfile;
828 _chmod( $mode, $targetfile, $verbose );
829 $result->{install}{$targetfile} = $sourcefile;
830 1
831 } or do {
832 $result->{install_fail}{$targetfile} = $sourcefile;
833 die $@;
834 };
060fb22c 835 } else {
546acaf9 836 $result->{install_unchanged}{$targetfile} = $sourcefile;
060fb22c
YO
837 print "Skipping $targetfile (unchanged)\n" if $verbose;
838 }
839
546acaf9 840 if ( $uninstall_shadows ) {
060fb22c 841 inc_uninstall($sourcefile,$ffd, $verbose,
546acaf9
YO
842 $dry_run,
843 $realtarget ne $targetfile ? $realtarget : "",
844 $result);
060fb22c
YO
845 }
846
847 # Record the full pathname.
848 $packlist->{$targetfile}++;
4b6d56d3 849 }
3a465856 850
4b6d56d3 851 if ($pack{'write'}) {
060fb22c 852 $dir = install_rooted_dir(dirname($pack{'write'}));
546acaf9 853 _mkpath( $dir, 0, 0755, $verbose, $dry_run );
4954abf7 854 print "Writing $pack{'write'}\n" if $verbose;
546acaf9 855 $packlist->write(install_rooted_file($pack{'write'})) unless $dry_run;
4b6d56d3 856 }
3a465856
SP
857
858 _do_cleanup($verbose);
546acaf9 859 return $result;
3a465856
SP
860}
861
862=begin _private
863
864=item _do_cleanup
865
866Standardize finish event for after another instruction has occured.
867Handles converting $MUST_REBOOT to a die for instance.
868
869=end _private
870
871=cut
872
873sub _do_cleanup {
874 my ($verbose) = @_;
875 if ($MUST_REBOOT) {
dc7d4075
SP
876 die _estr "Operation not completed! ",
877 "You must reboot to complete the installation.",
878 "Sorry.";
3a465856 879 } elsif (defined $MUST_REBOOT & $verbose) {
dc7d4075 880 warn _estr "Installation will be completed at the next reboot.\n",
3a465856
SP
881 "However it is not necessary to reboot immediately.\n";
882 }
4b6d56d3
PP
883}
884
3a465856
SP
885=begin _undocumented
886
887=item install_rooted_file( $file )
888
889Returns $file, or catfile($INSTALL_ROOT,$file) if $INSTALL_ROOT
890is defined.
891
892=item install_rooted_dir( $dir )
893
894Returns $dir, or catdir($INSTALL_ROOT,$dir) if $INSTALL_ROOT
895is defined.
896
897=end _undocumented
898
899=cut
900
901
479d2113
MS
902sub install_rooted_file {
903 if (defined $INSTALL_ROOT) {
060fb22c 904 File::Spec->catfile($INSTALL_ROOT, $_[0]);
479d2113 905 } else {
060fb22c 906 $_[0];
479d2113
MS
907 }
908}
909
910
911sub install_rooted_dir {
912 if (defined $INSTALL_ROOT) {
060fb22c 913 File::Spec->catdir($INSTALL_ROOT, $_[0]);
479d2113 914 } else {
060fb22c 915 $_[0];
479d2113
MS
916 }
917}
918
3a465856
SP
919=begin _undocumented
920
921=item forceunlink( $file, $tryhard )
922
923Tries to delete a file. If $tryhard is true then we will use whatever
924devious tricks we can to delete the file. Currently this only applies to
925Win32 in that it will try to use Win32API::File to schedule a delete at
926reboot. A wrapper for _unlink_or_rename().
927
928=end _undocumented
929
930=cut
931
479d2113
MS
932
933sub forceunlink {
3a465856 934 my ( $file, $tryhard )= @_; #XXX OS-SPECIFIC
f6d658cc 935 _unlink_or_rename( $file, $tryhard, not("installing") );
479d2113
MS
936}
937
3a465856
SP
938=begin _undocumented
939
940=item directory_not_empty( $dir )
941
942Returns 1 if there is an .exists file somewhere in a directory tree.
943Returns 0 if there is not.
944
945=end _undocumented
946
947=cut
479d2113 948
456e5c25
A
949sub directory_not_empty ($) {
950 my($dir) = @_;
951 my $files = 0;
952 find(sub {
060fb22c
YO
953 return if $_ eq ".exists";
954 if (-f) {
955 $File::Find::prune++;
956 $files = 1;
957 }
456e5c25
A
958 }, $dir);
959 return $files;
960}
961
3f6d40bd 962=pod
479d2113
MS
963
964=item B<install_default> I<DISCOURAGED>
965
966 install_default();
967 install_default($fullext);
968
969Calls install() with arguments to copy a module from blib/ to the
970default site installation location.
971
972$fullext is the name of the module converted to a directory
973(ie. Foo::Bar would be Foo/Bar). If $fullext is not specified, it
974will attempt to read it from @ARGV.
975
976This is primarily useful for install scripts.
977
978B<NOTE> This function is not really useful because of the hard-coded
979install location with no way to control site vs core vs vendor
980directories and the strange way in which the module name is given.
981Consider its use discouraged.
982
983=cut
984
c3648e42 985sub install_default {
dc7d4075 986 @_ < 2 or Carp::croak("install_default should be called with 0 or 1 argument");
c3648e42
IZ
987 my $FULLEXT = @_ ? shift : $ARGV[0];
988 defined $FULLEXT or die "Do not know to where to write install log";
7292dc67
RGS
989 my $INST_LIB = File::Spec->catdir($Curdir,"blib","lib");
990 my $INST_ARCHLIB = File::Spec->catdir($Curdir,"blib","arch");
991 my $INST_BIN = File::Spec->catdir($Curdir,'blib','bin');
992 my $INST_SCRIPT = File::Spec->catdir($Curdir,'blib','script');
993 my $INST_MAN1DIR = File::Spec->catdir($Curdir,'blib','man1');
994 my $INST_MAN3DIR = File::Spec->catdir($Curdir,'blib','man3');
4954abf7
YO
995
996 my @INST_HTML;
997 if($Config{installhtmldir}) {
998 my $INST_HTMLDIR = File::Spec->catdir($Curdir,'blib','html');
999 @INST_HTML = ($INST_HTMLDIR => $Config{installhtmldir});
1000 }
1001
c3648e42 1002 install({
060fb22c
YO
1003 read => "$Config{sitearchexp}/auto/$FULLEXT/.packlist",
1004 write => "$Config{installsitearch}/auto/$FULLEXT/.packlist",
1005 $INST_LIB => (directory_not_empty($INST_ARCHLIB)) ?
1006 $Config{installsitearch} :
1007 $Config{installsitelib},
1008 $INST_ARCHLIB => $Config{installsitearch},
1009 $INST_BIN => $Config{installbin} ,
1010 $INST_SCRIPT => $Config{installscript},
1011 $INST_MAN1DIR => $Config{installman1dir},
1012 $INST_MAN3DIR => $Config{installman3dir},
16f0d0fc 1013 @INST_HTML,
060fb22c 1014 },1,0,0);
c3648e42
IZ
1015}
1016
479d2113
MS
1017
1018=item B<uninstall>
1019
1020 uninstall($packlist_file);
1021 uninstall($packlist_file, $verbose, $dont_execute);
1022
1023Removes the files listed in a $packlist_file.
1024
1025If $verbose is true, will print out each file removed. Default is
1026false.
1027
1028If $dont_execute is true it will only print what it was going to do
1029without actually doing it. Default is false.
1030
1031=cut
1032
4b6d56d3 1033sub uninstall {
546acaf9 1034 my($fil,$verbose,$dry_run) = @_;
479d2113 1035 $verbose ||= 0;
546acaf9 1036 $dry_run ||= 0;
479d2113 1037
dc7d4075
SP
1038 die _estr "ERROR: no packlist file found: '$fil'"
1039 unless -f $fil;
f1387719
PP
1040 # my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
1041 # require $my_req; # Hairy, but for the first
354f3b56
AB
1042 my ($packlist) = ExtUtils::Packlist->new($fil);
1043 foreach (sort(keys(%$packlist))) {
060fb22c
YO
1044 chomp;
1045 print "unlink $_\n" if $verbose;
546acaf9 1046 forceunlink($_,'tryhard') unless $dry_run;
4b6d56d3
PP
1047 }
1048 print "unlink $fil\n" if $verbose;
546acaf9 1049 forceunlink($fil, 'tryhard') unless $dry_run;
3a465856 1050 _do_cleanup($verbose);
f1387719
PP
1051}
1052
3a465856
SP
1053=begin _undocumented
1054
546acaf9 1055=item inc_uninstall($filepath,$libdir,$verbose,$dry_run,$ignore,$results)
3a465856
SP
1056
1057Remove shadowed files. If $ignore is true then it is assumed to hold
1058a filename to ignore. This is used to prevent spurious warnings from
c4a6f826 1059occurring when doing an install at reboot.
3a465856 1060
f6d658cc
YO
1061We now only die when failing to remove a file that has precedence over
1062our own, when our install has precedence we only warn.
1063
546acaf9
YO
1064$results is assumed to contain a hashref which will have the keys
1065'uninstall' and 'uninstall_fail' populated with keys for the files
1066removed and values of the source files they would shadow.
1067
3a465856
SP
1068=end _undocumented
1069
1070=cut
1071
f1387719 1072sub inc_uninstall {
546acaf9 1073 my($filepath,$libdir,$verbose,$dry_run,$ignore,$results) = @_;
f1387719 1074 my($dir);
3a465856 1075 $ignore||="";
1df8d179 1076 my $file = (File::Spec->splitpath($filepath))[2];
f1387719 1077 my %seen_dir = ();
16f0d0fc 1078
3a465856 1079 my @PERL_ENV_LIB = split $Config{path_sep}, defined $ENV{'PERL5LIB'}
1df8d179 1080 ? $ENV{'PERL5LIB'} : $ENV{'PERLLIB'} || '';
16f0d0fc
YO
1081
1082 my @dirs=( @PERL_ENV_LIB,
1083 @INC,
f6d658cc
YO
1084 @Config{qw(archlibexp
1085 privlibexp
1086 sitearchexp
16f0d0fc
YO
1087 sitelibexp)});
1088
f6d658cc
YO
1089 #warn join "\n","---",@dirs,"---";
1090 my $seen_ours;
1091 foreach $dir ( @dirs ) {
553b5000 1092 my $canonpath = $Is_VMS ? $dir : File::Spec->canonpath($dir);
060fb22c
YO
1093 next if $canonpath eq $Curdir;
1094 next if $seen_dir{$canonpath}++;
1095 my $targetfile = File::Spec->catfile($canonpath,$libdir,$file);
1096 next unless -f $targetfile;
1097
1098 # The reason why we compare file's contents is, that we cannot
1099 # know, which is the file we just installed (AFS). So we leave
1100 # an identical file in place
1101 my $diff = 0;
1102 if ( -f $targetfile && -s _ == -s $filepath) {
1103 # We have a good chance, we can skip this one
1104 $diff = compare($filepath,$targetfile);
1105 } else {
1106 $diff++;
1107 }
3a465856 1108 print "#$file and $targetfile differ\n" if $diff && $verbose > 1;
f1387719 1109
f6d658cc
YO
1110 if (!$diff or $targetfile eq $ignore) {
1111 $seen_ours = 1;
1112 next;
1113 }
546acaf9
YO
1114 if ($dry_run) {
1115 $results->{uninstall}{$targetfile} = $filepath;
060fb22c
YO
1116 if ($verbose) {
1117 $Inc_uninstall_warn_handler ||= ExtUtils::Install::Warn->new();
1118 $libdir =~ s|^\./||s ; # That's just cosmetics, no need to port. It looks prettier.
1119 $Inc_uninstall_warn_handler->add(
479d2113
MS
1120 File::Spec->catfile($libdir, $file),
1121 $targetfile
1122 );
060fb22c
YO
1123 }
1124 # if not verbose, we just say nothing
1125 } else {
1126 print "Unlinking $targetfile (shadowing?)\n" if $verbose;
f6d658cc 1127 eval {
16f0d0fc 1128 die "Fake die for testing"
f6d658cc 1129 if $ExtUtils::Install::Testing and
553b5000 1130 ucase(File::Spec->canonpath($ExtUtils::Install::Testing)) eq ucase($targetfile);
f6d658cc 1131 forceunlink($targetfile,'tryhard');
546acaf9 1132 $results->{uninstall}{$targetfile} = $filepath;
f6d658cc
YO
1133 1;
1134 } or do {
546acaf9 1135 $results->{fail_uninstall}{$targetfile} = $filepath;
16f0d0fc 1136 if ($seen_ours) {
f6d658cc
YO
1137 warn "Failed to remove probably harmless shadow file '$targetfile'\n";
1138 } else {
1139 die "$@\n";
1140 }
1141 };
060fb22c 1142 }
f1387719 1143 }
08ad6bd5
PP
1144}
1145
3a465856
SP
1146=begin _undocumented
1147
1148=item run_filter($cmd,$src,$dest)
1149
1150Filter $src using $cmd into $dest.
1151
1152=end _undocumented
1153
1154=cut
1155
131aa089
RM
1156sub run_filter {
1157 my ($cmd, $src, $dest) = @_;
1df8d179 1158 local(*CMD, *SRC);
57b1a898
MS
1159 open(CMD, "|$cmd >$dest") || die "Cannot fork: $!";
1160 open(SRC, $src) || die "Cannot open $src: $!";
131aa089
RM
1161 my $buf;
1162 my $sz = 1024;
57b1a898 1163 while (my $len = sysread(SRC, $buf, $sz)) {
060fb22c 1164 syswrite(CMD, $buf, $len);
131aa089 1165 }
57b1a898
MS
1166 close SRC;
1167 close CMD or die "Filter command '$cmd' failed for $src";
131aa089
RM
1168}
1169
3f6d40bd 1170=pod
479d2113
MS
1171
1172=item B<pm_to_blib>
1173
1174 pm_to_blib(\%from_to, $autosplit_dir);
1175 pm_to_blib(\%from_to, $autosplit_dir, $filter_cmd);
1176
1177Copies each key of %from_to to its corresponding value efficiently.
1178Filenames with the extension .pm are autosplit into the $autosplit_dir.
af7522e5 1179Any destination directories are created.
479d2113
MS
1180
1181$filter_cmd is an optional shell command to run each .pm file through
1182prior to splitting and copying. Input is the contents of the module,
1183output the new module contents.
1184
1185You can have an environment variable PERL_INSTALL_ROOT set which will
1186be prepended as a directory to each installed file (and directory).
1187
1188=cut
1189
08ad6bd5 1190sub pm_to_blib {
131aa089 1191 my($fromto,$autodir,$pm_filter) = @_;
08ad6bd5 1192
dc7d4075 1193 _mkpath($autodir,0,0755);
479d2113 1194 while(my($from, $to) = each %$fromto) {
060fb22c 1195 if( -f $to && -s $from == -s $to && -M $to < -M $from ) {
dedf98bc
MS
1196 print "Skip $to (unchanged)\n";
1197 next;
1198 }
131aa089 1199
060fb22c
YO
1200 # When a pm_filter is defined, we need to pre-process the source first
1201 # to determine whether it has changed or not. Therefore, only perform
1202 # the comparison check when there's no filter to be ran.
1203 # -- RAM, 03/01/2001
131aa089 1204
060fb22c 1205 my $need_filtering = defined $pm_filter && length $pm_filter &&
479d2113 1206 $from =~ /\.pm$/;
131aa089 1207
060fb22c
YO
1208 if (!$need_filtering && 0 == compare($from,$to)) {
1209 print "Skip $to (unchanged)\n";
1210 next;
1211 }
1212 if (-f $to){
1213 # we wont try hard here. its too likely to mess things up.
1214 forceunlink($to);
1215 } else {
1216 _mkpath(dirname($to),0,0755);
1217 }
1218 if ($need_filtering) {
1219 run_filter($pm_filter, $from, $to);
1220 print "$pm_filter <$from >$to\n";
1221 } else {
1222 _copy( $from, $to );
1223 print "cp $from $to\n";
1224 }
1225 my($mode,$atime,$mtime) = (stat $from)[2,8,9];
1226 utime($atime,$mtime+$Is_VMS,$to);
1227 _chmod(0444 | ( $mode & 0111 ? 0111 : 0 ),$to);
1228 next unless $from =~ /\.pm$/;
1229 _autosplit($to,$autodir);
08ad6bd5 1230 }
4b6d56d3
PP
1231}
1232
479d2113
MS
1233
1234=begin _private
1235
1236=item _autosplit
1237
1238From 1.0307 back, AutoSplit will sometimes leave an open filehandle to
1239the file being split. This causes problems on systems with mandatory
1240locking (ie. Windows). So we wrap it and close the filehandle.
1241
1242=end _private
1243
1244=cut
1245
3a465856 1246sub _autosplit { #XXX OS-SPECIFIC
479d2113
MS
1247 my $retval = autosplit(@_);
1248 close *AutoSplit::IN if defined *AutoSplit::IN{IO};
1249
1250 return $retval;
1251}
1252
1253
f1387719
PP
1254package ExtUtils::Install::Warn;
1255
1256sub new { bless {}, shift }
1257
1258sub add {
1259 my($self,$file,$targetfile) = @_;
1260 push @{$self->{$file}}, $targetfile;
1261}
1262
1263sub DESTROY {
479d2113
MS
1264 unless(defined $INSTALL_ROOT) {
1265 my $self = shift;
1266 my($file,$i,$plural);
1267 foreach $file (sort keys %$self) {
1268 $plural = @{$self->{$file}} > 1 ? "s" : "";
1269 print "## Differing version$plural of $file found. You might like to\n";
1270 for (0..$#{$self->{$file}}) {
1271 print "rm ", $self->{$file}[$_], "\n";
1272 $i++;
1273 }
1274 }
1275 $plural = $i>1 ? "all those files" : "this file";
3a465856 1276 my $inst = (_invokant() eq 'ExtUtils::MakeMaker')
553b5000
NC
1277 ? ( $Config::Config{make} || 'make' ).' install'
1278 . ( $Is_VMS ? '/MACRO="UNINST"=1' : ' UNINST=1' )
3a465856
SP
1279 : './Build install uninst=1';
1280 print "## Running '$inst' will unlink $plural for you.\n";
479d2113 1281 }
f1387719
PP
1282}
1283
3a465856
SP
1284=begin _private
1285
1286=item _invokant
1287
1288Does a heuristic on the stack to see who called us for more intelligent
1289error messages. Currently assumes we will be called only by Module::Build
1290or by ExtUtils::MakeMaker.
1291
1292=end _private
1293
1294=cut
1295
1296sub _invokant {
1297 my @stack;
1298 my $frame = 0;
1299 while (my $file = (caller($frame++))[1]) {
1300 push @stack, (File::Spec->splitpath($file))[2];
1301 }
1302
1303 my $builder;
1304 my $top = pop @stack;
1305 if ($top =~ /^Build/i || exists($INC{'Module/Build.pm'})) {
1306 $builder = 'Module::Build';
1307 } else {
1308 $builder = 'ExtUtils::MakeMaker';
1309 }
1310 return $builder;
1311}
1312
3f6d40bd 1313=pod
4b6d56d3 1314
3a465856 1315=back
4b6d56d3 1316
479d2113 1317=head1 ENVIRONMENT
4b6d56d3 1318
479d2113 1319=over 4
4b6d56d3 1320
479d2113 1321=item B<PERL_INSTALL_ROOT>
4b6d56d3 1322
479d2113 1323Will be prepended to each install path.
4b6d56d3 1324
3a465856
SP
1325=item B<EU_INSTALL_IGNORE_SKIP>
1326
1327Will prevent the automatic use of INSTALL.SKIP as the install skip file.
1328
1329=item B<EU_INSTALL_SITE_SKIPFILE>
1330
1331If there is no INSTALL.SKIP file in the make directory then this value
1332can be used to provide a default.
1333
3f6d40bd 1334=item B<EU_INSTALL_ALWAYS_COPY>
546acaf9
YO
1335
1336If this environment variable is true then normal install processes will
1337always overwrite older identical files during the install process.
1338
3f6d40bd
SH
1339Note that the alias EU_ALWAYS_COPY will be supported if EU_INSTALL_ALWAYS_COPY
1340is not defined until at least the 1.50 release. Please ensure you use the
16f0d0fc 1341correct EU_INSTALL_ALWAYS_COPY.
3f6d40bd 1342
479d2113 1343=back
4b6d56d3 1344
479d2113 1345=head1 AUTHOR
4b6d56d3 1346
479d2113 1347Original author lost in the mists of time. Probably the same as Makemaker.
08ad6bd5 1348
f6d658cc 1349Production release currently maintained by demerphq C<yves at cpan.org>,
546acaf9 1350extensive changes by Michael G. Schwern.
4b6d56d3 1351
479d2113
MS
1352Send bug reports via http://rt.cpan.org/. Please send your
1353generated Makefile along with your report.
4b6d56d3 1354
479d2113
MS
1355=head1 LICENSE
1356
3a465856 1357This program is free software; you can redistribute it and/or
479d2113
MS
1358modify it under the same terms as Perl itself.
1359
a7d1454b 1360See L<http://www.perl.com/perl/misc/Artistic.html>
4b6d56d3 1361
ae1d6394 1362
08ad6bd5 1363=cut
479d2113
MS
1364
13651;