This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
.1]; as Re: [PATCH 5.6.1-TRIAL1 and @8223]; was Re: Perlbug 20000322.006 status update
[perl5.git] / lib / ExtUtils / Install.pm
CommitLineData
4b6d56d3
PP
1package ExtUtils::Install;
2
17f410f9
GS
3use 5.005_64;
4our(@ISA, @EXPORT, $VERSION);
456e5c25
A
5$VERSION = substr q$Revision: 1.28 $, 10;
6# $Date: 1998/01/25 07:08:24 $
f1387719 7
08ad6bd5 8use Exporter;
08ad6bd5 9use Carp ();
c3648e42 10use Config qw(%Config);
4b6d56d3 11@ISA = ('Exporter');
c3648e42 12@EXPORT = ('install','uninstall','pm_to_blib', 'install_default');
08ad6bd5
PP
13$Is_VMS = $^O eq 'VMS';
14
39e571d4 15my $splitchar = $^O eq 'VMS' ? '|' : ($^O eq 'os2' || $^O eq 'dos') ? ';' : ':';
d6abf24b 16my @PERL_ENV_LIB = split $splitchar, defined $ENV{'PERL5LIB'} ? $ENV{'PERL5LIB'} : $ENV{'PERLLIB'} || '';
f1387719
PP
17my $Inc_uninstall_warn_handler;
18
a9d83807
BC
19# install relative to here
20
21my $INSTALL_ROOT = $ENV{PERL_INSTALL_ROOT};
22
23use File::Spec;
24
25sub install_rooted_file {
26 if (defined $INSTALL_ROOT) {
27 MY->catfile($INSTALL_ROOT, $_[0]);
28 } else {
29 $_[0];
30 }
31}
32
33sub install_rooted_dir {
34 if (defined $INSTALL_ROOT) {
35 MY->catdir($INSTALL_ROOT, $_[0]);
36 } else {
37 $_[0];
38 }
39}
40
17f410f9 41#our(@EXPORT, @ISA, $Is_VMS);
4b6d56d3
PP
42#use strict;
43
f1387719
PP
44sub forceunlink {
45 chmod 0666, $_[0];
46 unlink $_[0] or Carp::croak("Cannot forceunlink $_[0]: $!")
47}
08ad6bd5 48
4b6d56d3 49sub install {
f1387719 50 my($hash,$verbose,$nonono,$inc_uninstall) = @_;
4b6d56d3
PP
51 $verbose ||= 0;
52 $nonono ||= 0;
08ad6bd5
PP
53
54 use Cwd qw(cwd);
55 use ExtUtils::MakeMaker; # to implement a MY class
354f3b56 56 use ExtUtils::Packlist;
08ad6bd5
PP
57 use File::Basename qw(dirname);
58 use File::Copy qw(copy);
59 use File::Find qw(find);
60 use File::Path qw(mkpath);
fb73857a 61 use File::Compare qw(compare);
08ad6bd5 62
4b6d56d3 63 my(%hash) = %$hash;
354f3b56
AB
64 my(%pack, $dir, $warn_permissions);
65 my($packlist) = ExtUtils::Packlist->new();
3e3baf6d
TB
66 # -w doesn't work reliably on FAT dirs
67 $warn_permissions++ if $^O eq 'MSWin32';
354f3b56 68 local(*DIR);
4b6d56d3
PP
69 for (qw/read write/) {
70 $pack{$_}=$hash{$_};
71 delete $hash{$_};
72 }
08ad6bd5
PP
73 my($source_dir_or_file);
74 foreach $source_dir_or_file (sort keys %hash) {
4b6d56d3
PP
75 #Check if there are files, and if yes, look if the corresponding
76 #target directory is writable for us
08ad6bd5 77 opendir DIR, $source_dir_or_file or next;
f1387719 78 for (readdir DIR) {
4b6d56d3 79 next if $_ eq "." || $_ eq ".." || $_ eq ".exists";
a9d83807
BC
80 my $targetdir = install_rooted_dir($hash{$source_dir_or_file});
81 if (-w $targetdir ||
82 mkpath($targetdir)) {
4b6d56d3
PP
83 last;
84 } else {
456e5c25
A
85 warn "Warning: You do not have permissions to " .
86 "install into $hash{$source_dir_or_file}"
cee7b94a 87 unless $warn_permissions++;
4b6d56d3
PP
88 }
89 }
90 closedir DIR;
91 }
a9d83807
BC
92 my $tmpfile = install_rooted_file($pack{"read"});
93 $packlist->read($tmpfile) if (-f $tmpfile);
4b6d56d3 94 my $cwd = cwd();
4b6d56d3 95
4b6d56d3
PP
96 my($source);
97 MOD_INSTALL: foreach $source (sort keys %hash) {
98 #copy the tree to the target directory without altering
99 #timestamp and permission and remember for the .packlist
100 #file. The packlist file contains the absolute paths of the
101 #install locations. AFS users may call this a bug. We'll have
102 #to reconsider how to add the means to satisfy AFS users also.
456e5c25
A
103
104 #October 1997: we want to install .pm files into archlib if
105 #there are any files in arch. So we depend on having ./blib/arch
106 #hardcoded here.
a9d83807
BC
107
108 my $targetroot = install_rooted_dir($hash{$source});
109
e8aa0dbc
AB
110 if ($source eq "blib/lib" and
111 exists $hash{"blib/arch"} and
112 directory_not_empty("blib/arch")) {
a9d83807 113 $targetroot = install_rooted_dir($hash{"blib/arch"});
dcc96bbd 114 print "Files found in blib/arch: installing files in blib/lib into architecture dependent library tree\n";
456e5c25 115 }
4b6d56d3
PP
116 chdir($source) or next;
117 find(sub {
118 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
119 $atime,$mtime,$ctime,$blksize,$blocks) = stat;
120 return unless -f _;
121 return if $_ eq ".exists";
a9d83807
BC
122 my $targetdir = MY->catdir($targetroot, $File::Find::dir);
123 my $origfile = $_;
124 my $targetfile = MY->catfile($targetdir, $_);
4b6d56d3 125
f1387719 126 my $diff = 0;
4b6d56d3
PP
127 if ( -f $targetfile && -s _ == $size) {
128 # We have a good chance, we can skip this one
fb73857a 129 $diff = compare($_,$targetfile);
4b6d56d3
PP
130 } else {
131 print "$_ differs\n" if $verbose>1;
132 $diff++;
133 }
134
135 if ($diff){
08ad6bd5 136 if (-f $targetfile){
f1387719 137 forceunlink($targetfile) unless $nonono;
08ad6bd5
PP
138 } else {
139 mkpath($targetdir,0,0755) unless $nonono;
140 print "mkpath($targetdir,0,0755)\n" if $verbose>1;
141 }
4b6d56d3 142 copy($_,$targetfile) unless $nonono;
f1387719 143 print "Installing $targetfile\n";
08ad6bd5 144 utime($atime,$mtime + $Is_VMS,$targetfile) unless $nonono>1;
4b6d56d3 145 print "utime($atime,$mtime,$targetfile)\n" if $verbose>1;
f1387719 146 $mode = 0444 | ( $mode & 0111 ? 0111 : 0 );
4b6d56d3
PP
147 chmod $mode, $targetfile;
148 print "chmod($mode, $targetfile)\n" if $verbose>1;
149 } else {
f1387719
PP
150 print "Skipping $targetfile (unchanged)\n" if $verbose;
151 }
152
153 if (! defined $inc_uninstall) { # it's called
154 } elsif ($inc_uninstall == 0){
155 inc_uninstall($_,$File::Find::dir,$verbose,1); # nonono set to 1
156 } else {
157 inc_uninstall($_,$File::Find::dir,$verbose,0); # nonono set to 0
4b6d56d3 158 }
a9d83807 159 $packlist->{$origfile}++;
4b6d56d3
PP
160
161 }, ".");
08ad6bd5 162 chdir($cwd) or Carp::croak("Couldn't chdir to $cwd: $!");
4b6d56d3 163 }
4b6d56d3 164 if ($pack{'write'}) {
a9d83807 165 $dir = install_rooted_dir(dirname($pack{'write'}));
4b6d56d3
PP
166 mkpath($dir,0,0755);
167 print "Writing $pack{'write'}\n";
a9d83807 168 $packlist->write(install_rooted_file($pack{'write'}));
4b6d56d3
PP
169 }
170}
171
456e5c25
A
172sub directory_not_empty ($) {
173 my($dir) = @_;
174 my $files = 0;
175 find(sub {
176 return if $_ eq ".exists";
177 if (-f) {
178 $File::Find::prune++;
179 $files = 1;
180 }
181 }, $dir);
182 return $files;
183}
184
c3648e42
IZ
185sub install_default {
186 @_ < 2 or die "install_default should be called with 0 or 1 argument";
187 my $FULLEXT = @_ ? shift : $ARGV[0];
188 defined $FULLEXT or die "Do not know to where to write install log";
189 my $INST_LIB = MM->catdir(MM->curdir,"blib","lib");
190 my $INST_ARCHLIB = MM->catdir(MM->curdir,"blib","arch");
191 my $INST_BIN = MM->catdir(MM->curdir,'blib','bin');
192 my $INST_SCRIPT = MM->catdir(MM->curdir,'blib','script');
193 my $INST_MAN1DIR = MM->catdir(MM->curdir,'blib','man1');
194 my $INST_MAN3DIR = MM->catdir(MM->curdir,'blib','man3');
195 install({
196 read => "$Config{sitearchexp}/auto/$FULLEXT/.packlist",
197 write => "$Config{installsitearch}/auto/$FULLEXT/.packlist",
456e5c25
A
198 $INST_LIB => (directory_not_empty($INST_ARCHLIB)) ?
199 $Config{installsitearch} :
200 $Config{installsitelib},
c3648e42
IZ
201 $INST_ARCHLIB => $Config{installsitearch},
202 $INST_BIN => $Config{installbin} ,
203 $INST_SCRIPT => $Config{installscript},
204 $INST_MAN1DIR => $Config{installman1dir},
205 $INST_MAN3DIR => $Config{installman3dir},
206 },1,0,0);
207}
208
4b6d56d3 209sub uninstall {
354f3b56 210 use ExtUtils::Packlist;
4b6d56d3
PP
211 my($fil,$verbose,$nonono) = @_;
212 die "no packlist file found: $fil" unless -f $fil;
f1387719
PP
213 # my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
214 # require $my_req; # Hairy, but for the first
354f3b56
AB
215 my ($packlist) = ExtUtils::Packlist->new($fil);
216 foreach (sort(keys(%$packlist))) {
4b6d56d3
PP
217 chomp;
218 print "unlink $_\n" if $verbose;
f1387719 219 forceunlink($_) unless $nonono;
4b6d56d3
PP
220 }
221 print "unlink $fil\n" if $verbose;
f1387719
PP
222 forceunlink($fil) unless $nonono;
223}
224
225sub inc_uninstall {
226 my($file,$libdir,$verbose,$nonono) = @_;
227 my($dir);
f1387719 228 my %seen_dir = ();
456e5c25
A
229 foreach $dir (@INC, @PERL_ENV_LIB, @Config{qw(archlibexp
230 privlibexp
231 sitearchexp
232 sitelibexp)}) {
f1387719
PP
233 next if $dir eq ".";
234 next if $seen_dir{$dir}++;
456e5c25 235 my($targetfile) = MY->catfile($dir,$libdir,$file);
f1387719
PP
236 next unless -f $targetfile;
237
238 # The reason why we compare file's contents is, that we cannot
239 # know, which is the file we just installed (AFS). So we leave
240 # an identical file in place
241 my $diff = 0;
242 if ( -f $targetfile && -s _ == -s $file) {
243 # We have a good chance, we can skip this one
fb73857a 244 $diff = compare($file,$targetfile);
f1387719
PP
245 } else {
246 print "#$file and $targetfile differ\n" if $verbose>1;
247 $diff++;
248 }
249
250 next unless $diff;
251 if ($nonono) {
252 if ($verbose) {
253 $Inc_uninstall_warn_handler ||= new ExtUtils::Install::Warn;
4f44ac69 254 $libdir =~ s|^\./||s ; # That's just cosmetics, no need to port. It looks prettier.
f1387719
PP
255 $Inc_uninstall_warn_handler->add("$libdir/$file",$targetfile);
256 }
257 # if not verbose, we just say nothing
258 } else {
259 print "Unlinking $targetfile (shadowing?)\n";
260 forceunlink($targetfile);
261 }
262 }
08ad6bd5
PP
263}
264
265sub pm_to_blib {
266 my($fromto,$autodir) = @_;
267
268 use File::Basename qw(dirname);
269 use File::Copy qw(copy);
270 use File::Path qw(mkpath);
fb73857a 271 use File::Compare qw(compare);
08ad6bd5 272 use AutoSplit;
f1387719
PP
273 # my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
274 # require $my_req; # Hairy, but for the first
08ad6bd5 275
68dc0745
PP
276 if (!ref($fromto) && -r $fromto)
277 {
278 # Win32 has severe command line length limitations, but
279 # can generate temporary files on-the-fly
280 # so we pass name of file here - eval it to get hash
281 open(FROMTO,"<$fromto") or die "Cannot open $fromto:$!";
282 my $str = '$fromto = {qw{'.join('',<FROMTO>).'}}';
283 eval $str;
284 close(FROMTO);
285 }
286
08ad6bd5
PP
287 mkpath($autodir,0,0755);
288 foreach (keys %$fromto) {
289 next if -f $fromto->{$_} && -M $fromto->{$_} < -M $_;
fb73857a 290 unless (compare($_,$fromto->{$_})){
08ad6bd5
PP
291 print "Skip $fromto->{$_} (unchanged)\n";
292 next;
293 }
294 if (-f $fromto->{$_}){
f1387719 295 forceunlink($fromto->{$_});
08ad6bd5
PP
296 } else {
297 mkpath(dirname($fromto->{$_}),0,0755);
298 }
299 copy($_,$fromto->{$_});
cee7b94a
PP
300 my($mode,$atime,$mtime) = (stat)[2,8,9];
301 utime($atime,$mtime+$Is_VMS,$fromto->{$_});
302 chmod(0444 | ( $mode & 0111 ? 0111 : 0 ),$fromto->{$_});
08ad6bd5 303 print "cp $_ $fromto->{$_}\n";
4f44ac69 304 next unless /\.pm\z/;
08ad6bd5
PP
305 autosplit($fromto->{$_},$autodir);
306 }
4b6d56d3
PP
307}
308
f1387719
PP
309package ExtUtils::Install::Warn;
310
311sub new { bless {}, shift }
312
313sub add {
314 my($self,$file,$targetfile) = @_;
315 push @{$self->{$file}}, $targetfile;
316}
317
318sub DESTROY {
a9d83807
BC
319 unless(defined $INSTALL_ROOT) {
320 my $self = shift;
321 my($file,$i,$plural);
322 foreach $file (sort keys %$self) {
323 $plural = @{$self->{$file}} > 1 ? "s" : "";
324 print "## Differing version$plural of $file found. You might like to\n";
325 for (0..$#{$self->{$file}}) {
326 print "rm ", $self->{$file}[$_], "\n";
327 $i++;
328 }
329 }
330 $plural = $i>1 ? "all those files" : "this file";
331 print "## Running 'make install UNINST=1' will unlink $plural for you.\n";
f1387719 332 }
f1387719
PP
333}
334
4b6d56d3
PP
3351;
336
337__END__
338
339=head1 NAME
340
341ExtUtils::Install - install files from here to there
342
343=head1 SYNOPSIS
344
345B<use ExtUtils::Install;>
346
347B<install($hashref,$verbose,$nonono);>
348
349B<uninstall($packlistfile,$verbose,$nonono);>
350
08ad6bd5
PP
351B<pm_to_blib($hashref);>
352
4b6d56d3
PP
353=head1 DESCRIPTION
354
08ad6bd5 355Both install() and uninstall() are specific to the way
4b6d56d3
PP
356ExtUtils::MakeMaker handles the installation and deinstallation of
357perl modules. They are not designed as general purpose tools.
358
359install() takes three arguments. A reference to a hash, a verbose
360switch and a don't-really-do-it switch. The hash ref contains a
361mapping of directories: each key/value pair is a combination of
362directories to be copied. Key is a directory to copy from, value is a
363directory to copy to. The whole tree below the "from" directory will
364be copied preserving timestamps and permissions.
365
366There are two keys with a special meaning in the hash: "read" and
367"write". After the copying is done, install will write the list of
1fef88e7
JM
368target files to the file named by C<$hashref-E<gt>{write}>. If there is
369another file named by C<$hashref-E<gt>{read}>, the contents of this file will
4b6d56d3 370be merged into the written file. The read and the written file may be
a7665c5e 371identical, but on AFS it is quite likely that people are installing to a
4b6d56d3
PP
372different directory than the one where the files later appear.
373
c3648e42
IZ
374install_default() takes one or less arguments. If no arguments are
375specified, it takes $ARGV[0] as if it was specified as an argument.
376The argument is the value of MakeMaker's C<FULLEXT> key, like F<Tk/Canvas>.
377This function calls install() with the same arguments as the defaults
378the MakeMaker would use.
379
de592821 380The argument-less form is convenient for install scripts like
c3648e42
IZ
381
382 perl -MExtUtils::Install -e install_default Tk/Canvas
383
a7665c5e 384Assuming this command is executed in a directory with a populated F<blib>
c3648e42
IZ
385directory, it will proceed as if the F<blib> was build by MakeMaker on
386this machine. This is useful for binary distributions.
387
4b6d56d3
PP
388uninstall() takes as first argument a file containing filenames to be
389unlinked. The second argument is a verbose switch, the third is a
390no-don't-really-do-it-now switch.
391
08ad6bd5
PP
392pm_to_blib() takes a hashref as the first argument and copies all keys
393of the hash to the corresponding values efficiently. Filenames with
394the extension pm are autosplit. Second argument is the autosplit
395directory.
4b6d56d3 396
ae1d6394
JH
397You can have an environment variable PERL_INSTALL_ROOT set which will
398be prepended as a directory to each installed file (and directory).
399
08ad6bd5 400=cut