1N/Apackage ExtUtils::Install;

1N/A

1N/Ause 5.00503;

1N/Ause vars qw(@ISA @EXPORT $VERSION);

1N/A$VERSION = 1.32;

1N/A

1N/Ause Exporter;

1N/Ause Carp ();

1N/Ause Config qw(%Config);

1N/A@ISA = ('Exporter');

1N/A@EXPORT = ('install','uninstall','pm_to_blib', 'install_default');

1N/A$Is_VMS = $^O eq 'VMS';

1N/A$Is_MacPerl = $^O eq 'MacOS';

1N/A

1N/Amy $Inc_uninstall_warn_handler;

1N/A

1N/A

1N/Amy $INSTALL_ROOT = $ENV{PERL_INSTALL_ROOT};

1N/A

1N/Ause File::Spec;

1N/Amy $Curdir = File::Spec->curdir;

1N/Amy $Updir = File::Spec->updir;

1N/A

1N/A

1N/A

1N/Asub install {

1N/A my($from_to,$verbose,$nonono,$inc_uninstall) = @_;

1N/A $verbose ||= 0;

1N/A $nonono ||= 0;

1N/A

1N/A use Cwd qw(cwd);

1N/A use ExtUtils::Packlist;

1N/A use File::Basename qw(dirname);

1N/A use File::Copy qw(copy);

1N/A use File::Find qw(find);

1N/A use File::Path qw(mkpath);

1N/A use File::Compare qw(compare);

1N/A

1N/A my(%from_to) = %$from_to;

1N/A my(%pack, $dir, $warn_permissions);

1N/A my($packlist) = ExtUtils::Packlist->new();

1N/A # -w doesn't work reliably on FAT dirs

1N/A $warn_permissions++ if $^O eq 'MSWin32';

1N/A local(*DIR);

1N/A for (qw/read write/) {

1N/A $pack{$_}=$from_to{$_};

1N/A delete $from_to{$_};

1N/A }

1N/A my($source_dir_or_file);

1N/A foreach $source_dir_or_file (sort keys %from_to) {

1N/A #Check if there are files, and if yes, look if the corresponding

1N/A #target directory is writable for us

1N/A opendir DIR, $source_dir_or_file or next;

1N/A for (readdir DIR) {

1N/A next if $_ eq $Curdir || $_ eq $Updir || $_ eq ".exists";

1N/A my $targetdir = install_rooted_dir($from_to{$source_dir_or_file});

1N/A mkpath($targetdir) unless $nonono;

1N/A if (!$nonono && !-w $targetdir) {

1N/A warn "Warning: You do not have permissions to " .

1N/A "install into $from_to{$source_dir_or_file}"

1N/A unless $warn_permissions++;

1N/A }

1N/A }

1N/A closedir DIR;

1N/A }

1N/A my $tmpfile = install_rooted_file($pack{"read"});

1N/A $packlist->read($tmpfile) if (-f $tmpfile);

1N/A my $cwd = cwd();

1N/A

1N/A MOD_INSTALL: foreach my $source (sort keys %from_to) {

1N/A #copy the tree to the target directory without altering

1N/A #timestamp and permission and remember for the .packlist

1N/A #file. The packlist file contains the absolute paths of the

1N/A #install locations. AFS users may call this a bug. We'll have

1N/A #to reconsider how to add the means to satisfy AFS users also.

1N/A

1N/A #October 1997: we want to install .pm files into archlib if

1N/A #there are any files in arch. So we depend on having ./blib/arch

1N/A #hardcoded here.

1N/A

1N/A my $targetroot = install_rooted_dir($from_to{$source});

1N/A

1N/A my $blib_lib = File::Spec->catdir('blib', 'lib');

1N/A my $blib_arch = File::Spec->catdir('blib', 'arch');

1N/A if ($source eq $blib_lib and

1N/A exists $from_to{$blib_arch} and

1N/A directory_not_empty($blib_arch)) {

1N/A $targetroot = install_rooted_dir($from_to{$blib_arch});

1N/A print "Files found in $blib_arch: installing files in $blib_lib into architecture dependent library tree\n";

1N/A }

1N/A

1N/A chdir $source or next;

1N/A find(sub {

1N/A my ($mode,$size,$atime,$mtime) = (stat)[2,7,8,9];

1N/A return unless -f _;

1N/A

1N/A my $origfile = $_;

1N/A return if $origfile eq ".exists";

1N/A my $targetdir = File::Spec->catdir($targetroot, $File::Find::dir);

1N/A my $targetfile = File::Spec->catfile($targetdir, $origfile);

1N/A my $sourcedir = File::Spec->catdir($source, $File::Find::dir);

1N/A my $sourcefile = File::Spec->catfile($sourcedir, $origfile);

1N/A

1N/A my $save_cwd = cwd;

1N/A chdir $cwd; # in case the target is relative

1N/A # 5.5.3's File::Find missing no_chdir option.

1N/A

1N/A my $diff = 0;

1N/A if ( -f $targetfile && -s _ == $size) {

1N/A # We have a good chance, we can skip this one

1N/A $diff = compare($sourcefile, $targetfile);

1N/A } else {

1N/A print "$sourcefile differs\n" if $verbose>1;

1N/A $diff++;

1N/A }

1N/A

1N/A if ($diff){

1N/A if (-f $targetfile){

1N/A forceunlink($targetfile) unless $nonono;

1N/A } else {

1N/A mkpath($targetdir,0,0755) unless $nonono;

1N/A print "mkpath($targetdir,0,0755)\n" if $verbose>1;

1N/A }

1N/A copy($sourcefile, $targetfile) unless $nonono;

1N/A print "Installing $targetfile\n";

1N/A utime($atime,$mtime + $Is_VMS,$targetfile) unless $nonono>1;

1N/A print "utime($atime,$mtime,$targetfile)\n" if $verbose>1;

1N/A $mode = 0444 | ( $mode & 0111 ? 0111 : 0 );

1N/A chmod $mode, $targetfile;

1N/A print "chmod($mode, $targetfile)\n" if $verbose>1;

1N/A } else {

1N/A print "Skipping $targetfile (unchanged)\n" if $verbose;

1N/A }

1N/A

1N/A if (defined $inc_uninstall) {

1N/A inc_uninstall($sourcefile,$File::Find::dir,$verbose,

1N/A $inc_uninstall ? 0 : 1);

1N/A }

1N/A

1N/A # Record the full pathname.

1N/A $packlist->{$targetfile}++;

1N/A

1N/A # File::Find can get confused if you chdir in here.

1N/A chdir $save_cwd;

1N/A

1N/A # File::Find seems to always be Unixy except on MacPerl :(

1N/A }, $Is_MacPerl ? $Curdir : '.' );

1N/A chdir($cwd) or Carp::croak("Couldn't chdir to $cwd: $!");

1N/A }

1N/A if ($pack{'write'}) {

1N/A $dir = install_rooted_dir(dirname($pack{'write'}));

1N/A mkpath($dir,0,0755) unless $nonono;

1N/A print "Writing $pack{'write'}\n";

1N/A $packlist->write(install_rooted_file($pack{'write'})) unless $nonono;

1N/A }

1N/A}

