tools/make_announce

   1 #!/usr/bin/perl -w
   2 #
   3 # Update the ANNOUNCE file for a new release.
   4 #
   5 # Usage: make_announce [new_version]
   6 #
   7 # Copyright 2016 Alexandre Julliard
   8 #
   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.
  13 #
  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.
  18 #
  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
  22 #
  23
  24 use strict;
  25 use locale;
  26 use POSIX;
  27 use Text::CSV::Encoded;
  28 use open ':encoding(utf8)';
  29
  30 sub unescape($)
  31 {
  32     my $str = shift;
  33     $str =~ s/&quot;/\"/g;
  34     $str =~ s/&apos;/\'/g;
  35     $str =~ s/&amp;/&/g;
  36     $str =~ s/&lt;/</g;
  37     $str =~ s/&gt;/>/g;
  38     $str =~ s/&#64;/\@/g;
  39     return $str;
  40 }
  41
  42 # update a file if changed
  43 sub update_file($)
  44 {
  45     my $file = shift;
  46     if (!(-f $file) || system "cmp $file $file.new >/dev/null")
  47     {
  48         rename "$file.new", "$file";
  49         print "$file updated\n";
  50     }
  51     else
  52     {
  53         unlink "$file.new";
  54     }
  55 }
  56
  57 # determine the current version number
  58 sub get_current_version()
  59 {
  60     my $version;
  61
  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;
  67 }
  68
  69 # retrieve a list of bugs with the specified filter
  70 sub get_bugs($)
  71 {
  72     my $filter = shift;
  73     my $csv = Text::CSV::Encoded->new({ encoding_in => "utf-8", encoding_out => "utf-8" });
  74     my %bugs;
  75
  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>)
  80     {
  81         next unless $csv->parse($_);
  82         my ($id, $descr) = $csv->fields();
  83         $bugs{$id} = $descr;
  84     }
  85     close QUERY;
  86     return %bugs;
  87 }
  88
  89 # retrieve the current list of authors
  90 sub get_authors()
  91 {
  92     my %authors;
  93
  94     open AUTHORS, "<AUTHORS" or die "cannot open AUTHORS";
  95     <AUTHORS>;  # skip header line
  96     while (<AUTHORS>)
  97     {
  98         chomp;
  99         next if /^$/;
 100         $authors{$_} = 1;
 101     }
 102     close AUTHORS;
 103     return %authors;
 104 }
 105
 106 # determine the version number
 107
 108 my $old = get_current_version();
 109 my $new = $ARGV[0];
 110 unless ($new)
 111 {
 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"; }
 116 }
 117
 118 print "Updating files for release $new\n";
 119
 120 my $reldir = $new;
 121 if ($reldir =~ /^([0-9]+\.0)/) { $reldir = $1; }
 122 elsif ($reldir =~ /^([0-9]+)\./) { $reldir = "$1.x"; }
 123 else { die "unknown version format $reldir"; }
 124
 125 my $is_stable = ($new =~ /^([0-9]+)\.0\.([0-9]+)$/);  # stable releases have a 0 minor number
 126 my $filter = "product=Wine&resolution=FIXED&" . ($is_stable ? "target_milestone=$reldir.x" : "bug_status=RESOLVED");
 127
 128 my %bugs = get_bugs( $filter );
 129 my %authors = get_authors();
 130
 131 # update the ANNOUNCE file
 132
 133 open ANNOUNCE, "<ANNOUNCE.md" or die "cannot open ANNOUNCE.md";
 134 open NEW, ">ANNOUNCE.md.new" or die "cannot create ANNOUNCE.md.new";
 135
 136 # replace version number in first line
 137 $_ = <ANNOUNCE>;
 138 s/(([0-9]+)\.)+[0-9]+(-rc[0-9]+)?/$new/;
 139 print NEW $_;
 140
 141 while (<ANNOUNCE>)
 142 {
 143     last if /^------------------/;
 144     s!(https://.*/wine/source/).*\.tar!$1$reldir/wine-$new.tar!;
 145     s/wine-(([0-9]+)\.)+[0-9]+(-rc[0-9]+)?/wine-$new/g;
 146     print NEW $_;
 147 }
 148 close ANNOUNCE;
 149
 150 print NEW "----------------------------------------------------------------\n\n";
 151 printf NEW "### Bugs fixed in %s (total %u):\n\n", $new, scalar( keys %bugs );
 152 foreach my $id (sort {$a <=> $b} keys %bugs)
 153 {
 154     printf NEW " - #%-6d %s\n", $id, unescape( $bugs{$id} );
 155 }
 156
 157 print NEW "\n### Changes since $old:\n```\n";
 158
 159 my @shortlog = ();
 160 open LOG, "-|" or exec "git", "shortlog", "wine-$old..HEAD" or die "cannot run git shortlog";
 161 while (<LOG>)
 162 {
 163     next if /^$/;
 164     if (/^(\S.*)\s\(\d+\):$/) { $authors{$1} = 1; push @shortlog, "\n" if @shortlog; }
 165     push @shortlog, $_;
 166 }
 167 close LOG;
 168 print NEW join("",@shortlog);
 169 print NEW "```\n";
 170 close NEW;
 171 update_file( "ANNOUNCE.md" );
 172
 173 # update the AUTHORS file
 174
 175 setlocale( LC_COLLATE, "en_US.UTF-8" );
 176
 177 open AUTHORS, ">AUTHORS.new" or die "cannot create AUTHORS.new";
 178 print AUTHORS "Wine is available thanks to the work of:\n\n", join( "\n", sort keys %authors ), "\n";
 179 close AUTHORS;
 180 update_file( "AUTHORS" );