[p5sagit/p5-mst-13.2.git] / lib / ExtUtils / Install.pm

package ExtUtils::Install;

use 5.005_64;
our(@ISA, @EXPORT, $VERSION);
$VERSION = substr q$Revision: 1.28 $, 10;
# $Date: 1998/01/25 07:08:24 $

use Exporter;
use Carp ();
use Config qw(%Config);
@ISA = ('Exporter');
@EXPORT = ('install','uninstall','pm_to_blib', 'install_default');
$Is_VMS = $^O eq 'VMS';

my $splitchar = $^O eq 'VMS' ? '|' : ($^O eq 'os2' || $^O eq 'dos') ? ';' : ':';
my @PERL_ENV_LIB = split $splitchar, defined $ENV{'PERL5LIB'} ? $ENV{'PERL5LIB'} : $ENV{'PERLLIB'} || '';
my $Inc_uninstall_warn_handler;

#our(@EXPORT, @ISA, $Is_VMS);
#use strict;

sub forceunlink {
    chmod 0666, $_[0];
    unlink $_[0] or Carp::croak("Cannot forceunlink $_[0]: $!")
}

sub install {
    my($hash,$verbose,$nonono,$inc_uninstall) = @_;
    $verbose ||= 0;
    $nonono  ||= 0;

    use Cwd qw(cwd);
    use ExtUtils::MakeMaker; # to implement a MY class
    use ExtUtils::Packlist;
    use File::Basename qw(dirname);
    use File::Copy qw(copy);
    use File::Find qw(find);
    use File::Path qw(mkpath);
    use File::Compare qw(compare);

    my(%hash) = %$hash;
    my(%pack, $dir, $warn_permissions);
    my($packlist) = ExtUtils::Packlist->new();
    # -w doesn't work reliably on FAT dirs
    $warn_permissions++ if $^O eq 'MSWin32';
    local(*DIR);
    for (qw/read write/) {
	$pack{$_}=$hash{$_};
	delete $hash{$_};
    }
    my($source_dir_or_file);
    foreach $source_dir_or_file (sort keys %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;
	for (readdir DIR) {
	    next if $_ eq "." || $_ eq ".." || $_ eq ".exists";
	    if (-w $hash{$source_dir_or_file} ||
		mkpath($hash{$source_dir_or_file})) {
		last;
	    } else {
		warn "Warning: You do not have permissions to " .
		    "install into $hash{$source_dir_or_file}"
		    unless $warn_permissions++;
	    }
	}
	closedir DIR;
    }
    $packlist->read($pack{"read"}) if (-f $pack{"read"});
    my $cwd = cwd();

    my($source);
    MOD_INSTALL: foreach $source (sort keys %hash) {
	#copy the tree to the target directory without altering
	#timestamp and permission and remember for the .packlist
	#file. The packlist file contains the absolute paths of the
	#install locations. AFS users may call this a bug. We'll have
	#to reconsider how to add the means to satisfy AFS users also.

	#October 1997: we want to install .pm files into archlib if
	#there are any files in arch. So we depend on having ./blib/arch
	#hardcoded here.
	my $targetroot = $hash{$source};
	if ($source eq "blib/lib" and
	    exists $hash{"blib/arch"} and
	    directory_not_empty("blib/arch")) {
	    $targetroot = $hash{"blib/arch"};
            print "Files found in blib/arch: installing files in blib/lib into architecture dependent library tree\n";
	}
	chdir($source) or next;
	find(sub {
	    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
                         $atime,$mtime,$ctime,$blksize,$blocks) = stat;
	    return unless -f _;
	    return if $_ eq ".exists";
	    my $targetdir = MY->catdir($targetroot,$File::Find::dir);
	    my $targetfile = MY->catfile($targetdir,$_);

	    my $diff = 0;
	    if ( -f $targetfile && -s _ == $size) {
		# We have a good chance, we can skip this one
		$diff = compare($_,$targetfile);
	    } else {
		print "$_ differs\n" if $verbose>1;
		$diff++;
	    }

	    if ($diff){
		if (-f $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";
		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" 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
	    }
	    $packlist->{$targetfile}++;

	}, ".");
	chdir($cwd) or Carp::croak("Couldn't chdir to $cwd: $!");
    }
    if ($pack{'write'}) {
	$dir = dirname($pack{'write'});
	mkpath($dir,0,0755);
	print "Writing $pack{'write'}\n";
	$packlist->write($pack{'write'});
    }
}

