From: John Malmberg <wb8tyw@gmail.com>
Date: Sun, 15 Feb 2009 15:25:10 +0000 (-0600)
Subject: ExtUtils::Install VMS extended character set support
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3d55b451d9544fbd4c27c33287b76bee30328830;p=p5sagit%2Fp5-mst-13.2.git

ExtUtils::Install VMS extended character set support

Preview from https://rt.cpan.org/Ticket/Display.html?id=42149
---

diff --git a/lib/ExtUtils/Install.pm b/lib/ExtUtils/Install.pm
index d8f325a..c8aa0b3 100644
--- a/lib/ExtUtils/Install.pm
+++ b/lib/ExtUtils/Install.pm
@@ -42,7 +42,7 @@ ExtUtils::Install - install files from here to there
 
 =cut
 
-$VERSION = '1.52';
+$VERSION = '1.52_01';
 $VERSION = eval $VERSION;
 
 =pod
@@ -92,11 +92,34 @@ Dies with a special message.
 =cut
 
 my $Is_VMS     = $^O eq 'VMS';
+my $Is_VMS_noefs = $Is_VMS;
 my $Is_MacPerl = $^O eq 'MacOS';
 my $Is_Win32   = $^O eq 'MSWin32';
 my $Is_cygwin  = $^O eq 'cygwin';
 my $CanMoveAtBoot = ($Is_Win32 || $Is_cygwin);
 
+    if( $Is_VMS ) {
+        my $vms_unix_rpt;
+        my $vms_efs;
+        my $vms_case;
+
+        if (eval { local $SIG{__DIE__}; require VMS::Feature; }) {
+            $vms_unix_rpt = VMS::Feature::current("filename_unix_report");
+            $vms_efs = VMS::Feature::current("efs_charset");
+            $vms_case = VMS::Feature::current("efs_case_preserve");
+        } else {
+            my $unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';
+            my $efs_charset = $ENV{'DECC$EFS_CHARSET'} || '';
+            my $efs_case = $ENV{'DECC$EFS_CASE_PRESERVE'} || '';
+            $vms_unix_rpt = $unix_rpt =~ /^[ET1]/i; 
+            $vms_efs = $efs_charset =~ /^[ET1]/i;
+            $vms_case = $efs_case =~ /^[ET1]/i;
+        }
+        $Is_VMS_noefs = 0 if ($vms_efs); 
+    }
+
+
+
 # *note* CanMoveAtBoot is only incidentally the same condition as below
 # this needs not hold true in the future.
 my $Has_Win32API_File = ($Is_Win32 || $Is_cygwin)
