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