Author: dagolden
Date: Thu May 14 17:57:20 2009
New Revision: 12770
Modified:
Module-Build/trunk/Changes
Module-Build/trunk/lib/Module/Build/Base.pm
Module-Build/trunk/lib/Module/Build/Compat.pm
Module-Build/trunk/lib/Module/Build/Platform/VMS.pm
Module-Build/trunk/t/compat.t
Module-Build/trunk/t/extend.t
Module-Build/trunk/t/metadata.t
Module-Build/trunk/t/runthrough.t
Log:
RT#42724: [PATCH] consolidated VMS fixes by CBERRY
Modified: Module-Build/trunk/Changes
==============================================================================
--- Module-Build/trunk/Changes (original)
+++ Module-Build/trunk/Changes Thu May 14 17:57:20 2009
@@ -2,6 +2,9 @@
0.33_01 -
+ Bug-fixes:
+ - Fixed RT#42724: consolidated VMS fixes [patch by CBERRY]
+
0.33 - Sun May 3 20:16:34 PDT 2009
Bug-fixes:
Modified: Module-Build/trunk/lib/Module/Build/Base.pm
==============================================================================
--- Module-Build/trunk/lib/Module/Build/Base.pm (original)
+++ Module-Build/trunk/lib/Module/Build/Base.pm Thu May 14 17:57:20 2009
@@ -2828,7 +2828,7 @@
my ($name, $path) = File::Basename::fileparse($pods->{$pod},
file_qr('\.(?:pm|plx?|pod)$'));
my @dirs = File::Spec->splitdir( File::Spec->canonpath( $path ) );
- pop( @dirs ) if $dirs[-1] eq File::Spec->curdir;
+ pop( @dirs ) if scalar(@dirs) && $dirs[-1] eq File::Spec->curdir;
my $fulldir = File::Spec->catfile($htmldir, @rootdirs, @dirs);
my $outfile = File::Spec->catfile($fulldir, "${name}.html");
@@ -4096,7 +4096,7 @@
# Need to remove volume from $map{$_} using splitpath, or else
# we'll create something crazy like C:\Foo\Bar\E:\Baz\Quux
# VMS will always have the file separate than the path.
- my ($volume, $path, $file) = File::Spec->splitpath( $map{$_}, 1 );
+ my ($volume, $path, $file) = File::Spec->splitpath( $map{$_}, 0 );
# catdir needs a list of directories, or it will create something
# crazy like volume:[Foo.Bar.volume.Baz.Quux]
Modified: Module-Build/trunk/lib/Module/Build/Compat.pm
==============================================================================
--- Module-Build/trunk/lib/Module/Build/Compat.pm (original)
+++ Module-Build/trunk/lib/Module/Build/Compat.pm Thu May 14 17:57:20 2009
@@ -282,7 +282,7 @@
my $Build = 'Build' . $filetype . ' --makefile_env_macros 1';
my $unlink = $class->oneliner('1 while unlink $ARGV[0]', [], [$args{makefile}]);
- $unlink =~ s/\$/\$\$/g;
+ $unlink =~ s/\$/\$\$/g unless $class->is_vmsish;
my $maketext = <<"EOF";
all : force_do_it
Modified: Module-Build/trunk/lib/Module/Build/Platform/VMS.pm
==============================================================================
--- Module-Build/trunk/lib/Module/Build/Platform/VMS.pm (original)
+++ Module-Build/trunk/lib/Module/Build/Platform/VMS.pm Thu May 14 17:57:20 2009
@@ -188,6 +188,21 @@
return !system("$cmd $args");
}
+=item oneliner
+
+Override to ensure that we do not quote the command.
+
+=cut
+
+sub oneliner {
+ my $self = shift;
+ my $oneliner = $self->SUPER::oneliner(@_);
+
+ $oneliner =~ s/^\"\S+\"//;
+
+ return "MCR $^X $oneliner";
+}
+
=item _infer_xs_spec
Inherit the standard version but tweak the library file name to be
@@ -214,8 +229,9 @@
=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.
+Inherit the standard version but remove dots at end of name.
+If the extended character set is in effect, do not remove dots from filenames
+with Unix path delimiters.
=cut
@@ -224,7 +240,11 @@
my $result = $self->SUPER::rscan_dir( $dir, $pattern );
- for my $file (@$result) { $file =~ s/\.$//; }
+ for my $file (@$result) {
+ if (!_efs() && ($file =~ m#/#)) {
+ $file =~ s/\.$//;
+ }
+ }
return $result;
}
@@ -239,7 +259,7 @@
my $self = shift;
my $dist_dir = $self->SUPER::dist_dir;
- $dist_dir =~ s/\./_/g;
+ $dist_dir =~ s/\./_/g unless _efs();
return $dist_dir;
}
@@ -307,8 +327,14 @@
# break up the paths for the merge
my $home = VMS::Filespec::unixify($ENV{HOME});
+ # In the default VMS mode, the trailing slash is present.
+ # In Unix report mode it is not. The parsing logic assumes that
+ # it is present.
+ $home .= '/' unless $home =~ m#/$#;
+
# Trivial case of just ~ by it self
if ($spec eq '') {
+ $home =~ s#/$##;
return $home;
}
@@ -345,9 +371,8 @@
# Now put the two cases back together
$arg = File::Spec::Unix->catpath($hvol, $newdirs, $file);
- } else {
- return $arg;
}
+ return $arg;
}
@@ -360,7 +385,9 @@
=cut
-sub find_perl_interpreter { return $^X; }
+sub find_perl_interpreter {
+ return VMS::Filespec::vmsify($^X);
+}
=item localize_file_path
@@ -370,8 +397,9 @@
sub localize_file_path {
my ($self, $path) = @_;
+ $path = VMS::Filespec::vmsify($path);
$path =~ s/\.\z//;
- return VMS::Filespec::vmsify($path);
+ return $path;
}
=item localize_dir_path
@@ -385,6 +413,57 @@
return VMS::Filespec::vmspath($path);
}
+=item ACTION_clean
+
+The home-grown glob() expands a bit too aggressively when given a bare name,
+so default in a zero-length extension.
+
+=cut
+
+sub ACTION_clean {
+ my ($self) = @_;
+ foreach my $item (map glob(VMS::Filespec::rmsexpand($_, '.;0')), $self->cleanup) {
+ $self->delete_filetree($item);
+ }
+}
+
+
+# Need to look up the feature settings. The preferred way is to use the
+# VMS::Feature module, but that may not be available to dual life modules.
+
+my $use_feature;
+BEGIN {
+ if (eval { local $SIG{__DIE__}; require VMS::Feature; }) {
+ $use_feature = 1;
+ }
+}
+
+# Need to look up the UNIX report mode. This may become a dynamic mode
+# in the future.
+sub _unix_rpt {
+ my $unix_rpt;
+ if ($use_feature) {
+ $unix_rpt = VMS::Feature::current("filename_unix_report");
+ } else {
+ my $env_unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';
+ $unix_rpt = $env_unix_rpt =~ /^[ET1]/i;
+ }
+ return $unix_rpt;
+}
+
+# Need to look up the EFS character set mode. This may become a dynamic
+# mode in the future.
+sub _efs {
+ my $efs;
+ if ($use_feature) {
+ $efs = VMS::Feature::current("efs_charset");
+ } else {
+ my $env_efs = $ENV{'DECC$EFS_CHARSET'} || '';
+ $efs = $env_efs =~ /^[ET1]/i;
+ }
+ return $efs;
+}
+
=back
=head1 AUTHOR
Modified: Module-Build/trunk/t/compat.t
==============================================================================
--- Module-Build/trunk/t/compat.t (original)
+++ Module-Build/trunk/t/compat.t Thu May 14 17:57:20 2009
@@ -235,7 +235,7 @@
ok $ran_ok, "make fakeinstall with INSTALLDIRS=vendor ran ok";
$output =~ s/^/# /gm; # Don't confuse our own test output
like $output,
- qr/\Q$libdir2\E .* Simple\.pm/x,
+ qr/\Q$libdir2\E .* Simple\.pm/ix,
'Should have installdirs=vendor';
}
Modified: Module-Build/trunk/t/extend.t
==============================================================================
--- Module-Build/trunk/t/extend.t (original)
+++ Module-Build/trunk/t/extend.t Thu May 14 17:57:20 2009
@@ -50,7 +50,9 @@
$mb->test_files('*t*');
my $files = $mb->test_files;
ok grep {$_ eq 'script'} @$files;
- ok grep {$_ eq File::Spec->catfile('t', 'basic.t')} @$files;
+ my $t_basic_t = File::Spec->catfile('t', 'basic.t');
+ $t_basic_t = VMS::Filespec::vmsify($t_basic_t) if $^O eq 'VMS';
+ ok grep {$_ eq $t_basic_t} @$files;
ok !grep {$_ eq 'Build.PL' } @$files;
# Make sure order is preserved
Modified: Module-Build/trunk/t/metadata.t
==============================================================================
--- Module-Build/trunk/t/metadata.t (original)
+++ Module-Build/trunk/t/metadata.t Thu May 14 17:57:20 2009
@@ -33,14 +33,24 @@
my $simple_file = 'lib/Simple.pm';
my $simple2_file = 'lib/Simple2.pm';
- #TODO:
# Traditional VMS will return the file in in lower case, and is_deeply
# does exact case comparisons.
- # When ODS-5 support is active for preserved case file names, this will
- # need to be changed.
+ # When ODS-5 support is active for preserved case file names we do not
+ # change the case.
if ($^O eq 'VMS') {
- $simple_file = lc($simple_file);
- $simple2_file = lc($simple2_file);
+ my $lower_case_expect = 1;
+ my $vms_efs_case = 0;
+ if (eval 'require VMS::Feature') {
+ $vms_efs_case = VMS::Feature::current("efs_case_preserve");
+ } else {
+ my $efs_case = $ENV{'DECC$EFS_CASE_PRESERVE'} || '';
+ $vms_efs_case = $efs_case =~ /^[ET1]/i;
+ }
+ $lower_case_expect = 0 if $vms_efs_case;
+ if ($lower_case_expect) {
+ $simple_file = lc($simple_file);
+ $simple2_file = lc($simple2_file);
+ }
}
Modified: Module-Build/trunk/t/runthrough.t
==============================================================================
--- Module-Build/trunk/t/runthrough.t (original)
+++ Module-Build/trunk/t/runthrough.t Thu May 14 17:57:20 2009
@@ -73,11 +73,22 @@
my $dist_dir = 'Simple-0.01';
-# VMS may or may not need to modify the name, vmsify will do this if
-# the name looks like a UNIX directory.
+# VMS in traditional mode needs the $dist_dir name to not have a '.' in it
+# as this is a directory delimiter. In extended character set mode the dot
+# is permitted for Unix format file specifications.
if ($^O eq 'VMS') {
- my @dist_dirs = File::Spec->splitdir(VMS::Filespec::vmsify($dist_dir.'/'));
- $dist_dir = $dist_dirs[0];
+ my $Is_VMS_noefs = 1;
+ my $vms_efs = 0;
+ if (eval 'require VMS::Feature') {
+ $vms_efs = VMS::Feature::current("efs_charset");
+ } else {
+ my $efs_charset = $ENV{'DECC$EFS_CHARSET'} || '';
+ $vms_efs = $efs_charset =~ /^[ET1]/i;
+ }
+ $Is_VMS_noefs = 0 if $vms_efs;
+ if ($Is_VMS_noefs) {
+ $dist_dir = 'Simple-0_01';
+ }
}
is $mb->dist_dir, $dist_dir;
lmpx.com only provides a reader for public news (NNTP) servers. It is not
affiliated with the servers or forums shown here and is not responsible for
the content of articles, which is written by their respective authors.