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 blib/lib into architecture dependent library tree\n";
90 chdir($source) or next;
92 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
93 $atime,$mtime,$ctime,$blksize,$blocks) = stat;
95 return if $_ eq ".exists";
96 my $targetdir = MY->catdir($targetroot,$File::Find::dir);
97 my $targetfile = MY->catfile($targetdir,$_);
100 if ( -f $targetfile && -s _ == $size) {
101 # We have a good chance, we can skip this one
102 $diff = compare($_,$targetfile);
104 print "$_ differs\n" if $verbose>1;
110 forceunlink($targetfile) unless $nonono;
112 mkpath($targetdir,0,0755) unless $nonono;
113 print "mkpath($targetdir,0,0755)\n" if $verbose>1;
115 copy($_,$targetfile) unless $nonono;
116 print "Installing $targetfile\n";
117 utime($atime,$mtime + $Is_VMS,$targetfile) unless $nonono>1;
118 print "utime($atime,$mtime,$targetfile)\n" if $verbose>1;
119 $mode = 0444 | ( $mode & 0111 ? 0111 : 0 );
120 chmod $mode, $targetfile;
121 print "chmod($mode, $targetfile)\n" if $verbose>1;
123 print "Skipping $targetfile (unchanged)\n" if $verbose;
126 if (! defined $inc_uninstall) { # it's called
127 } elsif ($inc_uninstall == 0){
128 inc_uninstall($_,$File::Find::dir,$verbose,1); # nonono set to 1
130 inc_uninstall($_,$File::Find::dir,$verbose,0); # nonono set to 0
132 $packlist->{$targetfile}++;
135 chdir($cwd) or Carp::croak("Couldn't chdir to $cwd: $!");
137 if ($pack{'write'}) {
138 $dir = dirname($pack{'write'});
140 print "Writing $pack{'write'}\n";
141 $packlist->write($pack{'write'});
143 umask $umask unless $Is_VMS;
146 sub directory_not_empty ($) {
150 return if $_ eq ".exists";
152 $File::Find::prune++;
159 sub install_default {
160 @_ < 2 or die "install_default should be called with 0 or 1 argument";
161 my $FULLEXT = @_ ? shift : $ARGV[0];
162 defined $FULLEXT or die "Do not know to where to write install log";
163 my $INST_LIB = MM->catdir(MM->curdir,"blib","lib");
164 my $INST_ARCHLIB = MM->catdir(MM->curdir,"blib","arch");
165 my $INST_BIN = MM->catdir(MM->curdir,'blib','bin');
166 my $INST_SCRIPT = MM->catdir(MM->curdir,'blib','script');
167 my $INST_MAN1DIR = MM->catdir(MM->curdir,'blib','man1');
168 my $INST_MAN3DIR = MM->catdir(MM->curdir,'blib','man3');
170 read => "$Config{sitearchexp}/auto/$FULLEXT/.packlist",
171 write => "$Config{installsitearch}/auto/$FULLEXT/.packlist",
172 $INST_LIB => (directory_not_empty($INST_ARCHLIB)) ?
173 $Config{installsitearch} :
174 $Config{installsitelib},
175 $INST_ARCHLIB => $Config{installsitearch},
176 $INST_BIN => $Config{installbin} ,
177 $INST_SCRIPT => $Config{installscript},
178 $INST_MAN1DIR => $Config{installman1dir},
179 $INST_MAN3DIR => $Config{installman3dir},
184 use ExtUtils::Packlist;
185 my($fil,$verbose,$nonono) = @_;
186 die "no packlist file found: $fil" unless -f $fil;
187 # my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
188 # require $my_req; # Hairy, but for the first
189 my ($packlist) = ExtUtils::Packlist->new($fil);
190 foreach (sort(keys(%$packlist))) {
192 print "unlink $_\n" if $verbose;
193 forceunlink($_) unless $nonono;
195 print "unlink $fil\n" if $verbose;
197 forceunlink($fil) unless $nonono;
201 my($file,$libdir,$verbose,$nonono) = @_;
204 foreach $dir (@INC, @PERL_ENV_LIB, @Config{qw(archlibexp
209 next if $seen_dir{$dir}++;
210 my($targetfile) = MY->catfile($dir,$libdir,$file);
211 next unless -f $targetfile;
213 # The reason why we compare file's contents is, that we cannot
214 # know, which is the file we just installed (AFS). So we leave
215 # an identical file in place
217 if ( -f $targetfile && -s _ == -s $file) {
218 # We have a good chance, we can skip this one
219 $diff = compare($file,$targetfile);
221 print "#$file and $targetfile differ\n" if $verbose>1;
228 $Inc_uninstall_warn_handler ||= new ExtUtils::Install::Warn;
229 $libdir =~ s|^\./|| ; # That's just cosmetics, no need to port. It looks prettier.
230 $Inc_uninstall_warn_handler->add("$libdir/$file",$targetfile);
232 # if not verbose, we just say nothing
234 print "Unlinking $targetfile (shadowing?)\n";
235 forceunlink($targetfile);
241 my($fromto,$autodir) = @_;
243 use File::Basename qw(dirname);
244 use File::Copy qw(copy);
245 use File::Path qw(mkpath);
246 use File::Compare qw(compare);
248 # my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
249 # require $my_req; # Hairy, but for the first
251 if (!ref($fromto) && -r $fromto)
253 # Win32 has severe command line length limitations, but
254 # can generate temporary files on-the-fly
255 # so we pass name of file here - eval it to get hash
256 open(FROMTO,"<$fromto") or die "Cannot open $fromto:$!";
257 my $str = '$fromto = {qw{'.join('',<FROMTO>).'}}';
262 my $umask = umask 0022 unless $Is_VMS;
263 mkpath($autodir,0,0755);
264 foreach (keys %$fromto) {
265 next if -f $fromto->{$_} && -M $fromto->{$_} < -M $_;
266 unless (compare($_,$fromto->{$_})){
267 print "Skip $fromto->{$_} (unchanged)\n";
270 if (-f $fromto->{$_}){
271 forceunlink($fromto->{$_});
273 mkpath(dirname($fromto->{$_}),0,0755);
275 copy($_,$fromto->{$_});
276 my($mode,$atime,$mtime) = (stat)[2,8,9];
277 utime($atime,$mtime+$Is_VMS,$fromto->{$_});
278 chmod(0444 | ( $mode & 0111 ? 0111 : 0 ),$fromto->{$_});
279 print "cp $_ $fromto->{$_}\n";
281 autosplit($fromto->{$_},$autodir);
283 umask $umask unless $Is_VMS;
286 package ExtUtils::Install::Warn;
288 sub new { bless {}, shift }
291 my($self,$file,$targetfile) = @_;
292 push @{$self->{$file}}, $targetfile;
297 my($file,$i,$plural);
298 foreach $file (sort keys %$self) {
299 $plural = @{$self->{$file}} > 1 ? "s" : "";
300 print "## Differing version$plural of $file found. You might like to\n";
301 for (0..$#{$self->{$file}}) {
302 print "rm ", $self->{$file}[$_], "\n";
306 $plural = $i>1 ? "all those files" : "this file";
307 print "## Running 'make install UNINST=1' will unlink $plural for you.\n";
316 ExtUtils::Install - install files from here to there
320 B<use ExtUtils::Install;>
322 B<install($hashref,$verbose,$nonono);>
324 B<uninstall($packlistfile,$verbose,$nonono);>
326 B<pm_to_blib($hashref);>
330 Both install() and uninstall() are specific to the way
331 ExtUtils::MakeMaker handles the installation and deinstallation of
332 perl modules. They are not designed as general purpose tools.
334 install() takes three arguments. A reference to a hash, a verbose
335 switch and a don't-really-do-it switch. The hash ref contains a
336 mapping of directories: each key/value pair is a combination of
337 directories to be copied. Key is a directory to copy from, value is a
338 directory to copy to. The whole tree below the "from" directory will
339 be copied preserving timestamps and permissions.
341 There are two keys with a special meaning in the hash: "read" and
342 "write". After the copying is done, install will write the list of
343 target files to the file named by C<$hashref-E<gt>{write}>. If there is
344 another file named by C<$hashref-E<gt>{read}>, the contents of this file will
345 be merged into the written file. The read and the written file may be
346 identical, but on AFS it is quite likely, people are installing to a
347 different directory than the one where the files later appear.
349 install_default() takes one or less arguments. If no arguments are
350 specified, it takes $ARGV[0] as if it was specified as an argument.
351 The argument is the value of MakeMaker's C<FULLEXT> key, like F<Tk/Canvas>.
352 This function calls install() with the same arguments as the defaults
353 the MakeMaker would use.
355 The argument-less form is convenient for install scripts like
357 perl -MExtUtils::Install -e install_default Tk/Canvas
359 Assuming this command is executed in a directory with populated F<blib>
360 directory, it will proceed as if the F<blib> was build by MakeMaker on
361 this machine. This is useful for binary distributions.
363 uninstall() takes as first argument a file containing filenames to be
364 unlinked. The second argument is a verbose switch, the third is a
365 no-don't-really-do-it-now switch.
367 pm_to_blib() takes a hashref as the first argument and copies all keys
368 of the hash to the corresponding values efficiently. Filenames with
369 the extension pm are autosplit. Second argument is the autosplit