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