1 package ExtUtils::Install;
3 $VERSION = substr q$Revision: 1.16 $, 10;
4 # $Date: 1996/12/17 00:31:26 $
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);
39 my(%pack, %write, $dir, $warn_permissions);
40 # -w doesn't work reliably on FAT dirs
41 $warn_permissions++ if $^O eq 'MSWin32';
43 for (qw/read write/) {
47 my($source_dir_or_file);
48 foreach $source_dir_or_file (sort keys %hash) {
49 #Check if there are files, and if yes, look if the corresponding
50 #target directory is writable for us
51 opendir DIR, $source_dir_or_file or next;
53 next if $_ eq "." || $_ eq ".." || $_ eq ".exists";
54 if (-w $hash{$source_dir_or_file} || mkpath($hash{$source_dir_or_file})) {
57 warn "Warning: You do not have permissions to install into $hash{$source_dir_or_file}"
58 unless $warn_permissions++;
63 if (-f $pack{"read"}) {
64 open P, $pack{"read"} or Carp::croak("Couldn't read $pack{'read'}");
65 # Remember what you found
73 my $umask = umask 0 unless $Is_VMS;
75 # This silly reference is just here to be able to call MY->catdir
76 # without a warning (Waiting for a proper path/directory module,
81 MOD_INSTALL: foreach $source (sort keys %hash) {
82 #copy the tree to the target directory without altering
83 #timestamp and permission and remember for the .packlist
84 #file. The packlist file contains the absolute paths of the
85 #install locations. AFS users may call this a bug. We'll have
86 #to reconsider how to add the means to satisfy AFS users also.
87 chdir($source) or next;
89 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
90 $atime,$mtime,$ctime,$blksize,$blocks) = stat;
92 return if $_ eq ".exists";
93 my $targetdir = $MY->catdir($hash{$source},$File::Find::dir);
94 my $targetfile = $MY->catfile($targetdir,$_);
97 if ( -f $targetfile && -s _ == $size) {
98 # We have a good chance, we can skip this one
99 $diff = my_cmp($_,$targetfile);
101 print "$_ differs\n" if $verbose>1;
107 forceunlink($targetfile) unless $nonono;
109 mkpath($targetdir,0,0755) unless $nonono;
110 print "mkpath($targetdir,0,0755)\n" if $verbose>1;
112 copy($_,$targetfile) unless $nonono;
113 print "Installing $targetfile\n";
114 utime($atime,$mtime + $Is_VMS,$targetfile) unless $nonono>1;
115 print "utime($atime,$mtime,$targetfile)\n" if $verbose>1;
116 $mode = 0444 | ( $mode & 0111 ? 0111 : 0 );
117 chmod $mode, $targetfile;
118 print "chmod($mode, $targetfile)\n" if $verbose>1;
120 print "Skipping $targetfile (unchanged)\n" if $verbose;
123 if (! defined $inc_uninstall) { # it's called
124 } elsif ($inc_uninstall == 0){
125 inc_uninstall($_,$File::Find::dir,$verbose,1); # nonono set to 1
127 inc_uninstall($_,$File::Find::dir,$verbose,0); # nonono set to 0
129 $write{$targetfile}++;
132 chdir($cwd) or Carp::croak("Couldn't chdir to $cwd: $!");
134 umask $umask unless $Is_VMS;
135 if ($pack{'write'}) {
136 $dir = dirname($pack{'write'});
138 print "Writing $pack{'write'}\n";
139 open P, ">$pack{'write'}" or Carp::croak("Couldn't write $pack{'write'}: $!");
140 for (sort keys %write) {
147 sub install_default {
148 @_ < 2 or die "install_default should be called with 0 or 1 argument";
149 my $FULLEXT = @_ ? shift : $ARGV[0];
150 defined $FULLEXT or die "Do not know to where to write install log";
151 my $INST_LIB = MM->catdir(MM->curdir,"blib","lib");
152 my $INST_ARCHLIB = MM->catdir(MM->curdir,"blib","arch");
153 my $INST_BIN = MM->catdir(MM->curdir,'blib','bin');
154 my $INST_SCRIPT = MM->catdir(MM->curdir,'blib','script');
155 my $INST_MAN1DIR = MM->catdir(MM->curdir,'blib','man1');
156 my $INST_MAN3DIR = MM->catdir(MM->curdir,'blib','man3');
158 read => "$Config{sitearchexp}/auto/$FULLEXT/.packlist",
159 write => "$Config{installsitearch}/auto/$FULLEXT/.packlist",
160 $INST_LIB => $Config{installsitelib},
161 $INST_ARCHLIB => $Config{installsitearch},
162 $INST_BIN => $Config{installbin} ,
163 $INST_SCRIPT => $Config{installscript},
164 $INST_MAN1DIR => $Config{installman1dir},
165 $INST_MAN3DIR => $Config{installman3dir},
173 open T, $two or return 1;
174 open F, $one or Carp::croak("Couldn't open $one: $!");
175 my($fr, $tr, $fbuf, $tbuf, $size);
177 # print "Reading $one\n";
178 while ( $fr = read(F,$fbuf,$size)) {
180 $tr = read(T,$tbuf,$size) and
196 my($fil,$verbose,$nonono) = @_;
197 die "no packlist file found: $fil" unless -f $fil;
198 # my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
199 # require $my_req; # Hairy, but for the first
201 open P, $fil or Carp::croak("uninstall: Could not read packlist file $fil: $!");
204 print "unlink $_\n" if $verbose;
205 forceunlink($_) unless $nonono;
207 print "unlink $fil\n" if $verbose;
208 forceunlink($fil) unless $nonono;
212 my($file,$libdir,$verbose,$nonono) = @_;
217 foreach $dir (@INC, @PERL_ENV_LIB, @Config{qw/archlibexp privlibexp sitearchexp sitelibexp/}) {
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 = my_cmp($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);
257 # my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
258 # require $my_req; # Hairy, but for the first
260 if (!ref($fromto) && -r $fromto)
262 # Win32 has severe command line length limitations, but
263 # can generate temporary files on-the-fly
264 # so we pass name of file here - eval it to get hash
265 open(FROMTO,"<$fromto") or die "Cannot open $fromto:$!";
266 my $str = '$fromto = {qw{'.join('',<FROMTO>).'}}';
271 my $umask = umask 0022 unless $Is_VMS;
272 mkpath($autodir,0,0755);
273 foreach (keys %$fromto) {
274 next if -f $fromto->{$_} && -M $fromto->{$_} < -M $_;
275 unless (my_cmp($_,$fromto->{$_})){
276 print "Skip $fromto->{$_} (unchanged)\n";
279 if (-f $fromto->{$_}){
280 forceunlink($fromto->{$_});
282 mkpath(dirname($fromto->{$_}),0,0755);
284 copy($_,$fromto->{$_});
285 my($mode,$atime,$mtime) = (stat)[2,8,9];
286 utime($atime,$mtime+$Is_VMS,$fromto->{$_});
287 chmod(0444 | ( $mode & 0111 ? 0111 : 0 ),$fromto->{$_});
288 print "cp $_ $fromto->{$_}\n";
290 autosplit($fromto->{$_},$autodir);
292 umask $umask unless $Is_VMS;
295 package ExtUtils::Install::Warn;
297 sub new { bless {}, shift }
300 my($self,$file,$targetfile) = @_;
301 push @{$self->{$file}}, $targetfile;
306 my($file,$i,$plural);
307 foreach $file (sort keys %$self) {
308 $plural = @{$self->{$file}} > 1 ? "s" : "";
309 print "## Differing version$plural of $file found. You might like to\n";
310 for (0..$#{$self->{$file}}) {
311 print "rm ", $self->{$file}[$_], "\n";
315 $plural = $i>1 ? "all those files" : "this file";
316 print "## Running 'make install UNINST=1' will unlink $plural for you.\n";
325 ExtUtils::Install - install files from here to there
329 B<use ExtUtils::Install;>
331 B<install($hashref,$verbose,$nonono);>
333 B<uninstall($packlistfile,$verbose,$nonono);>
335 B<pm_to_blib($hashref);>
339 Both install() and uninstall() are specific to the way
340 ExtUtils::MakeMaker handles the installation and deinstallation of
341 perl modules. They are not designed as general purpose tools.
343 install() takes three arguments. A reference to a hash, a verbose
344 switch and a don't-really-do-it switch. The hash ref contains a
345 mapping of directories: each key/value pair is a combination of
346 directories to be copied. Key is a directory to copy from, value is a
347 directory to copy to. The whole tree below the "from" directory will
348 be copied preserving timestamps and permissions.
350 There are two keys with a special meaning in the hash: "read" and
351 "write". After the copying is done, install will write the list of
352 target files to the file named by C<$hashref-E<gt>{write}>. If there is
353 another file named by C<$hashref-E<gt>{read}>, the contents of this file will
354 be merged into the written file. The read and the written file may be
355 identical, but on AFS it is quite likely, people are installing to a
356 different directory than the one where the files later appear.
358 install_default() takes one or less arguments. If no arguments are
359 specified, it takes $ARGV[0] as if it was specified as an argument.
360 The argument is the value of MakeMaker's C<FULLEXT> key, like F<Tk/Canvas>.
361 This function calls install() with the same arguments as the defaults
362 the MakeMaker would use.
364 The argumement-less form is convenient for install scripts like
366 perl -MExtUtils::Install -e install_default Tk/Canvas
368 Assuming this command is executed in a directory with populated F<blib>
369 directory, it will proceed as if the F<blib> was build by MakeMaker on
370 this machine. This is useful for binary distributions.
372 uninstall() takes as first argument a file containing filenames to be
373 unlinked. The second argument is a verbose switch, the third is a
374 no-don't-really-do-it-now switch.
376 pm_to_blib() takes a hashref as the first argument and copies all keys
377 of the hash to the corresponding values efficiently. Filenames with
378 the extension pm are autosplit. Second argument is the autosplit