Re: [Module::Build] Re: Module::Build status on VMS

[Ken Williams]

On Jan 26, 2006, at 11:45 AM, Craig A. Berry wrote:
The pathname is ok.  The test can't find it because it really doesn't
exist because it got deleted by DistGen->clean(), which doesn't
recognize it as one of the directories in its cache of directory
names.  The basic issues revolve around VMS filespec idiosyncracies.
For example, we'll have to call splitpath before splitdir if we want
the device name to be separated from the first directory name:
$ perl -e "use File::Spec; print join('|', 
File::Spec->splitdir('DEV:[foo.bar]'));"
DEV:[foo|bar
$ perl -e "use File::Spec; print join('|', 
File::Spec->splitpath('DEV:[foo.bar]'));"
DEV:|[foo.bar]|


How's the following patch look for this issue?

Index: t/lib/DistGen.pm
===================================================================
RCS file: /cvsroot/module-build/Module-Build/t/lib/DistGen.pm,v
retrieving revision 1.15
diff -u -r1.15 DistGen.pm
--- t/lib/DistGen.pm    4 Dec 2005 08:48:09 -0000       1.15
+++ t/lib/DistGen.pm    26 Jan 2006 23:34:39 -0000
@@ -282,33 +282,26 @@
   my %names;
   foreach my $file ( keys %{$self->{filedata}} ) {
     my $filename = $self->_real_filename( $file );
-    my $dirname = File::Basename::dirname( $filename );
+    my ($vol, $dirname, $f) = File::Spec->splitpath( $filename );
+    $dirname = File::Spec->curdir unless length $dirname;  # Old F::S 
bug
+    $dirname = File::Spec->canonpath($dirname);

-    $names{files}{$filename} = 0;
+    $names{$filename} = 0;

     my @dirs = File::Spec->splitdir( $dirname );
     while ( @dirs ) {
       my $dir = File::Spec->catdir( @dirs );
-      $names{dirs}{$dir} = 0;
+      $names{$dir} = 0;
       pop( @dirs );
     }
   }

   File::Find::finddepth( sub {
-    my $dir  = File::Spec->canonpath( $File::Find::dir  );
     my $name = File::Spec->canonpath( $File::Find::name );

-    if ( -d && not exists $names{dirs}{$name} ) {
-      print "Removing directory '$name'\n" if $VERBOSE;
+    if ( not exists $names{$name} ) {
+      print "Removing '$name'\n" if $VERBOSE;
       File::Path::rmtree( $_ );
-      return;
-    } elsif ( -d ) {
-      return;
-    } elsif ( exists $names{files}{$name} ) {
-      #print "Leaving file '$name'\n" if $VERBOSE;
-    } else {
-      print "Unlinking file '$name'\n" if $VERBOSE;
-      1 while unlink( $_ );
     }
   }, File::Spec->curdir );