diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/IPC/Cmd.pm')
-rw-r--r-- | Master/tlpkg/tlperl/lib/IPC/Cmd.pm | 38 |
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: |