summaryrefslogtreecommitdiff
path: root/announce-gen
blob: a98fdff84d7dec9da87c516059d28acc0e8ab0bc (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
#!/usr/bin/perl -w
# Generate an announcement message.
use strict;

use Getopt::Long;
use Digest::MD5;
use Digest::SHA1;

(my $VERSION = '$Revision: 1.10 $ ') =~ tr/[0-9].//cd;
(my $ME = $0) =~ s|.*/||;

my %valid_release_types = map {$_ => 1} qw (alpha beta major);

END
{
  # Nobody ever checks the status of print()s.  That's okay, because
  # if any do fail, we're guaranteed to get an indicator when we close()
  # the filehandle.
  #
  # Close stdout now, and if there were no errors, return happy status.
  # If stdout has already been closed by the script, though, do nothing.
  defined fileno STDOUT
    or return;
  close STDOUT
    and return;

  # Errors closing stdout.  Indicate that, and hope stderr is OK.
  warn "$ME: closing standard output: $!\n";

  # Don't be so arrogant as to assume that we're the first END handler
  # defined, and thus the last one invoked.  There may be others yet
  # to come.  $? will be passed on to them, and to the final _exit().
  #
  # If it isn't already an error, make it one (and if it _is_ an error,
  # preserve the value: it might be important).
  $? ||= 1;
}

sub usage ($)
{
  my ($exit_code) = @_;
  my $STREAM = ($exit_code == 0 ? *STDOUT : *STDERR);
  if ($exit_code != 0)
    {
      print $STREAM "Try `$ME --help' for more information.\n";
    }
  else
    {
      print $STREAM <<EOF;
Usage: $ME [OPTIONS]

OPTIONS:

  Generate an announcement message.

  FIXME: describe the following

   --release-type=TYPE
   --package-name=PACKAGE_NAME
   --previous-version=VER
   --current-version=VER
   --release-archive-directory=DIR
   --url-directory=URL_DIR
   --news=NEWS_FILE

   --help             display this help and exit
   --version          output version information and exit

EOF
    }
  exit $exit_code;
}

{
  my $release_type;
  my $package_name;
  my $prev_version;
  my $curr_version;
  my $release_archive_dir;
  my @url_dir_list;
  my $news_file;

  GetOptions
    (
     'release-type=s' => \$release_type,
     'package-name=s' => \$package_name,
     'previous-version=s' => \$prev_version,
     'current-version=s' => \$curr_version,
     'release-archive-directory=s' => \$release_archive_dir,
     'url-directory=s@' => \@url_dir_list,
     'news=s@' => \$news_file,

     help => sub { usage 0 },
     version => sub { print "$ME version $VERSION\n"; exit },
    ) or usage 1;

  my $fail = 0;
  # Ensure that sure each required option is specified.
  $release_type
    or (warn "$ME: release type not specified\n"), $fail = 1;
  $package_name
    or (warn "$ME: package name not specified\n"), $fail = 1;
  $prev_version
    or (warn "$ME: previous version string not specified\n"), $fail = 1;
  $curr_version
    or (warn "$ME: current version string not specified\n"), $fail = 1;
  $release_archive_dir
    or (warn "$ME: release directory name not specified\n"), $fail = 1;
  @url_dir_list
    or (warn "$ME: URL directory name(s) not specified\n"), $fail = 1;

  exists $valid_release_types{$release_type}
    or (warn "$ME: `$release_type': invalid release type\n"), $fail = 1;

  @ARGV
    and (warn "$ME: too many arguments\n"), $fail = 1;
  $fail
    and usage 1;

  my $my_distdir = "$package_name-$curr_version";
  my $tgz = "$my_distdir.tar.gz";
  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;

  print <<EOF;

Subject: $my_distdir released

<#secure method=pgpmime mode=sign>

FIXME: put comments here

EOF

  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.sig\n";
      print "  $url/$tbz.sig\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";
  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";
	}
    }

  close OUT
    or die "$ME: $tmp: while writing: $!\n";
  chmod 0400, $tmp;  # ignore failure

  if ($news_file)
    {
      print "\nNEWS\n\n";

      # Print all lines from $news_file, starting with the first one
      # that mentions $curr_version up to but not including
      # the first occurrence of $prev_version.
      my $in_items;
      open NEWS, '<', $news_file
	or die "$ME: $news_file: cannot open for reading: $!\n";
      while (defined (my $line = <NEWS>))
	{
	  if ( ! $in_items)
	    {
	      $line =~ /^[^ *].*\Q$curr_version\E/o
		or next;
	      $in_items = 1;
	      print $line;
	    }
	  else
	    {
	      # Be careful that this regexp cannot match version numbers
	      # in NEWS items -- they might well say `introduced in 4.5.5',
	      # and we don't want that to match.
	      $line =~ /^[^ *].*\Q$prev_version\E/o
		and last;
	      print $line;
	    }
	}
      close NEWS;

      $in_items
	or die "$ME: $news_file: no matching lines\n";
    }

  # FIXME: Print ChangeLog entries only for test releases
  # echo ChangeLog entries:;
  # find . -name ChangeLog -maxdepth 2
  #   | xargs $(CVS) diff -up -r$(prev-cvs-tag) -rHEAD
  #   | sed -n 's/^+//p'
  #   | perl -ne 'm!^\+\+ (\./)?! or print,next;'
  #     -e 'print "\n"."*"x70 ."\n"; s///; print; print "*"x70 ."\n"';
}