diff options
author | Jim Meyering <jim@meyering.net> | 2006-11-23 16:28:49 +0100 |
---|---|---|
committer | Jim Meyering <jim@meyering.net> | 2006-11-23 16:28:49 +0100 |
commit | d0275e280ebff8a0d18f7e57d765e0329dbf6a6c (patch) | |
tree | a9c85b4c11a8bbf8f90839eb2eeeac1c9642f8cf /announce-gen | |
parent | 37012effc9177d4446e3a63f836df371b602a302 (diff) | |
download | coreutils-d0275e280ebff8a0d18f7e57d765e0329dbf6a6c.tar.xz |
* announce-gen: Remove file. It's moving to gnulib.
* bootstrap: Pull it from gnulib/build-aux instead.
* Makefile.maint (announcement): Reflect move to ./build-aux.
Diffstat (limited to 'announce-gen')
-rwxr-xr-x | announce-gen | 435 |
1 files changed, 0 insertions, 435 deletions
diff --git a/announce-gen b/announce-gen deleted file mode 100755 index 96774d9f6..000000000 --- a/announce-gen +++ /dev/null @@ -1,435 +0,0 @@ -#!/usr/bin/perl -w -# Generate an announcement message. - -# 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. - -use strict; - -use Getopt::Long; -use Digest::MD5; -use Digest::SHA1; - -(my $VERSION = '$Revision: 1.25 $ ') =~ tr/[0-9].//cd; -(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 <<EOF; -Usage: $ME [OPTIONS] - -OPTIONS: - - Generate an announcement message. - - FIXME: describe the following - - --release-type=TYPE TYPE must be one of @types - --package-name=PACKAGE_NAME - --previous-version=VER - --current-version=VER - --gpg-key-id=ID The GnuPG ID of the key used to sign the tarballs - --url-directory=URL_DIR - --news=NEWS_FILE optional - - --help display this help and exit - --version output version information and exit - -EOF - } - exit $exit_code; -} - - -=item C<%size> = C<sizes (@file)> - -Compute the sizes of the C<@file> and return them as a hash. Return -C<undef> 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<print_locations ($title, \@url, \%size, @file) - -Print a section C<$title> 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<print_checksums (@file) - -Print the MD5 and SHA1 signature section for each C<@file>. - -=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<print_news_deltas ($news_file, $prev_version, $curr_version) - -Print the section of the NEWS file C<$news_file> 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 = <NEWS>)) - { - 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 = <DIFF>)) - { - 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"; -} - -{ - # 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; - - 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, - - 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 <<EOF; - -Subject: $my_distdir released - -<\#secure method=pgpmime mode=sign> - -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 <<EOF; - -[*] You can use either of the above signature files to verify that -the corresponding file (without the .sig suffix) is intact. First, -be sure to download both the .sig file and the corresponding tarball. -Then, run a command like this: - - gpg --verify $tgz.sig - -If that command fails because you don't have the required public key, -then run this command to import it: - - gpg --keyserver wwwkeys.pgp.net --recv-keys $gpg_key_id - -and rerun the \`gpg --verify' command. -EOF - - print_news_deltas ($_, $prev_version, $curr_version) - foreach @news_file; - - $release_type eq 'major' - or print_changelog_deltas ($package_name, $prev_version); - - exit 0; -} - - - -### Setup "GNU" style for perl-mode and cperl-mode. -## Local Variables: -## perl-indent-level: 2 -## perl-continued-statement-offset: 2 -## perl-continued-brace-offset: 0 -## perl-brace-offset: 0 -## perl-brace-imaginary-offset: 0 -## perl-label-offset: -2 -## cperl-indent-level: 2 -## cperl-brace-offset: 0 -## cperl-continued-brace-offset: 0 -## cperl-label-offset: -2 -## cperl-extra-newline-before-brace: t -## cperl-merge-trailing-else: nil -## cperl-continued-statement-offset: 2 -## End: |