lib/PublicInbox/Thread.pm

   1 # subclass Mail::Thread and use this to workaround a memory leak
   2 # Based on the patch in: https://rt.cpan.org/Public/Bug/Display.html?id=22817
   3 #
   4 # Additionally, workaround for a bug where $walk->topmost returns undef:
   5 # - http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=795913
   6 # - https://rt.cpan.org/Ticket/Display.html?id=106498
   7 #
   8 # And avoid recursion in recurse_down:
   9 # - https://rt.cpan.org/Ticket/Display.html?id=116727
  10 # - http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=833479
  11 #
  12 # License differs from the rest of public-inbox (but is compatible):
  13 # This library is free software; you can redistribute it and/or modify
  14 # it under the same terms as Perl itself.
  15 package PublicInbox::Thread;
  16 use strict;
  17 use warnings;
  18 use base qw(Mail::Thread);
  19 # WARNING! both these Mail::Thread knobs were found by inspecting
  20 # the Mail::Thread 2.55 source code, and we have some monkey patches
  21 # in PublicInbox::Thread to fix memory leaks.  Since Mail::Thread
  22 # appears unmaintained, I suppose it's safe to depend on these
  23 # variables for now:
  24 {
  25         no warnings 'once';
  26         # we want strict threads to expose (and hopefully discourage)
  27         # use of broken email clients
  28         $Mail::Thread::nosubject = 1;
  29         # Keep ghosts with only a single direct child,
  30         # don't hide that there may be missing messages.
  31         $Mail::Thread::noprune = 1;
  32 }
  33
  34 if ($Mail::Thread::VERSION <= 2.55) {
  35         eval q(sub _container_class { 'PublicInbox::Thread::Container' });
  36 }
  37
  38 package PublicInbox::Thread::Container;
  39 use strict;
  40 use warnings;
  41 use base qw(Mail::Thread::Container);
  42 use Scalar::Util qw(weaken);
  43 sub parent { @_ == 2 ? weaken($_[0]->{parent} = $_[1]) : $_[0]->{parent} }
  44
  45 sub topmost {
  46         $_[0]->SUPER::topmost || PublicInbox::Thread::CPANRTBug106498->new;
  47 }
  48
  49 # non-recursive version of recurse_down to avoid stack depth warnings
  50 sub recurse_down {
  51         my ($self, $callback) = @_;
  52         my %seen;
  53         my @q = ($self);
  54         while (my $cont = shift @q) {
  55                 $seen{$cont}++;
  56                 $callback->($cont);
  57
  58                 if (my $next = $cont->next) {
  59                         if ($seen{$next}) {
  60                                 $cont->next(undef);
  61                         } else {
  62                                 push @q, $next;
  63                         }
  64                 }
  65                 if (my $child = $cont->child) {
  66                         if ($seen{$child}) {
  67                                 $cont->child(undef);
  68                         } else {
  69                                 push @q, $child;
  70                         }
  71                 }
  72         }
  73 }
  74
  75 # ref:
  76 # - http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=795913
  77 # - https://rt.cpan.org/Ticket/Display.html?id=106498
  78 package PublicInbox::Thread::CPANRTBug106498;
  79 use strict;
  80 use warnings;
  81
  82 sub new { bless {}, $_[0] }
  83
  84 sub simple_subject {}
  85
  86 1;