sub directory_not_empty ($) {
  my($dir) = @_;
  my $files = 0;
  find(sub {
	   return if $_ eq ".exists";
	   if (-f) {
	     $File::Find::prune++;
	     $files = 1;
	   }
       }, $dir);
  return $files;
}

sub install_default {
  @_ < 2 or die "install_default should be called with 0 or 1 argument";
  my $FULLEXT = @_ ? shift : $ARGV[0];
  defined $FULLEXT or die "Do not know to where to write install log";
  my $INST_LIB = MM->catdir(MM->curdir,"blib","lib");
  my $INST_ARCHLIB = MM->catdir(MM->curdir,"blib","arch");
  my $INST_BIN = MM->catdir(MM->curdir,'blib','bin');
  my $INST_SCRIPT = MM->catdir(MM->curdir,'blib','script');
  my $INST_MAN1DIR = MM->catdir(MM->curdir,'blib','man1');
  my $INST_MAN3DIR = MM->catdir(MM->curdir,'blib','man3');
  install({
	   read => "$Config{sitearchexp}/auto/$FULLEXT/.packlist",
	   write => "$Config{installsitearch}/auto/$FULLEXT/.packlist",
	   $INST_LIB => (directory_not_empty($INST_ARCHLIB)) ?
			 $Config{installsitearch} :
			 $Config{installsitelib},
	   $INST_ARCHLIB => $Config{installsitearch},
	   $INST_BIN => $Config{installbin} ,
	   $INST_SCRIPT => $Config{installscript},
	   $INST_MAN1DIR => $Config{installman1dir},
	   $INST_MAN3DIR => $Config{installman3dir},
	  },1,0,0);
}

sub uninstall {
    use ExtUtils::Packlist;
    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
    my ($packlist) = ExtUtils::Packlist->new($fil);
    foreach (sort(keys(%$packlist))) {
	chomp;
	print "unlink $_\n" if $verbose;
	forceunlink($_) unless $nonono;
    }
    print "unlink $fil\n" if $verbose;
    forceunlink($fil) unless $nonono;
}