1N/A

1N/Asub install_rooted_file {

1N/A if (defined $INSTALL_ROOT) {

1N/A File::Spec->catfile($INSTALL_ROOT, $_[0]);

1N/A } else {

1N/A $_[0];

1N/A }

1N/A}

1N/A

1N/A

1N/Asub install_rooted_dir {

1N/A if (defined $INSTALL_ROOT) {

1N/A File::Spec->catdir($INSTALL_ROOT, $_[0]);

1N/A } else {

1N/A $_[0];

1N/A }

1N/A}

1N/A

1N/A

1N/Asub forceunlink {

1N/A chmod 0666, $_[0];

1N/A unlink $_[0] or Carp::croak("Cannot forceunlink $_[0]: $!")

1N/A}

1N/A

1N/A

1N/Asub directory_not_empty ($) {

1N/A my($dir) = @_;

1N/A my $files = 0;

1N/A find(sub {

1N/A return if $_ eq ".exists";

1N/A if (-f) {

1N/A $File::Find::prune++;

1N/A $files = 1;

1N/A }

1N/A }, $dir);

1N/A return $files;

1N/A}

1N/A

1N/A

1N/A

1N/Asub install_default {

1N/A @_ < 2 or die "install_default should be called with 0 or 1 argument";

1N/A my $FULLEXT = @_ ? shift : $ARGV[0];

1N/A defined $FULLEXT or die "Do not know to where to write install log";

1N/A my $INST_LIB = File::Spec->catdir(File::Spec->curdir,"blib","lib");

1N/A my $INST_ARCHLIB = File::Spec->catdir(File::Spec->curdir,"blib","arch");

1N/A my $INST_BIN = File::Spec->catdir(File::Spec->curdir,'blib','bin');

1N/A my $INST_SCRIPT = File::Spec->catdir(File::Spec->curdir,'blib','script');

1N/A my $INST_MAN1DIR = File::Spec->catdir(File::Spec->curdir,'blib','man1');

1N/A my $INST_MAN3DIR = File::Spec->catdir(File::Spec->curdir,'blib','man3');

1N/A install({

1N/A read => "$Config{sitearchexp}/auto/$FULLEXT/.packlist",

1N/A write => "$Config{installsitearch}/auto/$FULLEXT/.packlist",

1N/A $INST_LIB => (directory_not_empty($INST_ARCHLIB)) ?

1N/A $Config{installsitearch} :

1N/A $Config{installsitelib},

1N/A $INST_ARCHLIB => $Config{installsitearch},

1N/A $INST_BIN => $Config{installbin} ,

1N/A $INST_SCRIPT => $Config{installscript},

1N/A $INST_MAN1DIR => $Config{installman1dir},

1N/A $INST_MAN3DIR => $Config{installman3dir},

1N/A },1,0,0);

1N/A}

