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);
$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;
? 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);
# Need to create with the same name as DynaLoader will load with.
if (defined &DynaLoader::mod2fname) {
- my $file = DynaLoader::mod2fname([$$spec{base_name}]);
- $$spec{lib_file} = File::Spec->catfile($$spec{archdir}, "$file.$self->{config}->{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);
}
return $spec;
}
+=item rscan_dir
+
+Inherit the standard version but remove dots at end of name. This may not be
+necessary if File::Find has been fixed or DECC$FILENAME_UNIX_REPORT is in effect.
+
+=cut
+
+sub rscan_dir {
+ my ($self, $dir, $pattern) = @_;
+
+ my $result = $self->SUPER::rscan_dir( $dir, $pattern );
+
+ for my $file (@$result) { $file =~ s/\.$//; }
+ 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 );
+ my $sep = $self->manpage_separator;
+ $mpname =~ s/^$sep//;
+ return $mpname;
+}
+
+=item expand_test_dir
+
+Inherit the standard version but relativize the paths as the native glob() doesn't
+do that for us.
+
+=cut
+
+sub expand_test_dir {
+ my ($self, $dir) = @_;
+
+ my @reldirs = $self->SUPER::expand_test_dir( $dir );
+
+ for my $eachdir (@reldirs) {
+ my ($v,$d,$f) = File::Spec->splitpath( $eachdir );
+ my $reldir = File::Spec->abs2rel( File::Spec->catpath( $v, $d, '' ) );
+ $eachdir = File::Spec->catfile( $reldir, $f );
+ }
+ 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
-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