diff options
| author | Jos I. Boumans <kane@cpan.org> | 2009-06-13 13:57:57 -0500 |
|---|---|---|
| committer | Craig A. Berry <craigberry@mac.com> | 2009-06-13 13:57:57 -0500 |
| commit | 0ec35138181526e90fadf67d412593db519edc42 (patch) | |
| tree | a213f99a80d81d756b215c90227ba180c74b0193 /lib | |
| parent | 20fc10417a2e591867f81f2d35a64a646135e115 (diff) | |
| download | perl-0ec35138181526e90fadf67d412593db519edc42.tar.gz | |
Upgrade IPC::Cmd to 0.46
Message-Id: <5FC9E009-A18A-4385-8FDB-23FE449437C7@cpan.org>
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/IPC/Cmd.pm | 39 | ||||
| -rw-r--r-- | 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 ae67401a3d..a469d95464 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 ccbaadaa82..22c21b1b36 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@ |