From: Rafael Garcia-Suarez Date: Fri, 30 Apr 2010 13:52:16 +0000 (+0200) Subject: Upgrade to IPC::Cmd 0.58 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=4d239afe17c8b494dcc4e900abe2587eb6affcc8;p=p5sagit%2Fp5-mst-13.2.git Upgrade to IPC::Cmd 0.58 --- diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index fd8001b..d40a569 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -754,7 +754,7 @@ use File::Glob qw(:case); 'IPC::Cmd' => { 'MAINTAINER' => 'kane', - 'DISTRIBUTION' => 'BINGOS/IPC-Cmd-0.54.tar.gz', + 'DISTRIBUTION' => 'BINGOS/IPC-Cmd-0.58.tar.gz', 'FILES' => q[cpan/IPC-Cmd], 'UPSTREAM' => 'cpan', }, diff --git a/cpan/IPC-Cmd/lib/IPC/Cmd.pm b/cpan/IPC-Cmd/lib/IPC/Cmd.pm index e60c93f..873a17b 100644 --- a/cpan/IPC-Cmd/lib/IPC/Cmd.pm +++ b/cpan/IPC-Cmd/lib/IPC/Cmd.pm @@ -16,7 +16,7 @@ BEGIN { $USE_IPC_RUN $USE_IPC_OPEN3 $CAN_USE_RUN_FORKED $WARN ]; - $VERSION = '0.54'; + $VERSION = '0.58'; $VERBOSE = 0; $DEBUG = 0; $WARN = 1; @@ -360,6 +360,10 @@ sub kill_gently { $wait_cycles = $wait_cycles + 1; Time::HiRes::usleep(250000); # half a second } + + if (!$child_finished) { + kill(9, $pid); + } } sub open3_run { @@ -508,9 +512,9 @@ sub open3_run { } } -=head2 $hashref = run_forked( command => COMMAND, { child_stdin => SCALAR, timeout => DIGIT, stdout_handler => CODEREF, stderr_handler => CODEREF} ); +=head2 $hashref = run_forked( COMMAND, { child_stdin => SCALAR, timeout => DIGIT, stdout_handler => CODEREF, stderr_handler => CODEREF} ); -C is used to execute some program, +C is used to execute some program or a coderef, optionally feed it with some input, get its return code and output (both stdout and stderr into seperate buffers). In addition it allows to terminate the program @@ -536,7 +540,7 @@ feeds it with input, stores its exit code, stdout and stderr, terminates it in case it runs longer than specified. -Invocation requires the command to be executed and optionally a hashref of options: +Invocation requires the command to be executed or a coderef and optionally a hashref of options: =over @@ -559,6 +563,17 @@ stdout from the executing program. You may provide a coderef of a subroutine that will be called a portion of data is received on stderr from the executing program. +=item C + +Discards the buffering of the standard output and standard errors for return by run_forked(). +With this option you have to use the std*_handlers to read what the command outputs. +Useful for commands that send a lot of output. + +=item C + +Enable this option if you wish all spawned processes to be killed if the initially spawned +process (the parent) is killed or dies without waiting for child processes. + =back C will return a HASHREF with the following keys: @@ -576,17 +591,17 @@ The number of seconds the program ran for before being terminated, or 0 if no ti =item C Holds the standard output of the executed command -(or empty string if there were no stdout output; it's always defined!) +(or empty string if there were no stdout output or if discard_output was used; it's always defined!) =item C Holds the standard error of the executed command -(or empty string if there were no stderr output; it's always defined!) +(or empty string if there were no stderr output or if discard_output was used; it's always defined!) =item C Holds the standard output and error of the executed command merged into one stream -(or empty string if there were no output at all; it's always defined!) +(or empty string if there were no output at all or if discard_output was used; it's always defined!) =item C @@ -651,7 +666,6 @@ sub run_forked { close($parent_stderr_socket); close($parent_info_socket); - my $child_timedout = 0; my $flags; # prepare sockets to read from child @@ -673,11 +687,13 @@ sub run_forked { # print "child $pid started\n"; + my $child_timedout = 0; my $child_finished = 0; my $child_stdout = ''; my $child_stderr = ''; my $child_merged = ''; my $child_exit_code = 0; + my $parent_died = 0; my $got_sig_child = 0; $SIG{'CHLD'} = sub { $got_sig_child = time(); }; @@ -685,9 +701,26 @@ sub run_forked { my $child_child_pid; while (!$child_finished) { + my $now = time(); + + if ($opts->{'terminate_on_parent_sudden_death'}) { + $opts->{'runtime'}->{'last_parent_check'} = 0 + unless defined($opts->{'runtime'}->{'last_parent_check'}); + + # check for parent once each five seconds + if ($now - $opts->{'runtime'}->{'last_parent_check'} > 5) { + if (getppid() eq "1") { + kill (-9, $pid); + $parent_died = 1; + } + + $opts->{'runtime'}->{'last_parent_check'} = $now; + } + } + # user specified timeout if ($opts->{'timeout'}) { - if (time() - $start_time > $opts->{'timeout'}) { + if ($now - $start_time > $opts->{'timeout'}) { kill (-9, $pid); $child_timedout = 1; } @@ -697,7 +730,7 @@ sub run_forked { # kill process after that and finish wait loop; # shouldn't ever happen -- remove this code? if ($got_sig_child) { - if (time() - $got_sig_child > 10) { + if ($now - $got_sig_child > 10) { print STDERR "waitpid did not return -1 for 10 seconds after SIG_CHLD, killing [$pid]\n"; kill (-9, $pid); $child_finished = 1; @@ -729,17 +762,20 @@ sub run_forked { } while (my $l = <$child_stdout_socket>) { - $child_stdout .= $l; - $child_merged .= $l; + if (!$opts->{discard_output}) { + $child_stdout .= $l; + $child_merged .= $l; + } if ($opts->{'stdout_handler'} && ref($opts->{'stdout_handler'}) eq 'CODE') { $opts->{'stdout_handler'}->($l); } } while (my $l = <$child_stderr_socket>) { - $child_stderr .= $l; - $child_merged .= $l; - + if (!$opts->{discard_output}) { + $child_stderr .= $l; + $child_merged .= $l; + } if ($opts->{'stderr_handler'} && ref($opts->{'stderr_handler'}) eq 'CODE') { $opts->{'stderr_handler'}->($l); } @@ -776,6 +812,7 @@ sub run_forked { 'merged' => $child_merged, 'timeout' => $child_timedout ? $opts->{'timeout'} : 0, 'exit_code' => $child_exit_code, + 'parent_died' => $parent_died, }; my $err_msg = ''; @@ -785,6 +822,9 @@ sub run_forked { if ($o->{'timeout'}) { $err_msg .= "ran more than [$o->{'timeout'}] seconds\n"; } + if ($o->{'parent_died'}) { + $err_msg .= "parent died\n"; + } if ($o->{'stdout'}) { $err_msg .= "stdout:\n" . $o->{'stdout'} . "\n"; } @@ -810,12 +850,31 @@ sub run_forked { close($child_stderr_socket); close($child_info_socket); - my $child_exit_code = open3_run($cmd, { - 'parent_info' => $parent_info_socket, - 'parent_stdout' => $parent_stdout_socket, - 'parent_stderr' => $parent_stderr_socket, - 'child_stdin' => $opts->{'child_stdin'}, - }); + my $child_exit_code; + + # allow both external programs + # and internal perl calls + if (!ref($cmd)) { + $child_exit_code = open3_run($cmd, { + 'parent_info' => $parent_info_socket, + 'parent_stdout' => $parent_stdout_socket, + 'parent_stderr' => $parent_stderr_socket, + 'child_stdin' => $opts->{'child_stdin'}, + }); + } + elsif (ref($cmd) eq 'CODE') { + $child_exit_code = $cmd->({ + 'opts' => $opts, + 'parent_info' => $parent_info_socket, + 'parent_stdout' => $parent_stdout_socket, + 'parent_stderr' => $parent_stderr_socket, + 'child_stdin' => $opts->{'child_stdin'}, + }); + } + else { + print $parent_stderr_socket "Invalid command reference: " . ref($cmd) . "\n"; + $child_exit_code = 1; + } close($parent_stdout_socket); close($parent_stderr_socket); diff --git a/cpan/IPC-Cmd/t/01_IPC-Cmd.t b/cpan/IPC-Cmd/t/01_IPC-Cmd.t index 0773479..bf33faa 100644 --- a/cpan/IPC-Cmd/t/01_IPC-Cmd.t +++ b/cpan/IPC-Cmd/t/01_IPC-Cmd.t @@ -171,6 +171,25 @@ unless ( IPC::Cmd->can_use_run_forked ) { ok($r->{'stderr'}, "stderr: " . $r->{'stderr'}); } + +# try discarding the out+err +{ + my $out; + my $cmd = "echo out ; echo err >&2"; + my $r = run_forked( + $cmd, + { discard_output => 1, + stderr_handler => sub { $out .= shift }, + stdout_handler => sub { $out .= shift } + }); + + ok(ref($r) eq 'HASH', "executed: $cmd"); + ok(!$r->{'stdout'}, "stdout discarded"); + ok(!$r->{'stderr'}, "stderr discarded"); + ok($out =~ m/out/, "stdout handled"); + ok($out =~ m/err/, "stderr handled"); +} + __END__ ### special call to check that output is interleaved properly