[Module-build-checkins] Module-Build/lib/Module/Build/Platform VMS.pm,1.6,1.7

[Ken W. <kwi...@us...>]

Update of /cvsroot/module-build/Module-Build/lib/Module/Build/Platform
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv28385/lib/Module/Build/Platform

Modified Files:
	VMS.pm 
Log Message:
First stab at --prefix support

Index: VMS.pm
===================================================================
RCS file: /cvsroot/module-build/Module-Build/lib/Module/Build/Platform/VMS.pm,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -d -r1.6 -r1.7
--- VMS.pm	10 Oct 2004 04:39:34 -0000	1.6
+++ VMS.pm	7 Jun 2005 03:34:07 -0000	1.7
@@ -61,8 +61,6 @@
 
 Use '__' instead of '::'.
 
-=back
-
 =cut
 
 sub manpage_separator {
@@ -70,6 +68,70 @@
 }
 
 
+=item prefixify
+
+Prefixify taking into account VMS' filepath syntax.
+
+=cut
+
+# Translated from ExtUtils::MM_VMS::prefixify()
+sub prefixify {
+    my($self, $path, $sprefix, $rprefix) = @_;
+
+    $self->log_verbose("  prefixify $path from $sprefix to $rprefix\n");
+
+    # Translate $(PERLPREFIX) to a real path.
+    $rprefix = $self->eliminate_macros($rprefix);
+    $rprefix = VMS::Filespec::vmspath($rprefix) if $rprefix;
+    $sprefix = VMS::Filespec::vmspath($sprefix) if $sprefix;
+
+    $self->log_verbose("  rprefix translated to $rprefix\n".
+                       "  sprefix translated to $sprefix\n");
+
+    if( length $path == 0 ) {
+        $self->log_verbose("  no path to prefixify.\n")
+    }
+    elsif( !File::Spec->file_name_is_absolute($path) ) {
+        $self->log_verbose("    path is relative, not prefixifying.\n");
+    }
+    elsif( $sprefix eq $rprefix ) {
+        $self->log_verbose("  no new prefix.\n");
+    }
+    else {
+        my($path_vol, $path_dirs) = File::Spec->splitpath( $path );
+        if( $path_vol eq $Config{vms_prefix}.':' ) {
+            $self->log_verbose("  $Config{vms_prefix}: seen\n");
+
+            $path_dirs =~ s{^\[}{\[.} unless $path_dirs =~ m{^\[\.};
+            $path = $self->_catprefix($rprefix, $path_dirs);
+        }
+    }
+
+    $self->log_verbose("    now $path\n");
+
+    return $path;
+}
+
+
+# From ExtUtils::MM_VMS::_catpreifx()
+sub _catprefix {
+    my($self, $rprefix, $default) = @_;
+
+    my($rvol, $rdirs) = File::Spec->splitpath($rprefix);
+    if( $rvol ) {
+        return File::Spec->catpath($rvol,
+                                   File::Spec->catdir($rdirs, $default),
+                                   ''
+                                  )
+    }
+    else {
+        return File::Spec->catdir($rdirs, $default);
+    }
+}
+
+
+=back
+
 =head1 AUTHOR
 
 Michael G Schwern <sc...@po...>, Ken Williams <ke...@ma...>