@@ -405,7 +428,9 @@ sub _can_write_dir {
     my $path='';
     my @make;
     while (@dirs) {
-        if ($Is_VMS) {
+        if ($Is_VMS_noefs) {
+            # There is a bug in catdir that is fixed when the EFS character
+            # set is enabled, which requires this VMS specific code.
             $dir = File::Spec->catdir($vol,@dirs);
         }
         else {
diff --git a/lib/ExtUtils/t/INST.t b/lib/ExtUtils/t/INST.t
index 49938cb..2a85f08 100644
--- a/lib/ExtUtils/t/INST.t
+++ b/lib/ExtUtils/t/INST.t
@@ -24,6 +24,8 @@ use File::Spec;
 use TieOut;
 use Config;
 
+my $Is_VMS = $^O eq 'VMS';
+
 chdir 't';
 
 perl_lib;
@@ -74,6 +76,7 @@ is( !!$mm->{PERL_CORE}, !!$ENV{PERL_CORE}, 'PERL_CORE' );
 my($perl_src, $mm_perl_src);
 if( $ENV{PERL_CORE} ) {
     $perl_src = File::Spec->catdir($Updir, $Updir);
+    $perl_src = VMS::Filespec::vmsify($perl_src) if $Is_VMS;
     $perl_src = File::Spec->canonpath($perl_src);
     $mm_perl_src = File::Spec->canonpath($mm->{PERL_SRC});
 }
@@ -90,22 +93,28 @@ is( $mm->{PERM_RWX}, 755,    'PERM_RWX' );
 
 
 # INST_*
+my $expect = File::Spec->catdir($Curdir, 'blib', 'arch');
+$expect = VMS::Filespec::vmspath($expect) if $Is_VMS;
 is( $mm->{INST_ARCHLIB}, 
     $mm->{PERL_CORE} ? $mm->{PERL_ARCHLIB}
-                     : File::Spec->catdir($Curdir, 'blib', 'arch'),
-                                     'INST_ARCHLIB');
-is( $mm->{INST_BIN},     File::Spec->catdir($Curdir, 'blib', 'bin'),
-                                     'INST_BIN' );
+                     : $expect,
+                          'INST_ARCHLIB');
+$expect = File::Spec->catdir($Curdir, 'blib', 'bin');
+$expect = VMS::Filespec::vmspath($expect) if $Is_VMS;
+is( $mm->{INST_BIN}, $expect, 'INST_BIN' );
 
 is( keys %{$mm->{CHILDREN}}, 1 );
 my($child_pack) = keys %{$mm->{CHILDREN}};
 my $c_mm = $mm->{CHILDREN}{$child_pack};
+$expect = File::Spec->catdir($Updir, 'blib', 'arch');
+$expect = VMS::Filespec::vmspath($expect) if $Is_VMS;
 is( $c_mm->{INST_ARCHLIB}, 
     $c_mm->{PERL_CORE} ? $c_mm->{PERL_ARCHLIB}
-                       : File::Spec->catdir($Updir, 'blib', 'arch'),
-                                     'CHILD INST_ARCHLIB');
-is( $c_mm->{INST_BIN},     File::Spec->catdir($Updir, 'blib', 'bin'),
-                                     'CHILD INST_BIN' );
+                       : $expect,
+                             'CHILD INST_ARCHLIB');
+$expect = File::Spec->catdir($Updir, 'blib', 'bin');
+$expect = VMS::Filespec::vmspath($expect) if $Is_VMS;
+is( $c_mm->{INST_BIN}, $expect, 'CHILD INST_BIN' );
 
 
 my $inst_lib = File::Spec->catdir($Curdir, 'blib', 'lib');
diff --git a/lib/ExtUtils/t/INST_PREFIX.t b/lib/ExtUtils/t/INST_PREFIX.t
index 57e7eb2..1d580dd 100644
--- a/lib/ExtUtils/t/INST_PREFIX.t
+++ b/lib/ExtUtils/t/INST_PREFIX.t
@@ -103,6 +103,7 @@ is( !!$mm->{PERL_CORE}, !!$ENV{PERL_CORE}, 'PERL_CORE' );
 my($perl_src, $mm_perl_src);
 if( $ENV{PERL_CORE} ) {
     $perl_src = File::Spec->catdir($Updir, $Updir);
+    $perl_src = VMS::Filespec::vmsify($perl_src) if $Is_VMS;
     $perl_src = File::Spec->canonpath($perl_src);
     $mm_perl_src = File::Spec->canonpath($mm->{PERL_SRC});
 }
@@ -153,6 +154,7 @@ while( my($type, $vars) = each %Install_Vars) {
     _set_config(installman3dir => '');
 
     my $wibble = File::Spec->catdir(qw(wibble and such));
+    $wibble = VMS::Filespec::vmspath($wibble) if $Is_VMS;
     my $stdout = tie *STDOUT, 'TieOut' or die;
     my $mm = WriteMakefile(
                            NAME          => 'Big::Dummy',
@@ -187,7 +189,9 @@ while( my($type, $vars) = each %Install_Vars) {
                    INSTALLMAN3DIR=> 'foo/bar/baz',
                   );
 
-    is( $mm->{INSTALLVENDORMAN1DIR}, File::Spec->catdir('foo','bar'), 
+    my $expect = File::Spec->catdir('foo','bar');
+    $expect = VMS::Filespec::vmspath($expect) if $Is_VMS;
+    is( $mm->{INSTALLVENDORMAN1DIR}, $expect, 
                       'installvendorman1dir (in %Config) not modified' );
     isnt( $mm->{INSTALLVENDORMAN3DIR}, '', 
                       'installvendorman3dir (not in %Config) set'  );
@@ -212,9 +216,14 @@ while( my($type, $vars) = each %Install_Vars) {
                            VERSION_FROM  => 'lib/Big/Dummy.pm',
                            PERL_CORE     => $ENV{PERL_CORE},
                           );
-
-    is( $mm->{INSTALLMAN1DIR}, File::Spec->catdir('foo', 'bar') );
-    is( $mm->{INSTALLMAN3DIR}, File::Spec->catdir('foo', 'baz') );
+    my $expect1 = File::Spec->catdir('foo', 'bar');
+    my $expect2 = File::Spec->catdir('foo', 'baz');
+    if ($Is_VMS) {
+        $expect1 = VMS::Filespec::vmspath($expect1);
+        $expect2 = VMS::Filespec::vmspath($expect2);
+    }
+    is( $mm->{INSTALLMAN1DIR}, $expect1 );
+    is( $mm->{INSTALLMAN3DIR}, $expect2 );
     SKIP: {
         skip "VMS must expand macros in INSTALL* vars", 4 if $Is_VMS;
 
@@ -246,8 +255,14 @@ while( my($type, $vars) = each %Install_Vars) {
                            PERL_CORE     => $ENV{PERL_CORE},
                           );
 
-    is( $mm->{INSTALLMAN1DIR}, File::Spec->catdir('foo', 'bar') );
-    is( $mm->{INSTALLMAN3DIR}, File::Spec->catdir('foo', 'baz') );
+    my $expect1 = File::Spec->catdir('foo', 'bar');
+    my $expect2 = File::Spec->catdir('foo', 'baz');
+    if ($Is_VMS) {
+        $expect1 = VMS::Filespec::vmspath($expect1);
+        $expect2 = VMS::Filespec::vmspath($expect2);
+    }
+    is( $mm->{INSTALLMAN1DIR}, $expect1 );
+    is( $mm->{INSTALLMAN3DIR}, $expect2 );
     SKIP: {
         skip "VMS must expand macros in INSTALL* vars", 2 if $Is_VMS;
         is( $mm->{INSTALLSITEMAN1DIR},   '$(INSTALLMAN1DIR)' );