1N/A

1N/A

1N/A

1N/Asub uninstall {

1N/A use ExtUtils::Packlist;

1N/A my($fil,$verbose,$nonono) = @_;

1N/A $verbose ||= 0;

1N/A $nonono ||= 0;

1N/A

1N/A die "no packlist file found: $fil" unless -f $fil;

1N/A # my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));

1N/A # require $my_req; # Hairy, but for the first

1N/A my ($packlist) = ExtUtils::Packlist->new($fil);

1N/A foreach (sort(keys(%$packlist))) {

1N/A chomp;

1N/A print "unlink $_\n" if $verbose;

1N/A forceunlink($_) unless $nonono;

1N/A }

1N/A print "unlink $fil\n" if $verbose;

1N/A forceunlink($fil) unless $nonono;

1N/A}

1N/A

1N/Asub inc_uninstall {

1N/A my($filepath,$libdir,$verbose,$nonono) = @_;

1N/A my($dir);

1N/A my $file = (File::Spec->splitpath($filepath))[2];

1N/A my %seen_dir = ();

1N/A

1N/A my @PERL_ENV_LIB = split $Config{path_sep}, defined $ENV{'PERL5LIB'}

1N/A ? $ENV{'PERL5LIB'} : $ENV{'PERLLIB'} || '';

1N/A

1N/A foreach $dir (@INC, @PERL_ENV_LIB, @Config{qw(archlibexp

1N/A privlibexp

1N/A sitearchexp

1N/A sitelibexp)}) {

1N/A next if $dir eq $Curdir;

1N/A next if $seen_dir{$dir}++;

1N/A my($targetfile) = File::Spec->catfile($dir,$libdir,$file);

1N/A next unless -f $targetfile;

1N/A

1N/A # The reason why we compare file's contents is, that we cannot

1N/A # know, which is the file we just installed (AFS). So we leave

1N/A # an identical file in place

1N/A my $diff = 0;

1N/A if ( -f $targetfile && -s _ == -s $filepath) {

1N/A # We have a good chance, we can skip this one

1N/A $diff = compare($filepath,$targetfile);

1N/A } else {

1N/A print "#$file and $targetfile differ\n" if $verbose>1;

1N/A $diff++;

1N/A }

1N/A

1N/A next unless $diff;

1N/A if ($nonono) {

1N/A if ($verbose) {

1N/A $Inc_uninstall_warn_handler ||= new ExtUtils::Install::Warn;

1N/A $libdir =~ s|^\./||s ; # That's just cosmetics, no need to port. It looks prettier.

1N/A $Inc_uninstall_warn_handler->add(

1N/A File::Spec->catfile($libdir, $file),

1N/A $targetfile

1N/A );

1N/A }

1N/A # if not verbose, we just say nothing

1N/A } else {

1N/A print "Unlinking $targetfile (shadowing?)\n";

1N/A forceunlink($targetfile);

1N/A }

1N/A }

1N/A}

1N/A

