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 ExtUtils::Packlist;
34 use File::Basename qw(dirname);
35 use File::Copy qw(copy);
36 use File::Find qw(find);
37 use File::Path qw(mkpath);
38 use File::Compare qw(compare);
41 my(%pack, $dir, $warn_permissions);
42 my($packlist) = ExtUtils::Packlist->new();
43 # -w doesn't work reliably on FAT dirs
44 $warn_permissions++ if $^O eq 'MSWin32';
46 for (qw/read write/) {
50 my($source_dir_or_file);
51 foreach $source_dir_or_file (sort keys %hash) {
52 #Check if there are files, and if yes, look if the corresponding
53 #target directory is writable for us
54 opendir DIR, $source_dir_or_file or next;
56 next if $_ eq "." || $_ eq ".." || $_ eq ".exists";
57 if (-w $hash{$source_dir_or_file} ||
58 mkpath($hash{$source_dir_or_file})) {
61 warn "Warning: You do not have permissions to " .
62 "install into $hash{$source_dir_or_file}"
63 unless $warn_permissions++;
68 $packlist->read($pack{"read"}) if (-f $pack{"read"});
70 my $umask = umask 0 unless $Is_VMS;
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.
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
83 my $targetroot = $hash{$source};
84 if ($source eq "blib/lib" and
85 exists $hash{"blib/arch"} and
86 directory_not_empty("blib/arch")) {
87 $targetroot = $hash{"blib/arch"};
88 print "Files found in blib/arch --> Installing files in "
89 . "blib/lib into architecture dependend library tree!\n"
92 chdir($source) or next;
94 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
95 $atime,$mtime,$ctime,$blksize,$blocks) = stat;
97 return if $_ eq ".exists";
98 my $targetdir = MY->catdir($targetroot,$File::Find::dir);
99 my $targetfile = MY->catfile($targetdir,$_);
102 if ( -f $targetfile && -s _ == $size) {
103 # We have a good chance, we can skip this one
104 $diff = compare($_,$targetfile);
106 print "$_ differs\n" if $verbose>1;
112 forceunlink($targetfile) unless $nonono;
114 mkpath($targetdir,0,0755) unless $nonono;
115 print "mkpath($targetdir,0,0755)\n" if $verbose>1;
117 copy($_,$targetfile) unless $nonono;
118 print "Installing $targetfile\n";
119 utime($atime,$mtime + $Is_VMS,$targetfile) unless $nonono>1;
120 print "utime($atime,$mtime,$targetfile)\n" if $verbose>1;
121 $mode = 0444 | ( $mode & 0111 ? 0111 : 0 );
122 chmod $mode, $targetfile;
123 print "chmod($mode, $targetfile)\n" if $verbose>1;
125 print "Skipping $targetfile (unchanged)\n" if $verbose;
128 if (! defined $inc_uninstall) { # it's called
129 } elsif ($inc_uninstall == 0){
130 inc_uninstall($_,$File::Find::dir,$verbose,1); # nonono set to 1
132 inc_uninstall($_,$File::Find::dir,$verbose,0); # nonono set to 0
134 $packlist->{$targetfile}++;
137 chdir($cwd) or Carp::croak("Couldn't chdir to $cwd: $!");
139 umask $umask unless $Is_VMS;
140 if ($pack{'write'}) {
141 $dir = dirname($pack{'write'});
143 print "Writing $pack{'write'}\n";
144 $packlist->write($pack{'write'});
148 sub directory_not_empty ($) {
152 return if $_ eq ".exists";
154 $File::Find::prune++;
161 sub install_default {
162 @_ < 2 or die "install_default should be called with 0 or 1 argument";
163 my $FULLEXT = @_ ? shift : $ARGV[0];
164 defined $FULLEXT or die "Do not know to where to write install log";
165 my $INST_LIB = MM->catdir(MM->curdir,"blib","lib");
166 my $INST_ARCHLIB = MM->catdir(MM->curdir,"blib","arch");
167 my $INST_BIN = MM->catdir(MM->curdir,'blib','bin');
168 my $INST_SCRIPT = MM->catdir(MM->curdir,'blib','script');
169 my $INST_MAN1DIR = MM->catdir(MM->curdir,'blib','man1');
170 my $INST_MAN3DIR = MM->catdir(MM->curdir,'blib','man3');
172 read => "$Config{sitearchexp}/auto/$FULLEXT/.packlist",
173 write => "$Config{installsitearch}/auto/$FULLEXT/.packlist",
174 $INST_LIB => (directory_not_empty($INST_ARCHLIB)) ?
175 $Config{installsitearch} :
176 $Config{installsitelib},
177 $INST_ARCHLIB => $Config{installsitearch},
178 $INST_BIN => $Config{installbin} ,
179 $INST_SCRIPT => $Config{installscript},
180 $INST_MAN1DIR => $Config{installman1dir},
181 $INST_MAN3DIR => $Config{installman3dir},
186 use ExtUtils::Packlist;
187 my($fil,$verbose,$nonono) = @_;
188 die "no packlist file found: $fil" unless -f $fil;
189 # my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
190 # require $my_req; # Hairy, but for the first
191 my ($packlist) = ExtUtils::Packlist->new($fil);
192 foreach (sort(keys(%$packlist))) {
194 print "unlink $_\n" if $verbose;
195 forceunlink($_) unless $nonono;
197 print "unlink $fil\n" if $verbose;
199 forceunlink($fil) unless $nonono;
203 my($file,$libdir,$verbose,$nonono) = @_;
206 foreach $dir (@INC, @PERL_ENV_LIB, @Config{qw(archlibexp
211 next if $seen_dir{$dir}++;
212 my($targetfile) = MY->catfile($dir,$libdir,$file);
213 next unless -f $targetfile;
215 # The reason why we compare file's contents is, that we cannot
216 # know, which is the file we just installed (AFS). So we leave
217 # an identical file in place
219 if ( -f $targetfile && -s _ == -s $file) {
220 # We have a good chance, we can skip this one
221 $diff = compare($file,$targetfile);
223 print "#$file and $targetfile differ\n" if $verbose>1;
230 $Inc_uninstall_warn_handler ||= new ExtUtils::Install::Warn;
231 $libdir =~ s|^\./|| ; # That's just cosmetics, no need to port. It looks prettier.
232 $Inc_uninstall_warn_handler->add("$libdir/$file",$targetfile);
234 # if not verbose, we just say nothing
236 print "Unlinking $targetfile (shadowing?)\n";
237 forceunlink($targetfile);
243 my($fromto,$autodir) = @_;
245 use File::Basename qw(dirname);
246 use File::Copy qw(copy);
247 use File::Path qw(mkpath);
248 use File::Compare qw(compare);
250 # my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
251 # require $my_req; # Hairy, but for the first
253 if (!ref($fromto) && -r $fromto)
255 # Win32 has severe command line length limitations, but
256 # can generate temporary files on-the-fly
257 # so we pass name of file here - eval it to get hash
258 open(FROMTO,"<$fromto") or die "Cannot open $fromto:$!";
259 my $str = '$fromto = {qw{'.join('',<FROMTO>).'}}';
264 my $umask = umask 0022 unless $Is_VMS;
265 mkpath($autodir,0,0755);
266 foreach (keys %$fromto) {
267 next if -f $fromto->{$_} && -M $fromto->{$_} < -M $_;
268 unless (compare($_,$fromto->{$_})){
269 print "Skip $fromto->{$_} (unchanged)\n";
272 if (-f $fromto->{$_}){
273 forceunlink($fromto->{$_});
275 mkpath(dirname($fromto->{$_}),0,0755);
277 copy($_,$fromto->{$_});
278 my($mode,$atime,$mtime) = (stat)[2,8,9];
279 utime($atime,$mtime+$Is_VMS,$fromto->{$_});
280 chmod(0444 | ( $mode & 0111 ? 0111 : 0 ),$fromto->{$_});
281 print "cp $_ $fromto->{$_}\n";
283 autosplit($fromto->{$_},$autodir);
285 umask $umask unless $Is_VMS;
288 package ExtUtils::Install::Warn;
290 sub new { bless {}, shift }
293 my($self,$file,$targetfile) = @_;
294 push @{$self->{$file}}, $targetfile;
299 my($file,$i,$plural);
300 foreach $file (sort keys %$self) {
301 $plural = @{$self->{$file}} > 1 ? "s" : "";
302 print "## Differing version$plural of $file found. You might like to\n";
303 for (0..$#{$self->{$file}}) {
304 print "rm ", $self->{$file}[$_], "\n";
308 $plural = $i>1 ? "all those files" : "this file";
309 print "## Running 'make install UNINST=1' will unlink $plural for you.\n";
318 ExtUtils::Install - install files from here to there
322 B<use ExtUtils::Install;>
324 B<install($hashref,$verbose,$nonono);>
326 B<uninstall($packlistfile,$verbose,$nonono);>
328 B<pm_to_blib($hashref);>
332 Both install() and uninstall() are specific to the way
333 ExtUtils::MakeMaker handles the installation and deinstallation of
334 perl modules. They are not designed as general purpose tools.
336 install() takes three arguments. A reference to a hash, a verbose
337 switch and a don't-really-do-it switch. The hash ref contains a
338 mapping of directories: each key/value pair is a combination of
339 directories to be copied. Key is a directory to copy from, value is a
340 directory to copy to. The whole tree below the "from" directory will
341 be copied preserving timestamps and permissions.
343 There are two keys with a special meaning in the hash: "read" and
344 "write". After the copying is done, install will write the list of
345 target files to the file named by C<$hashref-E<gt>{write}>. If there is
346 another file named by C<$hashref-E<gt>{read}>, the contents of this file will
347 be merged into the written file. The read and the written file may be
348 identical, but on AFS it is quite likely, people are installing to a
349 different directory than the one where the files later appear.
351 install_default() takes one or less arguments. If no arguments are
352 specified, it takes $ARGV[0] as if it was specified as an argument.
353 The argument is the value of MakeMaker's C<FULLEXT> key, like F<Tk/Canvas>.
354 This function calls install() with the same arguments as the defaults
355 the MakeMaker would use.
357 The argument-less form is convenient for install scripts like
359 perl -MExtUtils::Install -e install_default Tk/Canvas
361 Assuming this command is executed in a directory with populated F<blib>
362 directory, it will proceed as if the F<blib> was build by MakeMaker on
363 this machine. This is useful for binary distributions.
365 uninstall() takes as first argument a file containing filenames to be
366 unlinked. The second argument is a verbose switch, the third is a
367 no-don't-really-do-it-now switch.
369 pm_to_blib() takes a hashref as the first argument and copies all keys
370 of the hash to the corresponding values efficiently. Filenames with
371 the extension pm are autosplit. Second argument is the autosplit