Actually prune messages from bugs
[emesinae:emesinae.git] / config / examples / test / check-bug-msgids.pl
1 #!/usr/bin/perl
2
3 use strict;
4 use warnings;
5
6 use File::Path;
7 use File::Temp qw();
8
9 use Emesinae::Bug;
10 use Emesinae::Common;
11
12 readconfig;
13 my $dbh = opendb;
14
15 die unless @ARGV > 1;
16
17 my $bugid = $ARGV[0];
18 my $results = $ARGV[1];
19
20 my %expected = (
21         Normal => [],
22         Pruned => [],
23         ControlReply => [],
24 );
25
26 open FD, "$results" or die "open results";
27 while(<FD>) {
28         m/^(\w*)\s+(<\S+>)$/ or die "syntax error";
29
30         my ($kind, $msgid) = ($1,$2);
31         
32         push $expected{$kind}, $msgid;
33 }
34 close FD;
35
36 my %actual;
37
38 my $bug = Emesinae::Bug->new( $dbh, ID => $bugid );
39
40 $actual{$_->{msgid}} = $_ foreach $bug->messages();
41
42 my $result = 0;
43
44 foreach ( @{$expected{Normal}} ) {
45         if ( $actual{$_} ) {
46                 #print "Found expected message $_\n";
47                 delete $actual{$_};
48         } else {
49                 print "Expected message not found: $_\n";
50                 $result++;
51         }
52 }
53
54 foreach ( @{ $expected{Pruned}} ) {
55         next unless $actual{$_};
56         print "Found message which should be pruned: $_\n";
57         $result++;
58         delete $actual{$_};
59 }
60
61 # At this point all thatshould remain in %actual is control replies.
62
63 my %irt;
64
65 # We generate control replies ourselves so they must have an In-Reply-To
66 # header. Construct a lookup table.
67 while ( my ($msgid,$msg) = each(%actual) ) {
68         my $tempdir = File::Temp::tempdir();
69         my $mime = $msg->get_mime($tempdir);
70         my $head = $mime->head;
71
72         $irt{$msgid} = $head->get('in-reply-to');
73         chomp($irt{$msgid});
74
75         rmtree $tempdir, 0, 1;
76 }
77
78 foreach my $cr ( @{ $expected{ControlReply} } ) {
79         my @msgs = grep { $irt{$_} eq $cr } keys %actual;
80
81         if ( @msgs > 1 ) {
82                 # This is possible in real life, but does not (currently) occur
83                 # within the test harness
84                 print "Got unexpected number of control replies to: $cr\n";
85                 $result++;
86         } elsif ( @msgs ) {
87                 #print "Got expected reply to $cr in $msgs[0]\n";
88                 delete $actual{$msgs[0]};
89         } else {
90                 print "Missing ControlReply to: $cr\n";
91                 $result++;
92         }
93 }
94
95 # At this point anything which remains is unexpected
96 foreach ( keys %actual ) {
97         print "Unexpected message in results: $_\n";
98         $result++;
99 }
100
101 print "FAILED: $result errors\n" if $result;
102 exit $result;