/[autoconf]/autoconf/config/announce-gen
ViewVC logotype

Diff of /autoconf/config/announce-gen

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.4 by akim, Tue Sep 30 13:07:28 2003 UTC revision 1.5 by akim, Mon Nov 24 16:11:41 2003 UTC
# Line 72  EOF Line 72  EOF
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) = @_;
# Line 113  sub print_news_deltas ($$$) Line 204  sub print_news_deltas ($$$)
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) = @_;
# Line 200  sub print_changelog_deltas ($$) Line 292  sub print_changelog_deltas ($$)
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;
# Line 250  sub print_changelog_deltas ($$) Line 346  sub print_changelog_deltas ($$)
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.
# Line 279  FIXME: put comments here Line 362  FIXME: put comments here
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;

Legend:
Removed from v.1.4  
changed lines
  Added in v.1.5

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26