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"};
89 chdir($source) or next;
91 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
92 $atime,$mtime,$ctime,$blksize,$blocks) = stat;
94 return if $_ eq ".exists";
95 my $targetdir = MY->catdir($targetroot,$File::Find::dir);
96 my $targetfile = MY->catfile($targetdir,$_);
99 if ( -f $targetfile && -s _ == $size) {
100 # We have a good chance, we can skip this one
101 $diff = compare($_,$targetfile);
103 print "$_ differs\n" if $verbose>1;
109 forceunlink($targetfile) unless $nonono;
111 mkpath($targetdir,0,0755) unless $nonono;
112 print "mkpath($targetdir,0,0755)\n" if $verbose>1;
114 copy($_,$targetfile) unless $nonono;
115 print "Installing $targetfile\n";
116 utime($atime,$mtime + $Is_VMS,$targetfile) unless $nonono>1;
117 print "utime($atime,$mtime,$targetfile)\n" if $verbose>1;
118 $mode = 0444 | ( $mode & 0111 ? 0111 : 0 );
119 chmod $mode, $targetfile;
120 print "chmod($mode, $targetfile)\n" if $verbose>1;
122 print "Skipping $targetfile (unchanged)\n" if $verbose;
125 if (! defined $inc_uninstall) { # it's called
126 } elsif ($inc_uninstall == 0){
127 inc_uninstall($_,$File::Find::dir,$verbose,1); # nonono set to 1
129 inc_uninstall($_,$File::Find::dir,$verbose,0); # nonono set to 0
131 $packlist->{$targetfile}++;
134 chdir($cwd) or Carp::croak("Couldn't chdir to $cwd: $!");
136 umask $umask unless $Is_VMS;
137 if ($pack{'write'}) {
138 $dir = dirname($pack{'write'});
140 print "Writing $pack{'write'}\n";
141 $packlist->write($pack{'write'});
145 sub directory_not_empty ($) {
149 return if $_ eq ".exists";
151 $File::Find::prune++;
158 sub install_default {
159 @_ < 2 or die "install_default should be called with 0 or 1 argument";
160 my $FULLEXT = @_ ? shift : $ARGV[0];
161 defined $FULLEXT or die "Do not know to where to write install log";
162 my $INST_LIB = MM->catdir(MM->curdir,"blib","lib");
163 my $INST_ARCHLIB = MM->catdir(MM->curdir,"blib","arch");
164 my $INST_BIN = MM->catdir(MM->curdir,'blib','bin');
165 my $INST_SCRIPT = MM->catdir(MM->curdir,'blib','script');
166 my $INST_MAN1DIR = MM->catdir(MM->curdir,'blib','man1');
167 my $INST_MAN3DIR = MM->catdir(MM->curdir,'blib','man3');
169 read => "$Config{sitearchexp}/auto/$FULLEXT/.packlist",
170 write => "$Config{installsitearch}/auto/$FULLEXT/.packlist",
171 $INST_LIB => (directory_not_empty($INST_ARCHLIB)) ?
172 $Config{installsitearch} :
173 $Config{installsitelib},
174 $INST_ARCHLIB => $Config{installsitearch},
175 $INST_BIN => $Config{installbin} ,
176 $INST_SCRIPT => $Config{installscript},
177 $INST_MAN1DIR => $Config{installman1dir},
178 $INST_MAN3DIR => $Config{installman3dir},
183 use ExtUtils::Packlist;
184 my($fil,$verbose,$nonono) = @_;
185 die "no packlist file found: $fil" unless -f $fil;
186 # my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
187 # require $my_req; # Hairy, but for the first
188 my ($packlist) = ExtUtils::Packlist->new($fil);
189 foreach (sort(keys(%$packlist))) {
191 print "unlink $_\n" if $verbose;
192 forceunlink($_) unless $nonono;
194 print "unlink $fil\n" if $verbose;
196 forceunlink($fil) unless $nonono;
200 my($file,$libdir,$verbose,$nonono) = @_;
203 foreach $dir (@INC, @PERL_ENV_LIB, @Config{qw(archlibexp
208 next if $seen_dir{$dir}++;
209 my($targetfile) = MY->catfile($dir,$libdir,$file);
210 next unless -f $targetfile;
212 # The reason why we compare file's contents is, that we cannot
213 # know, which is the file we just installed (AFS). So we leave
214 # an identical file in place
216 if ( -f $targetfile && -s _ == -s $file) {
217 # We have a good chance, we can skip this one
218 $diff = compare($file,$targetfile);
220 print "#$file and $targetfile differ\n" if $verbose>1;
227 $Inc_uninstall_warn_handler ||= new ExtUtils::Install::Warn;
228 $libdir =~ s|^\./|| ; # That's just cosmetics, no need to port. It looks prettier.
229 $Inc_uninstall_warn_handler->add("$libdir/$file",$targetfile);
231 # if not verbose, we just say nothing
233 print "Unlinking $targetfile (shadowing?)\n";
234 forceunlink($targetfile);
240 my($fromto,$autodir) = @_;
242 use File::Basename qw(dirname);
243 use File::Copy qw(copy);
244 use File::Path qw(mkpath);
245 use File::Compare qw(compare);
247 # my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
248 # require $my_req; # Hairy, but for the first
250 if (!ref($fromto) && -r $fromto)
252 # Win32 has severe command line length limitations, but
253 # can generate temporary files on-the-fly
254 # so we pass name of file here - eval it to get hash
255 open(FROMTO,"<$fromto") or die "Cannot open $fromto:$!";
256 my $str = '$fromto = {qw{'.join('',<FROMTO>).'}}';
261 my $umask = umask 0022 unless $Is_VMS;
262 mkpath($autodir,0,0755);
263 foreach (keys %$fromto) {
264 next if -f $fromto->{$_} && -M $fromto->{$_} < -M $_;
265 unless (compare($_,$fromto->{$_})){
266 print "Skip $fromto->{$_} (unchanged)\n";
269 if (-f $fromto->{$_}){
270 forceunlink($fromto->{$_});
272 mkpath(dirname($fromto->{$_}),0,0755);
274 copy($_,$fromto->{$_});
275 my($mode,$atime,$mtime) = (stat)[2,8,9];
276 utime($atime,$mtime+$Is_VMS,$fromto->{$_});
277 chmod(0444 | ( $mode & 0111 ? 0111 : 0 ),$fromto->{$_});
278 print "cp $_ $fromto->{$_}\n";
280 autosplit($fromto->{$_},$autodir);
282 umask $umask unless $Is_VMS;
285 package ExtUtils::Install::Warn;
287 sub new { bless {}, shift }
290 my($self,$file,$targetfile) = @_;
291 push @{$self->{$file}}, $targetfile;
296 my($file,$i,$plural);
297 foreach $file (sort keys %$self) {
298 $plural = @{$self->{$file}} > 1 ? "s" : "";
299 print "## Differing version$plural of $file found. You might like to\n";
300 for (0..$#{$self->{$file}}) {
301 print "rm ", $self->{$file}[$_], "\n";
305 $plural = $i>1 ? "all those files" : "this file";
306 print "## Running 'make install UNINST=1' will unlink $plural for you.\n";
315 ExtUtils::Install - install files from here to there
319 B<use ExtUtils::Install;>
321 B<install($hashref,$verbose,$nonono);>
323 B<uninstall($packlistfile,$verbose,$nonono);>
325 B<pm_to_blib($hashref);>
329 Both install() and uninstall() are specific to the way
330 ExtUtils::MakeMaker handles the installation and deinstallation of
331 perl modules. They are not designed as general purpose tools.
333 install() takes three arguments. A reference to a hash, a verbose
334 switch and a don't-really-do-it switch. The hash ref contains a
335 mapping of directories: each key/value pair is a combination of
336 directories to be copied. Key is a directory to copy from, value is a
337 directory to copy to. The whole tree below the "from" directory will
338 be copied preserving timestamps and permissions.
340 There are two keys with a special meaning in the hash: "read" and
341 "write". After the copying is done, install will write the list of
342 target files to the file named by C<$hashref-E<gt>{write}>. If there is
343 another file named by C<$hashref-E<gt>{read}>, the contents of this file will
344 be merged into the written file. The read and the written file may be
345 identical, but on AFS it is quite likely, people are installing to a
346 different directory than the one where the files later appear.
348 install_default() takes one or less arguments. If no arguments are
349 specified, it takes $ARGV[0] as if it was specified as an argument.
350 The argument is the value of MakeMaker's C<FULLEXT> key, like F<Tk/Canvas>.
351 This function calls install() with the same arguments as the defaults
352 the MakeMaker would use.
354 The argumement-less form is convenient for install scripts like
356 perl -MExtUtils::Install -e install_default Tk/Canvas
358 Assuming this command is executed in a directory with populated F<blib>
359 directory, it will proceed as if the F<blib> was build by MakeMaker on
360 this machine. This is useful for binary distributions.
362 uninstall() takes as first argument a file containing filenames to be
363 unlinked. The second argument is a verbose switch, the third is a
364 no-don't-really-do-it-now switch.
366 pm_to_blib() takes a hashref as the first argument and copies all keys
367 of the hash to the corresponding values efficiently. Filenames with
368 the extension pm are autosplit. Second argument is the autosplit