72 |
exit $exit_code; |
exit $exit_code; |
73 |
} |
} |
74 |
|
|
75 |
|
|
76 |
|
=item C<%size> = C<sizes (@file)> |
77 |
|
|
78 |
|
Compute the sizes of the C<@file> and return them as a hash. Return |
79 |
|
C<undef> if one of the computation failed. |
80 |
|
|
81 |
|
=cut |
82 |
|
|
83 |
|
sub sizes (@) |
84 |
|
{ |
85 |
|
my (@file) = @_; |
86 |
|
|
87 |
|
my $fail = 0; |
88 |
|
my %res; |
89 |
|
foreach my $f (@file) |
90 |
|
{ |
91 |
|
my $cmd = "du --human $f"; |
92 |
|
my $t = `$cmd`; |
93 |
|
# FIXME-someday: give a better diagnostic, a la $PROCESS_STATUS |
94 |
|
$@ |
95 |
|
and (warn "$ME: command failed: `$cmd'\n"), $fail = 1; |
96 |
|
chomp $t; |
97 |
|
$t =~ s/^([\d.]+[MkK]).*/${1}B/; |
98 |
|
$res{$f} = $t; |
99 |
|
} |
100 |
|
return $fail ? undef : %res; |
101 |
|
} |
102 |
|
|
103 |
|
=item C<print_locations ($title, \@url, \%size, @file) |
104 |
|
|
105 |
|
Print a section C<$title> dedicated to the list of <@file>, which |
106 |
|
sizes are stored in C<%size>, and which are available from the C<@url>. |
107 |
|
|
108 |
|
=cut |
109 |
|
|
110 |
|
sub print_locations ($\@\%@) |
111 |
|
{ |
112 |
|
my ($title, $url, $size, @file) = @_; |
113 |
|
print "Here are the $title:\n"; |
114 |
|
foreach my $url (@{$url}) |
115 |
|
{ |
116 |
|
for my $file (@file) |
117 |
|
{ |
118 |
|
print " $url/$file"; |
119 |
|
print " (", $$size{$file}, ")" |
120 |
|
if exists $$size{$file}; |
121 |
|
print "\n"; |
122 |
|
} |
123 |
|
} |
124 |
|
print "\n"; |
125 |
|
} |
126 |
|
|
127 |
|
=item C<print_signatures (@file) |
128 |
|
|
129 |
|
Print the MD5 and SHA1 signature section for each C<@file>. |
130 |
|
|
131 |
|
=cut |
132 |
|
|
133 |
|
sub print_signatures (@) |
134 |
|
{ |
135 |
|
my (@file) = @_; |
136 |
|
|
137 |
|
print "Here are the MD5 and SHA1 signatures:\n"; |
138 |
|
print "\n"; |
139 |
|
|
140 |
|
foreach my $meth (qw (md5 sha1)) |
141 |
|
{ |
142 |
|
foreach my $f (@file) |
143 |
|
{ |
144 |
|
open IN, '<', $f |
145 |
|
or die "$ME: $f: cannot open for reading: $!\n"; |
146 |
|
binmode IN; |
147 |
|
my $dig = |
148 |
|
($meth eq 'md5' |
149 |
|
? Digest::MD5->new->addfile(*IN)->hexdigest |
150 |
|
: Digest::SHA1->new->addfile(*IN)->hexdigest); |
151 |
|
close IN; |
152 |
|
print "$dig $f\n"; |
153 |
|
} |
154 |
|
} |
155 |
|
|
156 |
|
|
157 |
|
} |
158 |
|
|
159 |
|
=item C<print_news_deltas ($news_file, $prev_version, $curr_version) |
160 |
|
|
161 |
|
Print the section of the NEWS file C<$news_file> addressing changes |
162 |
|
between versions C<$prev_version> and C<$curr_version>. |
163 |
|
|
164 |
|
=cut |
165 |
|
|
166 |
sub print_news_deltas ($$$) |
sub print_news_deltas ($$$) |
167 |
{ |
{ |
168 |
my ($news_file, $prev_version, $curr_version) = @_; |
my ($news_file, $prev_version, $curr_version) = @_; |
204 |
or die "$ME: $news_file: no matching lines for `$curr_version'\n"; |
or die "$ME: $news_file: no matching lines for `$curr_version'\n"; |
205 |
} |
} |
206 |
|
|
207 |
|
|
208 |
sub print_changelog_deltas ($$) |
sub print_changelog_deltas ($$) |
209 |
{ |
{ |
210 |
my ($package_name, $prev_version) = @_; |
my ($package_name, $prev_version) = @_; |
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; |
my $release_type; |
300 |
my $package_name; |
my $package_name; |
301 |
my $prev_version; |
my $prev_version; |
346 |
my $tbz = "$my_distdir.tar.bz2"; |
my $tbz = "$my_distdir.tar.bz2"; |
347 |
my $xd = "$package_name-$prev_version-$curr_version.xdelta"; |
my $xd = "$package_name-$prev_version-$curr_version.xdelta"; |
348 |
|
|
349 |
my %size; |
my %size = sizes ($tgz, $tbz, $xd); |
350 |
|
%size |
351 |
foreach my $f ($tgz, $tbz, $xd) |
or exit 1; |
|
{ |
|
|
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; |
|
352 |
|
|
353 |
# The markup is escaped as <\# so that when this script is sent by |
# The markup is escaped as <\# so that when this script is sent by |
354 |
# mail (or part of a diff), Gnus is not triggered. |
# mail (or part of a diff), Gnus is not triggered. |
362 |
|
|
363 |
EOF |
EOF |
364 |
|
|
365 |
print "Here are the compressed sources:\n"; |
print_locations ("compressed sources", @url_dir_list, %size, |
366 |
foreach my $url (@url_dir_list) |
$tgz, $tbz); |
367 |
{ |
print_locations ("xdelta-style diffs", @url_dir_list, %size, |
368 |
print " $url/$tgz ($size{$tgz})\n"; |
$xd); |
369 |
print " $url/$tbz ($size{$tbz})\n"; |
print_locations ("GPG detached signatures", @url_dir_list, %size, |
370 |
} |
"$tgz.asc", "$tbz.asc"); |
|
|
|
|
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"; |
|
|
} |
|
|
} |
|
371 |
|
|
372 |
close OUT |
print_signatures ($tgz, $tbz, $xd); |
|
or die "$ME: $tmp: while writing: $!\n"; |
|
|
chmod 0400, $tmp; # ignore failure |
|
373 |
|
|
374 |
print_news_deltas ($_, $prev_version, $curr_version) |
print_news_deltas ($_, $prev_version, $curr_version) |
375 |
foreach @news_file; |
foreach @news_file; |