Update IPC::Cmd to 0.38

From: "Jos I. Boumans" <jos@dwim.org>
Message-Id: <E88BE0DB-CA4E-4798-AB5B-3D45D1B5799B@dwim.org>

p4raw-id: //depot/perl@32101

diff --git a/lib/IPC/Cmd.pm b/lib/IPC/Cmd.pm
index 3e8e6d2..ce668b1 100644 (file)
--- a/lib/IPC/Cmd.pm
+++ b/lib/IPC/Cmd.pm
@@ -13,7 +13,7 @@ BEGIN {
                         $USE_IPC_RUN $USE_IPC_OPEN3 $WARN
                     ];
 
-    $VERSION        = '0.36_01';
+    $VERSION        = '0.38';
     $VERBOSE        = 0;
     $DEBUG          = 0;
     $WARN           = 1;
@@ -25,6 +25,7 @@ BEGIN {
 }
 
 require Carp;
+use File::Spec;
 use Params::Check               qw[check];
 use Module::Load::Conditional   qw[can_load];
 use Locale::Maketext::Simple    Style => 'gettext';
@@ -186,9 +187,10 @@ sub can_run {
         return MM->maybe_command($command);
 
     } else {
-        for my $dir ((split /\Q$Config::Config{path_sep}\E/, $ENV{PATH}),
-                     File::Spec->curdir()
-        ) {
+        for my $dir (
+            (split /\Q$Config::Config{path_sep}\E/, $ENV{PATH}),
+            File::Spec->curdir
+        ) {           
             my $abs = File::Spec->catfile($dir, $command);
             return $abs if $abs = MM->maybe_command($abs);
         }
@@ -437,6 +439,8 @@ sub _open3_run {
 
     ### add an epxlicit break statement
     ### code courtesy of theorbtwo from #london.pm
+    my $stdout_done = 0;
+    my $stderr_done = 0;
     OUTER: while ( my @ready = $selector->can_read ) {
 
         for my $h ( @ready ) {
@@ -457,9 +461,12 @@ sub _open3_run {
             ### if we would print anyway, we'd provide bogus information
             $_out_handler->( "$buf" ) if $len && $h == $kidout;
             $_err_handler->( "$buf" ) if $len && $h == $kiderror;
-            
-            ### child process is done printing.
-            last OUTER if $h == $kidout and $len == 0
+
+            ### Wait till child process is done printing to both
+            ### stdout and stderr.
+            $stdout_done = 1 if $h == $kidout   and $len == 0;
+            $stderr_done = 1 if $h == $kiderror and $len == 0;
+            last OUTER if ($stdout_done && $stderr_done);
         }
     }
 
@@ -671,7 +678,7 @@ settings honored cleanly.
 Otherwise, if the variable C<$IPC::Cmd::USE_IPC_OPEN3> is set to true 
 (See the C<GLOBAL VARIABLES> Section), try to execute the command using
 C<IPC::Open3>. Buffers will be available on all platforms except C<Win32>,
-interactive commands will still execute cleanly, and also your  verbosity
+interactive commands will still execute cleanly, and also your verbosity
 settings will be adhered to nicely;
 
 =item *
@@ -764,22 +771,22 @@ however, since you can just inspect your buffers for the contents.
 
 C<IPC::Run>, C<IPC::Open3>
 
-=head1 AUTHOR
-
-This module by
-Jos Boumans E<lt>kane@cpan.orgE<gt>.
-
 =head1 ACKNOWLEDGEMENTS
 
 Thanks to James Mastros and Martijn van der Streek for their
 help in getting IPC::Open3 to behave nicely.
 
+=head1 BUG REPORTS
+
+Please report bugs or other issues to E<lt>bug-ipc-cmd@rt.cpan.orgE<gt>.
+
+=head1 AUTHOR
+
+This module by Jos Boumans E<lt>kane@cpan.orgE<gt>.
+
 =head1 COPYRIGHT
 
-This module is
-copyright (c) 2002 - 2006 Jos Boumans E<lt>kane@cpan.orgE<gt>.
-All rights reserved.
+This library is free software; you may redistribute and/or modify it 
+under the same terms as Perl itself.
 
-This library is free software;
-you may redistribute and/or modify it under the same
-terms as Perl itself.
+=cut

diff --git a/lib/IPC/Cmd/t/01_IPC-Cmd.t b/lib/IPC/Cmd/t/01_IPC-Cmd.t
index 1607002..ee876d9 100644 (file)
--- a/lib/IPC/Cmd/t/01_IPC-Cmd.t
+++ b/lib/IPC/Cmd/t/01_IPC-Cmd.t
@@ -35,7 +35,7 @@ my @Prefs = (
     ok( !can_run('10283lkjfdalskfjaf'), q[Not found non-existant binary] );
 }
 
-### run tests
+### run tests that print only to stdout
 {   ### list of commands and regexes matching output ###
     my $map = [
         # command                                    # output regex
@@ -45,6 +45,7 @@ my @Prefs = (
         [ [$^X,qw[-eprint+42 |], $^X, qw|-neprint|], qr/42/,            ],
     ];
 
+    diag( "Running tests that print only to stdout" ) if $Verbose;
     ### for each configuarion
     for my $pref ( @Prefs ) {
         diag( "Running config: IPC::Run: $pref->[0] IPC::Open3: $pref->[1]" )
@@ -108,6 +109,81 @@ my @Prefs = (
     }
 }
 
+### run tests that print only to stderr
+### XXX lots of duplication from stdout tests, only difference
+### is buffer inspection
+{   ### list of commands and regexes matching output ###
+    my $map = [
+        # command                                    # output regex
+        [ "$^X -ewarn+42",                          qr/^42 /, ],
+        [ [$^X, '-ewarn+42'],                       qr/^42 /, ],
+    ];
+
+    diag( "Running tests that print only to stderr" ) if $Verbose;
+    ### for each configuarion
+    for my $pref ( @Prefs ) {
+        diag( "Running config: IPC::Run: $pref->[0] IPC::Open3: $pref->[1]" )
+            if $Verbose;
+
+        $IPC::Cmd::USE_IPC_RUN    = $IPC::Cmd::USE_IPC_RUN      = $pref->[0];
+        $IPC::Cmd::USE_IPC_OPEN3  = $IPC::Cmd::USE_IPC_OPEN3    = $pref->[1];
+
+        ### for each command
+        for my $aref ( @$map ) {
+            my $cmd                 = $aref->[0];
+            my $regex               = $aref->[1];
+
+            my $pp_cmd = ref $cmd ? "@$cmd" : "$cmd";
+            diag( "Running '$pp_cmd' as " . (ref $cmd ? "ARRAY" : "SCALAR") )
+                if $Verbose;
+
+            ### in scalar mode
+            {   diag( "Running stderr command in scalar mode" ) if $Verbose;
+                my $buffer;
+                my $ok = run( command => $cmd, buffer => \$buffer );
+
+                ok( $ok,        "Ran stderr command succesfully in scalar mode." );
+
+                SKIP: {
+           # No buffers are expected if neither IPC::Run nor IPC::Open3 is used.
+                    skip "No buffers available", 1
+                                unless $Class->can_capture_buffer;
+
+                    like( $buffer, $regex,
+                                "   Buffer filled properly from stderr" );
+                }
+            }
+
+            ### in list mode
+            {   diag( "Running stderr command in list mode" ) if $Verbose;
+                my @list = run( command => $cmd );
+                ok( $list[0],   "Ran stderr command successfully in list mode." );
+                ok( !$list[1],  "   No error code set" );
+
+                my $list_length = $Class->can_capture_buffer ? 5 : 2;
+                is( scalar(@list), $list_length,
+                                "   Output list has $list_length entries" );
+
+                SKIP: {
+           # No buffers are expected if neither IPC::Run nor IPC::Open3 is used.
+                    skip "No buffers available", 6
+                                unless $Class->can_capture_buffer;
+
+                    ### the last 3 entries from the RV, are they array refs?
+                    isa_ok( $list[$_], 'ARRAY' ) for 2..4;
+
+                    like( "@{$list[2]}", $regex,
+                                "   Combined buffer holds output" );
+
+                    is( scalar( @{$list[3]} ), 0,
+                                    "   Stdout buffer empty" );
+                    like( "@{$list[4]}", qr/$regex/,
+                            "   Stderr buffer filled" );
+                }
+            }
+        }
+    }
+}
 
 ### test failures
 {   ### for each configuarion