This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Converge some changes from installperl into installman. I have a
authorNicholas Clark <nick@ccl4.org>
Mon, 19 May 2008 10:21:04 +0000 (10:21 +0000)
committerNicholas Clark <nick@ccl4.org>
Mon, 19 May 2008 10:21:04 +0000 (10:21 +0000)
suspicion that installman is only run on *nix and OS/2, not Win32 or
VMS. Specifically
sub unlink   - return scalar(@names) if $Is_VMS # from change 854
sub link     - change warn to die               # from change 4774
sub samepath - case insensitive name comparison # from change 311
(in the ansiperl branch, merged via the win32 branch)

p4raw-id: //depot/perl@33860

installman

index 8f6bd80..9778029 100755 (executable)
@@ -36,6 +36,16 @@ use ExtUtils::Packlist;
 use Pod::Man;
 use subs qw(unlink chmod rename link);
 use vars qw($packlist);
+use vars qw($Is_VMS $Is_W32 $Is_OS2 $Is_Cygwin $Is_Darwin $Is_NetWare);
+
+BEGIN {
+    $Is_VMS = $^O eq 'VMS';
+    $Is_W32 = $^O eq 'MSWin32';
+    $Is_OS2 = $^O eq 'os2';
+    $Is_Cygwin = $^O eq 'cygwin';
+    $Is_Darwin = $^O eq 'darwin';
+    if ($Is_VMS) { eval 'use VMS::Filespec;' }
+}
 
 if ($Config{d_umask}) {
     umask(022); # umasks like 077 aren't that useful for installations
@@ -241,6 +251,8 @@ sub unlink {
     my(@names) = @_;
     my $cnt = 0;
 
+    return scalar(@names) if $Is_VMS;
+
     foreach my $name (@names) {
        next unless -e $name;
        chmod 0777, $name if $^O eq 'os2';
@@ -261,7 +273,7 @@ sub link {
             ? $success++
             : ($from =~ m#^/afs/# || $to =~ m#^/afs/#)
               ? die "AFS"  # okay inside eval {}
-              : warn "Couldn't link $from to $to: $!\n"
+              : die "Couldn't link $from to $to: $!\n"
           unless $opts{notify};
     };
     if ($@) {
@@ -299,6 +311,8 @@ sub samepath {
     my($p1, $p2) = @_;
     my($dev1, $ino1, $dev2, $ino2);
 
+    return (lc($p1) eq lc($p2)) if ($Is_W32 || $Is_NetWare);
+
     if ($p1 ne $p2) {
        ($dev1, $ino1) = stat($p1);
        ($dev2, $ino2) = stat($p2);