diff options
author | Chris 'BinGOs' Williams <chris@bingosnet.co.uk> | 2012-01-30 10:45:15 +0000 |
---|---|---|
committer | Chris 'BinGOs' Williams <chris@bingosnet.co.uk> | 2012-01-30 11:38:12 +0000 |
commit | eb96f3fadee7d30808d6e2287f5d03c7e2c02192 (patch) | |
tree | 728464d1f0364a65960fa27ff0431a146a22987f /cpan/IPC-Cmd | |
parent | 7d76264217df3933754d722dc21cd67d80e35df9 (diff) | |
download | perl-eb96f3fadee7d30808d6e2287f5d03c7e2c02192.tar.gz |
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"
Diffstat (limited to 'cpan/IPC-Cmd')
-rw-r--r-- | cpan/IPC-Cmd/lib/IPC/Cmd.pm | 47 |
1 files changed, 33 insertions, 14 deletions
diff --git a/cpan/IPC-Cmd/lib/IPC/Cmd.pm b/cpan/IPC-Cmd/lib/IPC/Cmd.pm index 200e0c0553..99ba7bf988 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 |