package ExtUtils::Install;
+$VERSION = substr q$Revision: 1.15 $, 10;
+# $Date: 1996/09/03 21:58:58 $
+
use Exporter;
-use SelfLoader;
use Carp ();
-
+use Config ();
+use vars qw(@ISA @EXPORT $VERSION);
@ISA = ('Exporter');
@EXPORT = ('install','uninstall','pm_to_blib');
$Is_VMS = $^O eq 'VMS';
+my $splitchar = $^O eq 'VMS' ? '|' : $^O eq 'os2' ? ';' : ':';
+my @PERL_ENV_LIB = split $splitchar, defined $ENV{'PERL5LIB'} ? $ENV{'PERL5LIB'} : $ENV{'PERLLIB'};
+my $Inc_uninstall_warn_handler;
+
#use vars qw( @EXPORT @ISA $Is_VMS );
#use strict;
-1;
-
-sub ExtUtils::Install::install;
-sub ExtUtils::Install::uninstall;
-sub ExtUtils::Install::pm_to_blib;
-sub ExtUtils::Install::my_cmp;
-
-__DATA__
+sub forceunlink {
+ chmod 0666, $_[0];
+ unlink $_[0] or Carp::croak("Cannot forceunlink $_[0]: $!")
+}
sub install {
- my($hash,$verbose,$nonono) = @_;
+ my($hash,$verbose,$nonono,$inc_uninstall) = @_;
$verbose ||= 0;
$nonono ||= 0;
use File::Copy qw(copy);
use File::Find qw(find);
use File::Path qw(mkpath);
- # require "auto/ExtUtils/Install/my_cmp.al"; # Hairy, but for the first
- # time use we are in a different directory when autoload happens, so
- # the relativ path to ./blib is ill.
my(%hash) = %$hash;
- my(%pack, %write, $dir);
+ my(%pack, %write, $dir, $warn_permissions);
local(*DIR, *P);
for (qw/read write/) {
$pack{$_}=$hash{$_};
#Check if there are files, and if yes, look if the corresponding
#target directory is writable for us
opendir DIR, $source_dir_or_file or next;
- while ($_ = readdir DIR) {
+ for (readdir DIR) {
next if $_ eq "." || $_ eq ".." || $_ eq ".exists";
if (-w $hash{$source_dir_or_file} || mkpath($hash{$source_dir_or_file})) {
last;
} else {
- Carp::croak("You do not have permissions to install into $hash{$source_dir_or_file}");
+ warn "Warning: You do not have permissions to install into $hash{$source_dir_or_file}"
+ unless $warn_permissions++;
}
}
closedir DIR;
return if $_ eq ".exists";
my $targetdir = $MY->catdir($hash{$source},$File::Find::dir);
my $targetfile = $MY->catfile($targetdir,$_);
- my $diff = 0;
+ my $diff = 0;
if ( -f $targetfile && -s _ == $size) {
# We have a good chance, we can skip this one
$diff = my_cmp($_,$targetfile);
if ($diff){
if (-f $targetfile){
- unlink $targetfile or Carp::croak("Couldn't unlink $targetfile");
+ forceunlink($targetfile) unless $nonono;
} else {
mkpath($targetdir,0,0755) unless $nonono;
print "mkpath($targetdir,0,0755)\n" if $verbose>1;
}
copy($_,$targetfile) unless $nonono;
- print "Installing $targetfile\n" if $verbose;
+ print "Installing $targetfile\n";
utime($atime,$mtime + $Is_VMS,$targetfile) unless $nonono>1;
print "utime($atime,$mtime,$targetfile)\n" if $verbose>1;
+ $mode = 0444 | ( $mode & 0111 ? 0111 : 0 );
chmod $mode, $targetfile;
print "chmod($mode, $targetfile)\n" if $verbose>1;
} else {
- print "Skipping $targetfile (unchanged)\n";
+ print "Skipping $targetfile (unchanged)\n" if $verbose;
+ }
+
+ if (! defined $inc_uninstall) { # it's called
+ } elsif ($inc_uninstall == 0){
+ inc_uninstall($_,$File::Find::dir,$verbose,1); # nonono set to 1
+ } else {
+ inc_uninstall($_,$File::Find::dir,$verbose,0); # nonono set to 0
}
-
$write{$targetfile}++;
}, ".");
sub uninstall {
my($fil,$verbose,$nonono) = @_;
die "no packlist file found: $fil" unless -f $fil;
+ # my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
+ # require $my_req; # Hairy, but for the first
local *P;
open P, $fil or Carp::croak("uninstall: Could not read packlist file $fil: $!");
while (<P>) {
chomp;
print "unlink $_\n" if $verbose;
- unlink($_) || Carp::carp("Couldn't unlink $_") unless $nonono;
+ forceunlink($_) unless $nonono;
}
print "unlink $fil\n" if $verbose;
- unlink($fil) || Carp::carp("Couldn't unlink $fil") unless $nonono;
+ forceunlink($fil) unless $nonono;
+}
+
+sub inc_uninstall {
+ my($file,$libdir,$verbose,$nonono) = @_;
+ my($dir);
+ my $MY = {};
+ bless $MY, 'MY';
+ my %seen_dir = ();
+ foreach $dir (@INC, @PERL_ENV_LIB, @Config::Config{qw/archlibexp privlibexp sitearchexp sitelibexp/}) {
+ next if $dir eq ".";
+ next if $seen_dir{$dir}++;
+ my($targetfile) = $MY->catfile($dir,$libdir,$file);
+ next unless -f $targetfile;
+
+ # The reason why we compare file's contents is, that we cannot
+ # know, which is the file we just installed (AFS). So we leave
+ # an identical file in place
+ my $diff = 0;
+ if ( -f $targetfile && -s _ == -s $file) {
+ # We have a good chance, we can skip this one
+ $diff = my_cmp($file,$targetfile);
+ } else {
+ print "#$file and $targetfile differ\n" if $verbose>1;
+ $diff++;
+ }
+
+ next unless $diff;
+ if ($nonono) {
+ if ($verbose) {
+ $Inc_uninstall_warn_handler ||= new ExtUtils::Install::Warn;
+ $libdir =~ s|^\./|| ; # That's just cosmetics, no need to port. It looks prettier.
+ $Inc_uninstall_warn_handler->add("$libdir/$file",$targetfile);
+ }
+ # if not verbose, we just say nothing
+ } else {
+ print "Unlinking $targetfile (shadowing?)\n";
+ forceunlink($targetfile);
+ }
+ }
}
sub pm_to_blib {
use File::Copy qw(copy);
use File::Path qw(mkpath);
use AutoSplit;
+ # my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
+ # require $my_req; # Hairy, but for the first
my $umask = umask 0022 unless $Is_VMS;
mkpath($autodir,0,0755);
next;
}
if (-f $fromto->{$_}){
- unlink $fromto->{$_} or Carp::carp("Couldn't unlink $fromto->{$_}");
+ forceunlink($fromto->{$_});
} else {
mkpath(dirname($fromto->{$_}),0,0755);
}
copy($_,$fromto->{$_});
- chmod((stat)[2],$fromto->{$_});
+ my($mode,$atime,$mtime) = (stat)[2,8,9];
+ utime($atime,$mtime+$Is_VMS,$fromto->{$_});
+ chmod(0444 | ( $mode & 0111 ? 0111 : 0 ),$fromto->{$_});
print "cp $_ $fromto->{$_}\n";
next unless /\.pm$/;
autosplit($fromto->{$_},$autodir);
umask $umask unless $Is_VMS;
}
+package ExtUtils::Install::Warn;
+
+sub new { bless {}, shift }
+
+sub add {
+ my($self,$file,$targetfile) = @_;
+ push @{$self->{$file}}, $targetfile;
+}
+
+sub DESTROY {
+ my $self = shift;
+ my($file,$i,$plural);
+ foreach $file (sort keys %$self) {
+ $plural = @{$self->{$file}} > 1 ? "s" : "";
+ print "## Differing version$plural of $file found. You might like to\n";
+ for (0..$#{$self->{$file}}) {
+ print "rm ", $self->{$file}[$_], "\n";
+ $i++;
+ }
+ }
+ $plural = $i>1 ? "all those files" : "this file";
+ print "## Running 'make install UNINST=1' will unlink $plural for you.\n";
+}
+
1;
__END__
There are two keys with a special meaning in the hash: "read" and
"write". After the copying is done, install will write the list of
-target files to the file named by $hashref->{write}. If there is
-another file named by $hashref->{read}, the contents of this file will
+target files to the file named by C<$hashref-E<gt>{write}>. If there is
+another file named by C<$hashref-E<gt>{read}>, the contents of this file will
be merged into the written file. The read and the written file may be
identical, but on AFS it is quite likely, people are installing to a
different directory than the one where the files later appear.
directory.
=cut
-
projects / p5sagit/p5-mst-13.2.git / blobdiff