build-aux/gen-changelog

   1 #!/usr/bin/perl
   2 #
   3 # gen-changelog
   4 #
   5 # Copyright © 2020-2022 Guillem Jover <guillem@debian.org>
   6 #
   7 # This program is free software; you can redistribute it and/or modify
   8 # it under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; either version 2 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # This program is distributed in the hope that it will be useful,
  13 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with this program.  If not, see <https://www.gnu.org/licenses/>.
  19 #
  20
  21 use strict;
  22 use warnings;
  23
  24 use lib 'scripts';
  25
  26 use List::Util qw(uniq);
  27 use Text::Wrap;
  28 use Dpkg::IPC;
  29 use Dpkg::Index;
  30
  31 my @sections = qw(
  32     main
  33     arch
  34     port
  35     perl-mod
  36     make-mod
  37     doc
  38     code-int
  39     build-sys
  40     pkg
  41     test
  42     l10n
  43 );
  44
  45 my %sections = (
  46     arch => {
  47         title => 'Architecture support',
  48         match => qr/^arch: /,
  49     },
  50     port => {
  51         title => 'Portability',
  52         type => 'porting',
  53     },
  54     'perl-mod' => {
  55         title => 'Perl modules',
  56         match => qr/^(?:Test|Dpkg|Dselect).*[,:] /,
  57         keep => 1,
  58     },
  59     'make-mod' => {
  60         title => 'Make fragments',
  61         match => qr{^scripts/mk: },
  62     },
  63     doc => {
  64         title => 'Documentation',
  65         match => qr/^(?:doc|man)[,:] /,
  66         keep => 1,
  67     },
  68     'code-int' => {
  69         title => 'Code internals',
  70         type => 'internal',
  71         match => qr/^(?:lib(?:compat|dpkg)?|src|scripts|perl|utils): /,
  72         keep => 1,
  73     },
  74     'build-sys' => {
  75         title => 'Build system',
  76         match => qr/^build: /,
  77     },
  78     pkg => {
  79         title => 'Packaging',
  80         match => qr/^debian: /,
  81     },
  82     test => {
  83         title => 'Test suite',
  84         match => qr/^(?:test|t): /,
  85     },
  86     l10n => {
  87         title => 'Localization',
  88         match => qr/^po: /,
  89         sort => 1,
  90     },
  91 );
  92
  93 my @metafields = qw(
  94     Thanks-to
  95     Co-Author
  96     Based-on-patch-by
  97     Improved-by
  98     Prompted-by
  99     Reported-by
 100     Required-by
 101     Analysis-by
 102     Requested-by
 103     Suggested-by
 104     Spotted-by
 105     Naming-by
 106     Ref
 107 );
 108
 109 my %metafield = (
 110     'Co-Author' => 'Co-authored by',
 111     'Based-on-patch-by' => 'Based on a patch by',
 112     'Improved-by' => 'Improved by',
 113     'Prompted-by' => 'Prompted by',
 114     'Reported-by' => 'Reported by',
 115     'Required-by' => 'Required by',
 116     'Analysis-by' => 'Analysis by',
 117     'Requested-by' => 'Requested by',
 118     'Suggested-by' => 'Suggested by',
 119     'Spotted-by' => 'Spotted by',
 120     'Naming-by' => 'Naming by',
 121     'Thanks-to' => 'Thanks to',
 122     'Ref' => 'See',
 123 );
 124
 125 my %mappings = (
 126     'u-a' => 'update-alternatives',
 127     's-s-d' => 'start-stop-daemon',
 128     'dpkg-m-h' => 'dpkg-maintscript-helper',
 129 );
 130
 131 my $log_format =
 132     'Commit: %H%n' .
 133     'Author: %aN%n' .
 134     'AuthorEmail: %aE%n' .
 135     'Committer: %cN%n' .
 136     'CommitterEmail: %cE%n' .
 137     'Title: %s%n' .
 138     '%(trailers:only,unfold)%N';
 139
 140 my $tag_prev = $ARGV[0];
 141 my $tag_next = $ARGV[1] // "";
 142
 143 $tag_prev //= qx(git describe --abbrev=0);
 144 chomp $tag_prev;
 145
 146 my $fh_gitlog;
 147
 148 spawn(
 149     exec => [
 150         qw(git log --first-parent), "--format=tformat:$log_format",
 151         "$tag_prev..$tag_next"
 152     ],
 153     to_pipe => \$fh_gitlog,
 154 );
 155
 156 my $log = Dpkg::Index->new(
 157     get_key_func => sub { return $_[0]->{Commit} },
 158     item_opts => {
 159         keep_duplicate => 1,
 160         allow_duplicate => 1,
 161     },
 162 );
 163 $log->parse($fh_gitlog, 'git log');
 164
 165 my %entries;
 166 my %groups;
 167 my @groups;
 168
 169 # Analyze the commits and select which group and section to place them in.
 170 foreach my $id (reverse $log->get_keys()) {
 171     my $commit = $log->get_by_key($id);
 172     my $title = $commit->{Title};
 173     my $group = $commit->{Committer};
 174     my $changelog = $commit->{'Changelog'};
 175     my $sectmatch = 'main';
 176
 177     # Skip irrelevant commits.
 178     if ($title =~ m/^(?:Bump version to|Release) /) {
 179         next;
 180     }
 181     if ($title =~ m/^po: Regenerate/) {
 182         next;
 183     }
 184
 185     if (defined $changelog) {
 186         # Skip silent commits.
 187         next if $changelog =~ m/(?:silent|skip|ignore)/;
 188
 189         # Include the entire commit body for verbose commits.
 190         if ($changelog =~ m/(?:verbose|full)/) {
 191             my $body = qx(git show -s --pretty=tformat:%b $id);
 192             $commit->{Title} .= "\n$body";
 193         }
 194
 195         if ($changelog =~ m{s/([^/]+)/([^/]+)/}) {
 196             $commit->{Fixup} = {
 197                 old => $1,
 198                 new => $2,
 199             };
 200         }
 201     }
 202
 203     # Decide into what section the commit should go.
 204     foreach my $sectname (keys %sections) {
 205         my $section = $sections{$sectname};
 206
 207         if ((exists $section->{match} and $title =~ m/$section->{match}/) or
 208             (exists $section->{type} and defined $changelog and
 209              $changelog =~ m/$section->{type}/)) {
 210             $sectmatch = $sectname;
 211             last;
 212         }
 213     }
 214
 215     # Add the group entries in order, with l10n ones at the end.
 216     if (not exists $entries{$group}) {
 217         push @groups, $group;
 218     }
 219
 220     push @{$entries{$group}{$sectmatch}}, $commit;
 221 }
 222
 223 # Go over the groups and their sections and format them.
 224 foreach my $groupname (@groups) {
 225     print "\n";
 226     print "  [ $groupname ]\n";
 227
 228     foreach my $sectname (@sections) {
 229         my $section = $sections{$sectname};
 230
 231         next unless exists $entries{$groupname}{$sectname};
 232         next if @{$entries{$groupname}{$sectname}} == 0;
 233
 234         if (exists $sections{$sectname}->{title}) {
 235             print "  * $sections{$sectname}->{title}:\n";
 236         }
 237         my @entries;
 238         foreach my $commit (@{$entries{$groupname}{$sectname}}) {
 239             my $title = $commit->{Title} =~ s/\.$//r . '.';
 240
 241             # Remove the title prefix if needed.
 242             if (exists $section->{match} and not exists $section->{keep}) {
 243                 $title =~ s/$section->{match}//;
 244             }
 245
 246             # Metafields.
 247             if ($commit->{Author} ne $commit->{Committer}) {
 248                 $commit->{'Thanks-to'} = "$commit->{Author} <$commit->{AuthorEmail}>";
 249             }
 250             foreach my $metafield (@metafields) {
 251                 next unless exists $commit->{$metafield};
 252
 253                 my $values = $commit->{$metafield};
 254                 $values = [ $values ] if ref $values ne 'ARRAY';
 255
 256                 foreach my $value (@{$values}) {
 257                     $title .= "\n$metafield{$metafield} $value.";
 258                 }
 259             }
 260             # Handle the Closes metafield last.
 261             if (exists $commit->{Closes}) {
 262                 $title .= " Closes: $commit->{Closes}";
 263             }
 264
 265             # Handle fixups from git notes.
 266             if (exists $commit->{Fixup}) {
 267                 $title =~ s/\Q$commit->{Fixup}{old}\E/$commit->{Fixup}{new}/m;
 268             }
 269
 270             # Handle mappings.
 271             foreach my $mapping (keys %mappings) {
 272                 $title =~ s/$mapping/$mappings{$mapping}/g;
 273             }
 274
 275             # Select prefix formatting.
 276             my ($entry_tab, $body_tab);
 277             if (not exists $sections{$sectname}->{title}) {
 278                 $entry_tab = '  * ';
 279                 $body_tab  = '    ';
 280             } else {
 281                 $entry_tab = '    - ';
 282                 $body_tab  = '      ';
 283             }
 284
 285             local $Text::Wrap::columns = 80;
 286             local $Text::Wrap::unexpand = 0;
 287             local $Text::Wrap::huge = 'overflow';
 288             local $Text::Wrap::break = qr/(?<!Closes:)\s/;
 289             push @entries, wrap($entry_tab, $body_tab, $title) . "\n";
 290         }
 291
 292         if ($sections{$sectname}->{sort}) {
 293             @entries = uniq(sort @entries);
 294         }
 295
 296         print @entries;
 297     }
 298 }