X-Git-Url: http://www.git.stargrave.org/?a=blobdiff_plain;f=lib%2FPublicInbox%2FSearchThread.pm;h=8b2cb8059db94043affbbf82abbfbea2eddb57ba;hb=906393b801050e303d2ec2a660c85de4a5fa4740;hp=24a56d2d965a4826f2d9e25fc586f5278921523d;hpb=f2b07568e623c2a0aff4d0135617a26c887d2755;p=public-inbox.git diff --git a/lib/PublicInbox/SearchThread.pm b/lib/PublicInbox/SearchThread.pm index 24a56d2d..8b2cb805 100644 --- a/lib/PublicInbox/SearchThread.pm +++ b/lib/PublicInbox/SearchThread.pm @@ -4,10 +4,10 @@ # This license differs from the rest of public-inbox # # Our own jwz-style threading class based on Mail::Thread from CPAN. -# Mail::Thread is unmaintained and available on some distros. +# Mail::Thread is unmaintained and unavailable on some distros. # We also do not want pruning or subject grouping, since we want # to encourage strict threading and hopefully encourage people -# to use proper In-Reply-To. +# to use proper In-Reply-To/References. # # This includes fixes from several open bugs for Mail::Thread # @@ -20,41 +20,57 @@ package PublicInbox::SearchThread; use strict; use warnings; - -sub new { - return bless { - messages => $_[1], - id_table => {}, - rootset => [] - }, $_[0]; -} +use PublicInbox::MID qw($MID_EXTRACT); sub thread { - my $self = shift; - _add_message($self, $_) foreach @{$self->{messages}}; - my $id_table = delete $self->{id_table}; - $self->{rootset} = [ grep { !delete $_->{parent} } values %$id_table ]; + my ($msgs, $ordersub, $ctx) = @_; + my $id_table = {}; + + # Sadly, we sort here anyways since the fill-in-the-blanks References: + # can be shakier if somebody used In-Reply-To with multiple, disparate + # messages. So, take the client Date: into account since we can't + # alway determine ordering when somebody uses multiple In-Reply-To. + # We'll trust the client Date: header here instead of the Received: + # time since this is for display (and not retrieval) + _add_message($id_table, $_) for sort { $a->{ds} <=> $b->{ds} } @$msgs; + my $ibx = $ctx->{-inbox}; + my $rootset = [ grep { + !delete($_->{parent}) && $_->visible($ibx) + } values %$id_table ]; + $id_table = undef; + $rootset = $ordersub->($rootset); + $_->order_children($ordersub, $ctx) for @$rootset; + $rootset; } sub _get_cont_for_id ($$) { - my ($self, $mid) = @_; - $self->{id_table}{$mid} ||= PublicInbox::SearchThread::Msg->new($mid); + my ($id_table, $mid) = @_; + $id_table->{$mid} ||= PublicInbox::SearchThread::Msg->new($mid); } sub _add_message ($$) { - my ($self, $smsg) = @_; + my ($id_table, $smsg) = @_; # A. if id_table... - my $this = _get_cont_for_id($self, $smsg->{mid}); + my $this = _get_cont_for_id($id_table, $smsg->{mid}); $this->{smsg} = $smsg; + # saves around 4K across 1K messages + # TODO: move this to a more appropriate place, breaks tests + # if we do it during psgi_cull + delete $smsg->{num}; + # B. For each element in the message's References field: defined(my $refs = $smsg->{references}) or return; + # This loop exists to help fill in gaps left from missing + # messages. It is not needed in a perfect world where + # everything is perfectly referenced, only the last ref + # matters. my $prev; - foreach my $ref ($refs =~ m/<([^>]+)>/g) { + foreach my $ref ($refs =~ m/$MID_EXTRACT/go) { # Find a Container object for the given Message-ID - my $cont = _get_cont_for_id($self, $ref); + my $cont = _get_cont_for_id($id_table, $ref); # Link the References field's Containers together in # the order implied by the References header @@ -73,19 +89,12 @@ sub _add_message ($$) { } # C. Set the parent of this message to be the last element in - # References... - if ($prev && !$this->has_descendent($prev)) { # would loop - $prev->add_child($this) + # References. + if (defined $prev && !$this->has_descendent($prev)) { # would loop + $prev->add_child($this); } } -sub order { - my ($self, $ordersub) = @_; - my $rootset = $ordersub->($self->{rootset}); - $self->{rootset} = $rootset; - $_->order_children($ordersub) for @$rootset; -} - package PublicInbox::SearchThread::Msg; use strict; use warnings; @@ -98,6 +107,16 @@ sub new { }, $_[0]; } +sub topmost { + my ($self) = @_; + my @q = ($self); + while (my $cont = shift @q) { + return $cont if $cont->{smsg}; + push @q, values %{$cont->{children}}; + } + undef; +} + sub add_child { my ($self, $child) = @_; croak "Cowardly refusing to become my own parent: $self" @@ -116,22 +135,33 @@ sub add_child { sub has_descendent { my ($self, $child) = @_; + my %seen; # loop prevention while ($child) { - return 1 if $self == $child; + return 1 if $self == $child || $seen{$child}++; $child = $child->{parent}; } 0; } +# Do not show/keep ghosts iff they have no children. Sometimes +# a ghost Message-ID is the result of a long header line +# being folded/mangled by a MUA, and not a missing message. +sub visible ($$) { + my ($self, $ibx) = @_; + ($self->{smsg} ||= eval { $ibx->smsg_by_mid($self->{id}) }) || + (scalar values %{$self->{children}}); +} + sub order_children { - my ($cur, $ordersub) = @_; + my ($cur, $ordersub, $ctx) = @_; - my %seen = ($cur => 1); + my %seen = ($cur => 1); # self-referential loop prevention my @q = ($cur); + my $ibx = $ctx->{-inbox}; while (defined($cur = shift @q)) { my $c = $cur->{children}; # The hashref here... - $c = [ grep { !$seen{$_}++ } values %$c ]; # spot/break loops + $c = [ grep { !$seen{$_}++ && visible($_, $ibx) } values %$c ]; $c = $ordersub->($c) if scalar @$c > 1; $cur->{children} = $c; # ...becomes an arrayref push @q, @$c;