t/11_blocks.t

   1 # -*- mode: cperl;-*-
   2
   3 use Test::More tests => 20;
   4
   5 use warnings;
   6 use strict;
   7
   8 # Here, we're going to shoot messages through a set of things that can
   9 # happen.
  10
  11 # First, we're going to send mesages to receive.
  12 # To do so, we'll first send a message to submit,
  13 # then send messages to the newly created bugnumber.
  14
  15 use IO::File;
  16 use File::Temp qw(tempdir);
  17 use Cwd qw(getcwd);
  18 use Debbugs::MIME qw(create_mime_message);
  19 use File::Basename qw(dirname basename);
  20 # The test functions are placed here to make things easier
  21 use lib qw(t/lib);
  22 use DebbugsTest qw(:all);
  23 use Data::Dumper;
  24 use Test::WWW::Mechanize;
  25
  26 # HTTP::Server:::Simple defines a SIG{CHLD} handler that breaks system; undef it here.
  27 $SIG{CHLD} = sub {};
  28 my %config;
  29 eval {
  30      %config = create_debbugs_configuration();
  31 };
  32 if ($@) {
  33      BAIL_OUT($@);
  34 }
  35
  36 my $sendmail_dir = $config{sendmail_dir};
  37 my $spool_dir = $config{spool_dir};
  38 my $config_dir = $config{config_dir};
  39
  40
  41
  42 # We're going to use create mime message to create these messages, and
  43 # then just send them to receive.
  44
  45 for my $bug (1..11) {
  46     send_message(to=>'submit@bugs.something',
  47                  headers => [To   => 'submit@bugs.something',
  48                              From => 'foo@bugs.something',
  49                              Subject => 'Submiting a bug '.$bug,
  50                             ],
  51                  body => <<EOF) or fail('Unable to send message');
  52 Package: foo
  53 Severity: normal
  54
  55 This is a silly bug $bug
  56 EOF
  57 }
  58
  59 # next, we check to see that (at least) the proper messages have been
  60 # sent out. 1) ack to submitter 2) mail to maintainer
  61
  62 # This keeps track of the previous size of the sendmail directory
  63 my $SD_SIZE = 0;
  64 $SD_SIZE =
  65     num_messages_sent($SD_SIZE,10,
  66                       $sendmail_dir,
  67                       'submit messages appear to have been sent out properly',
  68                      );
  69
  70
  71 # now send a message to the bug
  72
  73 send_message(to => '1@bugs.something',
  74              headers => [To   => '1@bugs.something',
  75                          From => 'foo@bugs.something',
  76                          Subject => 'Sending a message to a bug',
  77                         ],
  78              body => <<EOF) or fail('sending message to 1@bugs.someting failed');
  79 Package: foo
  80 Severity: normal
  81
  82 This is a silly bug
  83 EOF
  84
  85 $SD_SIZE =
  86     num_messages_sent($SD_SIZE,2,
  87                       $sendmail_dir,
  88                       '1@bugs.something messages appear to have been sent out properly');
  89
  90 # just check to see that control doesn't explode
  91 send_message(to => 'control@bugs.something',
  92              headers => [To   => 'control@bugs.something',
  93                          From => 'foo@bugs.something',
  94                          Subject => 'Munging a bug',
  95                         ],
  96              body => <<EOF) or fail 'message to control@bugs.something failed';
  97 block 10 with 2
  98 thanks
  99 EOF
 100
 101 # now we need to check to make sure the control message was processed without errors
 102 ok(system('sh','-c','find '.$sendmail_dir.q( -type f | xargs grep -q "Subject: Processed: Munging a bug")) == 0,
 103    'control@bugs.something message was parsed without errors');
 104 eval "use Debbugs::Status qw(read_bug writebug);";
 105 my $status = read_bug(bug=>10);
 106 ok($status->{blockedby} eq '2','bug 10 is blocked by 2 (and only 2)');
 107 $status = read_bug(bug=>2);
 108 ok($status->{blocks} eq '10','bug 2 blocks 10 (and only 10)');
 109
 110 send_message(to => 'control@bugs.something',
 111              headers => [To   => 'control@bugs.something',
 112                          From => 'foo@bugs.something',
 113                          Subject => 'Munging a bug',
 114                         ],
 115              body => <<EOF) or fail 'message to control@bugs.something failed';
 116 merge 3 4
 117 block 10 by 3
 118 thanks
 119 EOF
 120 ok(system('sh','-c','find '.$sendmail_dir.q( -type f | xargs grep -q "Subject: Processed: Munging a bug")) == 0,
 121    'control@bugs.something message was parsed without errors');
 122 $status = read_bug(bug=>10);
 123 ok(is_deeply([sort split /\ /,$status->{blockedby}],[qw(2 3 4)]),'bug 10 is blocked by exactly 2, 3, and 4');
 124 send_message(to => 'control@bugs.something',
 125              headers => [To   => 'control@bugs.something',
 126                          From => 'foo@bugs.something',
 127                          Subject => 'Munging a bug',
 128                         ],
 129              body => <<EOF) or fail 'message to control@bugs.something failed';
 130 unblock 10 with 2
 131 thanks
 132 EOF
 133
 134 ok(system('sh','-c','find '.$sendmail_dir.q( -type f | xargs grep -q "Subject: Processed: Munging a bug")) == 0,
 135    'control@bugs.something message was parsed without errors');
 136
 137 $status = read_bug(bug=>10);
 138 ok(is_deeply([sort split /\ /,$status->{blockedby}],[qw(3 4)]),'bug 10 is blocked by exactly 3 and 4');
 139 $status = read_bug(bug=>3);
 140 ok($status->{blocks} eq '10','bug 3 blocks exactly 10');
 141
 142 send_message(to => 'control@bugs.something',
 143              headers => [To   => 'control@bugs.something',
 144                          From => 'foo@bugs.something',
 145                          Subject => 'Munging a bug',
 146                         ],
 147              body => <<EOF) or fail 'message to control@bugs.something failed';
 148 block 3 with 5
 149 thanks
 150 EOF
 151 ok(system('sh','-c','find '.$sendmail_dir.q( -type f | xargs grep -q "Subject: Processed: Munging a bug")) == 0,
 152    'control@bugs.something message was parsed without errors');
 153
 154
 155 $status = read_bug(bug=>3);
 156 ok($status->{blockedby} eq '5','bug 3 is blocked by exactly 5');
 157
 158 # Check how this blocked bug is presented on the web interface
 159
 160 # start up an HTTP::Server::Simple
 161 my $bugreport_cgi_handler = sub {
 162      # I do not understand why this is necessary.
 163      $ENV{DEBBUGS_CONFIG_FILE} = "$config{config_dir}/debbugs_config";
 164      my $content = qx(perl -I. -T cgi/bugreport.cgi);
 165      $content =~ s/^\s*Content-Type:[^\n]+\n*//si;
 166      print $content;
 167 };
 168
 169 my $port = 11342;
 170
 171 ok(DebbugsTest::HTTPServer::fork_and_create_webserver($bugreport_cgi_handler,$port),
 172    'forked HTTP::Server::Simple successfully');
 173
 174 my $mech = Test::WWW::Mechanize->new();
 175
 176 $mech->get_ok('http://localhost:'.$port.'/?bug=10',
 177               'Page received ok');
 178
 179 ok($mech->content() =~ qr//i,
 180    'Title of bug is \'Submitting a bug\'');
 181
 182 ok($mech->content() =~ qr/Added blocking bug\(s\) of <a[^>]+10[^>]+>10<\/a>: <a[^>]+2[^>]+>2<\/a>/i,
 183    '\'Added blocking bug(s) of x: y\' received markup');
 184
 185 $mech->get_ok('http://localhost:'.$port.'/?bug=2',
 186               'Page received ok');
 187
 188 ok($mech->content() =~ qr/Added indication that bug <a[^>]+2[^>]+>2<\/a> blocks <a[^>]+10[^>]+>10<\/a>/i,
 189    '\'indication that bug x blocks y\' received markup');