wine/tools/make_announce
2024-01-03 16:35:29 +01:00

180 lines
4.9 KiB
Perl
Executable file

#!/usr/bin/perl -w
#
# Update the ANNOUNCE file for a new release.
#
# Usage: make_announce [new_version]
#
# Copyright 2016 Alexandre Julliard
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Lesser General Public
# License as published by the Free Software Foundation; either
# version 2.1 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# Lesser General Public License for more details.
#
# You should have received a copy of the GNU Lesser General Public
# License along with this library; if not, write to the Free Software
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
#
use strict;
use locale;
use POSIX;
use Text::CSV::Encoded;
use open ':encoding(utf8)';
sub unescape($)
{
my $str = shift;
$str =~ s/"/\"/g;
$str =~ s/'/\'/g;
$str =~ s/&/&/g;
$str =~ s/&lt;/</g;
$str =~ s/&gt;/>/g;
$str =~ s/&#64;/\@/g;
return $str;
}
# update a file if changed
sub update_file($)
{
my $file = shift;
if (!(-f $file) || system "cmp $file $file.new >/dev/null")
{
rename "$file.new", "$file";
print "$file updated\n";
}
else
{
unlink "$file.new";
}
}
# determine the current version number
sub get_current_version()
{
my $version;
open VERSION, "<VERSION" or die "cannot open VERSION";
if (<VERSION> =~ /Wine version (\S+)/) { $version = $1; }
close VERSION;
die "failed to parse VERSION" unless $version;
return $version;
}
# retrieve a list of bugs with the specified filter
sub get_bugs($)
{
my $filter = shift;
my $csv = Text::CSV::Encoded->new({ encoding_in => "utf-8", encoding_out => "utf-8" });
my %bugs;
open QUERY, "-|" or exec "wget", "-qO-", "https://bugs.winehq.org/buglist.cgi?columnlist=short_desc&query_format=advanced&ctype=csv&$filter"
or die "cannot query bug list";
<QUERY>; # skip header line
while (<QUERY>)
{
next unless $csv->parse($_);
my ($id, $descr) = $csv->fields();
$bugs{$id} = $descr;
}
close QUERY;
return %bugs;
}
# retrieve the current list of authors
sub get_authors()
{
my %authors;
open AUTHORS, "<AUTHORS" or die "cannot open AUTHORS";
<AUTHORS>; # skip header line
while (<AUTHORS>)
{
chomp;
next if /^$/;
$authors{$_} = 1;
}
close AUTHORS;
return %authors;
}
# determine the version number
my $old = get_current_version();
my $new = $ARGV[0];
unless ($new)
{
if ($old =~ /^([0-9]+)\.([0-9]+)$/) { $new = "$1." . ($2 + 1); }
elsif ($old =~ /^([0-9]+)\.([0-9]+)\.([0-9]+)$/) { $new = "$1.$2." . ($3 + 1); }
elsif ($old =~ /^([0-9]+)\.([0-9]+)-rc([0-9]+)$/) { $new = "$1.$2-rc" . ($3 + 1); }
else { die "unknown version format $old"; }
}
print "Updating files for release $new\n";
my $reldir = $new;
if ($reldir =~ /^([0-9]+\.0)/) { $reldir = $1; }
elsif ($reldir =~ /^([0-9]+)\./) { $reldir = "$1.x"; }
else { die "unknown version format $reldir"; }
my $is_stable = ($new =~ /^([0-9]+)\.0\.([0-9]+)$/); # stable releases have a 0 minor number
my $filter = "product=Wine&resolution=FIXED&" . ($is_stable ? "target_milestone=$reldir.x" : "bug_status=RESOLVED");
my %bugs = get_bugs( $filter );
my %authors = get_authors();
# update the ANNOUNCE file
open ANNOUNCE, "<ANNOUNCE.md" or die "cannot open ANNOUNCE.md";
open NEW, ">ANNOUNCE.md.new" or die "cannot create ANNOUNCE.md.new";
# replace version number in first line
$_ = <ANNOUNCE>;
s/(([0-9]+)\.)+[0-9]+(-rc[0-9]+)?/$new/;
print NEW $_;
while (<ANNOUNCE>)
{
last if /^------------------/;
s!(https://.*/wine/source/).*\.tar!$1$reldir/wine-$new.tar!;
s/wine-(([0-9]+)\.)+[0-9]+(-rc[0-9]+)?/wine-$new/g;
print NEW $_;
}
close ANNOUNCE;
print NEW "----------------------------------------------------------------\n\n";
printf NEW "### Bugs fixed in %s (total %u):\n\n", $new, scalar( keys %bugs );
foreach my $id (sort {$a <=> $b} keys %bugs)
{
printf NEW " - #%-6d %s\n", $id, unescape( $bugs{$id} );
}
print NEW "\n### Changes since $old:\n```\n";
my @shortlog = ();
open LOG, "-|" or exec "git", "shortlog", "wine-$old..HEAD" or die "cannot run git shortlog";
while (<LOG>)
{
next if /^$/;
if (/^(\S.*)\s\(\d+\):$/) { $authors{$1} = 1; push @shortlog, "\n" if @shortlog; }
push @shortlog, $_;
}
close LOG;
print NEW join("",@shortlog);
print NEW "```\n";
close NEW;
update_file( "ANNOUNCE.md" );
# update the AUTHORS file
setlocale( LC_COLLATE, "en_US.UTF-8" );
open AUTHORS, ">AUTHORS.new" or die "cannot create AUTHORS.new";
print AUTHORS "Wine is available thanks to the work of:\n\n", join( "\n", sort keys %authors ), "\n";
close AUTHORS;
update_file( "AUTHORS" );