From: Jos I. Boumans Date: Thu, 11 Oct 2007 17:24:50 +0000 (+0200) Subject: Update IPC::Cmd to 0.38 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=cce6d045dc7c10e0ae53901ce375a88a7bd3205e;p=p5sagit%2Fp5-mst-13.2.git Update IPC::Cmd to 0.38 From: "Jos I. Boumans" Message-Id: p4raw-id: //depot/perl@32101 --- diff --git a/lib/IPC/Cmd.pm b/lib/IPC/Cmd.pm index 3e8e6d2..ce668b1 100644 --- 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 Section), try to execute the command using C. Buffers will be available on all platforms except C, -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, C -=head1 AUTHOR - -This module by -Jos Boumans Ekane@cpan.orgE. - =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 Ebug-ipc-cmd@rt.cpan.orgE. + +=head1 AUTHOR + +This module by Jos Boumans Ekane@cpan.orgE. + =head1 COPYRIGHT -This module is -copyright (c) 2002 - 2006 Jos Boumans Ekane@cpan.orgE. -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 --- 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