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

package ExtUtils::Install;

$VERSION = substr q$Revision: 1.19 $, 10;
# $Date: 1997/08/01 08:39:37 $

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 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, %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 = 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
	    }
	    $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 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 => $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 {
    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{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);
     }

    my $umask = umask 0022 unless $Is_VMS;
    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);
    }
    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.

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