view release on metacpan or  search on metacpan

lib/MCE/Signal.pm  view on Meta::CPAN

}

sub defer {
   $MCE::Signal::SIG = $_[0] if $_[0];
   return;
}

my %_sig_name_lkup = map { $_ => 1 } qw(
   __DIE__ ABRT HUP INT PIPE QUIT TERM __WARN__
);

my $_count = 0;

my $_handler_count = $INC{'threads/shared.pm'}
   ? threads::shared::share($_count)
   : \$_count;

sub stop_and_exit {
   shift @_ if (defined $_[0] && $_[0] eq 'MCE::Signal');
   return MCE::Signal::defer($_[0]) if $MCE::Signal::IPC;

   my ($_exit_status, $_is_sig, $_sig_name) = ($?, 0, $_[0] || 0);
   $SIG{__DIE__} = $SIG{__WARN__} = sub {};

   if (exists $_sig_name_lkup{$_sig_name}) {
      $_exit_status = $MCE::Signal::KILLED = $_is_sig = 1;
      $_exit_status = 255, $_sig_name = 'TERM' if ($_sig_name eq '__DIE__');
      $_exit_status = 0 if ($_sig_name eq 'PIPE');
      $SIG{INT} = $SIG{$_sig_name} = sub {};
   }
   else {
      $_exit_status = $_sig_name if ($_sig_name =~ /^\d+$/);
      $MCE::Signal::STOPPED = 1;
   }

   ## Main process.
   if ($$ == $main_proc_id) {

      if (++${ $_handler_count } == 1) {
         ## Kill process group if signaled.
         if ($_is_sig == 1) {
            ($_sig_name eq 'PIPE')
               ? CORE::kill('PIPE', $_is_MSWin32 ? -$$ : -getpgrp)
               : CORE::kill('INT' , $_is_MSWin32 ? -$$ : -getpgrp);

            if ($_sig_name eq 'PIPE') {
               for my $_i (1..2) { Time::HiRes::sleep(0.015); }
            } else {
               for my $_i (1..3) { Time::HiRes::sleep(0.060); }
            }
         }

         ## Remove temp directory.
         _remove_tmpdir() if defined($tmp_dir);

         ## Signal process group to die.
         if ($_is_sig == 1) {
            if ($_sig_name eq 'INT' && -t STDIN) { ## no critic
               print {*STDERR} "\n";
            }
            if ($INC{'threads.pm'} && ($] lt '5.012000' || threads->tid())) {
               ($_no_kill9 == 1 || $_sig_name eq 'PIPE')
                  ? CORE::kill('INT', $_is_MSWin32 ? -$$ : -getpgrp)
                  : CORE::kill('KILL', -$$);
            }
            else {
               CORE::kill('INT', $_is_MSWin32 ? -$$ : -getpgrp);
            }
         }
      }
   }

   ## Child processes.
   elsif ($_is_sig) {

      ## Windows support, from nested workers.
      if ($_is_MSWin32) {
         _remove_tmpdir() if defined($tmp_dir);
         CORE::kill('KILL', $main_proc_id, -$$);
      }

      ## Real child processes.
      else {
         CORE::kill($_sig_name, $main_proc_id, -$$);
         CORE::kill('KILL', -$$, $$);
      }
   }

   ## Exit with status.
   CORE::exit($_exit_status);
}

###############################################################################
## ----------------------------------------------------------------------------
## Run command via the system(...) function.
##
## The system function in Perl ignores SIGINT and SIGQUIT. These 2 signals
## are sent to the command being executed via system() but not back to
## the underlying Perl script. The code below will ensure the Perl script
## receives the same signal in order to raise an exception immediately
## after the system call.
##
## Returns the actual exit status.
##
###############################################################################

sub sys_cmd {
   shift @_ if (defined $_[0] && $_[0] eq 'MCE::Signal');

   _croak('MCE::Signal::sys_cmd: no arguments were specified') if (@_ == 0);

   my $_status = system(@_);
   my $_sig_no = $_status & 127;
   my $_exit_status = $_status >> 8;

   ## Kill the process group if command caught SIGINT or SIGQUIT.

   CORE::kill('INT',  $main_proc_id, $_is_MSWin32 ? -$$ : -getpgrp)
      if $_sig_no == 2;

   CORE::kill('QUIT', $main_proc_id, $_is_MSWin32 ? -$$ : -getpgrp)