sub inc_uninstall {
    my($file,$libdir,$verbose,$nonono) = @_;
    my($dir);
    my %seen_dir = ();
    foreach $dir (@INC, @PERL_ENV_LIB, @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 = compare($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 {
    my($fromto,$autodir) = @_;

    use File::Basename qw(dirname);
    use File::Copy qw(copy);
    use File::Path qw(mkpath);
    use File::Compare qw(compare);
    use AutoSplit;
    # my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
    # require $my_req; # Hairy, but for the first

    if (!ref($fromto) && -r $fromto)
     {
      # Win32 has severe command line length limitations, but
      # can generate temporary files on-the-fly
      # so we pass name of file here - eval it to get hash 
      open(FROMTO,"<$fromto") or die "Cannot open $fromto:$!";
      my $str = '$fromto = {qw{'.join('',<FROMTO>).'}}';
      eval $str;
      close(FROMTO);
     }

    mkpath($autodir,0,0755);
    foreach (keys %$fromto) {
	next if -f $fromto->{$_} && -M $fromto->{$_} < -M $_;
	unless (compare($_,$fromto->{$_})){
	    print "Skip $fromto->{$_} (unchanged)\n";
	    next;
	}
	if (-f $fromto->{$_}){
	    forceunlink($fromto->{$_});
	} else {
	    mkpath(dirname($fromto->{$_}),0,0755);
	}
	copy($_,$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);
    }
}

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__

=head1 NAME

ExtUtils::Install - install files from here to there

=head1 SYNOPSIS

B<use ExtUtils::Install;>

B<install($hashref,$verbose,$nonono);>

B<uninstall($packlistfile,$verbose,$nonono);>

B<pm_to_blib($hashref);>

=head1 DESCRIPTION

Both install() and uninstall() are specific to the way
ExtUtils::MakeMaker handles the installation and deinstallation of
perl modules. They are not designed as general purpose tools.

install() takes three arguments. A reference to a hash, a verbose
switch and a don't-really-do-it switch. The hash ref contains a
mapping of directories: each key/value pair is a combination of
directories to be copied. Key is a directory to copy from, value is a
directory to copy to. The whole tree below the "from" directory will
be copied preserving timestamps and permissions.

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 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 that people are installing to a
different directory than the one where the files later appear.

install_default() takes one or less arguments.  If no arguments are 
specified, it takes $ARGV[0] as if it was specified as an argument.  
The argument is the value of MakeMaker's C<FULLEXT> key, like F<Tk/Canvas>.  
This function calls install() with the same arguments as the defaults 
the MakeMaker would use.

The argument-less form is convenient for install scripts like

  perl -MExtUtils::Install -e install_default Tk/Canvas

Assuming this command is executed in a directory with a populated F<blib> 
directory, it will proceed as if the F<blib> was build by MakeMaker on 
this machine.  This is useful for binary distributions.

uninstall() takes as first argument a file containing filenames to be
unlinked. The second argument is a verbose switch, the third is a
no-don't-really-do-it-now switch.

pm_to_blib() takes a hashref as the first argument and copies all keys
of the hash to the corresponding values efficiently. Filenames with
the extension pm are autosplit. Second argument is the autosplit
directory.

=cut
Commit	Line	Data
4b6d56d3	1	package ExtUtils::Install;
4b6d56d3	2
17f410f9	3	use 5.005_64;
17f410f9	4	our(@ISA, @EXPORT, $VERSION);
456e5c25	5	$VERSION = substr q$Revision: 1.28 $, 10;
456e5c25	6	# $Date: 1998/01/25 07:08:24 $
f1387719	7
08ad6bd5	8	use Exporter;
08ad6bd5	9	use Carp ();
c3648e42	10	use Config qw(%Config);
4b6d56d3	11	@ISA = ('Exporter');
c3648e42	12	@EXPORT = ('install','uninstall','pm_to_blib', 'install_default');
08ad6bd5	13	$Is_VMS = $^O eq 'VMS';
08ad6bd5	14
39e571d4	15	my $splitchar = $^O eq 'VMS' ? '\|' : ($^O eq 'os2' \|\| $^O eq 'dos') ? ';' : ':';
d6abf24b	16	my @PERL_ENV_LIB = split $splitchar, defined $ENV{'PERL5LIB'} ? $ENV{'PERL5LIB'} : $ENV{'PERLLIB'} \|\| '';
f1387719	17	my $Inc_uninstall_warn_handler;
f1387719	18
17f410f9	19	#our(@EXPORT, @ISA, $Is_VMS);
4b6d56d3	20	#use strict;
4b6d56d3	21
f1387719	22	sub forceunlink {
	23	chmod 0666, $_[0];
	24	unlink $_[0] or Carp::croak("Cannot forceunlink $_[0]: $!")
	25	}
08ad6bd5	26
4b6d56d3	27	sub install {
f1387719	28	my($hash,$verbose,$nonono,$inc_uninstall) = @_;
4b6d56d3	29	$verbose \|\|= 0;
4b6d56d3	30	$nonono \|\|= 0;
08ad6bd5	31
	32	use Cwd qw(cwd);
	33	use ExtUtils::MakeMaker; # to implement a MY class
354f3b56	34	use ExtUtils::Packlist;
08ad6bd5	35	use File::Basename qw(dirname);
	36	use File::Copy qw(copy);
	37	use File::Find qw(find);
	38	use File::Path qw(mkpath);
fb73857a	39	use File::Compare qw(compare);
08ad6bd5	40
4b6d56d3	41	my(%hash) = %$hash;
354f3b56	42	my(%pack, $dir, $warn_permissions);
354f3b56	43	my($packlist) = ExtUtils::Packlist->new();
3e3baf6d	44	# -w doesn't work reliably on FAT dirs
3e3baf6d	45	$warn_permissions++ if $^O eq 'MSWin32';
354f3b56	46	local(*DIR);
4b6d56d3	47	for (qw/read write/) {
	48	$pack{$_}=$hash{$_};
	49	delete $hash{$_};
	50	}
08ad6bd5	51	my($source_dir_or_file);
08ad6bd5	52	foreach $source_dir_or_file (sort keys %hash) {
4b6d56d3	53	#Check if there are files, and if yes, look if the corresponding
4b6d56d3	54	#target directory is writable for us
08ad6bd5	55	opendir DIR, $source_dir_or_file or next;
f1387719	56	for (readdir DIR) {
4b6d56d3	57	next if $_ eq "." \|\| $_ eq ".." \|\| $_ eq ".exists";
456e5c25	58	if (-w $hash{$source_dir_or_file} \|\|
456e5c25	59	mkpath($hash{$source_dir_or_file})) {
4b6d56d3	60	last;
4b6d56d3	61	} else {
456e5c25	62	warn "Warning: You do not have permissions to " .
456e5c25	63	"install into $hash{$source_dir_or_file}"
cee7b94a	64	unless $warn_permissions++;
4b6d56d3	65	}
	66	}
	67	closedir DIR;
	68	}
354f3b56	69	$packlist->read($pack{"read"}) if (-f $pack{"read"});
4b6d56d3	70	my $cwd = cwd();
4b6d56d3	71
4b6d56d3	72	my($source);
	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.
456e5c25	79
	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
	82	#hardcoded here.
	83	my $targetroot = $hash{$source};
e8aa0dbc	84	if ($source eq "blib/lib" and
	85	exists $hash{"blib/arch"} and
	86	directory_not_empty("blib/arch")) {
	87	$targetroot = $hash{"blib/arch"};
dcc96bbd	88	print "Files found in blib/arch: installing files in blib/lib into architecture dependent library tree\n";
456e5c25	89	}
4b6d56d3	90	chdir($source) or next;
	91	find(sub {
	92	my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
	93	$atime,$mtime,$ctime,$blksize,$blocks) = stat;
	94	return unless -f _;
	95	return if $_ eq ".exists";
456e5c25	96	my $targetdir = MY->catdir($targetroot,$File::Find::dir);
456e5c25	97	my $targetfile = MY->catfile($targetdir,$_);
4b6d56d3	98
f1387719	99	my $diff = 0;
4b6d56d3	100	if ( -f $targetfile && -s _ == $size) {
4b6d56d3	101	# We have a good chance, we can skip this one
fb73857a	102	$diff = compare($_,$targetfile);
4b6d56d3	103	} else {
	104	print "$_ differs\n" if $verbose>1;
	105	$diff++;
	106	}
	107
	108	if ($diff){
08ad6bd5	109	if (-f $targetfile){
f1387719	110	forceunlink($targetfile) unless $nonono;
08ad6bd5	111	} else {
	112	mkpath($targetdir,0,0755) unless $nonono;
	113	print "mkpath($targetdir,0,0755)\n" if $verbose>1;
	114	}
4b6d56d3	115	copy($_,$targetfile) unless $nonono;
f1387719	116	print "Installing $targetfile\n";
08ad6bd5	117	utime($atime,$mtime + $Is_VMS,$targetfile) unless $nonono>1;
4b6d56d3	118	print "utime($atime,$mtime,$targetfile)\n" if $verbose>1;
f1387719	119	$mode = 0444 \| ( $mode & 0111 ? 0111 : 0 );
4b6d56d3	120	chmod $mode, $targetfile;
	121	print "chmod($mode, $targetfile)\n" if $verbose>1;
	122	} else {
f1387719	123	print "Skipping $targetfile (unchanged)\n" if $verbose;
	124	}
	125
	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
	129	} else {
	130	inc_uninstall($_,$File::Find::dir,$verbose,0); # nonono set to 0
4b6d56d3	131	}
354f3b56	132	$packlist->{$targetfile}++;
4b6d56d3	133
4b6d56d3	134	}, ".");
08ad6bd5	135	chdir($cwd) or Carp::croak("Couldn't chdir to $cwd: $!");
4b6d56d3	136	}
4b6d56d3	137	if ($pack{'write'}) {
	138	$dir = dirname($pack{'write'});
	139	mkpath($dir,0,0755);
	140	print "Writing $pack{'write'}\n";
354f3b56	141	$packlist->write($pack{'write'});
4b6d56d3	142	}
	143	}
	144
