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...>
|
