Update of /cvsroot/module-build/Module-Build/t/lib
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv7643/t/lib
Modified Files:
DistGen.pm
Log Message:
Fix for non-case-preserving test stuff on VMS
Index: DistGen.pm
===================================================================
RCS file: /cvsroot/module-build/Module-Build/t/lib/DistGen.pm,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -d -r1.16 -r1.17
--- DistGen.pm 27 Jan 2006 03:12:25 -0000 1.16
+++ DistGen.pm 25 Feb 2006 15:27:27 -0000 1.17
@@ -14,6 +14,7 @@
use File::Path ();
use File::Spec ();
use IO::File ();
+use Tie::CPHash;
sub new {
my $package = shift;
@@ -29,6 +30,10 @@
);
my $self = bless( \%data, $package );
+ tie %{$self->{filedata}}, 'Tie::CPHash';
+
+ tie %{$self->{pending}{change}}, 'Tie::CPHash';
+
if ( -d $self->dirname ) {
warn "Warning: Removing existing directory '@{[$self->dirname]}'\n";
$self->remove;
@@ -280,16 +285,23 @@
}
my %names;
+ tie %names, 'Tie::CPHash';
foreach my $file ( keys %{$self->{filedata}} ) {
my $filename = $self->_real_filename( $file );
my $dirname = File::Basename::dirname( $filename );
$names{$filename} = 0;
+ print "Splitting '$dirname'\n" if $VERBOSE;
my @dirs = File::Spec->splitdir( $dirname );
while ( @dirs ) {
- my $dir = File::Spec->catdir( @dirs );
- $names{$dir} = 0;
+ my $dir = ( scalar(@dirs) == 1
+ ? $dirname
+ : File::Spec->catdir( @dirs ) );
+ if (length $dir) {
+ print "Setting directory name '$dir' in \%names\n" if $VERBOSE;
+ $names{$dir} = 0;
+ }
pop( @dirs );
}
}
@@ -297,11 +309,13 @@
File::Find::finddepth( sub {
my $name = File::Spec->canonpath( $File::Find::name );
+ $name =~ s/\.\z// if $^O eq 'VMS';
+
if ( not exists $names{$name} ) {
print "Removing '$name'\n" if $VERBOSE;
File::Path::rmtree( $_ );
}
- }, File::Spec->curdir );
+ }, ($^O eq "VMS" ? './' : File::Spec->curdir) );
chdir( $here );
}
|