summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/IPC/Cmd.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/IPC/Cmd.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/IPC/Cmd.pm38
1 files changed, 24 insertions, 14 deletions
diff --git a/Master/tlpkg/tlperl/lib/IPC/Cmd.pm b/Master/tlpkg/tlperl/lib/IPC/Cmd.pm
index 4705f044338..c0e25a22fb3 100644
--- a/Master/tlpkg/tlperl/lib/IPC/Cmd.pm
+++ b/Master/tlpkg/tlperl/lib/IPC/Cmd.pm
@@ -18,7 +18,7 @@ BEGIN {
$HAVE_MONOTONIC
];
- $VERSION = '0.92_01';
+ $VERSION = '0.96';
$VERBOSE = 0;
$DEBUG = 0;
$WARN = 1;
@@ -60,6 +60,8 @@ use Text::ParseWords (); # import ONLY if needed!
use Module::Load::Conditional qw[can_load];
use Locale::Maketext::Simple Style => 'gettext';
+local $Module::Load::Conditional::FORCE_SAFE_INC = 1;
+
=pod
=head1 NAME
@@ -142,8 +144,6 @@ sub can_use_ipc_run {
return if IS_WIN98;
### if we don't have ipc::run, we obviously can't use it.
- local @INC = @INC;
- pop @INC if $INC[-1] eq '.';
return unless can_load(
modules => { 'IPC::Run' => '0.55' },
verbose => ($WARN && $verbose),
@@ -171,8 +171,6 @@ sub can_use_ipc_open3 {
### IPC::Open3 works on every non-VMS platform, but it can't
### capture buffers on win32 :(
- local @INC = @INC;
- pop @INC if $INC[-1] eq '.';
return unless can_load(
modules => { map {$_ => '0.0'} qw|IPC::Open3 IO::Select Symbol| },
verbose => ($WARN && $verbose),
@@ -403,6 +401,14 @@ sub adjust_monotonic_start_time {
}
}
+sub uninstall_signals {
+ return unless defined($IPC::Cmd::{'__old_signals'});
+
+ foreach my $sig_name (keys %{$IPC::Cmd::{'__old_signals'}}) {
+ $SIG{$sig_name} = $IPC::Cmd::{'__old_signals'}->{$sig_name};
+ }
+}
+
# incompatible with POSIX::SigAction
#
sub install_layered_signal {
@@ -415,6 +421,10 @@ sub install_layered_signal {
Carp::confess("install_layered_signal expects coderef")
if !ref($handler_code) || ref($handler_code) ne 'CODE';
+ $IPC::Cmd::{'__old_signals'} = {}
+ unless defined($IPC::Cmd::{'__old_signals'});
+ $IPC::Cmd::{'__old_signals'}->{$s} = $SIG{$s};
+
my $previous_handler = $SIG{$s};
my $sig_handler = sub {
@@ -572,7 +582,8 @@ sub open3_run {
# it will terminate only after child
# has terminated (except for SIGKILL,
# which is specially handled)
- foreach my $s (keys %SIG) {
+ SIGNAL: foreach my $s (keys %SIG) {
+ next SIGNAL if $s eq '__WARN__' or $s eq '__DIE__'; # Skip and don't clobber __DIE__ & __WARN__
my $sig_handler;
$sig_handler = sub {
kill("$s", $pid);
@@ -848,18 +859,15 @@ sub run_forked {
# prepare sockets to read from child
- $flags = 0;
- fcntl($child_stdout_socket, POSIX::F_GETFL, $flags) || Carp::confess "can't fnctl F_GETFL: $!";
+ $flags = fcntl($child_stdout_socket, POSIX::F_GETFL, 0) || Carp::confess "can't fnctl F_GETFL: $!";
$flags |= POSIX::O_NONBLOCK;
fcntl($child_stdout_socket, POSIX::F_SETFL, $flags) || Carp::confess "can't fnctl F_SETFL: $!";
- $flags = 0;
- fcntl($child_stderr_socket, POSIX::F_GETFL, $flags) || Carp::confess "can't fnctl F_GETFL: $!";
+ $flags = fcntl($child_stderr_socket, POSIX::F_GETFL, 0) || Carp::confess "can't fnctl F_GETFL: $!";
$flags |= POSIX::O_NONBLOCK;
fcntl($child_stderr_socket, POSIX::F_SETFL, $flags) || Carp::confess "can't fnctl F_SETFL: $!";
- $flags = 0;
- fcntl($child_info_socket, POSIX::F_GETFL, $flags) || Carp::confess "can't fnctl F_GETFL: $!";
+ $flags = fcntl($child_info_socket, POSIX::F_GETFL, 0) || Carp::confess "can't fnctl F_GETFL: $!";
$flags |= POSIX::O_NONBLOCK;
fcntl($child_info_socket, POSIX::F_SETFL, $flags) || Carp::confess "can't fnctl F_SETFL: $!";
@@ -1149,6 +1157,8 @@ sub run_forked {
delete($SIG{'CHLD'});
}
+ uninstall_signals();
+
return $o;
}
else {
@@ -1937,6 +1947,8 @@ sub _pp_child_error {
1;
+__END__
+
=head2 $q = QUOTE
Returns the character used for quoting strings on this platform. This is
@@ -1951,8 +1963,6 @@ You can use it as follows:
This makes sure that C<foo bar> is treated as a string, rather than two
separate arguments to the C<echo> function.
-__END__
-
=head1 HOW IT WORKS
C<run> will try to execute your command using the following logic: