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

package ExtUtils::Install;

$VERSION = substr q$Revision: 1.16 $, 10;
# $Date: 1996/12/17 00:31:26 $

use Exporter;
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;

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 File::Basename qw(dirname);
    use File::Copy qw(copy);
    use File::Find qw(find);
    use File::Path qw(mkpath);

    my(%hash) = %$hash;
    my(%pack, %write, $dir, $warn_permissions);
    # -w doesn't work reliably on FAT dirs
    $warn_permissions++ if $^O eq 'MSWin32';
    local(*DIR, *P);
    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;
    }
    if (-f $pack{"read"}) {
	open P, $pack{"read"} or Carp::croak("Couldn't read $pack{'read'}");
	# Remember what you found
	while (<P>) {
	    chomp;
	    $write{$_}++;
	}
	close P;
    }
    my $cwd = cwd();
    my $umask = umask 0 unless $Is_VMS;

    # This silly reference is just here to be able to call MY->catdir
    # without a warning (Waiting for a proper path/directory module,
    # Charles!)
    my $MY = {};
    bless $MY, 'MY';
    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.
	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($hash{$source},$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 = my_cmp($_,$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
	    }
	    $write{$targetfile}++;

	}, ".");
	chdir($cwd) or Carp::croak("Couldn't chdir to $cwd: $!");
    }
    umask $umask unless $Is_VMS;
    if ($pack{'write'}) {
	$dir = dirname($pack{'write'});
	mkpath($dir,0,0755);
	print "Writing $pack{'write'}\n";
	open P, ">$pack{'write'}" or Carp::croak("Couldn't write $pack{'write'}: $!");
	for (sort keys %write) {
	    print P "$_\n";
	}
	close P;
    }
}

sub my_cmp {
    my($one,$two) = @_;
    local(*F,*T);
    my $diff = 0;
    open T, $two or return 1;
    open F, $one or Carp::croak("Couldn't open $one: $!");
    my($fr, $tr, $fbuf, $tbuf, $size);
    $size = 1024;
    # print "Reading $one\n";
    while ( $fr = read(F,$fbuf,$size)) {
	unless (
		$tr = read(T,$tbuf,$size) and 
		$tbuf eq $fbuf
	       ){
	    # print "diff ";
	    $diff++;
	    last;
	}
	# print "$fr/$tr ";
    }
    # print "\n";
    close F;
    close T;
    $diff;
}

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;
	forceunlink($_) unless $nonono;
    }
    print "unlink $fil\n" if $verbose;
    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 {
    my($fromto,$autodir) = @_;

    use File::Basename qw(dirname);
    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

    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);
     }

    my $umask = umask 0022 unless $Is_VMS;
    mkpath($autodir,0,0755);
    foreach (keys %$fromto) {
	next if -f $fromto->{$_} && -M $fromto->{$_} < -M $_;
	unless (my_cmp($_,$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);
    }
    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__

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

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