X-Git-Url: http://erislabs.net/gitweb/?a=blobdiff_plain;f=build-aux%2Fannounce-gen;h=0eb6b5b6e77860ce63d728bfc0bc73b67679ab4e;hb=ee595ffa35986a68e78718000cc31cfd971c319c;hp=385ce8c3c0c3d03be48b9029e91ab06e930b402f;hpb=3825e896292608b8d225a2ea10e54c45a6867c0b;p=gnulib.git diff --git a/build-aux/announce-gen b/build-aux/announce-gen index 385ce8c3c..0eb6b5b6e 100755 --- a/build-aux/announce-gen +++ b/build-aux/announce-gen @@ -1,13 +1,15 @@ -#!/usr/bin/perl -w +eval '(exit $?0)' && eval 'exec perl -wS "$0" ${1+"$@"}' + & eval 'exec perl -wS "$0" $argv:q' + if 0; # Generate a release announcement message. -my $VERSION = '2008-06-02 08:18'; # UTC +my $VERSION = '2011-05-17 20:25'; # 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-2008 Free Software Foundation, Inc. +# Copyright (C) 2002-2011 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 @@ -33,32 +35,8 @@ 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; -} +my %valid_release_types = map {$_ => 1} qw (alpha beta stable); +my @archive_suffixes = ('tar.gz', 'tar.bz2', 'tar.lzma', 'tar.xz'); sub usage ($) { @@ -73,11 +51,10 @@ sub usage ($) my @types = sort keys %valid_release_types; print $STREAM <new->addfile(*IN)->hexdigest - : Digest::SHA1->new->addfile(*IN)->hexdigest); - close IN; - print "$dig $f\n"; - } + { + 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)) { 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; - } + { + # 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; - } + { + # 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; + $line =~ /\S/ + and $found_news = 1; + } } close NEWS; $in_items or die "$ME: $news_file: no matching lines for `$curr_version'\n"; + $found_news + or die "$ME: $news_file: no news item found for `$curr_version'\n"; } sub print_changelog_deltas ($$) @@ -249,8 +237,8 @@ sub print_changelog_deltas ($$) use File::Find; my @changelog; find ({wanted => sub {$_ eq 'ChangeLog' && -d 'CVS' - and push @changelog, $File::Find::name}}, - '.'); + and push @changelog, $File::Find::name}}, + '.'); # If there are no ChangeLog files, we're done. @changelog @@ -275,7 +263,7 @@ sub print_changelog_deltas ($$) my $dot_slash = $d eq '.' ? $d : "./$d"; my $target = "$dot_slash/ChangeLog"; delete $changelog{$target} - and push @reordered, $target; + and push @reordered, $target; } # Append any remaining ChangeLog files. @@ -302,20 +290,20 @@ sub print_changelog_deltas ($$) 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; - } + { + 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 =~ /^$/); - } + { + $line =~ s///; + print $line; + $prev_printed_line_empty = ($line =~ /^$/); + } } close DIFF; @@ -336,25 +324,25 @@ sub get_tool_versions ($$) foreach my $t (@$tool_list) { if ($t eq 'gnulib') - { - push @tool_version_pair, ucfirst $t . ' ' . $gnulib_version; - next; - } + { + 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"; - } + { + $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; - } + { + defined $first_line + and $first_line = ''; + warn "$ME: $t: unexpected --version output\n:$first_line"; + $fail = 1; + } } $fail @@ -368,6 +356,7 @@ sub get_tool_versions ($$) # issue "1,2" instead of "1.2", what confuses our regexps. $ENV{LC_ALL} = "C"; + my $mail_headers; my $release_type; my $package_name; my $prev_version; @@ -377,9 +366,11 @@ sub get_tool_versions ($$) my @news_file; my $bootstrap_tools; my $gnulib_version; + my $print_checksums_p = 1; GetOptions ( + 'mail-headers=s' => \$mail_headers, 'release-type=s' => \$release_type, 'package-name=s' => \$package_name, 'previous-version=s' => \$prev_version, @@ -389,6 +380,8 @@ sub get_tool_versions ($$) '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 }, @@ -413,8 +406,8 @@ sub get_tool_versions ($$) 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; + . "--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; @@ -426,12 +419,14 @@ sub get_tool_versions ($$) and usage 1; my $my_distdir = "$package_name-$curr_version"; - my $tgz = "$my_distdir.tar.gz"; - my $tbz = "$my_distdir.tar.bz2"; - my $lzma = "$my_distdir.tar.lzma"; + my $xd = "$package_name-$prev_version-$curr_version.xdelta"; - my @tarballs = grep {-f $_} ($tgz, $tbz, $lzma); + 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; @@ -439,11 +434,18 @@ sub get_tool_versions ($$) %size or exit 1; + my $headers = ''; + if (defined $mail_headers) + { + ($headers = $mail_headers) =~ s/\s+(\S+:)/\n$1/g; + $headers .= "\n"; + } + # The markup is escaped as <\# so that when this script is sent by # mail (or part of a diff), Gnus is not triggered. print < @@ -454,22 +456,27 @@ 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); + . "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); + @sig_files); + if ($url_dir_list[0] =~ "gnu\.org") + { + print "To reduce load on the main server, use a mirror listed at:\n"; + print " http://www.gnu.org/order/ftp.html\n\n"; + } - print_checksums (@sizable); + $print_checksums_p + and print_checksums (@sizable); print <