1 package ExtUtils::Install;
3 $VERSION = substr q$Revision: 1.12 $, 10;
4 # $Id: Install.pm,v 1.12 1996/06/23 20:46:07 k Exp $
9 use vars qw(@ISA @EXPORT $VERSION);
11 @EXPORT = ('install','uninstall','pm_to_blib');
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);
37 # The following lines were needed with AutoLoader (left for the record)
38 # my $my_req = $self->catfile(qw(auto ExtUtils Install my_cmp.al));
40 # $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
41 # require $my_req; # Hairy, but for the first
42 # time use we are in a different directory when autoload happens, so
43 # the relativ path to ./blib is ill.
46 my(%pack, %write, $dir);
48 for (qw/read write/) {
52 my($source_dir_or_file);
53 foreach $source_dir_or_file (sort keys %hash) {
54 #Check if there are files, and if yes, look if the corresponding
55 #target directory is writable for us
56 opendir DIR, $source_dir_or_file or next;
58 next if $_ eq "." || $_ eq ".." || $_ eq ".exists";
59 if (-w $hash{$source_dir_or_file} || mkpath($hash{$source_dir_or_file})) {
62 Carp::croak("You do not have permissions to install into $hash{$source_dir_or_file}");
67 if (-f $pack{"read"}) {
68 open P, $pack{"read"} or Carp::croak("Couldn't read $pack{'read'}");
69 # Remember what you found
77 my $umask = umask 0 unless $Is_VMS;
79 # This silly reference is just here to be able to call MY->catdir
80 # without a warning (Waiting for a proper path/directory module,
85 MOD_INSTALL: foreach $source (sort keys %hash) {
86 #copy the tree to the target directory without altering
87 #timestamp and permission and remember for the .packlist
88 #file. The packlist file contains the absolute paths of the
89 #install locations. AFS users may call this a bug. We'll have
90 #to reconsider how to add the means to satisfy AFS users also.
91 chdir($source) or next;
93 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
94 $atime,$mtime,$ctime,$blksize,$blocks) = stat;
96 return if $_ eq ".exists";
97 my $targetdir = $MY->catdir($hash{$source},$File::Find::dir);
98 my $targetfile = $MY->catfile($targetdir,$_);
101 if ( -f $targetfile && -s _ == $size) {
102 # We have a good chance, we can skip this one
103 $diff = my_cmp($_,$targetfile);
105 print "$_ differs\n" if $verbose>1;
111 forceunlink($targetfile) unless $nonono;
113 mkpath($targetdir,0,0755) unless $nonono;
114 print "mkpath($targetdir,0,0755)\n" if $verbose>1;
116 copy($_,$targetfile) unless $nonono;
117 print "Installing $targetfile\n";
118 utime($atime,$mtime + $Is_VMS,$targetfile) unless $nonono>1;
119 print "utime($atime,$mtime,$targetfile)\n" if $verbose>1;
120 $mode = 0444 | ( $mode & 0111 ? 0111 : 0 );
121 chmod $mode, $targetfile;
122 print "chmod($mode, $targetfile)\n" if $verbose>1;
124 print "Skipping $targetfile (unchanged)\n" if $verbose;
127 if (! defined $inc_uninstall) { # it's called
128 } elsif ($inc_uninstall == 0){
129 inc_uninstall($_,$File::Find::dir,$verbose,1); # nonono set to 1
131 inc_uninstall($_,$File::Find::dir,$verbose,0); # nonono set to 0
133 $write{$targetfile}++;
136 chdir($cwd) or Carp::croak("Couldn't chdir to $cwd: $!");
138 umask $umask unless $Is_VMS;
139 if ($pack{'write'}) {
140 $dir = dirname($pack{'write'});
142 print "Writing $pack{'write'}\n";
143 open P, ">$pack{'write'}" or Carp::croak("Couldn't write $pack{'write'}: $!");
144 for (sort keys %write) {
155 open T, $two or return 1;
156 open F, $one or Carp::croak("Couldn't open $one: $!");
157 my($fr, $tr, $fbuf, $tbuf, $size);
159 # print "Reading $one\n";
160 while ( $fr = read(F,$fbuf,$size)) {
162 $tr = read(T,$tbuf,$size) and
178 my($fil,$verbose,$nonono) = @_;
179 die "no packlist file found: $fil" unless -f $fil;
180 # my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
181 # require $my_req; # Hairy, but for the first
183 open P, $fil or Carp::croak("uninstall: Could not read packlist file $fil: $!");
186 print "unlink $_\n" if $verbose;
187 forceunlink($_) unless $nonono;
189 print "unlink $fil\n" if $verbose;
190 forceunlink($fil) unless $nonono;
194 my($file,$libdir,$verbose,$nonono) = @_;
199 foreach $dir (@INC, @PERL_ENV_LIB, @Config::Config{qw/archlibexp privlibexp sitearchexp sitelibexp/}) {
201 next if $seen_dir{$dir}++;
202 my($targetfile) = $MY->catfile($dir,$libdir,$file);
203 next unless -f $targetfile;
205 # The reason why we compare file's contents is, that we cannot
206 # know, which is the file we just installed (AFS). So we leave
207 # an identical file in place
209 if ( -f $targetfile && -s _ == -s $file) {
210 # We have a good chance, we can skip this one
211 $diff = my_cmp($file,$targetfile);
213 print "#$file and $targetfile differ\n" if $verbose>1;
220 $Inc_uninstall_warn_handler ||= new ExtUtils::Install::Warn;
221 $libdir =~ s|^\./|| ; # That's just cosmetics, no need to port. It looks prettier.
222 $Inc_uninstall_warn_handler->add("$libdir/$file",$targetfile);
224 # if not verbose, we just say nothing
226 print "Unlinking $targetfile (shadowing?)\n";
227 forceunlink($targetfile);
233 my($fromto,$autodir) = @_;
235 use File::Basename qw(dirname);
236 use File::Copy qw(copy);
237 use File::Path qw(mkpath);
239 # my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
240 # require $my_req; # Hairy, but for the first
242 my $umask = umask 0022 unless $Is_VMS;
243 mkpath($autodir,0,0755);
244 foreach (keys %$fromto) {
245 next if -f $fromto->{$_} && -M $fromto->{$_} < -M $_;
246 unless (my_cmp($_,$fromto->{$_})){
247 print "Skip $fromto->{$_} (unchanged)\n";
250 if (-f $fromto->{$_}){
251 forceunlink($fromto->{$_});
253 mkpath(dirname($fromto->{$_}),0,0755);
255 copy($_,$fromto->{$_});
256 chmod(0444 | ( (stat)[2] & 0111 ? 0111 : 0 ),$fromto->{$_});
257 print "cp $_ $fromto->{$_}\n";
259 autosplit($fromto->{$_},$autodir);
261 umask $umask unless $Is_VMS;
264 package ExtUtils::Install::Warn;
266 sub new { bless {}, shift }
269 my($self,$file,$targetfile) = @_;
270 push @{$self->{$file}}, $targetfile;
275 my($file,$i,$plural);
276 foreach $file (sort keys %$self) {
277 $plural = @{$self->{$file}} > 1 ? "s" : "";
278 print "## Differing version$plural of $file found. You might like to\n";
279 for (0..$#{$self->{$file}}) {
280 print "rm ", $self->{$file}[$_], "\n";
284 $plural = $i>1 ? "all those files" : "this file";
285 print "## Running 'make install UNINST=1' will unlink $plural for you.\n";
294 ExtUtils::Install - install files from here to there
298 B<use ExtUtils::Install;>
300 B<install($hashref,$verbose,$nonono);>
302 B<uninstall($packlistfile,$verbose,$nonono);>
304 B<pm_to_blib($hashref);>
308 Both install() and uninstall() are specific to the way
309 ExtUtils::MakeMaker handles the installation and deinstallation of
310 perl modules. They are not designed as general purpose tools.
312 install() takes three arguments. A reference to a hash, a verbose
313 switch and a don't-really-do-it switch. The hash ref contains a
314 mapping of directories: each key/value pair is a combination of
315 directories to be copied. Key is a directory to copy from, value is a
316 directory to copy to. The whole tree below the "from" directory will
317 be copied preserving timestamps and permissions.
319 There are two keys with a special meaning in the hash: "read" and
320 "write". After the copying is done, install will write the list of
321 target files to the file named by $hashref->{write}. If there is
322 another file named by $hashref->{read}, the contents of this file will
323 be merged into the written file. The read and the written file may be
324 identical, but on AFS it is quite likely, people are installing to a
325 different directory than the one where the files later appear.
327 uninstall() takes as first argument a file containing filenames to be
328 unlinked. The second argument is a verbose switch, the third is a
329 no-don't-really-do-it-now switch.
331 pm_to_blib() takes a hashref as the first argument and copies all keys
332 of the hash to the corresponding values efficiently. Filenames with
333 the extension pm are autosplit. Second argument is the autosplit