From: Craig A. Berry <craigberry@mac.com>
Date: Tue, 17 Jul 2007 03:37:22 +0000 (+0000)
Subject: Inching towards Module::Build-ability on VMS.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f82d2ab4f80792a36288c2270b44dbb7387cc379;p=p5sagit%2Fp5-mst-13.2.git

Inching towards Module::Build-ability on VMS.

p4raw-id: //depot/perl@31619
---

diff --git a/lib/Module/Build/Base.pm b/lib/Module/Build/Base.pm
index 0cc78e6..9ac7c96 100644
--- a/lib/Module/Build/Base.pm
+++ b/lib/Module/Build/Base.pm
@@ -2860,7 +2860,7 @@ sub ACTION_ppmdist {
 	File::Spec->abs2rel( File::Spec->rel2abs( $file ),
 			     File::Spec->rel2abs( $dir  ) );
       my $to_file  =
-	File::Spec->catdir( $ppm, 'blib',
+	File::Spec->catfile( $ppm, 'blib',
 			    exists( $types{$type} ) ? $types{$type} : $type,
 			    $rel_file );
       $self->copy_if_modified( from => $file, to => $to_file );
diff --git a/lib/Module/Build/Platform/VMS.pm b/lib/Module/Build/Platform/VMS.pm
index 1d512c8..6392973 100644
--- a/lib/Module/Build/Platform/VMS.pm
+++ b/lib/Module/Build/Platform/VMS.pm
@@ -196,8 +196,9 @@ sub _infer_xs_spec {
 
   # Need to create with the same name as DynaLoader will load with.
   if (defined &DynaLoader::mod2fname) {
-    my $file = DynaLoader::mod2fname([$$spec{base_name}]);
-    $file .= '.' . $self->{config}->get('dlext');
+    my $file = $$spec{module_name} . '.' . $self->{config}->get('dlext');
+    $file =~ tr/:/_/;
+    $file = DynaLoader::mod2fname([$file]);
     $$spec{lib_file} = File::Spec->catfile($$spec{archdir}, $file);
   }
 
@@ -220,12 +221,55 @@ sub rscan_dir {
   return $result;
 }
 
+=item dist_dir
+
+Inherit the standard version but replace embedded dots with underscores because 
+a dot is the directory delimiter on VMS.
+
+=cut
+
+sub dist_dir {
+  my $self = shift;
+
+  my $dist_dir = $self->SUPER::dist_dir;
+  $dist_dir =~ s/\./_/g;
+  return $dist_dir;
+}
+
+=item man3page_name
+
+Inherit the standard version but chop the extra manpage delimiter off the front if 
+there is one.  The VMS version of splitdir('[.foo]') returns '', 'foo'.
+
+=cut
+
+sub man3page_name {
+  my $self = shift;
+
+  my $mpname = $self->SUPER::man3page_name( shift );
+  $mpname =~ s/^$self->manpage_separator//;
+  return $mpname;
+}
+
+=item eliminate_macros
+
+Since make-style macros containing directory names can't just be pasted together 
+without expansion on VMS, we traditionally expand those macros much earlier than
+on other platforms.  Even though Module::Build isn't using make (or MMS or MMK),
+we depend on some bits that still refer to this as if it's a method that belongs 
+to $self, so we just put in a noop version here.
+
+sub eliminate_macros {
+  return(@_);
+}
 
 =back
 
 =head1 AUTHOR
 
-Michael G Schwern <schwern@pobox.com>, Ken Williams <kwilliams@cpan.org>
+Michael G Schwern <schwern@pobox.com>
+Ken Williams <kwilliams@cpan.org>
+Craig A. Berry <craigberry@mac.com>
 
 =head1 SEE ALSO
 
diff --git a/lib/Module/Build/t/destinations.t b/lib/Module/Build/t/destinations.t
index bbc6ab3..286687e 100644
--- a/lib/Module/Build/t/destinations.t
+++ b/lib/Module/Build/t/destinations.t
@@ -16,7 +16,7 @@ chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!";
 
 
 use Config;
-use File::Spec::Functions qw( catdir splitdir );
+use File::Spec::Functions qw( catdir splitdir splitpath );
 
 #########################
 
@@ -300,10 +300,12 @@ sub have_same_ending {
   my ($dir1, $dir2, $message) = @_;
 
   $dir1 =~ s{/$}{} if $^O eq 'cygwin'; # remove any trailing slash
-  my @dir1 = splitdir $dir1;
+  my (undef, $dirs1, undef) = splitpath $dir1;
+  my @dir1 = splitdir $dirs1;
 
   $dir2 =~ s{/$}{} if $^O eq 'cygwin'; # remove any trailing slash
-  my @dir2 = splitdir $dir2;
+  my (undef, $dirs2, undef) = splitpath $dir2;
+  my @dir2 = splitdir $dirs2;
 
   is $dir1[-1], $dir2[-1], $message;
 }
diff --git a/lib/Module/Build/t/manifypods.t b/lib/Module/Build/t/manifypods.t
index cdf6a13..422c602 100644
--- a/lib/Module/Build/t/manifypods.t
+++ b/lib/Module/Build/t/manifypods.t
@@ -113,7 +113,7 @@ while (my ($from, $v) = each %distro) {
     next;
   }
   
-  my $to = File::Spec->catfile('blib', ($from =~ /^lib/ ? 'libdoc' : 'bindoc'), $v);
+  my $to = File::Spec->catfile('blib', ($from =~ /^[\.\/\[]*lib/ ? 'libdoc' : 'bindoc'), $v);
   ok $mb->contains_pod($from), "$from should contain POD";
   ok -e $to, "Created $to manpage";
 }
diff --git a/lib/Module/Build/t/xs.t b/lib/Module/Build/t/xs.t
index 96cede4..9c34b17 100644
--- a/lib/Module/Build/t/xs.t
+++ b/lib/Module/Build/t/xs.t
@@ -109,7 +109,7 @@ $dist->remove;
 
 # Try a XS distro with a deep namespace
 
-$dist = DistGen->new( name => 'Simple::With::Deep::Namespace',
+$dist = DistGen->new( name => 'Simple::With::Deep::Name',
 		      dir => $tmp, xs => 1 );
 $dist->regen;
 chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!";