git-grep-footer

   1 #!/usr/bin/perl
   2 use 5.010;
   3 use strict;
   4 use warnings;
   5 use open ':std', OUT => ':utf8';
   6 use Encode 'decode';
   7 use Data::Dump 'pp';
   8 use Getopt::Long qw(:config bundling);
   9
  10 GetOptions(\my %opt,
  11         'debug!',
  12         'count|c!',
  13         'simplify|s:s',
  14         'ignore-case|i!',
  15         'fuzzy!',
  16         'min|min-count|unique|u:i',
  17         'max|max-count|show|n:i',
  18         'version|V'  => sub { Getopt::Long::VersionMessage() },
  19         'usage|h'    => sub { Getopt::Long::HelpMessage() },
  20         'help|man|?' => sub { Getopt::Long::HelpMessage(-verbose => 2) },
  21 ) or exit 129;
  22
  23 local $| = 1;
  24 local $/ = "\0";
  25
  26 my $HEADERMATCH = qr/ [a-z]+ (?: (?:-\w+)+ | \ by ) | cc | reference /ix;
  27
  28 my (%headercount, @headercache);
  29
  30 while (readline) {
  31         s/^([0-9a-f]{4,40})\n//m and
  32         my $hash = $1;
  33
  34         # strip commit seperator
  35         chomp;
  36         # skip expensive checks without potential identifier
  37         m/:/ or next;
  38         # try to parse as UTF-8
  39         eval { $_ = decode(utf8   => $_, Encode::FB_CROAK()) };
  40         # if invalid, assume it's latin1
  41                $_ = decode(cp1252 => $_) if $@;
  42
  43         my %attr;
  44
  45         BLOCK:
  46         for (reverse split /\n\n/) {
  47                 my @headers;
  48                 my $prefix = 0;
  49
  50                 LINE:
  51                 for (split /\n/) {
  52                         next if not /\S/;
  53                         my @header = m{
  54                                 ^
  55                                 (?<key> $HEADERMATCH)
  56                                 : \s*
  57                                 (?<val> \S .+)
  58                                 $
  59                         }imx or do {
  60                                 $prefix++;
  61                                 next LINE;
  62                         };
  63
  64                         push @header, $_ if defined $opt{max};
  65
  66                         if ($opt{fuzzy}) {
  67                                 for ($header[0]) {
  68                                         tr/ _/-/;
  69
  70                                         state $BY = qr{ (?: -? b[yu] )? \Z }ix;
  71                                         s{^ si (?:ge?n|n?g) (?:e?[dt])? -? (?:of+)? $BY}{Signed-off-by}ix;
  72                                         s{^ ack (?:ed|de)?  $BY}{Acked-by}ix;
  73                                         s{^ review (?:e?d)? $BY}{Reviewed-by}ix;
  74                                         s{^ teste[dt]       $BY}{Tested-by}ix;
  75                                 }
  76                         }
  77
  78                         given ($opt{simplify} // 'none') {
  79                                 when (['email', 'authors']) {
  80                                         $header[1] =~ s{
  81                                                 \A
  82                                                 (?: [^:;]+ )?
  83                                                 < [^@>]+ (?: @ | \h?\W? at \W?\h? ) [a-z0-9.-]+ >
  84                                                 \Z
  85                                         }{<...>}imsx;
  86                                 }
  87                                 when (['var', 'vars', '']) {
  88                                         when ($header[0] =~ /[ _-] (?: by | to ) $ | ^cc$/imsx) {
  89                                                 $header[1] = undef;
  90                                         }
  91                                         for ($header[1]) {
  92                                                 s{\b (https?)://\S+ }{[$1]}gmsx;  # url
  93                                                 s{(?: < | \A ) [^@>\s]+ @ [^>]+ (?: > | \Z )}{<...>}igmsx;  # address
  94                                                 s{\b [0-9]+ \b}{[num]}gmsx;  # number
  95                                                 s{\b [Ig]? [0-9a-f]{  40} \b}{[sha1]}gmsx;  # hash
  96                                                 s{\b [Ig]? [0-9a-f]{6,40} \b}{[hash]}gmsx;  # abbrev
  97                                         }
  98                                 }
  99                                 when (['all', 'contents']) {
 100                                         $header[1] = undef;
 101                                 }
 102                                 when (['none', 'no', '0']) {
 103                                 }
 104                                 default {
 105                                         die "Unknown simplify option: '$_'\n";
 106                                 }
 107                         }
 108
 109                         if ($opt{'ignore-case'}) {
 110                                 $_ = lc for $header[0], $header[1] // ();
 111                         }
 112
 113                         pop @header if not defined $header[-1];
 114
 115                         push @headers, \@header;
 116                 }
 117
 118                 next BLOCK if not @headers;
 119
 120                 if ($opt{debug} and $prefix) {
 121                         say sprintf ': invalid lines in %s (%s)', $hash // 'block', $prefix;
 122                 }
 123
 124                 for (@headers) {
 125                         my $line = $_->[2] // join(': ', @$_);
 126                         $line =~ s/^/$hash / if defined $hash;
 127
 128                         if (defined $opt{min} or $opt{max} or $opt{count}) {
 129                                 my $counter = \$headercount{ $_->[0] }->{ $_->[1] // '' };
 130                                 my $excess = $$counter++ - ($opt{min} // 0);
 131                                 next if $excess >= ($opt{max} || 1);
 132                                 next if $excess <  0;
 133                                 if ($opt{count}) {
 134                                         push @headercache, [ $line, $excess ? \undef : $counter ];
 135                                         next;
 136                                 }
 137                         }
 138                         say $line;
 139                 }
 140
 141                 last BLOCK;
 142         }
 143 }
 144
 145 for (@headercache) {
 146         say ${$_->[1]} // '', "\t", $_->[0];
 147 }
 148
 149 __END__
 150
 151 =head1 NAME
 152
 153 git-grep-footer - Find custom header lines in commit messages
 154
 155 =head1 SYNOPSIS
 156
 157 F<git> log --pretty=%b%x00 | F<git-grep-footer> [OPTIONS]
 158
 159 =head1 DESCRIPTION
 160
 161 Filters out header sections near the end of a commit body,
 162 a common convention to list custom metadata such as
 163 C<Signed-off-by> and C<Acked-by>.
 164
 165 Sections are identified by at least one leading keyword containing a dash
 166 (or exceptionally recognised)
 167 followed by a colon.
 168
 169 =head1 OPTIONS
 170
 171 =over
 172
 173 =item -i, --ignore-case
 174
 175 Lowercases everything.
 176
 177 =item -s, --simplify[=<rule>]
 178
 179 Modifies values to hide specific details.
 180 Several different rules are supported:
 181
 182 =over
 183
 184 =item I<var> (default)
 185
 186 Replaces highly variable contents such as numbers, hashes, and addresses,
 187 leaving only exceptional annotations as distinct text.
 188 Attributes ending in I<-to> or I<-by> are assumed variable author names
 189 and omitted entirely,
 190 unless they contain a colon indicating possible attribute exceptions.
 191
 192 =item I<email>
 193
 194 Filters out author lines following the git signoff convention,
 195 i.e. an <email address> optionally preceded by a name.
 196
 197 =item I<all>
 198
 199 Values will be hidden entirely, so only attribute names remain.
 200
 201 =back
 202
 203 =item -u, --unique[=<threshold>]
 204
 205 Each match is only shown once,
 206 optionally after it has already occurred a given amount of times.
 207
 208 =item -n, --show[=<limit>]
 209
 210 The original line is given for each match,
 211 but simplifications still apply for duplicate determination.
 212 Additional samples are optionally given upto the given maximum.
 213
 214 =item -c, --count
 215
 216 Prefixes (unique) lines by the number of occurrences.
 217 Causes output to be buffered until all input has been read (obviously).
 218
 219 =back
 220
 221 =head1 AUTHOR
 222
 223 Mischa POSLAWSKY <perl@shiar.org>
 224
 225 =head1 LICENSE
 226
 227 Copyright. All rights reserved.
 228