1#!/usr/bin/perl -w
2# Generate an announcement message.
3
4# Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
5
6# This program is free software; you can redistribute it and/or modify
7# it under the terms of the GNU General Public License as published by
8# the Free Software Foundation; either version 2, or (at your option)
9# any later version.
10
11# This program is distributed in the hope that it will be useful,
12# but WITHOUT ANY WARRANTY; without even the implied warranty of
13# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14# GNU General Public License for more details.
15
16# You should have received a copy of the GNU General Public License
17# along with this program; if not, write to the Free Software Foundation,
18# Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
19
20use strict;
21
22use Getopt::Long;
23use Digest::MD5;
24use Digest::SHA1;
25
26(my $VERSION = '$Revision: 1.6 $ ') =~ tr/[0-9].//cd;
27(my $ME = $0) =~ s|.*/||;
28
29my %valid_release_types = map {$_ => 1} qw (alpha beta major);
30
31END
32{
33  # Nobody ever checks the status of print()s.  That's okay, because
34  # if any do fail, we're guaranteed to get an indicator when we close()
35  # the filehandle.
36  #
37  # Close stdout now, and if there were no errors, return happy status.
38  # If stdout has already been closed by the script, though, do nothing.
39  defined fileno STDOUT
40    or return;
41  close STDOUT
42    and return;
43
44  # Errors closing stdout.  Indicate that, and hope stderr is OK.
45  warn "$ME: closing standard output: $!\n";
46
47  # Don't be so arrogant as to assume that we're the first END handler
48  # defined, and thus the last one invoked.  There may be others yet
49  # to come.  $? will be passed on to them, and to the final _exit().
50  #
51  # If it isn't already an error, make it one (and if it _is_ an error,
52  # preserve the value: it might be important).
53  $? ||= 1;
54}
55
56sub usage ($)
57{
58  my ($exit_code) = @_;
59  my $STREAM = ($exit_code == 0 ? *STDOUT : *STDERR);
60  if ($exit_code != 0)
61    {
62      print $STREAM "Try `$ME --help' for more information.\n";
63    }
64  else
65    {
66      my @types = sort keys %valid_release_types;
67      print $STREAM <<EOF;
68Usage: $ME [OPTIONS]
69
70OPTIONS:
71
72  Generate an announcement message.
73
74  FIXME: describe the following
75
76   --release-type=TYPE          TYPE must be one of @types
77   --package-name=PACKAGE_NAME
78   --previous-version=VER
79   --current-version=VER
80   --gpg-key-id=ID         The GnuPG ID of the key used to sign the tarballs
81   --release-archive-directory=DIR
82   --url-directory=URL_DIR
83   --news=NEWS_FILE             optional
84
85   --help             display this help and exit
86   --version          output version information and exit
87
88EOF
89    }
90  exit $exit_code;
91}
92
93
94=item C<%size> = C<sizes (@file)>
95
96Compute the sizes of the C<@file> and return them as a hash.  Return
97C<undef> if one of the computation failed.
98
99=cut
100
101sub sizes (@)
102{
103  my (@file) = @_;
104
105  my $fail = 0;
106  my %res;
107  foreach my $f (@file)
108    {
109      my $cmd = "du --human $f";
110      my $t = `$cmd`;
111      # FIXME-someday: give a better diagnostic, a la $PROCESS_STATUS
112      $@
113	and (warn "$ME: command failed: `$cmd'\n"), $fail = 1;
114      chomp $t;
115      $t =~ s/^([\d.]+[MkK]).*/${1}B/;
116      $res{$f} = $t;
117    }
118  return $fail ? undef : %res;
119}
120
121=item C<print_locations ($title, \@url, \%size, @file)
122
123Print a section C<$title> dedicated to the list of <@file>, which
124sizes are stored in C<%size>, and which are available from the C<@url>.
125
126=cut
127
128sub print_locations ($\@\%@)
129{
130  my ($title, $url, $size, @file) = @_;
131  print "Here are the $title:\n";
132  foreach my $url (@{$url})
133    {
134      for my $file (@file)
135	{
136	  print "  $url/$file";
137	  print "   (", $$size{$file}, ")"
138	    if exists $$size{$file};
139	  print "\n";
140	}
141    }
142  print "\n";
143}
144
145=item C<print_checksums (@file)
146
147Print the MD5 and SHA1 signature section for each C<@file>.
148
149=cut
150
151sub print_checksums (@)
152{
153  my (@file) = @_;
154
155  print "Here are the MD5 and SHA1 checksums:\n";
156  print "\n";
157
158  foreach my $meth (qw (md5 sha1))
159    {
160      foreach my $f (@file)
161	{
162	  open IN, '<', $f
163	    or die "$ME: $f: cannot open for reading: $!\n";
164	  binmode IN;
165	  my $dig =
166	    ($meth eq 'md5'
167	     ? Digest::MD5->new->addfile(*IN)->hexdigest
168	     : Digest::SHA1->new->addfile(*IN)->hexdigest);
169	  close IN;
170	  print "$dig  $f\n";
171	}
172    }
173
174
175}
176
177=item C<print_news_deltas ($news_file, $prev_version, $curr_version)
178
179Print the section of the NEWS file C<$news_file> addressing changes
180between versions C<$prev_version> and C<$curr_version>.
181
182=cut
183
184sub print_news_deltas ($$$)
185{
186  my ($news_file, $prev_version, $curr_version) = @_;
187
188  print "\n$news_file\n\n";
189
190  # Print all lines from $news_file, starting with the first one
191  # that mentions $curr_version up to but not including
192  # the first occurrence of $prev_version.
193  my $in_items;
194
195  open NEWS, '<', $news_file
196    or die "$ME: $news_file: cannot open for reading: $!\n";
197  while (defined (my $line = <NEWS>))
198    {
199      if ( ! $in_items)
200	{
201	  # Match lines like this one:
202	  # * Major changes in release 5.0.1:
203	  # but not any other line that starts with a space, *, or -.
204	  $line =~ /^(\* Major changes.*|[^ *-].*)\Q$curr_version\E/o
205	    or next;
206	  $in_items = 1;
207	  print $line;
208	}
209      else
210	{
211	  # Be careful that this regexp cannot match version numbers
212	  # in NEWS items -- they might well say `introduced in 4.5.5',
213	  # and we don't want that to match.
214	  $line =~ /^(\* Major changes.*|[^ *-].*)\Q$prev_version\E/o
215	    and last;
216	  print $line;
217	}
218    }
219  close NEWS;
220
221  $in_items
222    or die "$ME: $news_file: no matching lines for `$curr_version'\n";
223}
224
225sub print_changelog_deltas ($$)
226{
227  my ($package_name, $prev_version) = @_;
228
229  # Print new ChangeLog entries.
230
231  # First find all CVS-controlled ChangeLog files.
232  use File::Find;
233  my @changelog;
234  find ({wanted => sub {$_ eq 'ChangeLog' && -d 'CVS'
235			  and push @changelog, $File::Find::name}},
236	'.');
237
238  # If there are no ChangeLog files, we're done.
239  @changelog
240    or return;
241  my %changelog = map {$_ => 1} @changelog;
242
243  # Reorder the list of files so that if there are ChangeLog
244  # files in the specified directories, they're listed first,
245  # in this order:
246  my @dir = qw ( . src lib m4 config doc );
247
248  # A typical @changelog array might look like this:
249  # ./ChangeLog
250  # ./po/ChangeLog
251  # ./m4/ChangeLog
252  # ./lib/ChangeLog
253  # ./doc/ChangeLog
254  # ./config/ChangeLog
255  my @reordered;
256  foreach my $d (@dir)
257    {
258      my $dot_slash = $d eq '.' ? $d : "./$d";
259      my $target = "$dot_slash/ChangeLog";
260      delete $changelog{$target}
261	and push @reordered, $target;
262    }
263
264  # Append any remaining ChangeLog files.
265  push @reordered, sort keys %changelog;
266
267  # Remove leading `./'.
268  @reordered = map { s!^\./!!; $_ } @reordered;
269
270  print "\nChangeLog entries:\n\n";
271  # print join ("\n", @reordered), "\n";
272
273  $prev_version =~ s/\./_/g;
274  my $prev_cvs_tag = "\U$package_name\E-$prev_version";
275
276  my $cmd = "cvs -n diff -u -r$prev_cvs_tag -rHEAD @reordered";
277  open DIFF, '-|', $cmd
278    or die "$ME: cannot run `$cmd': $!\n";
279  # Print two types of lines, making minor changes:
280  # Lines starting with `+++ ', e.g.,
281  # +++ ChangeLog   22 Feb 2003 16:52:51 -0000      1.247
282  # and those starting with `+'.
283  # Don't print the others.
284  my $prev_printed_line_empty = 1;
285  while (defined (my $line = <DIFF>))
286    {
287      if ($line =~ /^\+\+\+ /)
288	{
289	  my $separator = "*"x70 ."\n";
290	  $line =~ s///;
291	  $line =~ s/\s.*//;
292	  $prev_printed_line_empty
293	    or print "\n";
294	  print $separator, $line, $separator;
295	}
296      elsif ($line =~ /^\+/)
297	{
298	  $line =~ s///;
299	  print $line;
300	  $prev_printed_line_empty = ($line =~ /^$/);
301	}
302    }
303  close DIFF;
304
305  # The exit code should be 1.
306  # Allow in case there are no modified ChangeLog entries.
307  $? == 256 || $? == 128
308    or warn "$ME: warning: `cmd' had unexpected exit code or signal ($?)\n";
309}
310
311{
312  # Neutralize the locale, so that, for instance, "du" does not
313  # issue "1,2" instead of "1.2", what confuses our regexps.
314  $ENV{LC_ALL} = "C";
315
316  my $release_type;
317  my $package_name;
318  my $prev_version;
319  my $curr_version;
320  my $release_archive_dir;
321  my $gpg_key_id;
322  my @url_dir_list;
323  my @news_file;
324
325  GetOptions
326    (
327     'release-type=s'     => \$release_type,
328     'package-name=s'     => \$package_name,
329     'previous-version=s' => \$prev_version,
330     'current-version=s'  => \$curr_version,
331     'gpg-key-id=s'       => \$gpg_key_id,
332     'release-archive-directory=s' => \$release_archive_dir,
333     'url-directory=s'    => \@url_dir_list,
334     'news=s'             => \@news_file,
335
336     help => sub { usage 0 },
337     version => sub { print "$ME version $VERSION\n"; exit },
338    ) or usage 1;
339
340  my $fail = 0;
341  # Ensure that sure each required option is specified.
342  $release_type
343    or (warn "$ME: release type not specified\n"), $fail = 1;
344  $package_name
345    or (warn "$ME: package name not specified\n"), $fail = 1;
346  $prev_version
347    or (warn "$ME: previous version string not specified\n"), $fail = 1;
348  $curr_version
349    or (warn "$ME: current version string not specified\n"), $fail = 1;
350  $release_archive_dir
351    or (warn "$ME: release directory name not specified\n"), $fail = 1;
352  @url_dir_list
353    or (warn "$ME: URL directory name(s) not specified\n"), $fail = 1;
354
355  exists $valid_release_types{$release_type}
356    or (warn "$ME: `$release_type': invalid release type\n"), $fail = 1;
357
358  @ARGV
359    and (warn "$ME: too many arguments\n"), $fail = 1;
360  $fail
361    and usage 1;
362
363  my $my_distdir = "$package_name-$curr_version";
364  my $tgz = "$my_distdir.tar.gz";
365  my $tbz = "$my_distdir.tar.bz2";
366  my $xd = "$package_name-$prev_version-$curr_version.xdelta";
367
368  my %size = sizes ($tgz, $tbz, $xd);
369  %size
370    or exit 1;
371
372  # The markup is escaped as <\# so that when this script is sent by
373  # mail (or part of a diff), Gnus is not triggered.
374  print <<EOF;
375
376Subject: $my_distdir released
377
378<\#secure method=pgpmime mode=sign>
379
380FIXME: put comments here
381
382EOF
383
384  print_locations ("compressed sources", @url_dir_list, %size,
385		   $tgz, $tbz);
386  print_locations ("xdelta-style diffs", @url_dir_list, %size,
387		   $xd);
388  print_locations ("GPG detached signatures[*]", @url_dir_list, %size,
389		   "$tgz.sig", "$tbz.sig");
390
391  print_checksums ($tgz, $tbz, $xd);
392
393  print <<EOF;
394
395[*] You can use either of the above signature files to verify that
396the corresponding file (without the .sig suffix) is intact.  First,
397be sure to download both the .sig file and the corresponding tarball.
398Then, run a command like this:
399
400  gpg --verify $tgz.sig
401
402If that command fails because you don't have the required public key,
403then run this command to import it:
404
405  gpg --keyserver wwwkeys.pgp.net --recv-keys $gpg_key_id
406
407and rerun the \`gpg --verify' command.
408EOF
409
410  print_news_deltas ($_, $prev_version, $curr_version)
411    foreach @news_file;
412
413  $release_type eq 'major'
414    or print_changelog_deltas ($package_name, $prev_version);
415
416  exit 0;
417}
418
419
420
421### Setup "GNU" style for perl-mode and cperl-mode.
422## Local Variables:
423## perl-indent-level: 2
424## perl-continued-statement-offset: 2
425## perl-continued-brace-offset: 0
426## perl-brace-offset: 0
427## perl-brace-imaginary-offset: 0
428## perl-label-offset: -2
429## cperl-indent-level: 2
430## cperl-brace-offset: 0
431## cperl-continued-brace-offset: 0
432## cperl-label-offset: -2
433## cperl-extra-newline-before-brace: t
434## cperl-merge-trailing-else: nil
435## cperl-continued-statement-offset: 2
436## End:
437