1 package ExtUtils::Install;
3 $VERSION = substr q$Revision: 1.19 $, 10;
4 # $Date: 1997/08/01 08:39:37 $
8 use Config qw(%Config);
9 use vars qw(@ISA @EXPORT $VERSION);
11 @EXPORT = ('install','uninstall','pm_to_blib', 'install_default');
12 $Is_VMS = $^O eq 'VMS';
14 my $splitchar = $^O eq 'VMS' ? '|' : $^O eq 'os2' ? ';' : ':';
15 my @PERL_ENV_LIB = split $splitchar, defined $ENV{'PERL5LIB'} ? $ENV{'PERL5LIB'} : $ENV{'PERLLIB'} || '';
16 my $Inc_uninstall_warn_handler;
18 #use vars qw( @EXPORT @ISA $Is_VMS );
23 unlink $_[0] or Carp::croak("Cannot forceunlink $_[0]: $!")
27 my($hash,$verbose,$nonono,$inc_uninstall) = @_;
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);
37 use File::Compare qw(compare);
40 my(%pack, %write, $dir, $warn_permissions);
41 # -w doesn't work reliably on FAT dirs
42 $warn_permissions++ if $^O eq 'MSWin32';
44 for (qw/read write/) {
48 my($source_dir_or_file);
49 foreach $source_dir_or_file (sort keys %hash) {
50 #Check if there are files, and if yes, look if the corresponding
51 #target directory is writable for us
52 opendir DIR, $source_dir_or_file or next;
54 next if $_ eq "." || $_ eq ".." || $_ eq ".exists";
55 if (-w $hash{$source_dir_or_file} || mkpath($hash{$source_dir_or_file})) {
58 warn "Warning: You do not have permissions to install into $hash{$source_dir_or_file}"
59 unless $warn_permissions++;
64 if (-f $pack{"read"}) {
65 open P, $pack{"read"} or Carp::croak("Couldn't read $pack{'read'}");
66 # Remember what you found
74 my $umask = umask 0 unless $Is_VMS;
76 # This silly reference is just here to be able to call MY->catdir
77 # without a warning (Waiting for a proper path/directory module,
82 MOD_INSTALL: foreach $source (sort keys %hash) {
83 #copy the tree to the target directory without altering
84 #timestamp and permission and remember for the .packlist
85 #file. The packlist file contains the absolute paths of the
86 #install locations. AFS users may call this a bug. We'll have
87 #to reconsider how to add the means to satisfy AFS users also.
88 chdir($source) or next;
90 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
91 $atime,$mtime,$ctime,$blksize,$blocks) = stat;
93 return if $_ eq ".exists";
94 my $targetdir = $MY->catdir($hash{$source},$File::Find::dir);
95 my $targetfile = $MY->catfile($targetdir,$_);
98 if ( -f $targetfile && -s _ == $size) {
99 # We have a good chance, we can skip this one
100 $diff = compare($_,$targetfile);
102 print "$_ differs\n" if $verbose>1;
108 forceunlink($targetfile) unless $nonono;
110 mkpath($targetdir,0,0755) unless $nonono;
111 print "mkpath($targetdir,0,0755)\n" if $verbose>1;
113 copy($_,$targetfile) unless $nonono;
114 print "Installing $targetfile\n";
115 utime($atime,$mtime + $Is_VMS,$targetfile) unless $nonono>1;
116 print "utime($atime,$mtime,$targetfile)\n" if $verbose>1;
117 $mode = 0444 | ( $mode & 0111 ? 0111 : 0 );
118 chmod $mode, $targetfile;
119 print "chmod($mode, $targetfile)\n" if $verbose>1;
121 print "Skipping $targetfile (unchanged)\n" if $verbose;
124 if (! defined $inc_uninstall) { # it's called
125 } elsif ($inc_uninstall == 0){
126 inc_uninstall($_,$File::Find::dir,$verbose,1); # nonono set to 1
128 inc_uninstall($_,$File::Find::dir,$verbose,0); # nonono set to 0
130 $write{$targetfile}++;
133 chdir($cwd) or Carp::croak("Couldn't chdir to $cwd: $!");
135 umask $umask unless $Is_VMS;
136 if ($pack{'write'}) {
137 $dir = dirname($pack{'write'});
139 print "Writing $pack{'write'}\n";
140 open P, ">$pack{'write'}" or Carp::croak("Couldn't write $pack{'write'}: $!");
141 for (sort keys %write) {
148 sub install_default {
149 @_ < 2 or die "install_default should be called with 0 or 1 argument";
150 my $FULLEXT = @_ ? shift : $ARGV[0];
151 defined $FULLEXT or die "Do not know to where to write install log";
152 my $INST_LIB = MM->catdir(MM->curdir,"blib","lib");
153 my $INST_ARCHLIB = MM->catdir(MM->curdir,"blib","arch");
154 my $INST_BIN = MM->catdir(MM->curdir,'blib','bin');
155 my $INST_SCRIPT = MM->catdir(MM->curdir,'blib','script');
156 my $INST_MAN1DIR = MM->catdir(MM->curdir,'blib','man1');
157 my $INST_MAN3DIR = MM->catdir(MM->curdir,'blib','man3');
159 read => "$Config{sitearchexp}/auto/$FULLEXT/.packlist",
160 write => "$Config{installsitearch}/auto/$FULLEXT/.packlist",
161 $INST_LIB => $Config{installsitelib},
162 $INST_ARCHLIB => $Config{installsitearch},
163 $INST_BIN => $Config{installbin} ,
164 $INST_SCRIPT => $Config{installscript},
165 $INST_MAN1DIR => $Config{installman1dir},
166 $INST_MAN3DIR => $Config{installman3dir},
171 my($fil,$verbose,$nonono) = @_;
172 die "no packlist file found: $fil" unless -f $fil;
173 # my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
174 # require $my_req; # Hairy, but for the first
176 open P, $fil or Carp::croak("uninstall: Could not read packlist file $fil: $!");
179 print "unlink $_\n" if $verbose;
180 forceunlink($_) unless $nonono;
182 print "unlink $fil\n" if $verbose;
183 forceunlink($fil) unless $nonono;
187 my($file,$libdir,$verbose,$nonono) = @_;
192 foreach $dir (@INC, @PERL_ENV_LIB, @Config{qw/archlibexp privlibexp sitearchexp sitelibexp/}) {
194 next if $seen_dir{$dir}++;
195 my($targetfile) = $MY->catfile($dir,$libdir,$file);
196 next unless -f $targetfile;
198 # The reason why we compare file's contents is, that we cannot
199 # know, which is the file we just installed (AFS). So we leave
200 # an identical file in place
202 if ( -f $targetfile && -s _ == -s $file) {
203 # We have a good chance, we can skip this one
204 $diff = compare($file,$targetfile);
206 print "#$file and $targetfile differ\n" if $verbose>1;
213 $Inc_uninstall_warn_handler ||= new ExtUtils::Install::Warn;
214 $libdir =~ s|^\./|| ; # That's just cosmetics, no need to port. It looks prettier.
215 $Inc_uninstall_warn_handler->add("$libdir/$file",$targetfile);
217 # if not verbose, we just say nothing
219 print "Unlinking $targetfile (shadowing?)\n";
220 forceunlink($targetfile);
226 my($fromto,$autodir) = @_;
228 use File::Basename qw(dirname);
229 use File::Copy qw(copy);
230 use File::Path qw(mkpath);
231 use File::Compare qw(compare);
233 # my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
234 # require $my_req; # Hairy, but for the first
236 if (!ref($fromto) && -r $fromto)
238 # Win32 has severe command line length limitations, but
239 # can generate temporary files on-the-fly
240 # so we pass name of file here - eval it to get hash
241 open(FROMTO,"<$fromto") or die "Cannot open $fromto:$!";
242 my $str = '$fromto = {qw{'.join('',<FROMTO>).'}}';
247 my $umask = umask 0022 unless $Is_VMS;
248 mkpath($autodir,0,0755);
249 foreach (keys %$fromto) {
250 next if -f $fromto->{$_} && -M $fromto->{$_} < -M $_;
251 unless (compare($_,$fromto->{$_})){
252 print "Skip $fromto->{$_} (unchanged)\n";
255 if (-f $fromto->{$_}){
256 forceunlink($fromto->{$_});
258 mkpath(dirname($fromto->{$_}),0,0755);
260 copy($_,$fromto->{$_});
261 my($mode,$atime,$mtime) = (stat)[2,8,9];
262 utime($atime,$mtime+$Is_VMS,$fromto->{$_});
263 chmod(0444 | ( $mode & 0111 ? 0111 : 0 ),$fromto->{$_});
264 print "cp $_ $fromto->{$_}\n";
266 autosplit($fromto->{$_},$autodir);
268 umask $umask unless $Is_VMS;
271 package ExtUtils::Install::Warn;
273 sub new { bless {}, shift }
276 my($self,$file,$targetfile) = @_;
277 push @{$self->{$file}}, $targetfile;
282 my($file,$i,$plural);
283 foreach $file (sort keys %$self) {
284 $plural = @{$self->{$file}} > 1 ? "s" : "";
285 print "## Differing version$plural of $file found. You might like to\n";
286 for (0..$#{$self->{$file}}) {
287 print "rm ", $self->{$file}[$_], "\n";
291 $plural = $i>1 ? "all those files" : "this file";
292 print "## Running 'make install UNINST=1' will unlink $plural for you.\n";
301 ExtUtils::Install - install files from here to there
305 B<use ExtUtils::Install;>
307 B<install($hashref,$verbose,$nonono);>
309 B<uninstall($packlistfile,$verbose,$nonono);>
311 B<pm_to_blib($hashref);>
315 Both install() and uninstall() are specific to the way
316 ExtUtils::MakeMaker handles the installation and deinstallation of
317 perl modules. They are not designed as general purpose tools.
319 install() takes three arguments. A reference to a hash, a verbose
320 switch and a don't-really-do-it switch. The hash ref contains a
321 mapping of directories: each key/value pair is a combination of
322 directories to be copied. Key is a directory to copy from, value is a
323 directory to copy to. The whole tree below the "from" directory will
324 be copied preserving timestamps and permissions.
326 There are two keys with a special meaning in the hash: "read" and
327 "write". After the copying is done, install will write the list of
328 target files to the file named by C<$hashref-E<gt>{write}>. If there is
329 another file named by C<$hashref-E<gt>{read}>, the contents of this file will
330 be merged into the written file. The read and the written file may be
331 identical, but on AFS it is quite likely, people are installing to a
332 different directory than the one where the files later appear.
334 install_default() takes one or less arguments. If no arguments are
335 specified, it takes $ARGV[0] as if it was specified as an argument.
336 The argument is the value of MakeMaker's C<FULLEXT> key, like F<Tk/Canvas>.
337 This function calls install() with the same arguments as the defaults
338 the MakeMaker would use.
340 The argumement-less form is convenient for install scripts like
342 perl -MExtUtils::Install -e install_default Tk/Canvas
344 Assuming this command is executed in a directory with populated F<blib>
345 directory, it will proceed as if the F<blib> was build by MakeMaker on
346 this machine. This is useful for binary distributions.
348 uninstall() takes as first argument a file containing filenames to be
349 unlinked. The second argument is a verbose switch, the third is a
350 no-don't-really-do-it-now switch.
352 pm_to_blib() takes a hashref as the first argument and copies all keys
353 of the hash to the corresponding values efficiently. Filenames with
354 the extension pm are autosplit. Second argument is the autosplit