]> Sergey Matveev's repositories - public-inbox.git/blobdiff - lib/PublicInbox/DS.pm
ds: next_tick: avoid $_ in top-level loop iterator
[public-inbox.git] / lib / PublicInbox / DS.pm
index 01c9abd4baded2fa7b336398bb98e73417d8392b..263c34580afdb4a4d73316e6a37c6353acbb8352 100644 (file)
@@ -24,7 +24,7 @@ use strict;
 use v5.10.1;
 use parent qw(Exporter);
 use bytes;
-use POSIX qw(WNOHANG);
+use POSIX qw(WNOHANG sigprocmask SIG_SETMASK);
 use IO::Handle qw();
 use Fcntl qw(SEEK_SET :DEFAULT O_APPEND);
 use Time::HiRes qw(clock_gettime CLOCK_MONOTONIC);
@@ -66,8 +66,9 @@ Reset all state
 
 =cut
 sub Reset {
+    $in_loop = undef; # first in case DESTROY callbacks use this
     %DescriptorMap = ();
-    $in_loop = $wait_pids = $later_queue = $reap_armed = undef;
+    $wait_pids = $later_queue = $reap_armed = undef;
     $EXPMAP = {};
     $nextq = $ToClose = $later_timer = $exp_timer = undef;
     $LoopTimeout = -1;  # no timeout by default
@@ -161,13 +162,13 @@ sub now () { clock_gettime(CLOCK_MONOTONIC) }
 sub next_tick () {
     my $q = $nextq or return;
     $nextq = undef;
-    for (@$q) {
+    for my $obj (@$q) {
         # we avoid "ref" on blessed refs to workaround a Perl 5.16.3 leak:
         # https://rt.perl.org/Public/Bug/Display.html?id=114340
-        if (blessed($_)) {
-            $_->event_step;
+        if (blessed($obj)) {
+            $obj->event_step;
         } else {
-            $_->();
+            $obj->();
         }
     }
 }
@@ -201,6 +202,16 @@ sub RunTimers {
     ($LoopTimeout < 0 || $LoopTimeout >= $timeout) ? $timeout : $LoopTimeout;
 }
 
+sub sig_setmask { sigprocmask(SIG_SETMASK, @_) or die "sigprocmask: $!" }
+
+sub block_signals () {
+       my $oldset = POSIX::SigSet->new;
+       my $newset = POSIX::SigSet->new;
+       $newset->fillset or die "fillset: $!";
+       sig_setmask($newset, $oldset);
+       $oldset;
+}
+
 # We can't use waitpid(-1) safely here since it can hit ``, system(),
 # and other things.  So we scan the $wait_pids list, which is hopefully
 # not too big.  We keep $wait_pids small by not calling dwaitpid()
@@ -210,6 +221,7 @@ sub reap_pids {
        $reap_armed = undef;
        my $tmp = $wait_pids or return;
        $wait_pids = undef;
+       my $oldset = block_signals();
        foreach my $ary (@$tmp) {
                my ($pid, $cb, $arg) = @$ary;
                my $ret = waitpid($pid, WNOHANG);
@@ -224,8 +236,7 @@ sub reap_pids {
                        warn "waitpid($pid, WNOHANG) = $ret, \$!=$!, \$?=$?";
                }
        }
-       # we may not be done, yet, and could've missed/masked a SIGCHLD:
-       $reap_armed //= requeue(\&reap_pids) if $wait_pids;
+       sig_setmask($oldset);
 }
 
 # reentrant SIGCHLD handler (since reap_pids is not reentrant)
@@ -260,6 +271,7 @@ sub EventLoop {
     $Epoll //= _InitPoller();
     local $in_loop = 1;
     my @events;
+    my $obj; # guard stack-not-refcounted w/ Carp + @DB::args
     do {
         my $timeout = RunTimers();
 
@@ -270,7 +282,8 @@ sub EventLoop {
             # that ones in the front triggered unregister-interest actions.  if we
             # can't find the %sock entry, it's because we're no longer interested
             # in that event.
-            $DescriptorMap{$fd}->event_step;
+            $obj = $DescriptorMap{$fd};
+            $obj->event_step;
         }
     } while (PostEventLoop());
     _run_later();
@@ -624,10 +637,10 @@ sub dwaitpid ($;$$) {
                if ($ret == $pid) {
                        if ($cb) {
                                eval { $cb->($arg, $pid) };
-                               warn "E: dwaitpid($pid) !in_loop: $@" if $@;
+                               carp "E: dwaitpid($pid) !in_loop: $@" if $@;
                        }
                } else {
-                       warn "waitpid($pid, 0) = $ret, \$!=$!, \$?=$?";
+                       carp "waitpid($pid, 0) = $ret, \$!=$!, \$?=$?";
                }
        }
 }