From 19cc6c4a496c1666b29427e21b128baeeea0d341 Mon Sep 17 00:00:00 2001 From: Micah Cowan Date: Fri, 4 Sep 2009 00:37:14 -0700 Subject: [PATCH] announce-gen. --- ChangeLog | 3 +- announce-gen | 497 +++++++++++++++++++++++++++++++++++++++++++++ lib/Makefile.am | 9 +- m4/gnulib-cache.m4 | 3 +- m4/gnulib-comp.m4 | 1 + 5 files changed, 510 insertions(+), 3 deletions(-) create mode 100755 announce-gen diff --git a/ChangeLog b/ChangeLog index 5da461b5..4ebb5f3d 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,9 +1,10 @@ 2009-09-04 Micah Cowan + * announce-gen: Imported from gnulib. * update-copyright: Imported from gnulib. * gnupload: Imported from gnulib. * lib/Makefile.am, m4/gnulib-cache.m4, m4/gnulib-comp.m4: Adjusted - for update-copyright and gnupload. + for announce-gen, update-copyright, and gnupload. 2009-09-03 Micah Cowan diff --git a/announce-gen b/announce-gen new file mode 100755 index 00000000..df08fd96 --- /dev/null +++ b/announce-gen @@ -0,0 +1,497 @@ +#!/usr/bin/perl -w +# Generate a release announcement message. + +my $VERSION = '2009-09-01 06:47'; # UTC +# The definition above must lie within the first 8 lines in order +# for the Emacs time-stamp write hook (at end) to update it. +# If you change this file with Emacs, please let the write hook +# do its job. Otherwise, update this string manually. + +# Copyright (C) 2002-2009 Free Software Foundation, Inc. + +# This program is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. + +# This program 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 General Public License for more details. + +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +# Written by Jim Meyering + +use strict; + +use Getopt::Long; +use Digest::MD5; +use Digest::SHA1; +use POSIX qw(strftime); + +(my $ME = $0) =~ s|.*/||; + +my %valid_release_types = map {$_ => 1} qw (alpha beta major); +my @archive_suffixes = ('tar.gz', 'tar.bz2', 'tar.lzma', 'tar.xz'); + +sub usage ($) +{ + my ($exit_code) = @_; + my $STREAM = ($exit_code == 0 ? *STDOUT : *STDERR); + if ($exit_code != 0) + { + print $STREAM "Try `$ME --help' for more information.\n"; + } + else + { + my @types = sort keys %valid_release_types; + print $STREAM < = C + +Compute the sizes of the C<@file> and return them as a hash. Return +C if one of the computation failed. + +=cut + +sub sizes (@) +{ + my (@file) = @_; + + my $fail = 0; + my %res; + foreach my $f (@file) + { + my $cmd = "du --human $f"; + my $t = `$cmd`; + # FIXME-someday: give a better diagnostic, a la $PROCESS_STATUS + $@ + and (warn "$ME: command failed: `$cmd'\n"), $fail = 1; + chomp $t; + $t =~ s/^([\d.]+[MkK]).*/${1}B/; + $res{$f} = $t; + } + return $fail ? undef : %res; +} + +=item C dedicated to the list of <@file>, which +sizes are stored in C<%size>, and which are available from the C<@url>. + +=cut + +sub print_locations ($\@\%@) +{ + my ($title, $url, $size, @file) = @_; + print "Here are the $title:\n"; + foreach my $url (@{$url}) + { + for my $file (@file) + { + print " $url/$file"; + print " (", $$size{$file}, ")" + if exists $$size{$file}; + print "\n"; + } + } + print "\n"; +} + +=item C. + +=cut + +sub print_checksums (@) +{ + my (@file) = @_; + + print "Here are the MD5 and SHA1 checksums:\n"; + print "\n"; + + foreach my $meth (qw (md5 sha1)) + { + foreach my $f (@file) + { + open IN, '<', $f + or die "$ME: $f: cannot open for reading: $!\n"; + binmode IN; + my $dig = + ($meth eq 'md5' + ? Digest::MD5->new->addfile(*IN)->hexdigest + : Digest::SHA1->new->addfile(*IN)->hexdigest); + close IN; + print "$dig $f\n"; + } + } + print "\n"; +} + +=item C addressing changes +between versions C<$prev_version> and C<$curr_version>. + +=cut + +sub print_news_deltas ($$$) +{ + my ($news_file, $prev_version, $curr_version) = @_; + + print "\n$news_file\n\n"; + + # Print all lines from $news_file, starting with the first one + # that mentions $curr_version up to but not including + # the first occurrence of $prev_version. + my $in_items; + + my $re_prefix = qr/(?:\* )?(?:Noteworthy c|Major c|C)(?i:hanges)/; + + open NEWS, '<', $news_file + or die "$ME: $news_file: cannot open for reading: $!\n"; + while (defined (my $line = )) + { + if ( ! $in_items) + { + # Match lines like these: + # * Major changes in release 5.0.1: + # * Noteworthy changes in release 6.6 (2006-11-22) [stable] + $line =~ /^$re_prefix.*(?:[^\d.]|$)\Q$curr_version\E(?:[^\d.]|$)/o + or next; + $in_items = 1; + print $line; + } + else + { + # This regexp must not match version numbers in NEWS items. + # For example, they might well say `introduced in 4.5.5', + # and we don't want that to match. + $line =~ /^$re_prefix.*(?:[^\d.]|$)\Q$prev_version\E(?:[^\d.]|$)/o + and last; + print $line; + } + } + close NEWS; + + $in_items + or die "$ME: $news_file: no matching lines for `$curr_version'\n"; +} + +sub print_changelog_deltas ($$) +{ + my ($package_name, $prev_version) = @_; + + # Print new ChangeLog entries. + + # First find all CVS-controlled ChangeLog files. + use File::Find; + my @changelog; + find ({wanted => sub {$_ eq 'ChangeLog' && -d 'CVS' + and push @changelog, $File::Find::name}}, + '.'); + + # If there are no ChangeLog files, we're done. + @changelog + or return; + my %changelog = map {$_ => 1} @changelog; + + # Reorder the list of files so that if there are ChangeLog + # files in the specified directories, they're listed first, + # in this order: + my @dir = qw ( . src lib m4 config doc ); + + # A typical @changelog array might look like this: + # ./ChangeLog + # ./po/ChangeLog + # ./m4/ChangeLog + # ./lib/ChangeLog + # ./doc/ChangeLog + # ./config/ChangeLog + my @reordered; + foreach my $d (@dir) + { + my $dot_slash = $d eq '.' ? $d : "./$d"; + my $target = "$dot_slash/ChangeLog"; + delete $changelog{$target} + and push @reordered, $target; + } + + # Append any remaining ChangeLog files. + push @reordered, sort keys %changelog; + + # Remove leading `./'. + @reordered = map { s!^\./!!; $_ } @reordered; + + print "\nChangeLog entries:\n\n"; + # print join ("\n", @reordered), "\n"; + + $prev_version =~ s/\./_/g; + my $prev_cvs_tag = "\U$package_name\E-$prev_version"; + + my $cmd = "cvs -n diff -u -r$prev_cvs_tag -rHEAD @reordered"; + open DIFF, '-|', $cmd + or die "$ME: cannot run `$cmd': $!\n"; + # Print two types of lines, making minor changes: + # Lines starting with `+++ ', e.g., + # +++ ChangeLog 22 Feb 2003 16:52:51 -0000 1.247 + # and those starting with `+'. + # Don't print the others. + my $prev_printed_line_empty = 1; + while (defined (my $line = )) + { + if ($line =~ /^\+\+\+ /) + { + my $separator = "*"x70 ."\n"; + $line =~ s///; + $line =~ s/\s.*//; + $prev_printed_line_empty + or print "\n"; + print $separator, $line, $separator; + } + elsif ($line =~ /^\+/) + { + $line =~ s///; + print $line; + $prev_printed_line_empty = ($line =~ /^$/); + } + } + close DIFF; + + # The exit code should be 1. + # Allow in case there are no modified ChangeLog entries. + $? == 256 || $? == 128 + or warn "$ME: warning: `cmd' had unexpected exit code or signal ($?)\n"; +} + +sub get_tool_versions ($$) +{ + my ($tool_list, $gnulib_version) = @_; + @$tool_list + or return (); + + my $fail; + my @tool_version_pair; + foreach my $t (@$tool_list) + { + if ($t eq 'gnulib') + { + push @tool_version_pair, ucfirst $t . ' ' . $gnulib_version; + next; + } + # Assume that the last "word" on the first line of + # `tool --version` output is the version string. + my ($first_line, undef) = split ("\n", `$t --version`); + if ($first_line =~ /.* (\d[\w.-]+)$/) + { + $t = ucfirst $t; + push @tool_version_pair, "$t $1"; + } + else + { + defined $first_line + and $first_line = ''; + warn "$ME: $t: unexpected --version output\n:$first_line"; + $fail = 1; + } + } + + $fail + and exit 1; + + return @tool_version_pair; +} + +{ + # Neutralize the locale, so that, for instance, "du" does not + # issue "1,2" instead of "1.2", what confuses our regexps. + $ENV{LC_ALL} = "C"; + + my $release_type; + my $package_name; + my $prev_version; + my $curr_version; + my $gpg_key_id; + my @url_dir_list; + my @news_file; + my $bootstrap_tools; + my $gnulib_version; + my $print_checksums_p = 1; + + GetOptions + ( + 'release-type=s' => \$release_type, + 'package-name=s' => \$package_name, + 'previous-version=s' => \$prev_version, + 'current-version=s' => \$curr_version, + 'gpg-key-id=s' => \$gpg_key_id, + 'url-directory=s' => \@url_dir_list, + 'news=s' => \@news_file, + 'bootstrap-tools=s' => \$bootstrap_tools, + 'gnulib-version=s' => \$gnulib_version, + 'print-checksums!' => \$print_checksums_p, + 'archive-suffix=s' => \@archive_suffixes, + + help => sub { usage 0 }, + version => sub { print "$ME version $VERSION\n"; exit }, + ) or usage 1; + + my $fail = 0; + # Ensure that sure each required option is specified. + $release_type + or (warn "$ME: release type not specified\n"), $fail = 1; + $package_name + or (warn "$ME: package name not specified\n"), $fail = 1; + $prev_version + or (warn "$ME: previous version string not specified\n"), $fail = 1; + $curr_version + or (warn "$ME: current version string not specified\n"), $fail = 1; + $gpg_key_id + or (warn "$ME: GnuPG key ID not specified\n"), $fail = 1; + @url_dir_list + or (warn "$ME: URL directory name(s) not specified\n"), $fail = 1; + + my @tool_list = split ',', $bootstrap_tools; + + grep (/^gnulib$/, @tool_list) ^ defined $gnulib_version + and (warn "$ME: when specifying gnulib as a tool, you must also specify\n" + . "--gnulib-version=V, where V is the result of running git describe\n" + . "in the gnulib source directory.\n"), $fail = 1; + + exists $valid_release_types{$release_type} + or (warn "$ME: `$release_type': invalid release type\n"), $fail = 1; + + @ARGV + and (warn "$ME: too many arguments:\n", join ("\n", @ARGV), "\n"), + $fail = 1; + $fail + and usage 1; + + my $my_distdir = "$package_name-$curr_version"; + + my $xd = "$package_name-$prev_version-$curr_version.xdelta"; + + my @candidates = map { "$my_distdir.$_" } @archive_suffixes; + my @tarballs = grep {-f $_} @candidates; + + @tarballs + or die "$ME: none of " . join(', ', @candidates) . " were found\n"; + my @sizable = @tarballs; + -f $xd + and push @sizable, $xd; + my %size = sizes (@sizable); + %size + or exit 1; + + # The markup is escaped as <\# so that when this script is sent by + # mail (or part of a diff), Gnus is not triggered. + print < + +FIXME: put comments here + +EOF + + print_locations ("compressed sources", @url_dir_list, %size, @tarballs); + -f $xd + and print_locations ("xdelta diffs (useful? if so, " + . "please tell bug-gnulib\@gnu.org)", + @url_dir_list, %size, $xd); + my @sig_files = map { "$_.sig" } @tarballs; + print_locations ("GPG detached signatures[*]", @url_dir_list, %size, + @sig_files); + + $print_checksums_p + and print_checksums (@sizable); + + print <