Merge remote-tracking branch 'laptop/newcg' into newcg
[ghc.git] / distrib / remilestoning.pl
1 #!/usr/bin/perl
2
3 use strict;
4
5 use DBI;
6
7 # ===== Config:
8
9 my $dbfile = "trac.db";
10 my $milestone = "7.4.1";
11 my $test = 0;
12
13 # ===== Code:
14
15 my $dbh = DBI->connect("dbi:SQLite:dbname=$dbfile","","", {});
16
17 my %emailof;
18 my %ticketsfor;
19
20 sub getUserAddress {
21 my $sth = $dbh->prepare("SELECT sid, value FROM session_attribute WHERE name = 'email'");
22 $sth->execute();
23 while (my $result = $sth->fetchrow_hashref("NAME_lc")) {
24 my $username = $result->{sid};
25 my $email = $result->{value};
26 if (defined($emailof{$username})) {
27 die "Two e-mail addresses found for $username";
28 }
29 if ($email =~ /@/) {
30 $emailof{$username} = $email;
31 }
32 else {
33 # warn "The e-mail address $email for $username contains no @";
34 }
35 }
36 $sth->finish;
37 }
38
39 sub doTickets {
40 my $sth = $dbh->prepare("SELECT id, summary, reporter, cc FROM ticket WHERE milestone = ? AND status = 'new'");
41 $sth->execute($milestone);
42 while (my $result = $sth->fetchrow_hashref("NAME_lc")) {
43 my $ticket = $result->{id};
44 my $title = $result->{summary};
45 my $reporter = $result->{reporter};
46 my $cc = $result->{cc};
47 my %addresses;
48 my $address_added;
49 for my $who ($reporter, split /[ ,]+/, $cc) {
50 $address_added = 0;
51 if ($who =~ /@/) {
52 $addresses{$who} = 1;
53 $address_added = 1;
54 }
55 if (defined($emailof{$who})) {
56 $addresses{$emailof{$who}} = 1;
57 $address_added = 1;
58 }
59 if ($who ne "nobody" && $address_added eq 0) {
60 # warn "No address found for $who";
61 }
62 }
63 for my $address (keys(%addresses)) {
64 $ticketsfor{$address}{$ticket}{"title"} = $title;
65 }
66 }
67 $sth->finish;
68 }
69
70 sub doEmails {
71 for my $email (sort (keys %ticketsfor)) {
72 if ($test ne 0) {
73 open FH, ">&STDOUT";
74 }
75 else {
76 open(FH, '|-', 'mail', '-s', 'GHC bugs', '-a', 'From: glasgow-haskell-bugs@haskell.org', $email) or die "Running mail failed: $!";
77 }
78 print FH <<'EOF';
79
80 Hello,
81
82 You are receiving this mail because you are the reporter, or on the CC
83 list, for one or more GHC tickets that are automatically having their
84 priority reduced due to our post-release ticket handling policy:
85 http://hackage.haskell.org/trac/ghc/wiki/WorkingConventions/BugTracker#Remilestoningticketsafterarelease
86
87 The list of tickets for which you are the reporter or on the CC list is
88 given below. If any of these are causing problems for you, please let us
89 know on glasgow-haskell-bugs@haskell.org and we'll look at raising the
90 priority.
91
92 Better still, if you are able to make any progress on any of the tickets
93 yourself (whether that be actually fixing the bug, or just making it
94 easier for someone else to - for example, by making a small,
95 self-contained test-case), then that would be a great help. We at GHC HQ
96 have limited resources, so if anything is waiting for us to make
97 progress then it can be waiting a long time!
98 EOF
99 for my $ticket (sort {$a <=> $b} (keys %{$ticketsfor{$email}})) {
100 my $title = $ticketsfor{$email}{$ticket}{"title"};
101 print FH "\n";
102 print FH "#$ticket $title:\n";
103 print FH " http://hackage.haskell.org/trac/ghc/ticket/$ticket\n";
104 }
105 print FH <<'EOF';
106
107 --
108 The GHC Team
109 http://www.haskell.org/ghc/
110 EOF
111 close FH or die "Close failed: $!";
112 }
113 }
114
115 &getUserAddress();
116 &doTickets();
117 &doEmails();
118