1 package ExtUtils::Install;
3 $VERSION = substr q$Revision: 1.28 $, 10;
4 # $Date: 1998/01/25 07:08:24 $
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' || $^O eq 'dos') ? ';' : ':';
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} ||
56 mkpath($hash{$source_dir_or_file})) {
59 warn "Warning: You do not have permissions to " .
60 "install into $hash{$source_dir_or_file}"
61 unless $warn_permissions++;
66 if (-f $pack{"read"}) {
67 open P, $pack{"read"} or Carp::croak("Couldn't read $pack{'read'}");
68 # Remember what you found
76 my $umask = umask 0 unless $Is_VMS;
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.
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
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"};
95 chdir($source) or next;
97 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
98 $atime,$mtime,$ctime,$blksize,$blocks) = stat;
100 return if $_ eq ".exists";
101 my $targetdir = MY->catdir($targetroot,$File::Find::dir);
102 my $targetfile = MY->catfile($targetdir,$_);
105 if ( -f $targetfile && -s _ == $size) {
106 # We have a good chance, we can skip this one
107 $diff = compare($_,$targetfile);
109 print "$_ differs\n" if $verbose>1;
115 forceunlink($targetfile) unless $nonono;
117 mkpath($targetdir,0,0755) unless $nonono;
118 print "mkpath($targetdir,0,0755)\n" if $verbose>1;
120 copy($_,$targetfile) unless $nonono;
121 print "Installing $targetfile\n";
122 utime($atime,$mtime + $Is_VMS,$targetfile) unless $nonono>1;
123 print "utime($atime,$mtime,$targetfile)\n" if $verbose>1;
124 $mode = 0444 | ( $mode & 0111 ? 0111 : 0 );
125 chmod $mode, $targetfile;
126 print "chmod($mode, $targetfile)\n" if $verbose>1;
128 print "Skipping $targetfile (unchanged)\n" if $verbose;
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
135 inc_uninstall($_,$File::Find::dir,$verbose,0); # nonono set to 0
137 $write{$targetfile}++;
140 chdir($cwd) or Carp::croak("Couldn't chdir to $cwd: $!");
142 umask $umask unless $Is_VMS;
143 if ($pack{'write'}) {
144 $dir = dirname($pack{'write'});
146 print "Writing $pack{'write'}\n";
147 open P, ">$pack{'write'}" or Carp::croak("Couldn't write $pack{'write'}: $!");
148 for (sort keys %write) {
155 sub directory_not_empty ($) {
159 return if $_ eq ".exists";
161 $File::Find::prune++;
168 sub 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');
179 read => "$Config{sitearchexp}/auto/$FULLEXT/.packlist",
180 write => "$Config{installsitearch}/auto/$FULLEXT/.packlist",
181 $INST_LIB => (directory_not_empty($INST_ARCHLIB)) ?
182 $Config{installsitearch} :
183 $Config{installsitelib},
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},
193 my($fil,$verbose,$nonono) = @_;
194 die "no packlist file found: $fil" unless -f $fil;
195 # my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
196 # require $my_req; # Hairy, but for the first
198 open P, $fil or Carp::croak("uninstall: Could not read packlist " .
202 print "unlink $_\n" if $verbose;
203 forceunlink($_) unless $nonono;
205 print "unlink $fil\n" if $verbose;
207 forceunlink($fil) unless $nonono;
211 my($file,$libdir,$verbose,$nonono) = @_;
214 foreach $dir (@INC, @PERL_ENV_LIB, @Config{qw(archlibexp
219 next if $seen_dir{$dir}++;
220 my($targetfile) = MY->catfile($dir,$libdir,$file);
221 next unless -f $targetfile;
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
227 if ( -f $targetfile && -s _ == -s $file) {
228 # We have a good chance, we can skip this one
229 $diff = compare($file,$targetfile);
231 print "#$file and $targetfile differ\n" if $verbose>1;
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);
242 # if not verbose, we just say nothing
244 print "Unlinking $targetfile (shadowing?)\n";
245 forceunlink($targetfile);
251 my($fromto,$autodir) = @_;
253 use File::Basename qw(dirname);
254 use File::Copy qw(copy);
255 use File::Path qw(mkpath);
256 use File::Compare qw(compare);
258 # my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
259 # require $my_req; # Hairy, but for the first
261 if (!ref($fromto) && -r $fromto)
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>).'}}';
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 $_;
276 unless (compare($_,$fromto->{$_})){
277 print "Skip $fromto->{$_} (unchanged)\n";
280 if (-f $fromto->{$_}){
281 forceunlink($fromto->{$_});
283 mkpath(dirname($fromto->{$_}),0,0755);
285 copy($_,$fromto->{$_});
286 my($mode,$atime,$mtime) = (stat)[2,8,9];
287 utime($atime,$mtime+$Is_VMS,$fromto->{$_});
288 chmod(0444 | ( $mode & 0111 ? 0111 : 0 ),$fromto->{$_});
289 print "cp $_ $fromto->{$_}\n";
291 autosplit($fromto->{$_},$autodir);
293 umask $umask unless $Is_VMS;
296 package ExtUtils::Install::Warn;
298 sub new { bless {}, shift }
301 my($self,$file,$targetfile) = @_;
302 push @{$self->{$file}}, $targetfile;
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";
316 $plural = $i>1 ? "all those files" : "this file";
317 print "## Running 'make install UNINST=1' will unlink $plural for you.\n";
326 ExtUtils::Install - install files from here to there
330 B<use ExtUtils::Install;>
332 B<install($hashref,$verbose,$nonono);>
334 B<uninstall($packlistfile,$verbose,$nonono);>
336 B<pm_to_blib($hashref);>
340 Both install() and uninstall() are specific to the way
341 ExtUtils::MakeMaker handles the installation and deinstallation of
342 perl modules. They are not designed as general purpose tools.
344 install() takes three arguments. A reference to a hash, a verbose
345 switch and a don't-really-do-it switch. The hash ref contains a
346 mapping of directories: each key/value pair is a combination of
347 directories to be copied. Key is a directory to copy from, value is a
348 directory to copy to. The whole tree below the "from" directory will
349 be copied preserving timestamps and permissions.
351 There 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
353 target files to the file named by C<$hashref-E<gt>{write}>. If there is
354 another file named by C<$hashref-E<gt>{read}>, the contents of this file will
355 be merged into the written file. The read and the written file may be
356 identical, but on AFS it is quite likely, people are installing to a
357 different directory than the one where the files later appear.
359 install_default() takes one or less arguments. If no arguments are
360 specified, it takes $ARGV[0] as if it was specified as an argument.
361 The argument is the value of MakeMaker's C<FULLEXT> key, like F<Tk/Canvas>.
362 This function calls install() with the same arguments as the defaults
363 the MakeMaker would use.
365 The argumement-less form is convenient for install scripts like
367 perl -MExtUtils::Install -e install_default Tk/Canvas
369 Assuming this command is executed in a directory with populated F<blib>
370 directory, it will proceed as if the F<blib> was build by MakeMaker on
371 this machine. This is useful for binary distributions.
373 uninstall() takes as first argument a file containing filenames to be
374 unlinked. The second argument is a verbose switch, the third is a
375 no-don't-really-do-it-now switch.
377 pm_to_blib() takes a hashref as the first argument and copies all keys
378 of the hash to the corresponding values efficiently. Filenames with
379 the extension pm are autosplit. Second argument is the autosplit