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.3 $ ') =~ tr/[0-9].//cd;
  10 (my $ME = $0) =~ s|.*/||;
  11
  12 END
  13 {
  14   # Nobody ever checks the status of print()s.  That's okay, because
  15   # if any do fail, we're guaranteed to get an indicator when we close()
  16   # the filehandle.
  17   #
  18   # Close stdout now, and if there were no errors, return happy status.
  19   # If stdout has already been closed by the script, though, do nothing.
  20   defined fileno STDOUT
  21     or return;
  22   close STDOUT
  23     and return;
  24
  25   # Errors closing stdout.  Indicate that, and hope stderr is OK.
  26   warn "$ME: closing standard output: $!\n";
  27
  28   # Don't be so arrogant as to assume that we're the first END handler
  29   # defined, and thus the last one invoked.  There may be others yet
  30   # to come.  $? will be passed on to them, and to the final _exit().
  31   #
  32   # If it isn't already an error, make it one (and if it _is_ an error,
  33   # preserve the value: it might be important).
  34   $? ||= 1;
  35 }
  36
  37 sub usage ($)
  38 {
  39   my ($exit_code) = @_;
  40   my $STREAM = ($exit_code == 0 ? *STDOUT : *STDERR);
  41   if ($exit_code != 0)
  42     {
  43       print $STREAM "Try `$ME --help' for more information.\n";
  44     }
  45   else
  46     {
  47       print $STREAM <<EOF;
  48 Usage: $ME [OPTIONS]
  49
  50 OPTIONS:
  51
  52   Generate an announcement message.
  53
  54   FIXME: describe the following
  55
  56    --package-name=PACKAGE_NAME
  57    --previous-version=VER
  58    --current-version=VER
  59    --release-archive-directory=DIR
  60    --url-directory=URL_DIR
  61
  62    --help             display this help and exit
  63    --version          output version information and exit
  64
  65 EOF
  66     }
  67   exit $exit_code;
  68 }
  69
  70 {
  71   my $package_name;
  72   my $prev_version;
  73   my $curr_version;
  74   my $release_archive_dir;
  75   my @url_dir_list;
  76
  77   GetOptions
  78     (
  79      'package-name=s' => \$package_name,
  80      'previous-version=s' => \$prev_version,
  81      'current-version=s' => \$curr_version,
  82      'release-archive-directory=s' => \$release_archive_dir,
  83      'url-directory=s@' => \@url_dir_list,
  84
  85      help => sub { usage 0 },
  86      version => sub { print "$ME version $VERSION\n"; exit },
  87     ) or usage 1;
  88
  89   my $fail = 0;
  90   # Ensure that sure each required option is specified.
  91   $package_name
  92     or (warn "$ME: missing package name\n"), $fail = 1;
  93   $prev_version
  94     or (warn "$ME: missing previous version string\n"), $fail = 1;
  95   $curr_version
  96     or (warn "$ME: missing current version string\n"), $fail = 1;
  97   $release_archive_dir
  98     or (warn "$ME: missing release directory name\n"), $fail = 1;
  99   @url_dir_list
 100     or (warn "$ME: missing URL directory name(s)\n"), $fail = 1;
 101
 102   @ARGV
 103     and (warn "$ME: too many arguments\n"), $fail = 1;
 104   $fail
 105     and usage 1;
 106
 107   my $my_distdir = "$package_name-$curr_version";
 108   my $tgz = "$my_distdir.tar.gz";
 109   my $tbz = "$my_distdir.tar.bz2";
 110   my $xd = "$package_name-$prev_version-$curr_version.xdelta";
 111
 112   my %size;
 113
 114   foreach my $f (($tgz, $tbz, $xd))
 115     {
 116       my $cmd = "du --human $f";
 117       my $t = `$cmd`;
 118       # FIXME-someday: give a better diagnostic, a la $PROCESS_STATUS
 119       $@
 120         and (warn "$ME: command failed: `$cmd'\n"), $fail = 1;
 121       chomp $t;
 122       $t =~ s/^([\d.]+[MkK]).*/${1}B/;
 123       $size{$f} = $t;
 124     }
 125
 126   $fail
 127     and exit 1;
 128
 129   print <<EOF;
 130
 131 Subject: $my_distdir released
 132
 133 <#secure method=pgpmime mode=sign>
 134
 135 FIXME: put comments here
 136
 137 EOF
 138
 139   foreach my $url (@url_dir_list)
 140     {
 141       print "  $url/$tgz   ($size{$tgz})\n";
 142       print "  $url/$tbz  ($size{$tbz})\n";
 143     }
 144
 145   print "\nAnd here are xdelta-style diffs:\n";
 146   foreach my $url (@url_dir_list)
 147     {
 148       print "  $url/$xd   ($size{$xd})\n";
 149     }
 150
 151   print "\nHere are GPG detached signatures:\n";
 152   foreach my $url (@url_dir_list)
 153     {
 154       print "  $url/$tgz.sig\n";
 155       print "  $url/$tbz.sig\n";
 156     }
 157
 158   # FIXME: clean up upon interrupt or die
 159   my $tmpdir = $ENV{TMPDIR} || '/tmp';
 160   my $tmp = "$tmpdir/$ME-$$";
 161   unlink $tmp;  # ignore failure
 162
 163   print "\nHere are the MD5 and SHA1 signatures:\n";
 164   print "<#part type=text/plain filename=\"$tmp\" disposition=inline>\n"
 165     . "<#/part>";
 166
 167   open OUT, '>', $tmp
 168     or die "$ME: $tmp: cannot open for writing: $!\n";
 169
 170   foreach my $meth (qw (md5 sha1))
 171     {
 172       foreach my $f (($tgz, $tbz, $xd))
 173         {
 174           open IN, '<', $f
 175             or die "$ME: $f: cannot open for reading: $!\n";
 176           binmode IN;
 177           my $dig =
 178             ($meth eq 'md5'
 179              ? Digest::MD5->new->addfile(*IN)->hexdigest
 180              : Digest::SHA1->new->addfile(*IN)->hexdigest);
 181           close IN;
 182           print OUT "$dig  $f\n";
 183         }
 184     }
 185
 186   close OUT
 187     or die "$ME: $tmp: while writing: $!\n";
 188   chmod 0400, $tmp;  # ignore failure
 189
 190   # FIXME: depend on whether it's a test release
 191   # sed -n "$news-r1),$news-r2)p" NEWS
 192   #   | grep -v '^\[';
 193   # echo;
 194   # echo ChangeLog entries:;
 195   # find . -name ChangeLog -maxdepth 2
 196   #   | xargs $(CVS) diff -up -r$(prev-cvs-tag) -rHEAD
 197   #   | sed -n 's/^+//p'
 198   #   | perl -ne 'm!^\+\+ (\./)?! or print,next;'
 199   #     -e 'print "\n"."*"x70 ."\n"; s///; print; print "*"x70 ."\n"';
 200 }