| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542 | 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 = '2012-04-19 14:36'; # 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-2012 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 <http://www.gnu.org/licenses/>.# Written by Jim Meyeringuse strict;use Getopt::Long;use Digest::MD5;eval { require Digest::SHA; }  or eval 'use Digest::SHA1';use POSIX qw(strftime);(my $ME = $0) =~ s|.*/||;my %valid_release_types = map {$_ => 1} qw (alpha beta stable);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 <<EOF;Usage: $ME [OPTIONS]Generate an announcement message.OPTIONS:These options must be specified:   --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_DIRThe following are optional:   --news=NEWS_FILE   --bootstrap-tools=TOOL_LIST  a comma-separated list of tools, e.g.,                                autoconf,automake,bison,gnulib   --gnulib-version=VERSION     report VERSION as the gnulib version, where                                VERSION is the result of running git describe                                in the gnulib source directory.                                required if gnulib is in TOOL_LIST.   --no-print-checksums         do not emit MD5 or SHA1 checksums   --archive-suffix=SUF         add SUF to the list of archive suffixes   --mail-headers=HEADERS       a space-separated list of mail headers, e.g.,                                To: x\@example.com Cc: y-announce\@example.com,...   --help             display this help and exit   --version          output version information and exitEOF    }  exit $exit_code;}=item C<%size> = C<sizes (@file)>Compute the sizes of the C<@file> and return them as a hash.  ReturnC<undef> if one of the computation failed.=cutsub 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>, whichsizes are stored in C<%size>, and which are available from the C<@url>.=cutsub 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>.=cutsub 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<print_news_deltas ($news_file, $prev_version, $curr_version)Print the section of the NEWS file C<$news_file> addressing changesbetween versions C<$prev_version> and C<$curr_version>.=cutsub print_news_deltas ($$$){  my ($news_file, $prev_version, $curr_version) = @_;  my $news_name = $news_file;  $news_name =~ s|^\./||;  print "\n$news_name\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)/;  my $found_news;  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;          $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 ($$){  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";}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 $mail_headers;  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    (     'mail-headers=s'     => \$mail_headers,     '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;  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 <<EOF;${headers}Subject: $my_distdir released [$release_type]<\#secure method=pgpmime mode=sign>FIXME: put comments hereEOF  if (@url_dir_list == 1 && @tarballs == 1)    {      # When there's only one tarball and one URL, use a more concise form.      my $m = "$url_dir_list[0]/$tarballs[0]";      print "Here are the compressed sources and a GPG detached signature[*]:\n"        . "  $m\n"        . "  $m.sig\n\n";    }  else    {      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);    }  if ($url_dir_list[0] =~ "gnu\.org")    {      print "Use a mirror for higher download bandwidth:\n";      if (@tarballs == 1 && $url_dir_list[0] =~ m!http://ftp\.gnu\.org/gnu/!)        {          (my $m = "$url_dir_list[0]/$tarballs[0]")            =~ s!http://ftp\.gnu\.org/gnu/!http://ftpmirror\.gnu\.org/!;          print "  $m\n"              . "  $m.sig\n\n";        }      else        {          print "  http://www.gnu.org/order/ftp.html\n\n";        }    }  $print_checksums_p    and print_checksums (@sizable);  print <<EOF;[*] Use a .sig file to verify that the corresponding file (without the.sig suffix) is intact.  First, be sure to download both the .sig fileand the corresponding tarball.  Then, run a command like this:  gpg --verify $tarballs[0].sigIf that command fails because you don't have the required public key,then run this command to import it:  gpg --keyserver keys.gnupg.net --recv-keys $gpg_key_idand rerun the 'gpg --verify' command.EOF  my @tool_versions = get_tool_versions (\@tool_list, $gnulib_version);  @tool_versions    and print "\nThis release was bootstrapped with the following tools:",      join ('', map {"\n  $_"} @tool_versions), "\n";  print_news_deltas ($_, $prev_version, $curr_version)    foreach @news_file;  $release_type eq 'stable'    or print_changelog_deltas ($package_name, $prev_version);  exit 0;}### Setup "GNU" style for perl-mode and cperl-mode.## Local Variables:## mode: perl## 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## perl-extra-newline-before-brace: t## perl-merge-trailing-else: nil## eval: (add-hook 'write-file-hooks 'time-stamp)## time-stamp-start: "my $VERSION = '"## time-stamp-format: "%:y-%02m-%02d %02H:%02M"## time-stamp-time-zone: "UTC"## time-stamp-end: "'; # UTC"## End:
 |