Michael T. Davis wrote:
At 17:20:04.46 on 26-MAY-2008 in message <[EMAIL PROTECTED]>, "John E.
Malmberg" <[EMAIL PROTECTED]> wrote:
[...]
I'm not sure about a lot of this, but your regular expressions for
determining if something matches "MMK" or "MMS" need more refining. To wit...
+my $vms_mms = ($^O eq 'VMS') && ($Config{make} =~ /MM[S|K]/i);
[...]
You're confusing character classes and alternation. The above means
(without regard to case) "MMS", "MM|", or "MMK". What you want is merely...
... /MM[SK]/i...
Fixed, and also removed a debug statement I left in the previous patch.
-John
[EMAIL PROTECTED]
Personal Opinion Only
--- /rsync_root/perl/lib/Module/Build/Base.pm Thu Oct 25 04:50:40 2007
+++ lib/Module/Build/Base.pm Mon May 26 17:37:28 2008
@@ -2304,7 +2304,7 @@
foreach my $file (keys %$files) {
my $result = $self->copy_if_modified($file, $script_dir, 'flatten') or
next;
- $self->fix_shebang_line($result) unless $self->is_vmsish;
+ $self->fix_shebang_line($result) unless $self->is_vms_mms;
$self->make_executable($result);
}
}
@@ -2392,7 +2392,7 @@
sub localize_file_path {
my ($self, $path) = @_;
- $path =~ s/\.\z// if $self->is_vmsish;
+ $path =~ s/\.\z// if $self->is_vms_mms;
return File::Spec->catfile( split m{/}, $path );
}
@@ -2674,10 +2674,15 @@
my ($name, $path) = File::Basename::fileparse($pods->{$pod},
file_qr('\.(?:pm|plx?|pod)$'));
+ if ($self->is_vmsish) {
+ #path can show up empty on VMS.
+ $path = File::Spec->curdir if ($path eq '');
+ }
my @dirs = File::Spec->splitdir( File::Spec->canonpath( $path ) );
+
pop( @dirs ) if $dirs[-1] eq File::Spec->curdir;
- my $fulldir = File::Spec->catfile($htmldir, @rootdirs, @dirs);
+ my $fulldir = File::Spec->catdir($htmldir, @rootdirs, @dirs);
my $outfile = File::Spec->catfile($fulldir, "${name}.html");
my $infile = File::Spec->abs2rel($pod);
@@ -2879,7 +2884,7 @@
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 );
@@ -3179,10 +3184,18 @@
\bblibdirs$
^MANIFEST\.SKIP$
+# Avoid VMS specific MakeMaker generated files
+\bDescrip.MMS$
+\bDESCRIP.MMS$
+\bdescrip.mms$
+
# Avoid Module::Build generated and utility files.
\bBuild$
\bBuild.bat$
\b_build
+\bBuild.com$
+\bBUILD.COM$
+\bbuild.com$
# Avoid Devel::Cover generated files
\bcover_db
--- /rsync_root/perl/lib/Module/Build/Compat.pm Thu Oct 25 04:50:40 2007
+++ lib/Module/Build/Compat.pm Sat May 24 22:11:04 2008
@@ -171,7 +171,15 @@
die "Malformed argument '$arg'");
# Do tilde-expansion if it looks like a tilde prefixed path
- ( $val ) = glob( $val ) if $val =~ /^~/;
+ if ($val =~ /^~/) {
+ my $class = 'Module::Build';
+ if ($class->is_vmsish) {
+ # VMS does not glob a ~ yet
+ ( $val ) = $class->_detildefy($val)
+ } else {
+ ( $val ) = glob( $val );
+ }
+ }
if (exists $makefile_to_build{$key}) {
my $trans = $makefile_to_build{$key};
@@ -216,10 +224,24 @@
my $class = $args{build_class};
my $perl = $class->find_perl_interpreter;
+
+ # VMS MMS/MMK usually needs to use MCR to run the Perl image
+ $perl = 'MCR ' . $perl if $class->is_vms_mms;
+
my $noop = ($class->is_windowsish ? 'rem>nul' :
- $class->is_vmsish ? 'Continue' :
+ $class->is_vms_mms ? 'Continue' :
'true');
- my $Build = 'Build --makefile_env_macros 1';
+
+ # VMS MMS/MMK has different file type.
+ my $filetype = $class->is_vms_mms ? '.COM' : '';
+
+ my $Build = 'Build' . $filetype . ' --makefile_env_macros 1';
+
+ my $unlink_makefile = "unlink -e shift $args{makefile}";
+
+ # VMS MMK/MMS has multiple file versions
+ $unlink_makefile = "\"1 while unlink \'$args{makefile}\'\""
+ if $class->is_vms_mms;
# Start with a couple special actions
my $maketext = <<"EOF";
@@ -227,7 +249,7 @@
$perl $Build
realclean : force_do_it
$perl $Build realclean
- $perl -e unlink -e shift $args{makefile}
+ $perl -e $unlink_makefile
force_do_it :
@ $noop
@@ -241,7 +263,10 @@
EOF
}
- $maketext .= "\n.EXPORT : " . join(' ', keys %makefile_to_build) . "\n\n";
+ # VMS MMS/MMK doe not support .EXPORT
+
+ $maketext .= "\n.EXPORT : " . join(' ', keys %makefile_to_build) . "\n\n"
+ unless $class->is_vms_mms;
return $maketext;
}
--- /rsync_root/perl/lib/Module/Build/t/compat.t Thu Feb 21 08:04:41 2008
+++ lib/Module/Build/t/compat.t Mon May 26 17:38:15 2008
@@ -21,6 +21,7 @@
}
ok 1, "Loaded";
+my $vms_mms = ($^O eq 'VMS') && ($Config{make} =~ /MM[SK]/i);
#########################
@@ -171,11 +172,23 @@
like $output, qr/(?:# ok \d+\s+)+/, 'Should be verbose';
# Make sure various Makefile arguments are supported
- $output = stdout_of( sub { $ran_ok = $mb->do_system(@make, 'test',
'TEST_VERBOSE=0') } );
+ my $arg = 'TEST_VERBOSE=0';
+ if ($vms_mms) {
+ $arg = '/macro=(' . $arg . ')';
+ }
+ $output = stdout_of( sub { $ran_ok = $mb->do_system(@make, 'test', $arg) });
+
ok $ran_ok, "make test without verbose ran ok";
$output =~ s/^/# /gm; # Don't confuse our own test output
+ my $regex2 = '(?:[\d.]+\s*m?s\s*)?(?:# \[[\d:]+\]\s*)?';
+ my $regex = qr/(?:# .+basic\.+ok\s+$regex2)# All tests /;
+
+ # VMS spreads the output over multiple liines.
+ if ($^O eq 'VMS') {
+ $regex = qr/(?:# .+basic\.+(?:\s.*)?ok\s+$regex2)# All tests /s;
+ }
like $output,
- qr/(?:# .+basic\.+ok\s+(?:[\d.]+\s*m?s\s*)?(?:# \[[\d:]+\]\s*)?)# All
tests/,
+ $regex,
'Should be non-verbose';
$mb->delete_filetree($libdir);
@@ -270,13 +283,24 @@
$label .= " (postargs: $postargs)";
}
ok $result, $label;
- ok -e 'Makefile', "Makefile exists";
-
+
+ my $makefile = 'Makefile';
+ if ($vms_mms) {
+ # VMS MMS/MMK can have either Makefile or descrip.mms as the created file.
+ my $make_test = -e $makefile;
+ unless ($make_test) {
+ $makefile = 'descrip.mms';
+ $make_test = -e $makefile;
+ }
+ ok $make_test, "$makefile exists - Looking for Makefile or descrip.mms";
+ } else {
+ ok -e 'Makefile', "Makefile exists";
+ }
if ($cleanup) {
$output = stdout_of( sub {
$build->do_system(@make, 'realclean');
});
- ok ! -e 'Makefile', "Makefile cleaned up";
+ ok ! -e $makefile, "$makefile cleaned up";
}
else {
pass '(skipping cleanup)'; # keep test count constant
@@ -287,10 +311,19 @@
my %requires = %{ $_[0] };
delete $requires{perl}; # until EU::MM supports this
SKIP: {
- skip 'Makefile not found', 1 unless -e 'Makefile';
- my $prereq_pm = find_makefile_prereq_pm();
+ my $makefile = 'Makefile';
+ if ($vms_mms) {
+ # VMS MMS/MMK can have either Makefile or descrip.mms as the created
file.
+ my $make_test = -e $makefile;
+ unless ($make_test) {
+ $makefile = 'descrip.mms';
+ $make_test = -e $makefile;
+ }
+ }
+ skip 'Makefile not found', 1 unless -e $makefile;
+ my $prereq_pm = find_makefile_prereq_pm($makefile);
is_deeply $prereq_pm, \%requires,
- "Makefile has correct PREREQ_PM line";
+ "$makefile has correct PREREQ_PM line";
}
}
@@ -313,8 +346,9 @@
# Following subroutine adapted from code in CPAN.pm
# by Andreas Koenig and A. Speer.
sub find_makefile_prereq_pm {
- my $fh = IO::File->new( 'Makefile', 'r' )
- or die "Can't read Makefile: $!";
+ my $makefile = shift;
+ my $fh = IO::File->new( $makefile, 'r' )
+ or die "Can't read $makefile: $!";
my $req = {};
local($/) = "\n";
while (<$fh>) {
--- /rsync_root/perl/lib/Module/Build/t/lib/MBTest.pm Fri Oct 26 19:01:41 2007
+++ lib/Module/Build/t/lib/MBTest.pm Sat May 24 18:07:44 2008
@@ -131,6 +131,10 @@
sub find_in_path {
my $thing = shift;
+
+ # VMS does not use path, and it is very complex to check to
+ # see if a command will work before just trying it.
+ return $thing if ($^O eq 'VMS');
my @path = split $Config{path_sep}, $ENV{PATH};
my @exe_ext = exe_exts();
--- /rsync_root/perl/lib/Module/Build.pm Thu Feb 21 08:04:41 2008
+++ lib/Module/Build.pm Mon May 26 17:38:24 2008
@@ -10,6 +10,7 @@
use File::Spec ();
use File::Path ();
use File::Basename ();
+use Config;
use Module::Build::Base;
@@ -99,6 +100,17 @@
sub is_vmsish { return ((os_type() || '') eq 'VMS') }
sub is_windowsish { return ((os_type() || '') eq 'Windows') }
sub is_unixish { return ((os_type() || '') eq 'Unix') }
+
+# VMS has both Unix like make and its Module Management System
+# or MMS and usually the difference in the desired
+# behavior for module build is really dependent on which one
+# is in use. MMK is a freeware clone of MMS.
+
+# TODO: When perl is launched from GNV utilities, it will be
+# assuming that a Unix make will be used.
+# For now default to what Perl was build with.
+
+sub is_vms_mms { return (is_vmsish && ($Config{make} =~ /MM[SK]/i)) }
1;
--- /rsync_root/perl/lib/Module/Build/t/tilde.t Fri Nov 16 17:46:01 2007
+++ lib/Module/Build/t/tilde.t Sat Nov 3 01:52:24 2007
@@ -39,7 +39,12 @@
SKIP: {
my $home = $ENV{HOME} ? $ENV{HOME} : undef;
- skip "Needs case and syntax tweaks for VMS", 14 if $^O eq 'VMS';
+
+ if ($^O eq 'VMS') {
+ # Convert the path to UNIX format, trim off the trailing slash
+ $home = VMS::Filespec::unixify($home);
+ $home =~ s#/$##;
+ }
unless (defined $home) {
my @info = eval { getpwuid $> };
skip "No home directory for tilde-expansion tests", 14 if $@;
@@ -83,12 +88,20 @@
# Again, with named users
SKIP: {
- skip "Needs case and syntax tweaks for VMS", 1 if $^O eq 'VMS';
my @info = eval { getpwuid $> };
skip "No home directory for tilde-expansion tests", 1 if $@;
my ($me, $home) = @info[0,7];
+
+ my $expected = "$home/foo";
+
+ if ($^O eq 'VMS') {
+ # Convert the path to UNIX format and trim off the trailing slash
+ $home = VMS::Filespec::unixify($home);
+ $home =~ s#/$##;
+ $expected = $home . '/../[^/]+' . '/foo';
+ }
- is( run_sample( $p => "~$me/foo")->$p(), "$home/foo" );
+ like( run_sample( $p => "~$me/foo")->$p(), qr($expected)i );
}
--- /rsync_root/perl/lib/Module/Build/Platform/VMS.pm Thu Oct 25 04:50:40 2007
+++ lib/Module/Build/Platform/VMS.pm Sun May 25 00:08:06 2008
@@ -136,7 +136,9 @@
? 1
: 0;
- map { $_ = q(").$_.q(") if !/^\"/ && length($_) > 0 }
+ # Do not quote qualifiers that begin with '/' or already
+ # quoted arguments.
+ map { $_ = q(").$_.q(") if !/^[\"|\/]/ && length($_) > 0 }
($got_arrayref ? @{$args[0]}
: @args
);
@@ -304,6 +306,7 @@
# Trivial case of just ~ by it self
if ($spec eq '') {
+ $home =~ s#/$##;
return $home;
}
@@ -334,8 +337,8 @@
my @backup = File::Spec::Unix->splitdir(File::Spec::Unix->updir);
$newdirs = File::Spec::Unix->catdir(@hdirs, @backup, @dirs);
-
}
+ $newdirs =~ s#/$##;
# Now put the two cases back together
$arg = File::Spec::Unix->catpath($hvol, $newdirs, $file);
