Quote Win32 arguments.

dist.ini

@@ -24,6 +24,9 @@ bugtracker.web  = https://github.com/pjf/ipc-system-simple/issues
 [AutoPrereqs]
 skip = BSD::Resource
 
+[OSPrereqs / MSWin32]
+Win32::ShellQuote = 0
+
 [OurPkgVersion]
 
 [@Git]

lib/IPC/System/Simple.pm

@@ -27,12 +27,12 @@ BEGIN {
             use Win32::Process qw(INFINITE NORMAL_PRIORITY_CLASS);
             use File::Spec;
             use Win32;
+            use Win32::ShellQuote;
 
             # This uses the same rules as the core win32.c/get_shell() call.
-
             use constant WINDOWS_SHELL => eval { Win32::IsWinNT() }
-                                            ? [ qw(cmd.exe /x/d/c) ]
-                                            : [ qw(command.com /c) ];
+                ? [ File::Spec->catfile(Win32::GetFolderPath(Win32::CSIDL_SYSTEM), 'cmd.exe'), '/x/d/c' ]
+                : [ File::Spec->catfile(Win32::GetFolderPath(Win32::CSIDL_SYSTEM), 'command.com'), '/c' ];
 
             # These are used when invoking _win32_capture
             use constant NO_SHELL  => 0;
@@ -166,7 +166,14 @@ sub run {
                 return systemx($valid_returns, $command, @args);
 	}
 
-        # Without arguments, we're calling system, and checking
+    if (WINDOWS) {
+        my $pid = _spawn_or_die(&WINDOWS_SHELL->[0], join ' ', @{&WINDOWS_SHELL}, $command);
+        $pid->Wait(INFINITE);	# Wait for process exit.
+        $pid->GetExitCode($EXITVAL);
+        return _check_exit($command,$EXITVAL,$valid_returns);
+    }
+
+    # Without arguments, we're calling system, and checking
         # the results.
 
 	# We're throwing our own exception on command not found, so
@@ -191,7 +198,7 @@ sub runx {
     if (WINDOWS) {
         our $EXITVAL = -1;
 
-        my $pid = _spawn_or_die($command, "$command @args");
+        my $pid = _spawn_or_die($command, Win32::ShellQuote::quote_native($command, @args));
 
         $pid->Wait(INFINITE);	# Wait for process exit.
         $pid->GetExitCode($EXITVAL);
@@ -221,7 +228,7 @@ sub capture {
 
         if (WINDOWS) {
             # USE_SHELL really means "You may use the shell if you need it."
-            return _win32_capture(USE_SHELL, $valid_returns, $command, @args);
+            return _win32_capture(USE_SHELL, $valid_returns, $command);
         }
 
 	our $EXITVAL = -1;
@@ -306,7 +313,7 @@ sub _win32_capture {
 
         my $err;
         my $pid = eval { 
-                _spawn_or_die($exe, qq{"$command" @args}); 
+                _spawn_or_die($exe, @args ? Win32::ShellQuote::quote_native($command, @args) : $command);
         }
         or do {
                 $err = $@;
@@ -874,16 +881,30 @@ exception will also be thrown.
 
 =head2 WINDOWS-SPECIFIC NOTES
 
-As of C<IPC::System::Simple> v0.06, the C<run> subroutine I<when
-called with multiple arguments> will make available the full 32-bit
-exit value on Win32 systems.  This is different from the
-previous versions of C<IPC::System::Simple> and from Perl's
-in-build C<system()> function, which can only handle 8-bit return values.
+The C<run> subroutine make available the full 32-bit exit value on
+Win32 systems. This has been true since C<IPC::System::Simple> v0.06
+when called with multiple arguments, and since v1.25 when called with
+a single argument.  This is different from the previous versions of
+C<IPC::System::Simple> and from Perl's in-build C<system()> function,
+which can only handle 8-bit return values.
 
 The C<capture> subroutine always returns the 32-bit exit value under
 Windows.  The C<capture> subroutine also never uses the shell,
 even when passed a single argument.
 
+The C<run> subroutine always uses a shell when passed a single
+argument. On NT systems, it uses C<cmd.exe> in the system root, and on
+non-NT systems it uses C<command.com> in the system root.
+
+As of C<IPC::System::Simple> v1.25, the C<runx> and C<capturex>
+subroutines, as well as multiple-argument calls to the C<run> and
+C<capture> subroutines, have their arguments properly quoted, so that
+arugments with spaces and the like work properly. Unfortunately, this
+breaks any attempt to invoke the shell itself. If you really need to
+execute C<cmd.exe> or C<command.com>, use the single-argument form.
+For single-argument calls to C<run> and C<capture>, the argument must
+be properly shell-quoted in advance of the call.
+
 Versions of C<IPC::System::Simple> before v0.09 would not search
 the C<PATH> environment variable when the multi-argument form of
 C<run()> was called.  Versions from v0.09 onwards correctly search
@@ -1043,11 +1064,6 @@ Signals are not supported under Win32 systems, since they don't
 work at all like Unix signals.  Win32 signals cause commands to
 exit with a given exit value, which this modules I<does> capture.
 
-Only 8-bit values are returned when C<run()> or C<system()> 
-is called with a single value under Win32.  Multi-argument calls
-to C<run()> and C<system()>, as well as the C<runx()> and
-C<systemx()> always return the 32-bit Windows return values.
-
 =head2 Reporting bugs
 
 Before reporting a bug, please check to ensure you are using the

t/args.t

@@ -0,0 +1,87 @@
+#!/usr/bin/perl -w
+
+use strict;
+
+use Test::More tests => 56;
+use IPC::System::Simple qw(run runx system systemx capture capturex);
+use Config;
+use File::Basename qw(fileparse);
+
+my $perl = $Config{perlpath};
+$perl .= $Config{_exe} if $^O ne 'VMS' && $perl !~ m/$Config{_exe}$/i;
+my $tmp = 'test.tmp';
+
+my $script = qq{
+    open my \$fh, '>', '$tmp' or die "Cannot write to $tmp: \$!\\n";
+    print {\$fh} "\$_\\n" for \@ARGV;
+};
+
+chdir 't';
+
+END {
+    unlink $tmp;
+}
+
+my $slurp = sub {
+    open my $fh, '<', $tmp or die "Cannot read $tmp: $!\n";
+    return join '', <$fh>;
+};
+
+for my $spec (
+    ['single arg', 'foo'],
+    ['multiple args', 'x', 'y', 'z'],
+    ['arg with spaces', 'foo', 'bar baz'],
+) {
+    my ($desc, @args) = @{ $spec };
+    my $exp = join "\n", @args, '';
+
+    # Test run.
+    my $exit = eval { run $perl, '-e', $script, @args };
+    is $@, "", "Should have no error from runx with $desc";
+    is $exit, 0, "Should have exit 0 from runx with $desc";
+    is $slurp->(), $exp, "Should have passed $desc from run";
+
+    # Test system.
+    $exit = eval { system $perl, '-e', $script, @args };
+    is $@, "", "Should have no error from systemx with $desc";
+    is $exit, 0, "Should have exit 0 from systemx with $desc";
+    is $slurp->(), $exp, "Should have passed $desc from system";
+
+    # Test runx.
+    $exit = eval { runx $perl, '-e', $script, @args };
+    is $@, "", "Should have no error from runx with $desc";
+    is $exit, 0, "Should have exit 0 from runx with $desc";
+    is $slurp->(), $exp, "Should have passed $desc from runx";
+
+    # Test systemx.
+    $exit = eval { systemx $perl, '-e', $script, @args };
+    is $@, "", "Should have no error from systemx with $desc";
+    is $exit, 0, "Should have exit 0 from systemx with $desc";
+    is $slurp->(), $exp, "Should have passed $desc from systemx";
+
+    # Test capture.
+    my $output = eval { capture $perl, '-e', 'print "$_\n" for @ARGV', @args };
+    is $@, "", "Should have no error from capture with $desc";
+    is $output, $exp, "Should have passed $desc from capture";
+
+    # Test capturex.
+    $output = eval { capturex $perl, '-e', 'print "$_\n" for @ARGV', @args };
+    is $@, "", "Should have no error from capturex with $desc";
+    is $output, $exp, "Should have passed $desc from capturex";
+}
+
+# Make sure redirection works, too.
+my $exit = eval { run "$perl output.pl > $tmp" };
+is $@, "", "Should have no error from run with redirection";
+is $exit, 0, "Should have exit 0 from run with redirection";
+is $slurp->(), "Hello\nGoodbye\n", "Should have redirected text run";
+
+$exit = eval { system "$perl output.pl > $tmp" };
+is $@, "", "Should have no error from systemx with redirection";
+is $exit, 0, "Should have exit 0 from systemx with redirection";
+is $slurp->(), "Hello\nGoodbye\n", "Should have redirected text systemx";
+
+# And single-string capture.
+my $output = eval { capture "$perl output.pl" };
+is $@, "", "Should have no error from single-string capture";
+is $output, "Hello\nGoodbye\n", "Should have output from capture";

t/win32.t

@@ -21,13 +21,13 @@ use constant BIG_EXIT => 1000;
 use constant HUGE_EXIT => 100_000;
 
 # This command should allow us to exit with a specific value.
-use constant EXIT_CMD => [ @{ &IPC::System::Simple::WINDOWS_SHELL }, 'exit'];
+use constant CMD => join ' ', @{ &IPC::System::Simple::WINDOWS_SHELL };
 
 # These are used in the testing of commands in paths which contain spaces.
 use constant CMD_WITH_SPACES        => 'dir with spaces\hello.exe';
 use constant CMD_WITH_SPACES_OUTPUT => "Hello World\n";
 
-plan tests => 33;
+plan tests => 37;
 
 my $perl_path = $Config{perlpath};
 $perl_path .= $Config{_exe} unless $perl_path =~ m/$Config{_exe}$/i;
@@ -45,8 +45,11 @@ chdir("t");
 foreach my $big_exitval (SMALL_EXIT, BIG_EXIT, HUGE_EXIT) {
 
     my $exit;
+    # XXX Ideally, we would find a way to test the multi-argument form, too,
+    # but cmd.exe no longer works with that form, because all args are quoted,
+    # and /x/d/c must not be.
     eval {
-        $exit = run([$big_exitval], @{&EXIT_CMD}, $big_exitval);
+        $exit = run([$big_exitval], CMD . qq{ "exit $big_exitval"});
     };
 
     is($@,"","Running with $big_exitval ok");
@@ -55,7 +58,7 @@ foreach my $big_exitval (SMALL_EXIT, BIG_EXIT, HUGE_EXIT) {
     my $capture;
 
     eval {
-	$capture = capture([$big_exitval], @{&EXIT_CMD}, $big_exitval);
+	$capture = capture([$big_exitval], CMD . qq{ exit $big_exitval"});
     };
 
     is($@,"","Capturing with $big_exitval ok");
@@ -123,29 +126,24 @@ ok(1,"raw perl found in multi-part path");
 
 my $output = capture(
 	$^X, '-MIPC::System::Simple=capture',
-	q(-e"print 1; eval { capture(q(nosuchcmd)); }; print 2; exit 0;")
+	'-e', q(print 1; eval { capture(q(nosuchcmd)); }; print 2; exit 0;)
 );
 
 is($output,"12","RT #48319 - Check for STDOUT replumbing");
 
 # Check to ensure we can run commands that include spaces.
+$output = eval { capturex(CMD_WITH_SPACES, 'ignore'); };
+is($@, "", "command with spaces should not error (capturex multi)");
+is($output, CMD_WITH_SPACES_OUTPUT, "...and give correct output");
 
-SKIP: {
+$output = eval { capturex(CMD_WITH_SPACES); };
+is($@, "", "command with spaces should not error (capturex single)");
+is($output, CMD_WITH_SPACES_OUTPUT, "...and give correct output");
 
-    # CMD_WITH_SPACES is not currently distributed with IPC::System::Simple,
-    # effectively making this an author test for now. -- PJF, Dec 4, 2009
+$output = eval { capture(CMD_WITH_SPACES, 'ignore'); };
+is($@, "", "command with spaces should not error (capture multi)");
+is($output, CMD_WITH_SPACES_OUTPUT, "...and give correct output");
 
-    skip(CMD_WITH_SPACES." not implemented", 4);
-    # skip(CMD_WITH_SPACES." not available", 4) unless -x CMD_WITH_SPACES;
-
-    my $output = eval { capturex(CMD_WITH_SPACES); };
-
-    is($@, "", "command with spaces should not error (capturex)");
-    is($output, CMD_WITH_SPACES_OUTPUT, "...and give correct output");
-
-    $output = eval { capture(CMD_WITH_SPACES); };
-
-    is($@, "", "command with spaces should not error (capture)");
-    is($output, CMD_WITH_SPACES_OUTPUT, "...and give correct output");
-
-}
+$output = eval { capture('"' . CMD_WITH_SPACES . '"'); };
+is($@, "", "command with spaces should not error (capture quoted)");
+is($output, CMD_WITH_SPACES_OUTPUT, "...and give correct output");