From a8f3d2d7ed00cb21068163f255a8a6311031e11f Mon Sep 17 00:00:00 2001
From: Nicholas Clark <nick@ccl4.org>
Date: Mon, 19 May 2008 10:21:04 +0000
Subject: Converge some changes from installperl into installman. I have a
 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 | 16 +++++++++++++++-
 1 file changed, 15 insertions(+), 1 deletion(-)

(limited to 'installman')

diff --git a/installman b/installman
index 8f6bd80d2a..9778029304 100755
--- a/installman
+++ b/installman
@@ -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);
-- 
cgit v1.2.1