Actually prune messages from bugs

We were recording the pruning in the database but not reflecting it when
displaying a bug.

Seen in bug #1 in the test suite and http://bugs.xenproject.org/xen/bug/36 in
real life. Add support to the test suite for validating the set of messages
which end up in a bug.

diff --git a/Emesinae/Bug.pm b/Emesinae/Bug.pm
index cfac17e995f4cf235ebf19029e29fa18df0cf5fc..94850bea38d95841fb1020c254c94f19b325ef66 100644 (file)
--- a/Emesinae/Bug.pm
+++ b/Emesinae/Bug.pm
@@ -252,10 +252,9 @@ sub messages {
         my $m = Emesinae::Message->lookup_id( $self->{dbh}, $msgid );
         die "lookup_id failed" unless $m;
 
-        #print "Subthread ".$m->{msgid}."\n";
         $m->subthread( $inc, \%refs );
     }
-    return map { $_->{Message} } values %refs;
+    return map { $_->{Message} } grep { $_->{Include} eq "true" } values %refs;
 }
 
 sub listall ($$;%) {

diff --git a/config/examples/test/check-bug-msgids.pl b/config/examples/test/check-bug-msgids.pl
new file mode 100755 (executable)
index 0000000..422ac23
--- /dev/null
+++ b/config/examples/test/check-bug-msgids.pl
@@ -0,0 +1,102 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use File::Path;
+use File::Temp qw();
+
+use Emesinae::Bug;
+use Emesinae::Common;
+
+readconfig;
+my $dbh = opendb;
+
+die unless @ARGV > 1;
+
+my $bugid = $ARGV[0];
+my $results = $ARGV[1];
+
+my %expected = (
+       Normal => [],
+       Pruned => [],
+       ControlReply => [],
+);
+
+open FD, "$results" or die "open results";
+while(<FD>) {
+       m/^(\w*)\s+(<\S+>)$/ or die "syntax error";
+
+       my ($kind, $msgid) = ($1,$2);
+       
+       push $expected{$kind}, $msgid;
+}
+close FD;
+
+my %actual;
+
+my $bug = Emesinae::Bug->new( $dbh, ID => $bugid );
+
+$actual{$_->{msgid}} = $_ foreach $bug->messages();
+
+my $result = 0;
+
+foreach ( @{$expected{Normal}} ) {
+       if ( $actual{$_} ) {
+               #print "Found expected message $_\n";
+               delete $actual{$_};
+       } else {
+               print "Expected message not found: $_\n";
+               $result++;
+       }
+}
+
+foreach ( @{ $expected{Pruned}} ) {
+       next unless $actual{$_};
+       print "Found message which should be pruned: $_\n";
+       $result++;
+       delete $actual{$_};
+}
+
+# At this point all thatshould remain in %actual is control replies.
+
+my %irt;
+
+# We generate control replies ourselves so they must have an In-Reply-To
+# header. Construct a lookup table.
+while ( my ($msgid,$msg) = each(%actual) ) {
+       my $tempdir = File::Temp::tempdir();
+       my $mime = $msg->get_mime($tempdir);
+       my $head = $mime->head;
+
+       $irt{$msgid} = $head->get('in-reply-to');
+       chomp($irt{$msgid});
+
+       rmtree $tempdir, 0, 1;
+}
+
+foreach my $cr ( @{ $expected{ControlReply} } ) {
+       my @msgs = grep { $irt{$_} eq $cr } keys %actual;
+
+       if ( @msgs > 1 ) {
+               # This is possible in real life, but does not (currently) occur
+               # within the test harness
+               print "Got unexpected number of control replies to: $cr\n";
+               $result++;
+       } elsif ( @msgs ) {
+               #print "Got expected reply to $cr in $msgs[0]\n";
+               delete $actual{$msgs[0]};
+       } else {
+               print "Missing ControlReply to: $cr\n";
+               $result++;
+       }
+}
+
+# At this point anything which remains is unexpected
+foreach ( keys %actual ) {
+       print "Unexpected message in results: $_\n";
+       $result++;
+}
+
+print "FAILED: $result errors\n" if $result;
+exit $result;

diff --git a/config/examples/test/results.bug.01.msgids b/config/examples/test/results.bug.01.msgids
new file mode 100644 (file)
index 0000000..22eb5b7
--- /dev/null
+++ b/config/examples/test/results.bug.01.msgids
@@ -0,0 +1,15 @@
+Normal         <control.1.test@emesinae.example.com>
+ControlReply   <control.1.test@emesinae.example.com>
+Normal         <6035A0D088A63A46850C3988ED045A4B299F74F8@BITCOM1.int.sbss.com.au>
+Normal         <20120905202927.GD27814@phenom.dumpdata.com>
+Normal         <6035A0D088A63A46850C3988ED045A4B29B5D23E@BITCOM1.int.sbss.com.au>
+Normal         <20120906105822.GB3668@phenom.dumpdata.com>
+Normal         <CAOzFzEiZopdFQuZkUcSWWre9b=NeZpJM9n2VtEoZcRo=ejYQPA@mail.gmail.com>
+Normal         <CC7B4CE4.3EE74%keir.xen@gmail.com>
+Normal         <CAOzFzEhh7pfpcq+0X-g7BXGAyNqgb8dZT4=Ys=Pmu1dFqH+46A@mail.gmail.com>
+Normal         <6035A0D088A63A46850C3988ED045A4B29B96FA1@BITCOM1.int.sbss.com.au>
+Normal         <CC7B740A.3EE89%keir.xen@gmail.com>
+Normal         <6035A0D088A63A46850C3988ED045A4B29B9806B@BITCOM1.int.sbss.com.au>
+Pruned         <20120916122704.4ea05b45@pyramind.ukuu.org.uk>
+Pruned         <6035A0D088A63A46850C3988ED045A4B29B980EB@BITCOM1.int.sbss.com.au>
+Pruned         <20120916170737.3c8f7e9e@pyramind.ukuu.org.uk>

diff --git a/config/examples/test/test.sh b/config/examples/test/test.sh
index c536a48ca922f8e6690af00cfa50489d8fb08aaa..086eac7186532e3124d60687136181b868639a73 100755 (executable)
--- a/config/examples/test/test.sh
+++ b/config/examples/test/test.sh
@@ -65,4 +65,11 @@ if [ "${mode}" = "test" -o "${mode}" = "both" ] ; then
     echo Queue run 2
     asuser env PERLLIB=$perllib TEST_SPOOL_CONTROL_REPLY=1 $libexec/queuerunner.pl
 
+    echo Checking results
+    for result in results.bug.*.msgids ; do
+       [[ $result =~ ^results.bug.([0-9]+).msgids ]]
+       bugnr=${BASH_REMATCH[1]}
+       asuser env PERLLIB=$perllib ./check-bug-msgids.pl $bugnr $result
+    done
+    echo Done $?
 fi