kernel32/tests: Use todo_wine_if().
[wine.git] / tools / make_announce
blobc65f900ed77f9eb8f0a91e88bf452bef781de365
1 #!/usr/bin/perl -w
3 # Update the ANNOUNCE file for a new release.
5 # Usage: make_announce [new_version]
7 # Copyright 2016 Alexandre Julliard
9 # This library is free software; you can redistribute it and/or
10 # modify it under the terms of the GNU Lesser General Public
11 # License as published by the Free Software Foundation; either
12 # version 2.1 of the License, or (at your option) any later version.
14 # This library is distributed in the hope that it will be useful,
15 # but WITHOUT ANY WARRANTY; without even the implied warranty of
16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
17 # Lesser General Public License for more details.
19 # You should have received a copy of the GNU Lesser General Public
20 # License along with this library; if not, write to the Free Software
21 # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
24 use strict;
25 use locale;
26 use POSIX;
27 use Text::CSV::Encoded;
28 use open ':encoding(utf8)';
30 sub unescape($)
32 my $str = shift;
33 $str =~ s/"/\"/g;
34 $str =~ s/'/\'/g;
35 $str =~ s/&/&/g;
36 $str =~ s/&lt;/</g;
37 $str =~ s/&gt;/>/g;
38 $str =~ s/&#64;/\@/g;
39 return $str;
42 # update a file if changed
43 sub update_file($)
45 my $file = shift;
46 if (!(-f $file) || system "cmp $file $file.new >/dev/null")
48 rename "$file.new", "$file";
49 print "$file updated\n";
51 else
53 unlink "$file.new";
57 # determine the current version number
58 sub get_current_version()
60 my $version;
62 open VERSION, "<VERSION" or die "cannot open VERSION";
63 if (<VERSION> =~ /Wine version (\S+)/) { $version = $1; }
64 close VERSION;
65 die "failed to parse VERSION" unless $version;
66 return $version;
69 # retrieve a list of bugs with the specified filter
70 sub get_bugs($)
72 my $filter = shift;
73 my $csv = Text::CSV::Encoded->new({ encoding_in => "utf-8", encoding_out => "utf-8" });
74 my %bugs;
76 open QUERY, "-|" or exec "wget", "-qO-", "https://bugs.winehq.org/buglist.cgi?columnlist=short_desc&query_format=advanced&ctype=csv&$filter"
77 or die "cannot query bug list";
78 <QUERY>; # skip header line
79 while (<QUERY>)
81 next unless $csv->parse($_);
82 my ($id, $descr) = $csv->fields();
83 $bugs{$id} = $descr;
85 close QUERY;
86 return %bugs;
89 # retrieve the current list of authors
90 sub get_authors()
92 my %authors;
94 open AUTHORS, "<AUTHORS" or die "cannot open AUTHORS";
95 <AUTHORS>; # skip header line
96 while (<AUTHORS>)
98 chomp;
99 next if /^$/;
100 $authors{$_} = 1;
102 close AUTHORS;
103 return %authors;
106 # determine the version number
108 my $old = get_current_version();
109 my $new = $ARGV[0];
110 unless ($new)
112 if ($old =~ /^([0-9]+)\.([0-9]+)$/) { $new = "$1.$2.1"; }
113 elsif ($old =~ /^([0-9]+)\.([0-9]+)\.([0-9]+)$/) { $new = "$1.$2." . ($3 + 1); }
114 elsif ($old =~ /^([0-9]+)\.([0-9]+)-rc([0-9]+)$/) { $new = "$1.$2-rc" . ($3 + 1); }
115 else { die "unknown version format $old"; }
118 print "Updating files for release $new\n";
120 (my $reldir = $new) =~ s/^([0-9]+\.[0-9]+).*/$1/;
121 my $is_stable = ($new =~ /^([0-9]+)\.([0-9]+)\.([0-9]+)$/) && !($2 % 2); # stable releases have an even minor number
122 my $filter = "product=Wine&resolution=FIXED&" . ($is_stable ? "target_milestone=$reldir.x" : "bug_status=RESOLVED");
124 my %bugs = get_bugs( $filter );
125 my %authors = get_authors();
127 # update the ANNOUNCE file
129 open ANNOUNCE, "<ANNOUNCE" or die "cannot open ANNOUNCE";
130 open NEW, ">ANNOUNCE.new" or die "cannot create ANNOUNCE.new";
131 while (<ANNOUNCE>)
133 last if /^------------------/;
134 s!http://mirrors.ibiblio.org/wine/source/.*!http://mirrors.ibiblio.org/wine/source/$reldir/wine-$new.tar.bz2!;
135 s!http://dl.winehq.org/wine/source/.*!http://dl.winehq.org/wine/source/$reldir/wine-$new.tar.bz2!;
136 print NEW $_;
139 print NEW "----------------------------------------------------------------\n\n";
140 printf NEW "Bugs fixed in %s (total %u):\n\n", $new, scalar( keys %bugs );
141 foreach my $id (sort {$a <=> $b} keys %bugs)
143 printf NEW " %6d %s\n", $id, unescape( $bugs{$id} );
146 print NEW "\n----------------------------------------------------------------\n\n";
147 print NEW "Changes since $old:\n\n";
149 open LOG, "-|" or exec "git", "shortlog", "wine-$old..HEAD" or die "cannot run git shortlog";
150 while (<LOG>)
152 if (/^(\S.*)\s\(\d+\):$/) { $authors{$1} = 1; }
153 print NEW $_;
155 close LOG;
157 while (<ANNOUNCE>) { last if /^--$/; }
158 print NEW "--\n";
159 while (<ANNOUNCE>) { print NEW $_; }
161 close ANNOUNCE;
162 close NEW;
163 update_file( "ANNOUNCE" );
165 # update the AUTHORS file
167 setlocale( LC_COLLATE, "en_US.UTF-8" );
169 open AUTHORS, ">AUTHORS.new" or die "cannot create AUTHORS.new";
170 print AUTHORS "Wine is available thanks to the work of:\n\n", join( "\n", sort keys %authors ), "\n";
171 close AUTHORS;
172 update_file( "AUTHORS" );