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;