diff -Nur Mail-Thread-2.5/Thread.pm Mail-Thread-rjbs/Thread.pm
--- Mail-Thread-2.5/Thread.pm 2004-05-27 08:51:05.000000000 -0400
+++ Mail-Thread-rjbs/Thread.pm 2006-10-29 17:27:47.000000000 -0500
@@ -141,8 +141,7 @@
my $self = shift;
$self->_setup();
$self->{rootset} = [ grep { !$_->parent } values %{$self->{id_table}} ];
- delete $self->{id_table};
- delete $self->{seen};
+
unless ($noprune) {
my $fakeroot = $self->_container_class->new( 'fakeroot' );
$fakeroot->set_children( $self->rootset );
@@ -150,12 +149,17 @@
my @kids = @{$self->{rootset}} = $fakeroot->children;
$fakeroot->remove_child($_) for $fakeroot->children;
}
- delete $self->{seen};
+
$self->_group_set_bysubject() unless $nosubject;
$self->_finish();
}
-sub _finish { }
+sub _finish {
+ my $self = shift;
+ delete $self->{id_table};
+ delete $self->{seen};
+ delete $self->{seen};
+}
sub _get_cont_for_id {
my $self = shift;
@@ -179,67 +183,72 @@
# 1. For each message
for my $message (@{$self->{messages}}) {
- debug "\n\nLooking at ".$self->_msgid($message)."\n";
- # A. if id_table...
- my $this_container = $self->_get_cont_for_id($self->_msgid($message));
- $this_container->message($message);
- debug " [".$this_container->subject."]\n----\n";
-
- # B. For each element in the message's References field:
- my @refs = $self->_references($message);
- debug " Now looking at its references: @refs\n";
-
- my $prev;
- for my $ref (@refs) {
- debug " Looking at reference $ref\n";
- # Find a Container object for the given Message-ID
- my $container = $self->_get_cont_for_id($ref);
-
- # Link the References field's Containers together in the
- # order implied by the References header
- # * If they are already linked don't change the existing links
- # * Do not add a link if adding that link would introduce
- # a loop...
-
- if ($prev &&
- !$container->parent && # already linked
- !$container->has_descendent($prev) # would loop
- ) {
- $prev->add_child($container);
- }
- $prev = $container;
- }
+ $self->_add_message($message);
+ }
+
+ debug "\nThe final table:\n";
+ if ($Mail::Thread::debug) {
+ _dump( values %{$self->{id_table}} );
+ }
+}
+
+sub _add_message {
+ my ($self, $message) = @_;
+
+ debug "\n\nLooking at ".$self->_msgid($message)."\n";
+ # A. if id_table...
+ my $this_container = $self->_get_cont_for_id($self->_msgid($message));
+ $this_container->message($message);
+ debug " [".$this_container->subject."]\n----\n";
+
+ # B. For each element in the message's References field:
+ my @refs = $self->_references($message);
+ debug " Now looking at its references: @refs\n";
+
+ my $prev;
+ for my $ref (@refs) {
+ debug " Looking at reference $ref\n";
+ # Find a Container object for the given Message-ID
+ my $container = $self->_get_cont_for_id($ref);
+
+ # Link the References field's Containers together in the
+ # order implied by the References header
+ # * If they are already linked don't change the existing links
+ # * Do not add a link if adding that link would introduce
+ # a loop...
- # C. Set the parent of this message to be the last element in
- # References...
if ($prev &&
- !$this_container->has_descendent($prev) # would loop
+ !$container->parent && # already linked
+ !$container->has_descendent($prev) # would loop
) {
- $prev->add_child($this_container)
- }
-
- debug "Done with this message!\n----\n";
- if ($debug) {
- _dump( values %{$self->{id_table}} );
+ $prev->add_child($container);
}
+ $prev = $container;
+ }
- if (0) {
- # Note that at all times the various 'parent' and 'child'
- # fields must be kept inter-consistent
- for my $c (values %{ $self->{id_table} }) {
- if ($c->parent && !grep { $c == $_ } $c->parent->children) {
- die "$c dysfunctional!\n";
- }
- }
- }
+ # C. Set the parent of this message to be the last element in
+ # References...
+ if ($prev &&
+ !$this_container->has_descendent($prev) # would loop
+ ) {
+ $prev->add_child($this_container)
}
- debug "\nThe final table:\n";
- if ($Mail::Thread::debug) {
+ debug "Done with this message!\n----\n";
+ if ($debug) {
_dump( values %{$self->{id_table}} );
}
-}
+ if (0) {
+ # Note that at all times the various 'parent' and 'child'
+ # fields must be kept inter-consistent
+ for my $c (values %{ $self->{id_table} }) {
+ if ($c->parent && !grep { $c == $_ } $c->parent->children) {
+ die "$c dysfunctional!\n";
+ }
+ }
+ }
+}
sub _prune_empties {
my $self = shift;
diff -Nur Mail-Thread-2.5/t/2-1.t Mail-Thread-rjbs/t/2-1.t
--- Mail-Thread-2.5/t/2-1.t 1969-12-31 19:00:00.000000000 -0500
+++ Mail-Thread-rjbs/t/2-1.t 2006-10-29 17:29:16.000000000 -0500
@@ -0,0 +1,32 @@
+#!perl -w
+BEGIN { require 't/common.pl' }
+
+use Test::More 'no_plan';
+use_ok("Mail::Thread");
+
+{
+ package Mail::Thread::Open;
+ @Mail::Thread::Open::ISA = qw(Mail::Thread);
+ sub _finish { }
+}
+
+my @messages = slurp_messages('t/testbox-2');
+my $tail = pop @messages;
+my $threader = Mail::Thread::Open->new(@messages);
+
+my @stuff;
+$threader->thread;
+$threader->_add_message($tail);
+
+use Data::Dump::Streamer;
+
+is($threader->rootset, 1, "We have one main threads");
+
+dump_into($threader => \@stuff);
+# Dump(\@stuff);
+
+deeply(\@stuff, [
+ [ 0, "sort numbers", '20030101210258.63148.qmail@web20805.mail.yahoo.com' ],
+ [ 1, "Re: sort numbers", 'auvpjq$ede$1@post.home.lunix' ],
+ [ 1, "Re: sort numbers", 'r3i71vcul4g95orb58173qj6b8dus6pnch@4ax.com' ]
+ ]);
RT for rt.cpan.org