[perl5.git] / lib / ExtUtils / Install.pm

package ExtUtils::Install;

$VERSION = substr q$Revision: 1.28 $, 10;
# $Date: 1998/01/25 07:08:24 $

use Exporter;
use Carp ();
use Config qw(%Config);
use vars qw(@ISA @EXPORT $VERSION);
@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;

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