Author: kwilliams
Date: Fri Sep 28 19:23:26 2007
New Revision: 10022
Modified:
Module-Build/trunk/Changes
Module-Build/trunk/lib/Module/Build/Base.pm
Module-Build/trunk/t/manifypods.t
Module-Build/trunk/t/metadata.t
Module-Build/trunk/t/runthrough.t
Log:
Some VMS fixes for non-case-preserving filesystems
Modified: Module-Build/trunk/Changes
==============================================================================
--- Module-Build/trunk/Changes (original)
+++ Module-Build/trunk/Changes Fri Sep 28 19:23:26 2007
@@ -1,5 +1,9 @@
Revision history for Perl extension Module::Build.
+ - Some large VMS fixes, mostly having to do with the non-case-
+ preserving nature of most VMS filesystems. [John E. Malmberg and
+ Craig A. Berry]
+
- We now use a much more reliable method when Data::Dumper-ing saved
state data to the _build/ directory. [Yves]
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 Fri Sep 28 19:23:26 2007
@@ -2189,7 +2189,8 @@
# See whether any of the *.pm files have changed since last time
# testcover was run. If so, start over.
if (-e 'cover_db') {
- my $pm_files = $self->rscan_dir(File::Spec->catdir($self->blib, 'lib'),
qr{\.pm$} );
+ my $pm_files = $self->rscan_dir
+ (File::Spec->catdir($self->blib, 'lib'), file_qr('\.pm$') );
my $cover_files = $self->rscan_dir('cover_db', sub {-f $_ and not
/\.html$/});
$self->do_system(qw(cover -delete))
@@ -2251,7 +2252,7 @@
push @{$p->{include_dirs}}, $p->{c_source};
- my $files = $self->rscan_dir($p->{c_source}, qr{\.c(pp)?$});
+ my $files = $self->rscan_dir($p->{c_source}, file_qr('\.c(pp)?$'));
foreach my $file (@$files) {
push @{$p->{objects}}, $self->compile_c($file);
}
@@ -2323,7 +2324,8 @@
}
return unless -d 'lib';
- return { map {$_, [/^(.*)\.PL$/]} @{ $self->rscan_dir('lib', qr{\.PL$}) } };
+ return { map {$_, [/^(.*)\.PL$/i ]} @{ $self->rscan_dir('lib',
+ file_qr('\.PL$')) }
};
}
sub find_pm_files { shift->_find_file_by_type('pm', 'lib') }
@@ -2376,7 +2378,7 @@
return { map {$_, $_}
map $self->localize_file_path($_),
grep !/\.\#/,
- @{ $self->rscan_dir($dir, qr{\.$type$}) } };
+ @{ $self->rscan_dir($dir, file_qr("\\.$type\$")) } };
}
sub localize_file_path {
@@ -2448,7 +2450,9 @@
or die "The 'testpod' action requires Test::Pod version 0.95";
my @files = sort keys %{$self->_find_pods($self->libdoc_dirs)},
- keys %{$self->_find_pods($self->bindoc_dirs, exclude => [
qr/\.bat$/ ])}
+ keys %{$self->_find_pods
+ ($self->bindoc_dirs,
+ exclude => [ file_qr('\.bat$') ])}
or die "Couldn't find any POD files to test\n";
{ package Module::Build::PodTester; # Don't want to pollute the main
namespace
@@ -2510,7 +2514,7 @@
foreach my $type ( qw(bin lib) ) {
my $files = $self->_find_pods( $self->{properties}{"${type}doc_dirs"},
- exclude => [ qr/\.bat$/ ] );
+ exclude => [ file_qr('\.bat$') ] );
next unless %$files;
my $sub = $self->can("manify_${type}_pods");
@@ -2529,7 +2533,7 @@
my $self = shift;
my $files = $self->_find_pods( $self->{properties}{bindoc_dirs},
- exclude => [ qr/\.bat$/ ] );
+ exclude => [ file_qr('\.bat$') ] );
return unless keys %$files;
my $mandir = File::Spec->catdir( $self->blib, 'bindoc' );
@@ -2612,7 +2616,8 @@
foreach my $type ( qw(bin lib) ) {
my $files = $self->_find_pods( $self->{properties}{"${type}doc_dirs"},
- exclude => [ qr/\.(?:bat|com|html)$/ ] );
+ exclude =>
+ [ file_qr('\.(?:bat|com|html)$') ] );
next unless %$files;
if ( $self->invoked_action eq 'html' ) {
@@ -2639,7 +2644,7 @@
$self->add_to_cleanup('pod2htm*');
my $pods = $self->_find_pods( $self->{properties}{"${type}doc_dirs"},
- exclude => [ qr/\.(?:bat|com|html)$/ ] );
+ exclude => [ file_qr('\.(?:bat|com|html)$') ]
);
return unless %$pods; # nothing to do
unless ( -d $htmldir ) {
@@ -2659,7 +2664,7 @@
foreach my $pod ( keys %$pods ) {
my ($name, $path) = File::Basename::fileparse($pods->{$pod},
- qr{\.(?:pm|plx?|pod)$});
+
file_qr('\.(?:pm|plx?|pod)$'));
my @dirs = File::Spec->splitdir( File::Spec->canonpath( $path ) );
pop( @dirs ) if $dirs[-1] eq File::Spec->curdir;
@@ -2749,7 +2754,7 @@
delete $installmap->{read};
delete $installmap->{write};
- my $text_suffix = qr{\.(pm|pod)$};
+ my $text_suffix = file_qr('\.(pm|pod)$');
while (my $localdir = each %$installmap) {
my @localparts = File::Spec->splitdir($localdir);
@@ -3210,6 +3215,11 @@
ExtUtils::Manifest::mkmanifest();
}
+# Case insenstive regex for files
+sub file_qr {
+ return File::Spec->case_tolerant ? qr($_[0])i : qr($_[0]);
+}
+
sub dist_dir {
my ($self) = @_;
return "$self->{properties}{dist_name}-$self->{properties}{dist_version}";
@@ -3820,8 +3830,22 @@
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.
+ if ($file ne '') {
+ $map{$_} = File::Spec->catfile($path, $file)
+ } else {
+ $map{$_} = $path;
+ }
}
}
Modified: Module-Build/trunk/t/manifypods.t
==============================================================================
--- Module-Build/trunk/t/manifypods.t (original)
+++ Module-Build/trunk/t/manifypods.t Fri Sep 28 19:23:26 2007
@@ -102,6 +102,11 @@
%distro = map {$mb->localize_file_path($_), $distro{$_}} keys %distro;
+my $lib_path = $mb->localize_dir_path('lib');
+
+# Remove trailing directory delimiter on VMS for compares
+$lib_path =~ s/\]// if $^O eq 'VMS';
+
$mb->dispatch('build');
eval {$mb->dispatch('docs')};
@@ -123,7 +128,8 @@
while (my ($from, $v) = each %distro) {
next unless $v;
- my $to = File::Spec->catfile($destdir, 'man', $man{($from =~ /^lib/ ? 'dir3'
: 'dir1')}, $v);
+ my $to = File::Spec->catfile
+ ($destdir, 'man', $man{($from =~ /^\Q$lib_path\E/ ? 'dir3' : 'dir1')},
$v);
ok -e $to, "Created $to manpage";
}
Modified: Module-Build/trunk/t/metadata.t
==============================================================================
--- Module-Build/trunk/t/metadata.t (original)
+++ Module-Build/trunk/t/metadata.t Fri Sep 28 19:23:26 2007
@@ -31,6 +31,20 @@
$dist->change_build_pl( \%metadata );
$dist->regen;
+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.
+ if ($^O eq 'VMS') {
+ $simple_file = lc($simple_file);
+ $simple2_file = lc($simple2_file);
+ }
+
+
chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!";
use Module::Build;
@@ -82,7 +96,7 @@
$dist->regen( clean => 1 );
$mb = new_build();
is_deeply($mb->find_dist_packages,
- {'Simple' => {file => 'lib/Simple.pm',
+ {'Simple' => {file => $simple_file,
version => '1.23'}});
$dist->change_file( 'lib/Simple.pm', <<'---' );
@@ -91,7 +105,7 @@
$dist->regen( clean => 1 );
$mb = new_build();
is_deeply($mb->find_dist_packages,
- {'Simple' => {file => 'lib/Simple.pm'}});
+ {'Simple' => {file => $simple_file}});
# File with no corresponding package (w/ or w/o version)
# Simple.pm => Foo::Bar v1.23
@@ -103,7 +117,7 @@
$dist->regen( clean => 1 );
$mb = new_build();
is_deeply($mb->find_dist_packages,
- {'Foo::Bar' => { file => 'lib/Simple.pm',
+ {'Foo::Bar' => { file => $simple_file,
version => '1.23' }});
$dist->change_file( 'lib/Simple.pm', <<'---' );
@@ -112,7 +126,7 @@
$dist->regen( clean => 1 );
$mb = new_build();
is_deeply($mb->find_dist_packages,
- {'Foo::Bar' => { file => 'lib/Simple.pm'}});
+ {'Foo::Bar' => { file => $simple_file}});
# Single file with multiple differing packages (w/ or w/o version)
@@ -128,9 +142,9 @@
$dist->regen( clean => 1 );
$mb = new_build();
is_deeply($mb->find_dist_packages,
- {'Simple' => { file => 'lib/Simple.pm',
+ {'Simple' => { file => $simple_file,
version => '1.23' },
- 'Foo::Bar' => { file => 'lib/Simple.pm',
+ 'Foo::Bar' => { file => $simple_file,
version => '1.23' }});
{
@@ -162,9 +176,9 @@
$dist->regen( clean => 1 );
$mb = new_build();
is_deeply($mb->find_dist_packages,
- {'Foo' => { file => 'lib/Simple.pm',
+ {'Foo' => { file => $simple_file,
version => '1.23' },
- 'Foo::Bar' => { file => 'lib/Simple.pm',
+ 'Foo::Bar' => { file => $simple_file,
version => '1.23' }});
@@ -180,7 +194,7 @@
$dist->regen( clean => 1 );
$mb = new_build();
is_deeply($mb->find_dist_packages,
- {'Simple' => { file => 'lib/Simple.pm' }});
+ {'Simple' => { file => $simple_file }});
# Single file with same package appearing multiple times, single
@@ -196,7 +210,7 @@
$dist->regen( clean => 1 );
$mb = new_build();
is_deeply($mb->find_dist_packages,
- {'Simple' => { file => 'lib/Simple.pm',
+ {'Simple' => { file => $simple_file,
version => '1.23' }});
@@ -213,7 +227,7 @@
$dist->regen( clean => 1 );
$mb = new_build();
is_deeply($mb->find_dist_packages,
- {'Simple' => { file => 'lib/Simple.pm',
+ {'Simple' => { file => $simple_file,
version => '1.23' }});
@@ -232,7 +246,7 @@
$err = stderr_of( sub { $mb = new_build() } );
$err = stderr_of( sub { $provides = $mb->find_dist_packages } );
is_deeply($provides,
- {'Simple' => { file => 'lib/Simple.pm',
+ {'Simple' => { file => $simple_file,
version => '1.23' }}); # XXX should be 2.34?
like( $err, qr/already declared/, ' with conflicting versions reported' );
@@ -251,7 +265,7 @@
$err = stderr_of( sub { $mb = new_build() } );
$err = stderr_of( sub { $provides = $mb->find_dist_packages } );
is_deeply($provides,
- {'Foo' => { file => 'lib/Simple.pm',
+ {'Foo' => { file => $simple_file,
version => '1.23' }}); # XXX should be 2.34?
like( $err, qr/already declared/, ' with conflicting versions reported' );
@@ -272,7 +286,7 @@
$dist->regen( clean => 1 );
$mb = new_build();
is_deeply($mb->find_dist_packages,
- {'Simple' => { file => 'lib/Simple.pm' }});
+ {'Simple' => { file => $simple_file }});
$dist->remove_file( 'lib/Simple2.pm' );
@@ -290,7 +304,7 @@
$dist->regen( clean => 1 );
$mb = new_build();
is_deeply($mb->find_dist_packages,
- {'Simple' => { file => 'lib/Simple.pm',
+ {'Simple' => { file => $simple_file,
version => '1.23' }});
$dist->remove_file( 'lib/Simple2.pm' );
@@ -310,7 +324,7 @@
$dist->regen( clean => 1 );
$mb = new_build();
is_deeply($mb->find_dist_packages,
- {'Simple' => { file => 'lib/Simple2.pm',
+ {'Simple' => { file => $simple2_file,
version => '1.23' }});
$dist->remove_file( 'lib/Simple2.pm' );
@@ -331,7 +345,7 @@
$mb = new_build();
$err = stderr_of( sub { $provides = $mb->find_dist_packages } );
is_deeply($provides,
- {'Simple' => { file => 'lib/Simple.pm',
+ {'Simple' => { file => $simple_file,
version => '1.23' }});
like( $err, qr/Found conflicting versions for package/,
' with conflicting versions reported' );
@@ -354,7 +368,7 @@
$mb = new_build();
$err = stderr_of( sub { $provides = $mb->find_dist_packages } );
is_deeply($provides,
- {'Simple' => { file => 'lib/Simple.pm',
+ {'Simple' => { file => $simple_file,
version => '1.23' }});
$dist->remove_file( 'lib/Simple2.pm' );
@@ -395,7 +409,7 @@
$dist->regen( clean => 1 );
$mb = new_build();
is_deeply($mb->find_dist_packages,
- {'Foo' => { file => 'lib/Simple.pm',
+ {'Foo' => { file => $simple_file,
version => '1.23' }});
$dist->remove_file( 'lib/Simple2.pm' );
@@ -414,7 +428,7 @@
$dist->regen( clean => 1 );
$mb = new_build();
is_deeply($mb->find_dist_packages,
- {'Foo' => { file => 'lib/Simple2.pm',
+ {'Foo' => { file => $simple2_file,
version => '1.23' }});
$dist->remove_file( 'lib/Simple2.pm' );
@@ -484,7 +498,7 @@
} );
$err = stderr_of( sub { $provides = $mb->find_dist_packages } );
is_deeply($provides,
- {'Simple' => { file => 'lib/Simple.pm',
+ {'Simple' => { file => $simple_file,
version => '1.23' }});
like( $err, qr/Found conflicting versions for package/,
' corresponding package conflicts with multiple alternatives' );
@@ -510,7 +524,7 @@
} );
$err = stderr_of( sub { $provides = $mb->find_dist_packages } );
is_deeply($provides,
- {'Simple' => { file => 'lib/Simple.pm',
+ {'Simple' => { file => $simple_file,
version => '1.23' }});
like( $err, qr/Found conflicting versions for package/,
' only one alternative conflicts with corresponding package' );
@@ -534,7 +548,7 @@
$dist->regen( clean => 1 );
$mb = new_build();
is_deeply($mb->find_dist_packages,
- {'Simple' => { file => 'lib/Simple.pm',
+ {'Simple' => { file => $simple_file,
version => '1.23' }});
Modified: Module-Build/trunk/t/runthrough.t
==============================================================================
--- Module-Build/trunk/t/runthrough.t (original)
+++ Module-Build/trunk/t/runthrough.t Fri Sep 28 19:23:26 2007
@@ -80,7 +80,16 @@
is $@, '';
ok -e $mb->build_script;
-is $mb->dist_dir, 'Simple-0.01';
+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.
+if ($^O eq 'VMS') {
+ my @dist_dirs = File::Spec->splitdir(VMS::Filespec::vmsify($dist_dir.'/'));
+ $dist_dir = $dist_dirs[0];
+}
+
+is $mb->dist_dir, $dist_dir;
# The 'cleanup' file doesn't exist yet
ok grep {$_ eq 'before_script'} $mb->cleanup;
@@ -156,12 +165,15 @@
ok $scripts->{script};
# Check that a shebang line is rewritten
- my $blib_script = File::Spec->catdir( qw( blib script script ) );
+ my $blib_script = File::Spec->catfile( qw( blib script script ) );
ok -e $blib_script;
- my $fh = IO::File->new($blib_script);
- my $first_line = <$fh>;
- isnt $first_line, "#!perl -w\n", "should rewrite the shebang line";
+ SKIP: {
+ skip("We do not rewrite shebang on VMS", 1) if $^O eq 'VMS';
+ my $fh = IO::File->new($blib_script);
+ my $first_line = <$fh>;
+ isnt $first_line, "#!perl -w\n", "should rewrite the shebang line";
+ }
}
{