456e5c25	145	sub directory_not_empty ($) {
	146	my($dir) = @_;
	147	my $files = 0;
	148	find(sub {
	149	return if $_ eq ".exists";
	150	if (-f) {
	151	$File::Find::prune++;
	152	$files = 1;
	153	}
	154	}, $dir);
	155	return $files;
	156	}
	157
c3648e42	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');
	168	install({
	169	read => "$Config{sitearchexp}/auto/$FULLEXT/.packlist",
	170	write => "$Config{installsitearch}/auto/$FULLEXT/.packlist",
456e5c25	171	$INST_LIB => (directory_not_empty($INST_ARCHLIB)) ?
	172	$Config{installsitearch} :
	173	$Config{installsitelib},
c3648e42	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},
	179	},1,0,0);
	180	}
	181
4b6d56d3	182	sub uninstall {
354f3b56	183	use ExtUtils::Packlist;
4b6d56d3	184	my($fil,$verbose,$nonono) = @_;
4b6d56d3	185	die "no packlist file found: $fil" unless -f $fil;
f1387719	186	# my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
f1387719	187	# require $my_req; # Hairy, but for the first
354f3b56	188	my ($packlist) = ExtUtils::Packlist->new($fil);
354f3b56	189	foreach (sort(keys(%$packlist))) {
4b6d56d3	190	chomp;
4b6d56d3	191	print "unlink $_\n" if $verbose;
f1387719	192	forceunlink($_) unless $nonono;
4b6d56d3	193	}
4b6d56d3	194	print "unlink $fil\n" if $verbose;
f1387719	195	forceunlink($fil) unless $nonono;
	196	}
	197
	198	sub inc_uninstall {
	199	my($file,$libdir,$verbose,$nonono) = @_;
	200	my($dir);
f1387719	201	my %seen_dir = ();
456e5c25	202	foreach $dir (@INC, @PERL_ENV_LIB, @Config{qw(archlibexp
	203	privlibexp
	204	sitearchexp
	205	sitelibexp)}) {
f1387719	206	next if $dir eq ".";
f1387719	207	next if $seen_dir{$dir}++;
456e5c25	208	my($targetfile) = MY->catfile($dir,$libdir,$file);
f1387719	209	next unless -f $targetfile;
	210
	211	# The reason why we compare file's contents is, that we cannot
	212	# know, which is the file we just installed (AFS). So we leave
	213	# an identical file in place
	214	my $diff = 0;
	215	if ( -f $targetfile && -s _ == -s $file) {
	216	# We have a good chance, we can skip this one
fb73857a	217	$diff = compare($file,$targetfile);
f1387719	218	} else {
	219	print "#$file and $targetfile differ\n" if $verbose>1;
	220	$diff++;
	221	}
	222
	223	next unless $diff;
	224	if ($nonono) {
	225	if ($verbose) {
	226	$Inc_uninstall_warn_handler \|\|= new ExtUtils::Install::Warn;
	227	$libdir =~ s\|^\./\|\| ; # That's just cosmetics, no need to port. It looks prettier.
	228	$Inc_uninstall_warn_handler->add("$libdir/$file",$targetfile);
	229	}
	230	# if not verbose, we just say nothing
	231	} else {
	232	print "Unlinking $targetfile (shadowing?)\n";
	233	forceunlink($targetfile);
	234	}
	235	}
08ad6bd5	236	}
	237
	238	sub pm_to_blib {
	239	my($fromto,$autodir) = @_;
	240
	241	use File::Basename qw(dirname);
	242	use File::Copy qw(copy);
	243	use File::Path qw(mkpath);
fb73857a	244	use File::Compare qw(compare);
08ad6bd5	245	use AutoSplit;
f1387719	246	# my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
f1387719	247	# require $my_req; # Hairy, but for the first
08ad6bd5	248
68dc0745	249	if (!ref($fromto) && -r $fromto)
	250	{
	251	# Win32 has severe command line length limitations, but
	252	# can generate temporary files on-the-fly
	253	# so we pass name of file here - eval it to get hash
	254	open(FROMTO,"<$fromto") or die "Cannot open $fromto:$!";
	255	my $str = '$fromto = {qw{'.join('',<FROMTO>).'}}';
	256	eval $str;
	257	close(FROMTO);
	258	}
	259
08ad6bd5	260	mkpath($autodir,0,0755);
	261	foreach (keys %$fromto) {
	262	next if -f $fromto->{$_} && -M $fromto->{$_} < -M $_;
fb73857a	263	unless (compare($_,$fromto->{$_})){
08ad6bd5	264	print "Skip $fromto->{$_} (unchanged)\n";
	265	next;
	266	}
	267	if (-f $fromto->{$_}){
f1387719	268	forceunlink($fromto->{$_});
08ad6bd5	269	} else {
	270	mkpath(dirname($fromto->{$_}),0,0755);
	271	}
	272	copy($_,$fromto->{$_});
cee7b94a	273	my($mode,$atime,$mtime) = (stat)[2,8,9];
	274	utime($atime,$mtime+$Is_VMS,$fromto->{$_});
	275	chmod(0444 \| ( $mode & 0111 ? 0111 : 0 ),$fromto->{$_});
08ad6bd5	276	print "cp $_ $fromto->{$_}\n";
	277	next unless /\.pm$/;
	278	autosplit($fromto->{$_},$autodir);
	279	}
4b6d56d3	280	}
4b6d56d3	281
f1387719	282	package ExtUtils::Install::Warn;
	283
	284	sub new { bless {}, shift }
	285
	286	sub add {
	287	my($self,$file,$targetfile) = @_;
	288	push @{$self->{$file}}, $targetfile;
	289	}
	290
	291	sub DESTROY {
	292	my $self = shift;
	293	my($file,$i,$plural);
	294	foreach $file (sort keys %$self) {
	295	$plural = @{$self->{$file}} > 1 ? "s" : "";
	296	print "## Differing version$plural of $file found. You might like to\n";
	297	for (0..$#{$self->{$file}}) {
	298	print "rm ", $self->{$file}[$_], "\n";
	299	$i++;
	300	}
	301	}
	302	$plural = $i>1 ? "all those files" : "this file";
	303	print "## Running 'make install UNINST=1' will unlink $plural for you.\n";
	304	}
	305
