Hello Ken,
Here is another step in getting Module::Build going on VMS.
In lib/Module/Build/Base.pm:
The code to merge the destination dir with the default directories
needed fixing, as it was stripping off any filenames that may be
present, such as .packlist.
In lib/Module/Build/t/install.t,
Change strip_volume to return a list of directories which catdir() and
catfile() can handle portably better, because the VMS directory
delimiters have been removed.
If you do not remove the directory delimiters, The VMS variants of the
catdir() routines will add an implied volume name as an additional
directory.
Change catdir() to catfile for .packlist.
The build file is "Build.COM" on VMS, not "Build".
Traditional VMS returns filenames and pathnames in lower case, so the
key $expect to $pods->{$expect} needs to be converted to lowercase.
TODO:
However this will need to be fixed for VMS ODS-5 support as that will
return the filename in the exact case it was created in. Currently
there is no API to let a module know that VMS is in this mode.
As a hack, $ENV{DECC$EFS_CASE_PRESERVE} having a string beginning with
one of "EeTt1" indicates that VMS is in this mode. It will not be
accurate once an API is available for controlling this mode.
-John
[EMAIL PROTECTED]
Personal Opinion Only
--- /rsync_root/perl/lib/Module/Build/Base.pm Sat Sep 8 15:48:35 2007
+++ lib/Module/Build/Base.pm Thu Sep 13 23:26:51 2007
@@ -3804,8 +3804,18 @@
foreach (keys %map) {
# Need to remove volume from $map{$_} using splitpath, or else
# we'll create something crazy like C:\Foo\Bar\E:\Baz\Quux
- my ($volume, $path) = File::Spec->splitpath( $map{$_}, 1 );
- $map{$_} = File::Spec->catdir($destdir, $path);
+ # VMS will always have the file separate than the path.
+ my ($volume, $path, $file) = File::Spec->splitpath( $map{$_}, 1 );
+
+ # catdir needs a list of directories, or it will create something
+ # crazy like volume:[Foo.Bar.volume.Baz.Quux]
+ my @dirs = File::Spec->splitdir($path);
+
+ # First merge the directories
+ $path = File::Spec->catdir($destdir, @dirs);
+
+ # Then put the file back on if there is one.
+ $map{$_} = File::Spec->catfile($path, $file);
}
}
--- /rsync_root/perl/lib/Module/Build/t/install.t Tue Jun 13 14:29:16 2006
+++ lib/Module/Build/t/install.t Thu Sep 13 21:12:45 2007
@@ -67,26 +67,27 @@
eval {$mb->dispatch('install', destdir => $destdir)};
is $@, '';
- my $libdir = strip_volume( $mb->install_destination('lib') );
- my $install_to = File::Spec->catfile($destdir, $libdir, $dist->name ) .
'.pm';
+ my @libdir = strip_volume( $mb->install_destination('lib') );
+ my $install_to = File::Spec->catfile($destdir, @libdir, $dist->name ) .
'.pm';
file_exists($install_to);
- local @INC = (@INC, File::Spec->catdir($destdir, $libdir));
+ local @INC = (@INC, File::Spec->catdir($destdir, @libdir));
eval "require @{[$dist->name]}";
is $@, '';
# Make sure there's a packlist installed
my $archdir = $mb->install_destination('arch');
- my ($v, $d) = File::Spec->splitpath($archdir, 1);
- my $packlist = File::Spec->catdir($destdir, $d, 'auto', $dist->name,
'.packlist');
+ my @dirs = strip_volume($archdir);
+ my $packlist = File::Spec->catfile
+ ($destdir, @dirs, 'auto', $dist->name,
'.packlist');
is -e $packlist, 1, "$packlist should be written";
}
{
eval {$mb->dispatch('install', installdirs => 'core', destdir => $destdir)};
is $@, '';
- my $libdir = strip_volume( $Config{installprivlib} );
- my $install_to = File::Spec->catfile($destdir, $libdir, $dist->name ) .
'.pm';
+ my @libdir = strip_volume( $Config{installprivlib} );
+ my $install_to = File::Spec->catfile($destdir, @libdir, $dist->name ) .
'.pm';
file_exists($install_to);
}
@@ -94,7 +95,8 @@
my $libdir = File::Spec->catdir(File::Spec->rootdir, 'foo', 'bar');
eval {$mb->dispatch('install', install_path => {lib => $libdir}, destdir =>
$destdir)};
is $@, '';
- my $install_to = File::Spec->catfile($destdir, $libdir, $dist->name ) .
'.pm';
+ my @dirs = strip_volume($libdir);
+ my $install_to = File::Spec->catfile($destdir, @dirs, $dist->name ) . '.pm';
file_exists($install_to);
}
@@ -102,7 +104,8 @@
my $libdir = File::Spec->catdir(File::Spec->rootdir, 'foo', 'base');
eval {$mb->dispatch('install', install_base => $libdir, destdir =>
$destdir)};
is $@, '';
- my $install_to = File::Spec->catfile($destdir, $libdir, 'lib', 'perl5',
$dist->name ) . '.pm';
+ my @dirs = strip_volume($libdir);
+ my $install_to = File::Spec->catfile($destdir, @dirs, 'lib', 'perl5',
$dist->name ) . '.pm';
file_exists($install_to);
}
@@ -115,8 +118,8 @@
eval {$mb->dispatch('install', destdir => $destdir)};
is $@, '';
- my $libdir = strip_volume( $mb->install_destination('lib') );
- local @INC = (@INC, File::Spec->catdir($destdir, $libdir));
+ my @libdir = strip_volume( $mb->install_destination('lib') );
+ local @INC = (@INC, File::Spec->catdir($destdir, @libdir));
eval "require @{[$dist->name]}::ConfigData";
is $mb->feature('auto_foo'), 1;
@@ -156,13 +159,15 @@
eval {$mb->run_perl_script('Build.PL', [], ['--install_path',
"lib=$libdir"])};
is $@, '';
- eval {$mb->run_perl_script('Build', [], ['install', '--destdir', $destdir])};
+ my $cmd = 'Build';
+ $cmd .= ".COM" if $^O eq 'VMS';
+ eval {$mb->run_perl_script($cmd, [], ['install', '--destdir', $destdir])};
is $@, '';
my $install_to = File::Spec->catfile($destdir, $libdir, $dist->name ) .
'.pm';
file_exists($install_to);
my $basedir = File::Spec->catdir('', 'bar');
- eval {$mb->run_perl_script('Build', [], ['install', '--destdir', $destdir,
+ eval {$mb->run_perl_script($cmd, [], ['install', '--destdir', $destdir,
'--install_base', $basedir])};
is $@, '';
@@ -204,6 +209,11 @@
my $pods = $mb->_find_file_by_type('pod', 'lib');
is keys %$pods, 1;
my $expect = $mb->localize_file_path('lib/Simple/Docs.pod');
+
+ # True for traditional VMS, but will need to be changed
+ # when ODS-5 support is enabled TODO
+ $expect = lc($expect) if $^O eq 'VMS';
+
is $pods->{$expect}, $expect;
my $pms = $mb->_find_file_by_type('awefawef', 'lib');
@@ -225,7 +235,8 @@
sub strip_volume {
my $dir = shift;
(undef, $dir) = File::Spec->splitpath( $dir, 1 );
- return $dir;
+ my @dirs = File::Spec->splitdir($dir);
+ return @dirs;
}
sub file_exists {
