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(debug => exists $ENV{DEBUG}?$ENV{DEBUG}:0);
  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 END{
  41      if ($ENV{DEBUG}) {
  42           diag("spool_dir:   $spool_dir\n");
  43           diag("config_dir:   $config_dir\n");
  44           diag("sendmail_dir: $sendmail_dir\n");
  45      }
  46 }
  47
  48 # We're going to use create mime message to create these messages, and
  49 # then just send them to receive.
  50
  51 for my $bug (1..11) {
  52     send_message(to=>'submit@bugs.something',
  53                  headers => [To   => 'submit@bugs.something',
  54                              From => 'foo@bugs.something',
  55                              Subject => 'Submiting a bug '.$bug,
  56                             ],
  57                  body => <<EOF) or fail('Unable to send message');
  58 Package: foo
  59 Severity: normal
  60
  61 This is a silly bug $bug
  62 EOF
  63 }
  64
  65 # next, we check to see that (at least) the proper messages have been
  66 # sent out. 1) ack to submitter 2) mail to maintainer
  67
  68 # This keeps track of the previous size of the sendmail directory
  69 my $SD_SIZE = 0;
  70 $SD_SIZE =
  71     num_messages_sent($SD_SIZE,10,
  72                       $sendmail_dir,
  73                       'submit messages appear to have been sent out properly',
  74                      );
  75
  76
  77 # now send a message to the bug
  78
  79 send_message(to => '1@bugs.something',
  80              headers => [To   => '1@bugs.something',
  81                          From => 'foo@bugs.something',
  82                          Subject => 'Sending a message to a bug',
  83                         ],
  84              body => <<EOF) or fail('sending message to 1@bugs.someting failed');
  85 Package: foo
  86 Severity: normal
  87
  88 This is a silly bug
  89 EOF
  90
  91 $SD_SIZE =
  92     num_messages_sent($SD_SIZE,2,
  93                       $sendmail_dir,
  94                       '1@bugs.something messages appear to have been sent out properly');
  95
  96 # just check to see that control doesn't explode
  97 send_message(to => 'control@bugs.something',
  98              headers => [To   => 'control@bugs.something',
  99                          From => 'foo@bugs.something',
 100                          Subject => 'Munging a bug',
 101                         ],
 102              body => <<EOF) or fail 'message to control@bugs.something failed';
 103 block 10 with 2
 104 thanks
 105 EOF
 106
 107 # now we need to check to make sure the control message was processed without errors
 108 ok(system('sh','-c','find '.$sendmail_dir.q( -type f | xargs grep -q "Subject: Processed: Munging a bug")) == 0,
 109    'control@bugs.something message was parsed without errors');
 110 eval "use Debbugs::Status qw(read_bug writebug);";
 111 my $status = read_bug(bug=>10);
 112 ok($status->{blockedby} eq '2','bug 10 is blocked by 2 (and only 2)');
 113 $status = read_bug(bug=>2);
 114 ok($status->{blocks} eq '10','bug 2 blocks 10 (and only 10)');
 115
 116 send_message(to => 'control@bugs.something',
 117              headers => [To   => 'control@bugs.something',
 118                          From => 'foo@bugs.something',
 119                          Subject => 'Munging a bug',
 120                         ],
 121              body => <<EOF) or fail 'message to control@bugs.something failed';
 122 merge 3 4
 123 block 10 by 3
 124 thanks
 125 EOF
 126 ok(system('sh','-c','find '.$sendmail_dir.q( -type f | xargs grep -q "Subject: Processed: Munging a bug")) == 0,
 127    'control@bugs.something message was parsed without errors');
 128 $status = read_bug(bug=>10);
 129 ok(is_deeply([sort split /\ /,$status->{blockedby}],[qw(2 3 4)]),'bug 10 is blocked by exactly 2, 3, and 4');
 130 send_message(to => 'control@bugs.something',
 131              headers => [To   => 'control@bugs.something',
 132                          From => 'foo@bugs.something',
 133                          Subject => 'Munging a bug',
 134                         ],
 135              body => <<EOF) or fail 'message to control@bugs.something failed';
 136 unblock 10 with 2
 137 thanks
 138 EOF
 139
 140 ok(system('sh','-c','find '.$sendmail_dir.q( -type f | xargs grep -q "Subject: Processed: Munging a bug")) == 0,
 141    'control@bugs.something message was parsed without errors');
 142
 143 $status = read_bug(bug=>10);
 144 ok(is_deeply([sort split /\ /,$status->{blockedby}],[qw(3 4)]),'bug 10 is blocked by exactly 3 and 4');
 145 $status = read_bug(bug=>3);
 146 ok($status->{blocks} eq '10','bug 3 blocks exactly 10');
 147
 148 send_message(to => 'control@bugs.something',
 149              headers => [To   => 'control@bugs.something',
 150                          From => 'foo@bugs.something',
 151                          Subject => 'Munging a bug',
 152                         ],
 153              body => <<EOF) or fail 'message to control@bugs.something failed';
 154 block 3 with 5
 155 thanks
 156 EOF
 157 ok(system('sh','-c','find '.$sendmail_dir.q( -type f | xargs grep -q "Subject: Processed: Munging a bug")) == 0,
 158    'control@bugs.something message was parsed without errors');
 159
 160
 161 $status = read_bug(bug=>3);
 162 ok($status->{blockedby} eq '5','bug 3 is blocked by exactly 5');
 163
 164 # Check how this blocked bug is presented on the web interface
 165
 166 # start up an HTTP::Server::Simple
 167 my $bugreport_cgi_handler = sub {
 168      # I do not understand why this is necessary.
 169      $ENV{DEBBUGS_CONFIG_FILE} = "$config{config_dir}/debbugs_config";
 170      my $content = qx(perl -I. -T cgi/bugreport.cgi);
 171      $content =~ s/^\s*Content-Type:[^\n]+\n*//si;
 172      print $content;
 173 };
 174
 175 my $port = 11342;
 176
 177 ok(DebbugsTest::HTTPServer::fork_and_create_webserver($bugreport_cgi_handler,$port),
 178    'forked HTTP::Server::Simple successfully');
 179
 180 my $mech = Test::WWW::Mechanize->new();
 181
 182 $mech->get_ok('http://localhost:'.$port.'/?bug=10',
 183               'Page received ok');
 184
 185 ok($mech->content() =~ qr//i,
 186    'Title of bug is \'Submitting a bug\'');
 187
 188 ok($mech->content() =~ qr/Added blocking bug\(s\) of <a[^>]+10[^>]+>10<\/a>: <a[^>]+2[^>]+>2<\/a>/i,
 189    '\'Added blocking bug(s) of x: y\' received markup');
 190
 191 $mech->get_ok('http://localhost:'.$port.'/?bug=2',
 192               'Page received ok');
 193
 194 ok($mech->content() =~ qr/Added indication that bug <a[^>]+2[^>]+>2<\/a> blocks <a[^>]+10[^>]+>10<\/a>/i,
 195    '\'indication that bug x blocks y\' received markup');