about summary refs log tree commit homepage
path: root/lib/PublicInbox/DS.pm
diff options
context:
space:
mode:
Diffstat (limited to 'lib/PublicInbox/DS.pm')
-rw-r--r--lib/PublicInbox/DS.pm75
1 files changed, 45 insertions, 30 deletions
diff --git a/lib/PublicInbox/DS.pm b/lib/PublicInbox/DS.pm
index 15ece4df..3cddfd18 100644
--- a/lib/PublicInbox/DS.pm
+++ b/lib/PublicInbox/DS.pm
@@ -35,9 +35,10 @@ use Errno qw(EAGAIN EINVAL);
 use Carp qw(carp croak);
 our @EXPORT_OK = qw(now msg_more dwaitpid add_timer);
 
+my %Stack;
 my $nextq; # queue for next_tick
 my $wait_pids; # list of [ pid, callback, callback_arg ]
-my $later_queue; # list of callbacks to run at some later interval
+my $later_q; # list of callbacks to run at some later interval
 my $EXPMAP; # fd -> idle_time
 our $EXPTIME = 180; # 3 minutes
 my ($later_timer, $reap_armed, $exp_timer);
@@ -66,18 +67,25 @@ Reset all state
 
 =cut
 sub Reset {
-    $in_loop = undef; # first in case DESTROY callbacks use this
-    %DescriptorMap = ();
-    $wait_pids = $later_queue = $reap_armed = undef;
-    $EXPMAP = {};
-    $nextq = $ToClose = $later_timer = $exp_timer = undef;
-    $LoopTimeout = -1;  # no timeout by default
-    @Timers = ();
-
-    $PostLoopCallback = undef;
-
-    $_io = undef; # closes real $Epoll FD
-    $Epoll = undef; # may call DSKQXS::DESTROY
+        do {
+                $in_loop = undef; # first in case DESTROY callbacks use this
+                %DescriptorMap = ();
+                @Timers = ();
+                $PostLoopCallback = undef;
+
+                # we may be iterating inside one of these on our stack
+                my @q = delete @Stack{keys %Stack};
+                for my $q (@q) { @$q = () }
+                $EXPMAP = {};
+                $wait_pids = $later_q = $nextq = $ToClose = undef;
+                $_io = undef; # closes real $Epoll FD
+                $Epoll = undef; # may call DSKQXS::DESTROY
+        } while (@Timers || keys(%Stack) || $nextq || $wait_pids ||
+                $later_q || $ToClose || keys(%DescriptorMap) ||
+                $PostLoopCallback);
+
+        $reap_armed = $later_timer = $exp_timer = undef;
+        $LoopTimeout = -1;  # no timeout by default
 }
 
 =head2 C<< CLASS->SetLoopTimeout( $timeout ) >>
@@ -160,17 +168,19 @@ C<PostLoopCallback> below for how to exit the loop.
 sub now () { clock_gettime(CLOCK_MONOTONIC) }
 
 sub next_tick () {
-    my $q = $nextq or return;
-    $nextq = undef;
-    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($obj)) {
-            $obj->event_step;
-        } else {
-            $obj->();
-        }
-    }
+        my $q = $nextq or return;
+        $nextq = undef;
+        $Stack{cur_runq} = $q;
+        for my $obj (@$q) {
+                # 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($obj)) {
+                        $obj->event_step;
+                } else {
+                        $obj->();
+                }
+        }
+        delete $Stack{cur_runq};
 }
 
 # runs timers and returns milliseconds for next one, or next event loop
@@ -221,6 +231,7 @@ sub reap_pids {
         $reap_armed = undef;
         my $tmp = $wait_pids or return;
         $wait_pids = undef;
+        $Stack{reap_runq} = $tmp;
         my $oldset = block_signals();
         foreach my $ary (@$tmp) {
                 my ($pid, $cb, $arg) = @$ary;
@@ -237,6 +248,7 @@ sub reap_pids {
                 }
         }
         sig_setmask($oldset);
+        delete $Stack{reap_runq};
 }
 
 # reentrant SIGCHLD handler (since reap_pids is not reentrant)
@@ -271,7 +283,6 @@ sub EventLoop {
     $Epoll //= _InitPoller();
     local $in_loop = 1;
     my @events;
-    my $obj; # guard stack-not-refcounted w/ Carp + @DB::args
     do {
         my $timeout = RunTimers();
 
@@ -282,7 +293,9 @@ 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.
-            $obj = $DescriptorMap{$fd};
+
+            # guard stack-not-refcounted w/ Carp + @DB::args
+            my $obj = $DescriptorMap{$fd};
             $obj->event_step;
         }
     } while (PostEventLoop());
@@ -646,13 +659,15 @@ sub dwaitpid ($;$$) {
 }
 
 sub _run_later () {
-        my $run = $later_queue or return;
-        $later_timer = $later_queue = undef;
-        $_->() for @$run;
+        my $q = $later_q or return;
+        $later_timer = $later_q = undef;
+        $Stack{later_q} = $q;
+        $_->() for @$q;
+        delete $Stack{later_q};
 }
 
 sub later ($) {
-        push @$later_queue, $_[0]; # autovivifies @$later_queue
+        push @$later_q, $_[0]; # autovivifies @$later_q
         $later_timer //= add_timer(60, \&_run_later);
 }