[svn:Module-Build] r12869 - in Module-Build/trunk: . lib/Module/Build/Platform t/lib

Author: dagolden
Date: Fri Jun 19 20:01:23 2009
New Revision: 12869

Modified:
   Module-Build/trunk/Changes
   Module-Build/trunk/lib/Module/Build/Platform/VMS.pm
   Module-Build/trunk/t/lib/DistGen.pm

Log:
#42157: Add support for VMS in Unix compatibility mode


Modified: Module-Build/trunk/Changes
==============================================================================
--- Module-Build/trunk/Changes	(original)
+++ Module-Build/trunk/Changes	Fri Jun 19 20:01:23 2009
@@ -11,6 +11,7 @@
 
  Other
  - On MSWin32, bumped File::Spec prereq to 3.30 for a variety of fixes
+ - Add support for VMS in Unix compatibility mode (RT#42157)
 
 0.33_02 - Mon Jun 15 12:23:55 EDT 2009
 

Modified: Module-Build/trunk/lib/Module/Build/Platform/VMS.pm
==============================================================================
--- Module-Build/trunk/lib/Module/Build/Platform/VMS.pm	(original)
+++ Module-Build/trunk/lib/Module/Build/Platform/VMS.pm	Fri Jun 19 20:01:23 2009
@@ -9,6 +9,42 @@
 use vars qw(@ISA);
 @ISA = qw(Module::Build::Base);
 
+# Need to look up the feature settings.  The preferred way is to use the
+# VMS::Feature module, but that may not be available to dual life modules.
+
+my $use_feature;
+BEGIN {
+    if (eval { local $SIG{__DIE__}; require VMS::Feature; }) {
+        $use_feature = 1;
+    }
+}
+
+# Need to look up the UNIX report mode.  This may become a dynamic mode
+# in the future.
+sub _unix_rpt {
+    my $unix_rpt;
+    if ($use_feature) {
+        $unix_rpt = VMS::Feature::current("filename_unix_report");
+    } else {
+        my $env_unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';
+        $unix_rpt = $env_unix_rpt =~ /^[ET1]/i; 
+    }
+    return $unix_rpt;
+}
+
+# Need to look up the EFS character set mode.  This may become a dynamic
+# mode in the future.
+sub _efs {
+    my $efs;
+    if ($use_feature) {
+        $efs = VMS::Feature::current("efs_charset");
+    } else {
+        my $env_efs = $ENV{'DECC$EFS_CHARSET'} || '';
+        $efs = $env_efs =~ /^[ET1]/i; 
+    }
+    return $efs;
+}
+
 
 
 =head1 NAME

Modified: Module-Build/trunk/t/lib/DistGen.pm
==============================================================================
--- Module-Build/trunk/t/lib/DistGen.pm	(original)
+++ Module-Build/trunk/t/lib/DistGen.pm	Fri Jun 19 20:01:23 2009
@@ -19,11 +19,31 @@
 use Tie::CPHash;
 use Data::Dumper;
 
+my $vms_mode;
+my $vms_lower_case;
+
 BEGIN {
+  $vms_mode = 0;
+  $vms_lower_case = 0;
   if( $^O eq 'VMS' ) {
     # For things like vmsify()
     require VMS::Filespec;
     VMS::Filespec->import;
+    $vms_mode = 1;
+    $vms_lower_case = 1;
+    my $vms_efs_case = 0;
+    my $unix_rpt = 0;
+    if (eval { local $SIG{__DIE__}; require VMS::Feature; }) {
+        $unix_rpt = VMS::Feature::current("filename_unix_report");
+        $vms_efs_case = VMS::Feature::current("efs_case_preserve");
+    } else {
+        my $env_unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';
+        $unix_rpt = $env_unix_rpt =~ /^[ET1]/i; 
+        my $efs_case = $ENV{'DECC$EFS_CASE_PRESERVE'} || '';
+        $vms_efs_case = $efs_case =~ /^[ET1]/i;
+    }
+    $vms_mode = 0 if $unix_rpt;
+    $vms_lower_case = 0 if $vms_efs_case;
   }
 }
 BEGIN {
@@ -330,6 +350,7 @@
   tie %names, 'Tie::CPHash';
   foreach my $file ( keys %{$self->{filedata}} ) {
     my $filename = $self->_real_filename( $file );
+    $filename = lc($filename) if $vms_lower_case;
     my $dirname = File::Basename::dirname( $filename );
 
     $names{$filename} = 0;
@@ -351,9 +372,13 @@
   File::Find::finddepth( sub {
     my $name = File::Spec->canonpath( $File::Find::name );
 
+    if ($vms_mode) {
+        if ($name ne '.') {
+            $name =~ s/\.\z//;
+            $name = vmspath($name) if -d $name;
+        }
+    }
     if ($^O eq 'VMS') {
-        $name =~ s/\.\z//;
-        $name = vmspath($name) if -d $name;
         $name = File::Spec->rel2abs($name) if $name eq File::Spec->curdir();
     }
 
@@ -361,7 +386,7 @@
       print "Removing '$name'\n" if $VERBOSE;
       File::Path::rmtree( $_ );
     }
-  }, ($^O eq "VMS" ? './' : File::Spec->curdir) );
+  }, ($^O eq 'VMS' ? './' : File::Spec->curdir) );
 
   chdir( $here );
 }