view release on metacpan or  search on metacpan

lib/POE/Resource/Signals.pm  view on Meta::CPAN

    }
    # Per https://rt.cpan.org/Ticket/Display.html?id=45109 setting the
    # signal handler must be done after reaping the outstanding child
    # processes, at least on SysV systems like HP-UX.
    $SIG{$signal} = \&_loop_signal_handler_chld;
  }
  else {
    # The poll loop is over.  Resume slowly polling for signals.

    if ($polling_for_signals) {
      if (TRACE_SIGNALS) {
        _warn("<sg> POE::Kernel will poll again after a delay");
      }
      $self->_data_sig_enqueue_poll_event($signal);
    }
    else {
      if (TRACE_SIGNALS) {
        _warn("<sg> POE::Kernel SIGCHLD poll loop paused");
      }
      $self->_idle_queue_shrink();
    }
  }
}

sub _data_sig_reap_pids {
  my $self = shift();

  # Reap children for as long as waitpid(2) says something
  # interesting has happened.
  # TODO This has a possibility of an infinite loop, but so far it
  # hasn't hasn't happened.

  my $pid;
  while ($pid = waitpid(-1, WNOHANG)) {
    # waitpid(2) returned a process ID.  Emit an appropriate SIGCHLD
    # event and loop around again.

    if (($pid > 0) or (RUNNING_IN_HELL and $pid < -1)) {
      if (RUNNING_IN_HELL or WIFEXITED($?) or WIFSIGNALED($?)) {

        if (TRACE_SIGNALS) {
          _warn("<sg> POE::Kernel detected SIGCHLD (pid=$pid; exit=$?)");
        }

        # Check for explicit SIGCHLD watchers, and enqueue explicit
        # events for them.

        if (exists $kr_pids_to_events{$pid}) {
          my @sessions_to_clear;
          while (my ($sid, $ses_rec) = each %{$kr_pids_to_events{$pid}}) {
            $self->_data_ev_enqueue(
              $ses_rec->[PID_SESSION], $self, $ses_rec->[PID_EVENT], ET_SIGCLD,
              [ 'CHLD', $pid, $?, @{$ses_rec->[PID_ARGS]} ],
              __FILE__, __LINE__, undef
            );
            push @sessions_to_clear, $sid;
          }
          $self->_data_sig_pid_ignore($_, $pid) foreach @sessions_to_clear;
        }

        # Kick off a SIGCHLD cascade.
        $self->_data_ev_enqueue(
          $self, $self, EN_SIGNAL, ET_SIGNAL, [ 'CHLD', $pid, $? ],
          __FILE__, __LINE__, undef
        );
      }
      elsif (TRACE_SIGNALS) {
        _warn("<sg> POE::Kernel detected strange exit (pid=$pid; exit=$?");
      }

      if (TRACE_SIGNALS) {
        _warn("<sg> POE::Kernel will poll again immediately");
      }

      next;
    }

    # The only other negative value waitpid(2) should return is -1.
    # This is highly unlikely, but it's necessary to catch
    # portability problems.
    #
    # TODO - Find a way to test this.

    _trap "internal consistency error: waitpid returned $pid" if $pid != -1;

    # If the error is an interrupted syscall, poll again right away.

    if ($! == EINTR) {
      if (TRACE_SIGNALS) {
        _warn(
          "<sg> POE::Kernel's waitpid(2) was interrupted.\n",
          "POE::Kernel will poll again immediately.\n"
        );
      }
      next;
    }

    # No child processes exist.  TODO This is different than
    # children being present but running.  Maybe this condition
    # could halt polling entirely, and some UNIVERSAL::fork wrapper
    # could restart polling when processes are forked.

    if ($! == ECHILD) {
      if (TRACE_SIGNALS) {
        _warn("<sg> POE::Kernel has no child processes");
      }
      last;
    }

    # Some other error occurred.

    if (TRACE_SIGNALS) {
      _warn("<sg> POE::Kernel's waitpid(2) got error: $!");
    }
    last;
  }

  # Remember whether there are more processes to reap.

  $kr_has_child_procs = !$pid;
}