FYI: announce-gen

[Akim Demaille]

Index: ChangeLog
from  Akim Demaille  <address@hidden>

        * config/announce-gen (&print_locations, &print_signatures)
        (&sizes): New.
        Use them.
        No longer rely on Gnus to inline the list of signatures: compute
        them on the fly.

Index: config/announce-gen
===================================================================
RCS file: /cvsroot/autoconf/autoconf/config/announce-gen,v
retrieving revision 1.4
diff -u -u -r1.4 announce-gen
--- config/announce-gen 30 Sep 2003 13:07:28 -0000 1.4
+++ config/announce-gen 24 Nov 2003 16:06:25 -0000
@@ -72,6 +72,97 @@
   exit $exit_code;
 }
 
+
+=item C<%size> = C<sizes (@file)>
+
+Compute the sizes of the C<@file> and return them as a hash.  Return
+C<undef> if one of the computation failed.
+
+=cut
+
+sub 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, address@hidden, \%size, @file)
+
+Print a section C<$title> dedicated to the list of <@file>, which
+sizes are stored in C<%size>, and which are available from the C<@url>.
+
+=cut
+
+sub print_locations (address@hidden@)
+{
+  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_signatures (@file)
+
+Print the MD5 and SHA1 signature section for each C<@file>.
+
+=cut
+
+sub print_signatures (@)
+{
+  my (@file) = @_;
+
+  print "Here are the MD5 and SHA1 signatures:\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";
+       }
+    }
+
+
+}
+
+=item C<print_news_deltas ($news_file, $prev_version, $curr_version)
+
+Print the section of the NEWS file C<$news_file> addressing changes
+between versions C<$prev_version> and C<$curr_version>.
+
+=cut
+
 sub print_news_deltas ($$$)
 {
   my ($news_file, $prev_version, $curr_version) = @_;
@@ -113,6 +204,7 @@
     or die "$ME: $news_file: no matching lines for `$curr_version'\n";
 }
 
+
 sub print_changelog_deltas ($$)
 {
   my ($package_name, $prev_version) = @_;
@@ -200,6 +292,10 @@
 }
 
 {
+  # 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 $release_type;
   my $package_name;
   my $prev_version;
@@ -250,22 +346,9 @@
   my $tbz = "$my_distdir.tar.bz2";
   my $xd = "$package_name-$prev_version-$curr_version.xdelta";
 
-  my %size;
-
-  foreach my $f ($tgz, $tbz, $xd)
-    {
-      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/;
-      $size{$f} = $t;
-    }
-
-  $fail
-    and exit 1;
+  my %size = sizes ($tgz, $tbz, $xd);
+  %size
+    or exit 1;
 
   # The markup is escaped as <\# so that when this script is sent by
   # mail (or part of a diff), Gnus is not triggered.
@@ -279,60 +362,14 @@
 
 EOF
 
-  print "Here are the compressed sources:\n";
-  foreach my $url (@url_dir_list)
-    {
-      print "  $url/$tgz   ($size{$tgz})\n";
-      print "  $url/$tbz  ($size{$tbz})\n";
-    }
-
-  print "\nAnd here are xdelta-style diffs:\n";
-  foreach my $url (@url_dir_list)
-    {
-      print "  $url/$xd   ($size{$xd})\n";
-    }
-
-  print "\nHere are GPG detached signatures:\n";
-  foreach my $url (@url_dir_list)
-    {
-      print "  $url/$tgz.asc\n";
-      print "  $url/$tbz.asc\n";
-    }
-
-  # FIXME: clean up upon interrupt or die
-  my $tmpdir = $ENV{TMPDIR} || '/tmp';
-  my $tmp = "$tmpdir/$ME-$$";
-  unlink $tmp;  # ignore failure
-
-  print "\nHere are the MD5 and SHA1 signatures:\n";
-  print "\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 "<\#part type=text/plain filename=\"$tmp\" disposition=inline>\n"
-    . "<\#/part>\n";
-
-  open OUT, '>', $tmp
-    or die "$ME: $tmp: cannot open for writing: $!\n";
-
-  foreach my $meth (qw (md5 sha1))
-    {
-      foreach my $f ($tgz, $tbz, $xd)
-       {
-         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 OUT "$dig  $f\n";
-       }
-    }
+  print_locations ("compressed sources", @url_dir_list, %size,
+                  $tgz, $tbz);
+  print_locations ("xdelta-style diffs", @url_dir_list, %size,
+                  $xd);
+  print_locations ("GPG detached signatures", @url_dir_list, %size,
+                  "$tgz.asc", "$tbz.asc");
 
-  close OUT
-    or die "$ME: $tmp: while writing: $!\n";
-  chmod 0400, $tmp;  # ignore failure
+  print_signatures ($tgz, $tbz, $xd);
 
   print_news_deltas ($_, $prev_version, $curr_version)
     foreach @news_file;