announce-gen

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