X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FIPC%2FCmd.pm;h=a469d95464f58e3212aab2e906b95e3e370579e0;hb=a06bfbf46ad8e21060b59ed409ba2f87fbfcdc35;hp=ae67401a3d74c81f8508004bf0e8fd6661d34760;hpb=2b78b7715e1330aaceb5d16e6de25abbe8fde06c;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/lib/IPC/Cmd.pm b/lib/IPC/Cmd.pm
index ae67401..a469d95 100644
--- a/lib/IPC/Cmd.pm
+++ b/lib/IPC/Cmd.pm
@@ -16,7 +16,7 @@ BEGIN {
                         $USE_IPC_RUN $USE_IPC_OPEN3 $WARN
                     ];
 
-    $VERSION        = '0.44';
+    $VERSION        = '0.46';
     $VERBOSE        = 0;
     $DEBUG          = 0;
     $WARN           = 1;
@@ -345,6 +345,8 @@ sub run {
         return;
     };        
 
+    $cmd = _quote_args_vms( $cmd ) if IS_VMS;
+
     ### strip any empty elements from $cmd if present
     $cmd = [ grep { length && defined } @$cmd ] if ref $cmd;
 
@@ -745,6 +747,41 @@ sub _system_run {
     }
 }
 
+### Command-line arguments (but not the command itself) must be quoted
+### to ensure case preservation. Borrowed from Module::Build with adaptations.
+### Patch for this supplied by Craig Berry, see RT #46288: [PATCH] Add argument
+### quoting for run() on VMS
+sub _quote_args_vms {
+  ### Returns a command string with proper quoting so that the subprocess
+  ### sees this same list of args, or if we get a single arg that is an
+  ### array reference, quote the elements of it (except for the first)
+  ### and return the reference.
+  my @args = @_;
+  my $got_arrayref = (scalar(@args) == 1
+                      && UNIVERSAL::isa($args[0], 'ARRAY'))
+                   ? 1
+                   : 0;
+
+  @args = split(/\s+/, $args[0]) unless $got_arrayref || scalar(@args) > 1;
+
+  my $cmd = $got_arrayref ? shift @{$args[0]} : shift @args;
+
+  ### Do not quote qualifiers that begin with '/' or previously quoted args.
+  map { if (/^[^\/\"]/) {
+          $_ =~ s/\"/""/g;     # escape C<"> by doubling
+          $_ = q(").$_.q(");
+        }
+  }
+    ($got_arrayref ? @{$args[0]}
+                   : @args
+    );
+
+  $got_arrayref ? unshift(@{$args[0]}, $cmd) : unshift(@args, $cmd);
+
+  return $got_arrayref ? $args[0]
+                       : join(' ', @args);
+}
+
 
 ### XXX this is cribbed STRAIGHT from M::B 0.30 here:
 ### http://search.cpan.org/src/KWILLIAMS/Module-Build-0.30/lib/Module/Build/Platform/Windows.pm:split_like_shell