summaryrefslogtreecommitdiff
path: root/cpan/IPC-Cmd
diff options
context:
space:
mode:
authorChris 'BinGOs' Williams <chris@bingosnet.co.uk>2012-01-30 10:45:15 +0000
committerChris 'BinGOs' Williams <chris@bingosnet.co.uk>2012-01-30 11:38:12 +0000
commiteb96f3fadee7d30808d6e2287f5d03c7e2c02192 (patch)
tree728464d1f0364a65960fa27ff0431a146a22987f /cpan/IPC-Cmd
parent7d76264217df3933754d722dc21cd67d80e35df9 (diff)
downloadperl-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.pm47
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