In perl.git, the branch maint-5.10 has been updated <http://perl5.git.perl.org/perl.git/commitdiff/27a65de2e2197b9a3754e51a45403dc08f65ae7e?hp=fee20489b599d73e63b2eb9eeb0730d34f904766>
- Log ----------------------------------------------------------------- commit 27a65de2e2197b9a3754e51a45403dc08f65ae7e Author: Jos I. Boumans <[email protected]> Date: Sat Jun 13 13:57:57 2009 -0500 Upgrade IPC::Cmd to 0.46 Message-Id: <[email protected]> (cherry picked from commit 0ec35138181526e90fadf67d412593db519edc42) ----------------------------------------------------------------------- Summary of changes: lib/IPC/Cmd.pm | 39 ++++++++++++++++++++++++++++++++++++++- lib/IPC/Cmd/t/src/x.tgz.packed | 2 +- 2 files changed, 39 insertions(+), 2 deletions(-) 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 diff --git a/lib/IPC/Cmd/t/src/x.tgz.packed b/lib/IPC/Cmd/t/src/x.tgz.packed index ccbaada..22c21b1 100644 --- a/lib/IPC/Cmd/t/src/x.tgz.packed +++ b/lib/IPC/Cmd/t/src/x.tgz.packed @@ -10,7 +10,7 @@ To recreate it use the following command: uupacktool.pl -p lib/IPC/Cmd/t/src/x.tgz lib/IPC/Cmd/t/src/x.tgz.packed -Created at Mon May 4 10:16:10 2009 +Created at Fri Jun 12 13:47:07 2009 ######################################################################### __UU__ M'XL(`````````^W.NPW"0!!%T2EE2YC%:[N>#7""1,"G?QM##!&.SDE&(]W@ -- Perl5 Master Repository
