Fix random failures in CPANPLUS tests on Win32

The failures were a result of calling Win32::GetShortPathName with
the program argument " /nologo" appended to the path. Program
arguments should not be passed to Win32::GetShortPathName.

(The randomness occurred because random garbage was being produced
due to a separate bug in that Win32 function, for which a fix is
forthcoming...).

p4raw-id: //depot/perl@31371

1 files changed, 24 insertions, 3 deletions

diff --git a/lib/CPANPLUS/Config.pm b/lib/CPANPLUS/Config.pm
index 2644efb1b5..1a1f4d09d7 100644
--- a/lib/CPANPLUS/Config.pm
+++ b/lib/CPANPLUS/Config.pm
@@ -622,9 +622,30 @@ sub _clean_up_paths {
     ### clean up paths if we are on win32
     if( $^O eq 'MSWin32' ) {
         for my $pgm ( $self->program->ls_accessors ) {
-            $self->program->$pgm(
-                Win32::GetShortPathName( $self->program->$pgm )
-            ) if $self->program->$pgm and $self->program->$pgm =~ /\s+/;      
+            my $path = $self->program->$pgm;
+
+            ### paths with whitespace needs to be shortened
+            ### for shell outs.
+            if ($path and $path =~ /\s+/) {
+                my($prog, $args);
+
+                ### patch from Steve Hay, 13nd of June 2007
+                ### msg-id: <467012A4.6060705@uk.radan.com>
+                ### windows directories are not allowed to end with 
+                ### a space, so any occurrence of '\w\s+/\w+' means
+                ### we're dealing with arguments, not directory
+                ### names.
+                if ($path =~ /^(.*?)(\s+\/.*$)/) {
+                    ($prog, $args) = ($1, $2);
+                
+                ### otherwise, there are no arguments
+                } else {
+                    ($prog, $args) = ($path, '');
+                }
+                
+                $prog = Win32::GetShortPathName( $prog );
+                $self->program->$pgm( $prog . $args );
+            }
         }
     }