Upgrade to Module-Build-0.30

[p5sagit/p5-mst-13.2.git] / lib / Module / Build / Platform / VMS.pm

diff --git a/lib/Module/Build/Platform/VMS.pm b/lib/Module/Build/Platform/VMS.pm
index 31408ed..85320e7 100644 (file)
--- a/lib/Module/Build/Platform/VMS.pm
+++ b/lib/Module/Build/Platform/VMS.pm
@@ -1,6 +1,9 @@
 package Module::Build::Platform::VMS;
 
 use strict;
+use vars qw($VERSION);
+$VERSION = '0.30';
+$VERSION = eval $VERSION;
 use Module::Build::Base;
 
 use vars qw(@ISA);
@@ -133,10 +136,15 @@ sub _quote_args {
                    ? 1 
                    : 0;
 
-  map { $_ = q(").$_.q(") if !/^\"/ && length($_) > 0 }
-     ($got_arrayref ? @{$args[0]} 
-                    : @args
-     );
+  # Do not quote qualifiers that begin with '/'.
+  map { if (!/^\//) { 
+          $_ =~ s/\"/""/g;     # escape C<"> by doubling
+          $_ = q(").$_.q(");
+        }
+  }
+    ($got_arrayref ? @{$args[0]} 
+                   : @args
+    );
 
   return $got_arrayref ? $args[0] 
                        : join(' ', @args);
@@ -271,6 +279,112 @@ sub expand_test_dir {
   return @reldirs;
 }
 
+=item _detildefy
+
+The home-grown glob() does not currently handle tildes, so provide limited support
+here.  Expect only UNIX format file specifications for now.
+
+=cut
+
+sub _detildefy {
+    my ($self, $arg) = @_;
+
+    # Apparently double ~ are not translated.
+    return $arg if ($arg =~ /^~~/);
+
+    # Apparently ~ followed by whitespace are not translated.
+    return $arg if ($arg =~ /^~ /);
+
+    if ($arg =~ /^~/) {
+        my $spec = $arg;
+
+        # Remove the tilde
+        $spec =~ s/^~//;
+
+        # Remove any slash folloing the tilde if present.
+        $spec =~ s#^/##;
+
+        # break up the paths for the merge
+        my $home = VMS::Filespec::unixify($ENV{HOME});
+
+        # Trivial case of just ~ by it self
+        if ($spec eq '') {
+            return $home;
+        }
+
+        my ($hvol, $hdir, $hfile) = File::Spec::Unix->splitpath($home);
+        if ($hdir eq '') {
+             # Someone has tampered with $ENV{HOME}
+             # So hfile is probably the directory since this should be
+             # a path.
+             $hdir = $hfile;
+        }
+
+        my ($vol, $dir, $file) = File::Spec::Unix->splitpath($spec);
+
+        my @hdirs = File::Spec::Unix->splitdir($hdir);
+        my @dirs = File::Spec::Unix->splitdir($dir);
+
+        my $newdirs;
+
+        # Two cases of tilde handling
+        if ($arg =~ m#^~/#) {
+
+            # Simple case, just merge together
+            $newdirs = File::Spec::Unix->catdir(@hdirs, @dirs);
+
+        } else {
+
+            # Complex case, need to add an updir - No delimiters
+            my @backup = File::Spec::Unix->splitdir(File::Spec::Unix->updir);
+
+            $newdirs = File::Spec::Unix->catdir(@hdirs, @backup, @dirs);
+
+        }
+        
+        # Now put the two cases back together
+        $arg = File::Spec::Unix->catpath($hvol, $newdirs, $file);
+
+    } else {
+        return $arg;
+    }
+
+}
+
+=item find_perl_interpreter
+
+On VMS, $^X returns the fully qualified absolute path including version
+number.  It's logically impossible to improve on it for getting the perl
+we're currently running, and attempting to manipulate it is usually
+lossy.
+
+=cut
+
+sub find_perl_interpreter { return $^X; }
+
+=item localize_file_path
+
+Convert the file path to the local syntax
+
+=cut
+
+sub localize_file_path {
+  my ($self, $path) = @_;
+  $path =~ s/\.\z//;
+  return VMS::Filespec::vmsify($path);
+}
+
+=item localize_dir_path
+
+Convert the directory path to the local syntax
+
+=cut
+
+sub localize_dir_path {
+  my ($self, $path) = @_;
+  return VMS::Filespec::vmspath($path);
+}
+
 =back
 
 =head1 AUTHOR