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