1N/Asub run_filter {

1N/A my ($cmd, $src, $dest) = @_;

1N/A local(*CMD, *SRC);

1N/A open(CMD, "|$cmd >$dest") || die "Cannot fork: $!";

1N/A open(SRC, $src) || die "Cannot open $src: $!";

1N/A my $buf;

1N/A my $sz = 1024;

1N/A while (my $len = sysread(SRC, $buf, $sz)) {

1N/A syswrite(CMD, $buf, $len);

1N/A }

1N/A close SRC;

1N/A close CMD or die "Filter command '$cmd' failed for $src";

1N/A}

1N/A

1N/A

1N/A

1N/Asub pm_to_blib {

1N/A my($fromto,$autodir,$pm_filter) = @_;

1N/A

1N/A use File::Basename qw(dirname);

1N/A use File::Copy qw(copy);

1N/A use File::Path qw(mkpath);

1N/A use File::Compare qw(compare);

1N/A use AutoSplit;

1N/A # my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));

1N/A # require $my_req; # Hairy, but for the first

1N/A

1N/A if (!ref($fromto) && -r $fromto)

1N/A {

1N/A # Win32 has severe command line length limitations, but

1N/A # can generate temporary files on-the-fly

1N/A # so we pass name of file here - eval it to get hash

1N/A open(FROMTO,"<$fromto") or die "Cannot open $fromto:$!";

1N/A my $str = '$fromto = {qw{'.join('',<FROMTO>).'}}';

1N/A eval $str;

1N/A close(FROMTO);

1N/A }

1N/A

1N/A mkpath($autodir,0,0755);

1N/A while(my($from, $to) = each %$fromto) {

1N/A if( -f $to && -s $from == -s $to && -M $to < -M $from ) {

1N/A print "Skip $to (unchanged)\n";

1N/A next;

1N/A }

1N/A

1N/A # When a pm_filter is defined, we need to pre-process the source first

1N/A # to determine whether it has changed or not. Therefore, only perform

1N/A # the comparison check when there's no filter to be ran.

1N/A # -- RAM, 03/01/2001

1N/A

1N/A my $need_filtering = defined $pm_filter && length $pm_filter &&

1N/A $from =~ /\.pm$/;

1N/A

1N/A if (!$need_filtering && 0 == compare($from,$to)) {

1N/A print "Skip $to (unchanged)\n";

1N/A next;

1N/A }

1N/A if (-f $to){

1N/A forceunlink($to);

1N/A } else {

1N/A mkpath(dirname($to),0,0755);

1N/A }

1N/A if ($need_filtering) {

1N/A run_filter($pm_filter, $from, $to);

1N/A print "$pm_filter <$from >$to\n";

1N/A } else {

1N/A copy($from,$to);

1N/A print "cp $from $to\n";

1N/A }

1N/A my($mode,$atime,$mtime) = (stat $from)[2,8,9];

1N/A utime($atime,$mtime+$Is_VMS,$to);

1N/A chmod(0444 | ( $mode & 0111 ? 0111 : 0 ),$to);

1N/A next unless $from =~ /\.pm$/;

1N/A _autosplit($to,$autodir);

1N/A }

1N/A}

1N/A

1N/A

1N/A

1N/Asub _autosplit {

1N/A my $retval = autosplit(@_);

1N/A close *AutoSplit::IN if defined *AutoSplit::IN{IO};

1N/A

1N/A return $retval;

1N/A}

1N/A

1N/A

1N/Apackage ExtUtils::Install::Warn;

1N/A

1N/Asub new { bless {}, shift }

1N/A

1N/Asub add {

1N/A my($self,$file,$targetfile) = @_;

1N/A push @{$self->{$file}}, $targetfile;

1N/A}

1N/A

1N/Asub DESTROY {

1N/A unless(defined $INSTALL_ROOT) {

1N/A my $self = shift;

1N/A my($file,$i,$plural);

1N/A foreach $file (sort keys %$self) {

1N/A $plural = @{$self->{$file}} > 1 ? "s" : "";

1N/A print "## Differing version$plural of $file found. You might like to\n";

1N/A for (0..$#{$self->{$file}}) {

1N/A print "rm ", $self->{$file}[$_], "\n";

1N/A $i++;

1N/A }

1N/A }

1N/A $plural = $i>1 ? "all those files" : "this file";

1N/A print "## Running 'make install UNINST=1' will unlink $plural for you.\n";

1N/A }

1N/A}

1N/A

1N/A

1N/A1;