From f239b1fb67970b50d1a4567a6e78676c91c4084c Mon Sep 17 00:00:00 2001 From: Simon Josefsson Date: Thu, 28 Dec 2006 18:13:07 +0000 Subject: [PATCH] Add. --- announce-gen | 508 ++++++++++++++++++++++++++++++++++++++++++++++++++ gl/Makefile.am | 2 +- gl/m4/gnulib-cache.m4 | 4 +- gl/m4/gnulib-comp.m4 | 1 + 4 files changed, 512 insertions(+), 3 deletions(-) create mode 100755 announce-gen diff --git a/announce-gen b/announce-gen new file mode 100755 index 0000000..1f87bc2 --- /dev/null +++ b/announce-gen @@ -0,0 +1,508 @@ +#!/usr/bin/perl -w +# Generate a release announcement message. + +my $VERSION = '2006-12-08 17:35'; # 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, 2003, 2004, 2005, 2006 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 2, 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, write to the Free Software Foundation, +# Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. + +# 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); + +END +{ + # Nobody ever checks the status of print()s. That's okay, because + # if any do fail, we're guaranteed to get an indicator when we close() + # the filehandle. + # + # Close stdout now, and if there were no errors, return happy status. + # If stdout has already been closed by the script, though, do nothing. + defined fileno STDOUT + or return; + close STDOUT + and return; + + # Errors closing stdout. Indicate that, and hope stderr is OK. + warn "$ME: closing standard output: $!\n"; + + # Don't be so arrogant as to assume that we're the first END handler + # defined, and thus the last one invoked. There may be others yet + # to come. $? will be passed on to them, and to the final _exit(). + # + # If it isn't already an error, make it one (and if it _is_ an error, + # preserve the value: it might be important). + $? ||= 1; +} + +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"; + } + } + + +} + +=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|Major) change/; + + 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 ($bootstrap_tools, $gnulib_snapshot_timestamp) = @_; + defined $bootstrap_tools + or return (); + + defined $gnulib_snapshot_timestamp + or $gnulib_snapshot_timestamp = strftime '%Y-%m-%d %T UTC', gmtime; + + my $fail; + my @tool_list = split ',', $bootstrap_tools; + my @tool_version_pair; + foreach my $t (@tool_list) + { + if ($t eq 'gnulib') + { + push @tool_version_pair, + "CVS Gnulib sources from $gnulib_snapshot_timestamp"; + 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_snapshot_timestamp; + + 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-snapshot-time-stamp=s' => \$gnulib_snapshot_timestamp, + + 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; + + 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"), $fail = 1; + $fail + and usage 1; + + my $my_distdir = "$package_name-$curr_version"; + my $tgz = "$my_distdir.tar.gz"; + my $tbz = "$my_distdir.tar.bz2"; + my $xd = "$package_name-$prev_version-$curr_version.xdelta"; + + my %size = sizes ($tgz, $tbz, $xd); + %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, + $tgz, $tbz); + print_locations ("xdelta-style diffs", @url_dir_list, %size, + $xd); + print_locations ("GPG detached signatures[*]", @url_dir_list, %size, + "$tgz.sig", "$tbz.sig"); + + print_checksums ($tgz, $tbz, $xd); + + print <