4b6d56d3	306	1;
	307
	308	__END__
	309
	310	=head1 NAME
	311
	312	ExtUtils::Install - install files from here to there
	313
	314	=head1 SYNOPSIS
	315
	316	B<use ExtUtils::Install;>
	317
	318	B<install($hashref,$verbose,$nonono);>
	319
	320	B<uninstall($packlistfile,$verbose,$nonono);>
	321
08ad6bd5	322	B<pm_to_blib($hashref);>
08ad6bd5	323
4b6d56d3	324	=head1 DESCRIPTION
4b6d56d3	325
08ad6bd5	326	Both install() and uninstall() are specific to the way
4b6d56d3	327	ExtUtils::MakeMaker handles the installation and deinstallation of
	328	perl modules. They are not designed as general purpose tools.
	329
	330	install() takes three arguments. A reference to a hash, a verbose
	331	switch and a don't-really-do-it switch. The hash ref contains a
	332	mapping of directories: each key/value pair is a combination of
	333	directories to be copied. Key is a directory to copy from, value is a
	334	directory to copy to. The whole tree below the "from" directory will
	335	be copied preserving timestamps and permissions.
	336
	337	There are two keys with a special meaning in the hash: "read" and
	338	"write". After the copying is done, install will write the list of
1fef88e7	339	target files to the file named by C<$hashref-E<gt>{write}>. If there is
1fef88e7	340	another file named by C<$hashref-E<gt>{read}>, the contents of this file will
4b6d56d3	341	be merged into the written file. The read and the written file may be
a7665c5e	342	identical, but on AFS it is quite likely that people are installing to a
4b6d56d3	343	different directory than the one where the files later appear.
4b6d56d3	344
c3648e42	345	install_default() takes one or less arguments. If no arguments are
	346	specified, it takes $ARGV[0] as if it was specified as an argument.
	347	The argument is the value of MakeMaker's C<FULLEXT> key, like F<Tk/Canvas>.
	348	This function calls install() with the same arguments as the defaults
	349	the MakeMaker would use.
	350
de592821	351	The argument-less form is convenient for install scripts like
c3648e42	352
	353	perl -MExtUtils::Install -e install_default Tk/Canvas
	354
a7665c5e	355	Assuming this command is executed in a directory with a populated F<blib>
c3648e42	356	directory, it will proceed as if the F<blib> was build by MakeMaker on
	357	this machine. This is useful for binary distributions.
	358
4b6d56d3	359	uninstall() takes as first argument a file containing filenames to be
	360	unlinked. The second argument is a verbose switch, the third is a
	361	no-don't-really-do-it-now switch.
	362
08ad6bd5	363	pm_to_blib() takes a hashref as the first argument and copies all keys
	364	of the hash to the corresponding values efficiently. Filenames with
	365	the extension pm are autosplit. Second argument is the autosplit
	366	directory.
4b6d56d3	367
08ad6bd5	368	=cut