None of these fixes affect current public-inbox-* code, or even
normal uses of lei. However, lei users wanting to switch
between $HOME directories or use alternate store paths may
notice strange behavior and this fixes some of it.
We'll also loop to account for DESTROY callbacks inserting into
container objects and retry appropriately.
use Carp qw(carp croak);
our @EXPORT_OK = qw(now msg_more dwaitpid add_timer);
use Carp qw(carp croak);
our @EXPORT_OK = qw(now msg_more dwaitpid add_timer);
my $nextq; # queue for next_tick
my $wait_pids; # list of [ pid, callback, callback_arg ]
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);
my $EXPMAP; # fd -> idle_time
our $EXPTIME = 180; # 3 minutes
my ($later_timer, $reap_armed, $exp_timer);
- $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 ) >>
}
=head2 C<< CLASS->SetLoopTimeout( $timeout ) >>
sub now () { clock_gettime(CLOCK_MONOTONIC) }
sub next_tick () {
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
}
# runs timers and returns milliseconds for next one, or next event loop
$reap_armed = undef;
my $tmp = $wait_pids or return;
$wait_pids = undef;
$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;
my $oldset = block_signals();
foreach my $ary (@$tmp) {
my ($pid, $cb, $arg) = @$ary;
}
}
sig_setmask($oldset);
}
}
sig_setmask($oldset);
+ delete $Stack{reap_runq};
}
# reentrant SIGCHLD handler (since reap_pids is not reentrant)
}
# reentrant SIGCHLD handler (since reap_pids is not reentrant)
$Epoll //= _InitPoller();
local $in_loop = 1;
my @events;
$Epoll //= _InitPoller();
local $in_loop = 1;
my @events;
- my $obj; # guard stack-not-refcounted w/ Carp + @DB::args
do {
my $timeout = RunTimers();
do {
my $timeout = RunTimers();
# 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.
# 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());
$obj->event_step;
}
} while (PostEventLoop());
- 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};
- push @$later_queue, $_[0]; # autovivifies @$later_queue
+ push @$later_q, $_[0]; # autovivifies @$later_q
$later_timer //= add_timer(60, \&_run_later);
}
$later_timer //= add_timer(60, \&_run_later);
}