1 eval '(exit $?0)' && eval 'exec perl -wS "$0" ${1+"$@"}'
2 & eval 'exec perl -wS "$0" $argv:q'
4 # Generate a release announcement message.
6 my $VERSION = '2011-05-17 20:25'; # UTC
7 # The definition above must lie within the first 8 lines in order
8 # for the Emacs time-stamp write hook (at end) to update it.
9 # If you change this file with Emacs, please let the write hook
10 # do its job. Otherwise, update this string manually.
12 # Copyright (C) 2002-2011 Free Software Foundation, Inc.
14 # This program is free software: you can redistribute it and/or modify
15 # it under the terms of the GNU General Public License as published by
16 # the Free Software Foundation, either version 3 of the License, or
17 # (at your option) any later version.
19 # This program is distributed in the hope that it will be useful,
20 # but WITHOUT ANY WARRANTY; without even the implied warranty of
21 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 # GNU General Public License for more details.
24 # You should have received a copy of the GNU General Public License
25 # along with this program. If not, see <http://www.gnu.org/licenses/>.
27 # Written by Jim Meyering
34 use POSIX qw(strftime);
36 (my $ME = $0) =~ s|.*/||;
38 my %valid_release_types = map {$_ => 1} qw (alpha beta stable);
39 my @archive_suffixes = ('tar.gz', 'tar.bz2', 'tar.lzma', 'tar.xz');
44 my $STREAM = ($exit_code == 0 ? *STDOUT : *STDERR);
47 print $STREAM "Try `$ME --help' for more information.\n";
51 my @types = sort keys %valid_release_types;
54 Generate an announcement message.
58 These options must be specified:
60 --release-type=TYPE TYPE must be one of @types
61 --package-name=PACKAGE_NAME
62 --previous-version=VER
64 --gpg-key-id=ID The GnuPG ID of the key used to sign the tarballs
65 --url-directory=URL_DIR
67 The following are optional:
70 --bootstrap-tools=TOOL_LIST a comma-separated list of tools, e.g.,
71 autoconf,automake,bison,gnulib
72 --gnulib-version=VERSION report VERSION as the gnulib version, where
73 VERSION is the result of running git describe
74 in the gnulib source directory.
75 required if gnulib is in TOOL_LIST.
76 --no-print-checksums do not emit MD5 or SHA1 checksums
77 --archive-suffix=SUF add SUF to the list of archive suffixes
78 --mail-headers=HEADERS a space-separated list of mail headers, e.g.,
79 To: x\@example.com Cc: y-announce\@example.com,...
81 --help display this help and exit
82 --version output version information and exit
90 =item C<%size> = C<sizes (@file)>
92 Compute the sizes of the C<@file> and return them as a hash. Return
93 C<undef> if one of the computation failed.
103 foreach my $f (@file)
105 my $cmd = "du --human $f";
107 # FIXME-someday: give a better diagnostic, a la $PROCESS_STATUS
109 and (warn "$ME: command failed: `$cmd'\n"), $fail = 1;
111 $t =~ s/^([\d.]+[MkK]).*/${1}B/;
114 return $fail ? undef : %res;
117 =item C<print_locations ($title, \@url, \%size, @file)
119 Print a section C<$title> dedicated to the list of <@file>, which
120 sizes are stored in C<%size>, and which are available from the C<@url>.
124 sub print_locations ($\@\%@)
126 my ($title, $url, $size, @file) = @_;
127 print "Here are the $title:\n";
128 foreach my $url (@{$url})
133 print " (", $$size{$file}, ")"
134 if exists $$size{$file};
141 =item C<print_checksums (@file)
143 Print the MD5 and SHA1 signature section for each C<@file>.
147 sub print_checksums (@)
151 print "Here are the MD5 and SHA1 checksums:\n";
154 foreach my $meth (qw (md5 sha1))
156 foreach my $f (@file)
159 or die "$ME: $f: cannot open for reading: $!\n";
163 ? Digest::MD5->new->addfile(*IN)->hexdigest
164 : Digest::SHA1->new->addfile(*IN)->hexdigest);
172 =item C<print_news_deltas ($news_file, $prev_version, $curr_version)
174 Print the section of the NEWS file C<$news_file> addressing changes
175 between versions C<$prev_version> and C<$curr_version>.
179 sub print_news_deltas ($$$)
181 my ($news_file, $prev_version, $curr_version) = @_;
183 my $news_name = $news_file;
184 $news_name =~ s|^\./||;
186 print "\n$news_name\n\n";
188 # Print all lines from $news_file, starting with the first one
189 # that mentions $curr_version up to but not including
190 # the first occurrence of $prev_version.
193 my $re_prefix = qr/(?:\* )?(?:Noteworthy c|Major c|C)(?i:hanges)/;
196 open NEWS, '<', $news_file
197 or die "$ME: $news_file: cannot open for reading: $!\n";
198 while (defined (my $line = <NEWS>))
202 # Match lines like these:
203 # * Major changes in release 5.0.1:
204 # * Noteworthy changes in release 6.6 (2006-11-22) [stable]
205 $line =~ /^$re_prefix.*(?:[^\d.]|$)\Q$curr_version\E(?:[^\d.]|$)/o
212 # This regexp must not match version numbers in NEWS items.
213 # For example, they might well say `introduced in 4.5.5',
214 # and we don't want that to match.
215 $line =~ /^$re_prefix.*(?:[^\d.]|$)\Q$prev_version\E(?:[^\d.]|$)/o
225 or die "$ME: $news_file: no matching lines for `$curr_version'\n";
227 or die "$ME: $news_file: no news item found for `$curr_version'\n";
230 sub print_changelog_deltas ($$)
232 my ($package_name, $prev_version) = @_;
234 # Print new ChangeLog entries.
236 # First find all CVS-controlled ChangeLog files.
239 find ({wanted => sub {$_ eq 'ChangeLog' && -d 'CVS'
240 and push @changelog, $File::Find::name}},
243 # If there are no ChangeLog files, we're done.
246 my %changelog = map {$_ => 1} @changelog;
248 # Reorder the list of files so that if there are ChangeLog
249 # files in the specified directories, they're listed first,
251 my @dir = qw ( . src lib m4 config doc );
253 # A typical @changelog array might look like this:
263 my $dot_slash = $d eq '.' ? $d : "./$d";
264 my $target = "$dot_slash/ChangeLog";
265 delete $changelog{$target}
266 and push @reordered, $target;
269 # Append any remaining ChangeLog files.
270 push @reordered, sort keys %changelog;
272 # Remove leading `./'.
273 @reordered = map { s!^\./!!; $_ } @reordered;
275 print "\nChangeLog entries:\n\n";
276 # print join ("\n", @reordered), "\n";
278 $prev_version =~ s/\./_/g;
279 my $prev_cvs_tag = "\U$package_name\E-$prev_version";
281 my $cmd = "cvs -n diff -u -r$prev_cvs_tag -rHEAD @reordered";
282 open DIFF, '-|', $cmd
283 or die "$ME: cannot run `$cmd': $!\n";
284 # Print two types of lines, making minor changes:
285 # Lines starting with `+++ ', e.g.,
286 # +++ ChangeLog 22 Feb 2003 16:52:51 -0000 1.247
287 # and those starting with `+'.
288 # Don't print the others.
289 my $prev_printed_line_empty = 1;
290 while (defined (my $line = <DIFF>))
292 if ($line =~ /^\+\+\+ /)
294 my $separator = "*"x70 ."\n";
297 $prev_printed_line_empty
299 print $separator, $line, $separator;
301 elsif ($line =~ /^\+/)
305 $prev_printed_line_empty = ($line =~ /^$/);
310 # The exit code should be 1.
311 # Allow in case there are no modified ChangeLog entries.
312 $? == 256 || $? == 128
313 or warn "$ME: warning: `cmd' had unexpected exit code or signal ($?)\n";
316 sub get_tool_versions ($$)
318 my ($tool_list, $gnulib_version) = @_;
323 my @tool_version_pair;
324 foreach my $t (@$tool_list)
328 push @tool_version_pair, ucfirst $t . ' ' . $gnulib_version;
331 # Assume that the last "word" on the first line of
332 # `tool --version` output is the version string.
333 my ($first_line, undef) = split ("\n", `$t --version`);
334 if ($first_line =~ /.* (\d[\w.-]+)$/)
337 push @tool_version_pair, "$t $1";
342 and $first_line = '';
343 warn "$ME: $t: unexpected --version output\n:$first_line";
351 return @tool_version_pair;
355 # Neutralize the locale, so that, for instance, "du" does not
356 # issue "1,2" instead of "1.2", what confuses our regexps.
369 my $print_checksums_p = 1;
373 'mail-headers=s' => \$mail_headers,
374 'release-type=s' => \$release_type,
375 'package-name=s' => \$package_name,
376 'previous-version=s' => \$prev_version,
377 'current-version=s' => \$curr_version,
378 'gpg-key-id=s' => \$gpg_key_id,
379 'url-directory=s' => \@url_dir_list,
380 'news=s' => \@news_file,
381 'bootstrap-tools=s' => \$bootstrap_tools,
382 'gnulib-version=s' => \$gnulib_version,
383 'print-checksums!' => \$print_checksums_p,
384 'archive-suffix=s' => \@archive_suffixes,
386 help => sub { usage 0 },
387 version => sub { print "$ME version $VERSION\n"; exit },
391 # Ensure that sure each required option is specified.
393 or (warn "$ME: release type not specified\n"), $fail = 1;
395 or (warn "$ME: package name not specified\n"), $fail = 1;
397 or (warn "$ME: previous version string not specified\n"), $fail = 1;
399 or (warn "$ME: current version string not specified\n"), $fail = 1;
401 or (warn "$ME: GnuPG key ID not specified\n"), $fail = 1;
403 or (warn "$ME: URL directory name(s) not specified\n"), $fail = 1;
405 my @tool_list = split ',', $bootstrap_tools;
407 grep (/^gnulib$/, @tool_list) ^ defined $gnulib_version
408 and (warn "$ME: when specifying gnulib as a tool, you must also specify\n"
409 . "--gnulib-version=V, where V is the result of running git describe\n"
410 . "in the gnulib source directory.\n"), $fail = 1;
412 exists $valid_release_types{$release_type}
413 or (warn "$ME: `$release_type': invalid release type\n"), $fail = 1;
416 and (warn "$ME: too many arguments:\n", join ("\n", @ARGV), "\n"),
421 my $my_distdir = "$package_name-$curr_version";
423 my $xd = "$package_name-$prev_version-$curr_version.xdelta";
425 my @candidates = map { "$my_distdir.$_" } @archive_suffixes;
426 my @tarballs = grep {-f $_} @candidates;
429 or die "$ME: none of " . join(', ', @candidates) . " were found\n";
430 my @sizable = @tarballs;
432 and push @sizable, $xd;
433 my %size = sizes (@sizable);
438 if (defined $mail_headers)
440 ($headers = $mail_headers) =~ s/\s+(\S+:)/\n$1/g;
444 # The markup is escaped as <\# so that when this script is sent by
445 # mail (or part of a diff), Gnus is not triggered.
448 ${headers}Subject: $my_distdir released [$release_type]
450 <\#secure method=pgpmime mode=sign>
452 FIXME: put comments here
456 print_locations ("compressed sources", @url_dir_list, %size, @tarballs);
458 and print_locations ("xdelta diffs (useful? if so, "
459 . "please tell bug-gnulib\@gnu.org)",
460 @url_dir_list, %size, $xd);
461 my @sig_files = map { "$_.sig" } @tarballs;
462 print_locations ("GPG detached signatures[*]", @url_dir_list, %size,
464 if ($url_dir_list[0] =~ "gnu\.org")
466 print "To reduce load on the main server, use a mirror listed at:\n";
467 print " http://www.gnu.org/order/ftp.html\n\n";
471 and print_checksums (@sizable);
474 [*] You can use either of the above signature files to verify that
475 the corresponding file (without the .sig suffix) is intact. First,
476 be sure to download both the .sig file and the corresponding tarball.
477 Then, run a command like this:
479 gpg --verify $tarballs[0].sig
481 If that command fails because you don't have the required public key,
482 then run this command to import it:
484 gpg --keyserver keys.gnupg.net --recv-keys $gpg_key_id
486 and rerun the \`gpg --verify' command.
489 my @tool_versions = get_tool_versions (\@tool_list, $gnulib_version);
491 and print "\nThis release was bootstrapped with the following tools:",
492 join ('', map {"\n $_"} @tool_versions), "\n";
494 print_news_deltas ($_, $prev_version, $curr_version)
497 $release_type eq 'stable'
498 or print_changelog_deltas ($package_name, $prev_version);
503 ### Setup "GNU" style for perl-mode and cperl-mode.
506 ## perl-indent-level: 2
507 ## perl-continued-statement-offset: 2
508 ## perl-continued-brace-offset: 0
509 ## perl-brace-offset: 0
510 ## perl-brace-imaginary-offset: 0
511 ## perl-label-offset: -2
512 ## perl-extra-newline-before-brace: t
513 ## perl-merge-trailing-else: nil
514 ## eval: (add-hook 'write-file-hooks 'time-stamp)
515 ## time-stamp-start: "my $VERSION = '"
516 ## time-stamp-format: "%:y-%02m-%02d %02H:%02M"
517 ## time-stamp-time-zone: "UTC"
518 ## time-stamp-end: "'; # UTC"