In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/eb96f3fadee7d30808d6e2287f5d03c7e2c02192?hp=7d76264217df3933754d722dc21cd67d80e35df9>
- Log ----------------------------------------------------------------- commit eb96f3fadee7d30808d6e2287f5d03c7e2c02192 Author: Chris 'BinGOs' Williams <[email protected]> Date: Mon Jan 30 10:45:15 2012 +0000 Update IPC-Cmd to CPAN version 0.76 [DELTA] Changes for 0.76 Mon Jan 30 11:30:53 GMT 2012 ================================================= * Make the empty arg stripping the default again, with option to override this behaviour. Changes for 0.74 Mon Jan 30 10:24:30 GMT 2012 ================================================= * Applied patch from WATANABE Hiroaki [RT #74470] "Empty string cannot be passed to command" * Resolved [RT #74373] reported by Randy Stauner "Compilation error when POSIX.pm fails to load" ----------------------------------------------------------------------- Summary of changes: Porting/Maintainers.pl | 2 +- cpan/IPC-Cmd/lib/IPC/Cmd.pm | 47 ++++++++++++++++++++++++++++++------------ pod/perldelta.pod | 4 +++ 3 files changed, 38 insertions(+), 15 deletions(-) diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 323786d..ccb2db6 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -1020,7 +1020,7 @@ use File::Glob qw(:case); 'IPC::Cmd' => { 'MAINTAINER' => 'kane', - 'DISTRIBUTION' => 'BINGOS/IPC-Cmd-0.72.tar.gz', + 'DISTRIBUTION' => 'BINGOS/IPC-Cmd-0.76.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 200e0c0..99ba7bf 100644 --- a/cpan/IPC-Cmd/lib/IPC/Cmd.pm +++ b/cpan/IPC-Cmd/lib/IPC/Cmd.pm @@ -14,15 +14,16 @@ BEGIN { use Exporter (); use vars qw[ @ISA $VERSION @EXPORT_OK $VERBOSE $DEBUG $USE_IPC_RUN $USE_IPC_OPEN3 $CAN_USE_RUN_FORKED $WARN - $INSTANCES + $INSTANCES $ALLOW_NULL_ARGS ]; - $VERSION = '0.72'; + $VERSION = '0.76'; $VERBOSE = 0; $DEBUG = 0; $WARN = 1; $USE_IPC_RUN = IS_WIN32 && !IS_WIN98; $USE_IPC_OPEN3 = not IS_VMS; + $ALLOW_NULL_ARGS = 0; $CAN_USE_RUN_FORKED = 0; eval { @@ -42,6 +43,7 @@ BEGIN { } require Carp; +use Socket; use File::Spec; use Params::Check qw[check]; use Text::ParseWords (); # import ONLY if needed! @@ -398,6 +400,8 @@ sub install_layered_signal { sub kill_gently { my ($pid, $opts) = @_; + require POSIX; + $opts = {} unless $opts; $opts->{'wait_time'} = 2 unless defined($opts->{'wait_time'}); $opts->{'first_kill_type'} = 'just_process' unless $opts->{'first_kill_type'}; @@ -414,7 +418,7 @@ sub kill_gently { my $wait_start_time = time(); while (!$child_finished && $wait_start_time + $opts->{'wait_time'} > time()) { - my $waitpid = waitpid($pid, WNOHANG); + my $waitpid = waitpid($pid, POSIX::WNOHANG); if ($waitpid eq -1) { $child_finished = 1; } @@ -705,6 +709,8 @@ sub run_forked { ### container to store things in my $self = bless {}, __PACKAGE__; + require POSIX; + if (!can_use_run_forked()) { Carp::carp("run_forked is not available: $CAN_USE_RUN_FORKED"); return; @@ -765,19 +771,19 @@ sub run_forked { # prepare sockets to read from child $flags = 0; - fcntl($child_stdout_socket, F_GETFL, $flags) || die "can't fnctl F_GETFL: $!"; - $flags |= O_NONBLOCK; - fcntl($child_stdout_socket, F_SETFL, $flags) || die "can't fnctl F_SETFL: $!"; + fcntl($child_stdout_socket, POSIX::F_GETFL, $flags) || die "can't fnctl F_GETFL: $!"; + $flags |= POSIX::O_NONBLOCK; + fcntl($child_stdout_socket, POSIX::F_SETFL, $flags) || die "can't fnctl F_SETFL: $!"; $flags = 0; - fcntl($child_stderr_socket, F_GETFL, $flags) || die "can't fnctl F_GETFL: $!"; - $flags |= O_NONBLOCK; - fcntl($child_stderr_socket, F_SETFL, $flags) || die "can't fnctl F_SETFL: $!"; + fcntl($child_stderr_socket, POSIX::F_GETFL, $flags) || die "can't fnctl F_GETFL: $!"; + $flags |= POSIX::O_NONBLOCK; + fcntl($child_stderr_socket, POSIX::F_SETFL, $flags) || die "can't fnctl F_SETFL: $!"; $flags = 0; - fcntl($child_info_socket, F_GETFL, $flags) || die "can't fnctl F_GETFL: $!"; - $flags |= O_NONBLOCK; - fcntl($child_info_socket, F_SETFL, $flags) || die "can't fnctl F_SETFL: $!"; + fcntl($child_info_socket, POSIX::F_GETFL, $flags) || die "can't fnctl F_GETFL: $!"; + $flags |= POSIX::O_NONBLOCK; + fcntl($child_info_socket, POSIX::F_SETFL, $flags) || die "can't fnctl F_SETFL: $!"; # print "child $pid started\n"; @@ -856,7 +862,7 @@ sub run_forked { $child_finished = 1; } - my $waitpid = waitpid($pid, WNOHANG); + my $waitpid = waitpid($pid, POSIX::WNOHANG); # child finished, catch it's exit status if ($waitpid ne 0 && $waitpid ne -1) { @@ -1072,7 +1078,12 @@ sub run { $cmd = _quote_args_vms( $cmd ) if IS_VMS; ### strip any empty elements from $cmd if present - $cmd = [ grep { defined && length } @$cmd ] if ref $cmd; + if ( $ALLOW_NULL_ARGS ) { + $cmd = [ grep { defined } @$cmd ] if ref $cmd; + } + else { + $cmd = [ grep { defined && length } @$cmd ] if ref $cmd; + } my $pp_cmd = (ref $cmd ? "@$cmd" : $cmd); print loc("Running [%1]...\n", $pp_cmd ) if $verbose; @@ -1847,6 +1858,14 @@ the binary it finds in the C<PATH> when called in a list context. Defaults to false, set to true to enable the described behaviour. +=head2 $IPC::Cmd::ALLOW_NULL_ARGS + +This variable controls whether C<run> will remove any empty/null arguments +it finds in command arguments. + +Defaults to false, so it will remove null arguments. Set to true to allow +them. + =head1 Caveats =over 4 diff --git a/pod/perldelta.pod b/pod/perldelta.pod index a50d651..587326d 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -141,6 +141,10 @@ L<DB_File> has been upgraded from version 1.824 to version 1.826. =item * +L<IPC::Cmd> has been upgraded from version 0.72 to version 0.76. + +=item * + L<Pod::Parser> has been upgraded from version 1.37 to version 1.51. =item * -- Perl5 Master Repository
