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