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 # License differs from the rest of public-inbox (but is compatible):
   9 # This library is free software; you can redistribute it and/or modify
  10 # it under the same terms as Perl itself.
  11 package PublicInbox::Thread;
  12 use strict;
  13 use warnings;
  14 use base qw(Mail::Thread);
  15 # WARNING! both these Mail::Thread knobs were found by inspecting
  16 # the Mail::Thread 2.55 source code, and we have some monkey patches
  17 # in PublicInbox::Thread to fix memory leaks.  Since Mail::Thread
  18 # appears unmaintained, I suppose it's safe to depend on these
  19 # variables for now:
  20 {
  21         no warnings 'once';
  22         # we want strict threads to expose (and hopefully discourage)
  23         # use of broken email clients
  24         $Mail::Thread::nosubject = 1;
  25         # Keep ghosts with only a single direct child,
  26         # don't hide that there may be missing messages.
  27         $Mail::Thread::noprune = 1;
  28 }
  29
  30 if ($Mail::Thread::VERSION <= 2.55) {
  31         eval q(sub _container_class { 'PublicInbox::Thread::Container' });
  32 }
  33
  34 package PublicInbox::Thread::Container;
  35 use strict;
  36 use warnings;
  37 use base qw(Mail::Thread::Container);
  38 use Scalar::Util qw(weaken);
  39 sub parent { @_ == 2 ? weaken($_[0]->{parent} = $_[1]) : $_[0]->{parent} }
  40
  41 sub topmost {
  42         $_[0]->SUPER::topmost || PublicInbox::Thread::CPANRTBug106498->new;
  43 }
  44
  45 # ref:
  46 # - http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=795913
  47 # - https://rt.cpan.org/Ticket/Display.html?id=106498
  48 package PublicInbox::Thread::CPANRTBug106498;
  49 use strict;
  50 use warnings;
  51
  52 sub new { bless {}, $_[0] }
  53
  54 sub simple_subject {}
  55
  56 1;