SYN SYN
[p5sagit/p5-mst-13.2.git] / lib / ExtUtils / Install.pm
index 74bd99b..92db8c9 100644 (file)
@@ -1,12 +1,13 @@
 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);
-use vars qw(@ISA @EXPORT $VERSION);
 @ISA = ('Exporter');
 @EXPORT = ('install','uninstall','pm_to_blib', 'install_default');
 $Is_VMS = $^O eq 'VMS';
@@ -15,7 +16,29 @@ 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 );
+# install relative to here
+
+my $INSTALL_ROOT = $ENV{PERL_INSTALL_ROOT};
+
+use File::Spec;
+
+sub install_rooted_file {
+    if (defined $INSTALL_ROOT) {
+       MY->catfile($INSTALL_ROOT, $_[0]);
+    } else {
+       $_[0];
+    }
+}
+
+sub install_rooted_dir {
+    if (defined $INSTALL_ROOT) {
+       MY->catdir($INSTALL_ROOT, $_[0]);
+    } else {
+       $_[0];
+    }
+}
+
+#our(@EXPORT, @ISA, $Is_VMS);
 #use strict;
 
 sub forceunlink {
@@ -54,8 +77,9 @@ sub install {
        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})) {
+               my $targetdir = install_rooted_dir($hash{$source_dir_or_file});
+           if (-w $targetdir ||
+               mkpath($targetdir)) {
                last;
            } else {
                warn "Warning: You do not have permissions to " .
@@ -65,9 +89,9 @@ sub install {
        }
        closedir DIR;
     }
-    $packlist->read($pack{"read"}) if (-f $pack{"read"});
+    my $tmpfile = install_rooted_file($pack{"read"});
+    $packlist->read($tmpfile) if (-f $tmpfile);
     my $cwd = cwd();
-    my $umask = umask 0 unless $Is_VMS;
 
     my($source);
     MOD_INSTALL: foreach $source (sort keys %hash) {
@@ -80,11 +104,13 @@ sub install {
        #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};
+
+       my $targetroot = install_rooted_dir($hash{$source});
+
        if ($source eq "blib/lib" and
            exists $hash{"blib/arch"} and
            directory_not_empty("blib/arch")) {
-           $targetroot = $hash{"blib/arch"};
+           $targetroot = install_rooted_dir($hash{"blib/arch"});
             print "Files found in blib/arch: installing files in blib/lib into architecture dependent library tree\n";
        }
        chdir($source) or next;
@@ -93,8 +119,9 @@ sub install {
                          $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 $targetdir  = MY->catdir($targetroot, $File::Find::dir);
+           my $origfile   = $_;
+           my $targetfile = MY->catfile($targetdir, $_);
 
            my $diff = 0;
            if ( -f $targetfile && -s _ == $size) {
@@ -129,17 +156,16 @@ sub install {
            } else {
                inc_uninstall($_,$File::Find::dir,$verbose,0); # nonono set to 0
            }
-           $packlist->{$targetfile}++;
+           $packlist->{$origfile}++;
 
        }, ".");
        chdir($cwd) or Carp::croak("Couldn't chdir to $cwd: $!");
     }
-    umask $umask unless $Is_VMS;
     if ($pack{'write'}) {
-       $dir = dirname($pack{'write'});
+       $dir = install_rooted_dir(dirname($pack{'write'}));
        mkpath($dir,0,0755);
        print "Writing $pack{'write'}\n";
-       $packlist->write($pack{'write'});
+       $packlist->write(install_rooted_file($pack{'write'}));
     }
 }
 
@@ -193,7 +219,6 @@ sub uninstall {
        forceunlink($_) unless $nonono;
     }
     print "unlink $fil\n" if $verbose;
-    close P;
     forceunlink($fil) unless $nonono;
 }
 
@@ -226,7 +251,7 @@ sub inc_uninstall {
        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.
+               $libdir =~ s|^\./||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
@@ -259,7 +284,6 @@ sub pm_to_blib {
       close(FROMTO);
      }
 
-    my $umask = umask 0022 unless $Is_VMS;
     mkpath($autodir,0,0755);
     foreach (keys %$fromto) {
        next if -f $fromto->{$_} && -M $fromto->{$_} < -M $_;
@@ -277,10 +301,9 @@ sub pm_to_blib {
        utime($atime,$mtime+$Is_VMS,$fromto->{$_});
        chmod(0444 | ( $mode & 0111 ? 0111 : 0 ),$fromto->{$_});
        print "cp $_ $fromto->{$_}\n";
-       next unless /\.pm$/;
+       next unless /\.pm\z/;
        autosplit($fromto->{$_},$autodir);
     }
-    umask $umask unless $Is_VMS;
 }
 
 package ExtUtils::Install::Warn;
@@ -293,18 +316,20 @@ sub add {
 }
 
 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++;
+       unless(defined $INSTALL_ROOT) {
+               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";
        }
-    }
-    $plural = $i>1 ? "all those files" : "this file";
-    print "## Running 'make install UNINST=1' will unlink $plural for you.\n";
 }
 
 1;
@@ -343,7 +368,7 @@ There are two keys with a special meaning in the hash: "read" and
 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
+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 
@@ -356,7 +381,7 @@ 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 populated F<blib> 
+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.