X-Git-Url: http://www.git.stargrave.org/?a=blobdiff_plain;f=lib%2FPublicInbox%2FThread.pm;h=8af94616f73d85edeaa50496dccb990c8c511906;hb=08913d1b05e32a7415cbe8afc3c229d108817de8;hp=a3dedf541cb592a0e23182ac5c7dbd91736d49ca;hpb=f045f561f0d6b8b573f38a966365d8898178d242;p=public-inbox.git diff --git a/lib/PublicInbox/Thread.pm b/lib/PublicInbox/Thread.pm index a3dedf54..8af94616 100644 --- a/lib/PublicInbox/Thread.pm +++ b/lib/PublicInbox/Thread.pm @@ -5,6 +5,10 @@ # - http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=795913 # - https://rt.cpan.org/Ticket/Display.html?id=106498 # +# And avoid recursion in recurse_down: +# - https://rt.cpan.org/Ticket/Display.html?id=116727 +# - http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=833479 +# # License differs from the rest of public-inbox (but is compatible): # This library is free software; you can redistribute it and/or modify # it under the same terms as Perl itself. @@ -12,18 +16,25 @@ package PublicInbox::Thread; use strict; use warnings; use base qw(Mail::Thread); +# WARNING! both these Mail::Thread knobs were found by inspecting +# the Mail::Thread 2.55 source code, and we have some monkey patches +# in PublicInbox::Thread to fix memory leaks. Since Mail::Thread +# appears unmaintained, I suppose it's safe to depend on these +# variables for now: +{ + no warnings 'once'; + # we want strict threads to expose (and hopefully discourage) + # use of broken email clients + $Mail::Thread::nosubject = 1; + # Keep ghosts with only a single direct child, + # don't hide that there may be missing messages. + $Mail::Thread::noprune = 1; +} if ($Mail::Thread::VERSION <= 2.55) { eval q(sub _container_class { 'PublicInbox::Thread::Container' }); } -sub sort_ts { - sort { - (eval { $a->topmost->message->header('X-PI-TS') } || 0) <=> - (eval { $b->topmost->message->header('X-PI-TS') } || 0) - } @_; -} - package PublicInbox::Thread::Container; use strict; use warnings; @@ -35,6 +46,32 @@ sub topmost { $_[0]->SUPER::topmost || PublicInbox::Thread::CPANRTBug106498->new; } +# non-recursive version of recurse_down to avoid stack depth warnings +sub recurse_down { + my ($self, $callback) = @_; + my %seen; + my @q = ($self); + while (my $cont = shift @q) { + $seen{$cont}++; + $callback->($cont); + + if (my $next = $cont->next) { + if ($seen{$next}) { + $cont->next(undef); + } else { + push @q, $next; + } + } + if (my $child = $cont->child) { + if ($seen{$child}) { + $cont->child(undef); + } else { + push @q, $child; + } + } + } +} + # ref: # - http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=795913 # - https://rt.cpan.org/Ticket/Display.html?id=106498