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