Prepare for 0.1 release: gnu-build-system.
[mes.git] / build-aux / gitlog-to-changelog
1 eval '(exit $?0)' && eval 'exec perl -wS "$0" "$@"'
2   & eval 'exec perl -wS "$0" $argv:q'
3     if 0;
4 # Convert git log output to ChangeLog format.
5
6 my $VERSION = '2016-10-16 06:30'; # UTC
7 # The definition above must lie within the first 8 lines in order
8 # for the Emacs time-stamp write hook (at end) to update it.
9 # If you change this file with Emacs, please let the write hook
10 # do its job.  Otherwise, update this string manually.
11
12 # Copyright (C) 2008-2016 Free Software Foundation, Inc.
13
14 # This program is free software: you can redistribute it and/or modify
15 # it under the terms of the GNU General Public License as published by
16 # the Free Software Foundation, either version 3 of the License, or
17 # (at your option) any later version.
18
19 # This program is distributed in the hope that it will be useful,
20 # but WITHOUT ANY WARRANTY; without even the implied warranty of
21 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
22 # GNU General Public License for more details.
23
24 # You should have received a copy of the GNU General Public License
25 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
26
27 # Written by Jim Meyering
28
29 use strict;
30 use warnings;
31 use Getopt::Long;
32 use POSIX qw(strftime);
33
34 (my $ME = $0) =~ s|.*/||;
35
36 # use File::Coda; # http://meyering.net/code/Coda/
37 END {
38   defined fileno STDOUT or return;
39   close STDOUT and return;
40   warn "$ME: failed to close standard output: $!\n";
41   $? ||= 1;
42 }
43
44 sub usage ($)
45 {
46   my ($exit_code) = @_;
47   my $STREAM = ($exit_code == 0 ? *STDOUT : *STDERR);
48   if ($exit_code != 0)
49     {
50       print $STREAM "Try '$ME --help' for more information.\n";
51     }
52   else
53     {
54       print $STREAM <<EOF;
55 Usage: $ME [OPTIONS] [ARGS]
56
57 Convert git log output to ChangeLog format.  If present, any ARGS
58 are passed to "git log".  To avoid ARGS being parsed as options to
59 $ME, they may be preceded by '--'.
60
61 OPTIONS:
62
63    --amend=FILE FILE maps from an SHA1 to perl code (i.e., s/old/new/) that
64                   makes a change to SHA1's commit log text or metadata.
65    --append-dot append a dot to the first line of each commit message if
66                   there is no other punctuation or blank at the end.
67    --no-cluster never cluster commit messages under the same date/author
68                   header; the default is to cluster adjacent commit messages
69                   if their headers are the same and neither commit message
70                   contains multiple paragraphs.
71    --srcdir=DIR the root of the source tree, from which the .git/
72                   directory can be derived.
73    --since=DATE convert only the logs since DATE;
74                   the default is to convert all log entries.
75    --until=DATE convert only the logs older than DATE.
76    --ignore-matching=PAT ignore commit messages whose first lines match PAT.
77    --ignore-line=PAT ignore lines of commit messages that match PAT.
78    --format=FMT set format string for commit subject and body;
79                   see 'man git-log' for the list of format metacharacters;
80                   the default is '%s%n%b%n'
81    --strip-tab  remove one additional leading TAB from commit message lines.
82    --strip-cherry-pick  remove data inserted by "git cherry-pick";
83                   this includes the "cherry picked from commit ..." line,
84                   and the possible final "Conflicts:" paragraph.
85    --help       display this help and exit
86    --version    output version information and exit
87
88 EXAMPLE:
89
90   $ME --since=2008-01-01 > ChangeLog
91   $ME -- -n 5 foo > last-5-commits-to-branch-foo
92
93 SPECIAL SYNTAX:
94
95 The following types of strings are interpreted specially when they appear
96 at the beginning of a log message line.  They are not copied to the output.
97
98   Copyright-paperwork-exempt: Yes
99     Append the "(tiny change)" notation to the usual "date name email"
100     ChangeLog header to mark a change that does not require a copyright
101     assignment.
102   Co-authored-by: Joe User <user\@example.com>
103     List the specified name and email address on a second
104     ChangeLog header, denoting a co-author.
105   Signed-off-by: Joe User <user\@example.com>
106     These lines are simply elided.
107
108 In a FILE specified via --amend, comment lines (starting with "#") are ignored.
109 FILE must consist of <SHA,CODE+> pairs where SHA is a 40-byte SHA1 (alone on
110 a line) referring to a commit in the current project, and CODE refers to one
111 or more consecutive lines of Perl code.  Pairs must be separated by one or
112 more blank line.
113
114 Here is sample input for use with --amend=FILE, from coreutils:
115
116 3a169f4c5d9159283548178668d2fae6fced3030
117 # fix typo in title:
118 s/all tile types/all file types/
119
120 1379ed974f1fa39b12e2ffab18b3f7a607082202
121 # Due to a bug in vc-dwim, I mis-attributed a patch by Paul to myself.
122 # Change the author to be Paul.  Note the escaped "@":
123 s,Jim .*>,Paul Eggert <eggert\\\@cs.ucla.edu>,
124
125 EOF
126     }
127   exit $exit_code;
128 }
129
130 # If the string $S is a well-behaved file name, simply return it.
131 # If it contains white space, quotes, etc., quote it, and return the new string.
132 sub shell_quote($)
133 {
134   my ($s) = @_;
135   if ($s =~ m![^\w+/.,-]!)
136     {
137       # Convert each single quote to '\''
138       $s =~ s/\'/\'\\\'\'/g;
139       # Then single quote the string.
140       $s = "'$s'";
141     }
142   return $s;
143 }
144
145 sub quoted_cmd(@)
146 {
147   return join (' ', map {shell_quote $_} @_);
148 }
149
150 # Parse file F.
151 # Comment lines (starting with "#") are ignored.
152 # F must consist of <SHA,CODE+> pairs where SHA is a 40-byte SHA1
153 # (alone on a line) referring to a commit in the current project, and
154 # CODE refers to one or more consecutive lines of Perl code.
155 # Pairs must be separated by one or more blank line.
156 sub parse_amend_file($)
157 {
158   my ($f) = @_;
159
160   open F, '<', $f
161     or die "$ME: $f: failed to open for reading: $!\n";
162
163   my $fail;
164   my $h = {};
165   my $in_code = 0;
166   my $sha;
167   while (defined (my $line = <F>))
168     {
169       $line =~ /^\#/
170         and next;
171       chomp $line;
172       $line eq ''
173         and $in_code = 0, next;
174
175       if (!$in_code)
176         {
177           $line =~ /^([0-9a-fA-F]{40})$/
178             or (warn "$ME: $f:$.: invalid line; expected an SHA1\n"),
179               $fail = 1, next;
180           $sha = lc $1;
181           $in_code = 1;
182           exists $h->{$sha}
183             and (warn "$ME: $f:$.: duplicate SHA1\n"),
184               $fail = 1, next;
185         }
186       else
187         {
188           $h->{$sha} ||= '';
189           $h->{$sha} .= "$line\n";
190         }
191     }
192   close F;
193
194   $fail
195     and exit 1;
196
197   return $h;
198 }
199
200 # git_dir_option $SRCDIR
201 #
202 # From $SRCDIR, the --git-dir option to pass to git (none if $SRCDIR
203 # is undef).  Return as a list (0 or 1 element).
204 sub git_dir_option($)
205 {
206   my ($srcdir) = @_;
207   my @res = ();
208   if (defined $srcdir)
209     {
210       my $qdir = shell_quote $srcdir;
211       my $cmd = "cd $qdir && git rev-parse --show-toplevel";
212       my $qcmd = shell_quote $cmd;
213       my $git_dir = qx($cmd);
214       defined $git_dir
215         or die "$ME: cannot run $qcmd: $!\n";
216       $? == 0
217         or die "$ME: $qcmd had unexpected exit code or signal ($?)\n";
218       chomp $git_dir;
219       push @res, "--git-dir=$git_dir/.git";
220     }
221   @res;
222 }
223
224 {
225   my $since_date;
226   my $until_date;
227   my $format_string = '%s%n%b%n';
228   my $amend_file;
229   my $append_dot = 0;
230   my $cluster = 1;
231   my $ignore_matching;
232   my $ignore_line;
233   my $strip_tab = 0;
234   my $strip_cherry_pick = 0;
235   my $srcdir;
236   GetOptions
237     (
238      help => sub { usage 0 },
239      version => sub { print "$ME version $VERSION\n"; exit },
240      'since=s' => \$since_date,
241      'until=s' => \$until_date,
242      'format=s' => \$format_string,
243      'amend=s' => \$amend_file,
244      'append-dot' => \$append_dot,
245      'cluster!' => \$cluster,
246      'ignore-matching=s' => \$ignore_matching,
247      'ignore-line=s' => \$ignore_line,
248      'strip-tab' => \$strip_tab,
249      'strip-cherry-pick' => \$strip_cherry_pick,
250      'srcdir=s' => \$srcdir,
251     ) or usage 1;
252
253   defined $since_date
254     and unshift @ARGV, "--since=$since_date";
255   defined $until_date
256     and unshift @ARGV, "--until=$until_date";
257
258   # This is a hash that maps an SHA1 to perl code (i.e., s/old/new/)
259   # that makes a correction in the log or attribution of that commit.
260   my $amend_code = defined $amend_file ? parse_amend_file $amend_file : {};
261
262   my @cmd = ('git',
263              git_dir_option $srcdir,
264              qw(log --log-size),
265              '--pretty=format:%H:%ct  %an  <%ae>%n%n'.$format_string, @ARGV);
266   open PIPE, '-|', @cmd
267     or die ("$ME: failed to run '". quoted_cmd (@cmd) ."': $!\n"
268             . "(Is your Git too old?  Version 1.5.1 or later is required.)\n");
269
270   my $prev_multi_paragraph;
271   my $prev_date_line = '';
272   my @prev_coauthors = ();
273   my @skipshas = ();
274   while (1)
275     {
276       defined (my $in = <PIPE>)
277         or last;
278       $in =~ /^log size (\d+)$/
279         or die "$ME:$.: Invalid line (expected log size):\n$in";
280       my $log_nbytes = $1;
281
282       my $log;
283       my $n_read = read PIPE, $log, $log_nbytes;
284       $n_read == $log_nbytes
285         or die "$ME:$.: unexpected EOF\n";
286
287       # Extract leading hash.
288       my ($sha, $rest) = split ':', $log, 2;
289       defined $sha
290         or die "$ME:$.: malformed log entry\n";
291       $sha =~ /^[0-9a-fA-F]{40}$/
292         or die "$ME:$.: invalid SHA1: $sha\n";
293
294       my $skipflag = 0;
295       if (@skipshas)
296         {
297           foreach(@skipshas)
298             {
299               if ($sha =~ /^$_/)
300                 {
301                   $skipflag = $_;
302                   last;
303                 }
304             }
305         }
306
307       # If this commit's log requires any transformation, do it now.
308       my $code = $amend_code->{$sha};
309       if (defined $code)
310         {
311           eval 'use Safe';
312           my $s = new Safe;
313           # Put the unpreprocessed entry into "$_".
314           $_ = $rest;
315
316           # Let $code operate on it, safely.
317           my $r = $s->reval("$code")
318             or die "$ME:$.:$sha: failed to eval \"$code\":\n$@\n";
319
320           # Note that we've used this entry.
321           delete $amend_code->{$sha};
322
323           # Update $rest upon success.
324           $rest = $_;
325         }
326
327       # Remove lines inserted by "git cherry-pick".
328       if ($strip_cherry_pick)
329         {
330           $rest =~ s/^\s*Conflicts:\n.*//sm;
331           $rest =~ s/^\s*\(cherry picked from commit [\da-f]+\)\n//m;
332         }
333
334       my @line = split /[ \t]*\n/, $rest;
335       my $author_line = shift @line;
336       defined $author_line
337         or die "$ME:$.: unexpected EOF\n";
338       $author_line =~ /^(\d+)  (.*>)$/
339         or die "$ME:$.: Invalid line "
340           . "(expected date/author/email):\n$author_line\n";
341
342       # Format 'Copyright-paperwork-exempt: Yes' as a standard ChangeLog
343       # `(tiny change)' annotation.
344       my $tiny = (grep (/^(?:Copyright-paperwork-exempt|Tiny-change):\s+[Yy]es$/, @line)
345                   ? '  (tiny change)' : '');
346
347       my $date_line = sprintf "%s  %s$tiny\n",
348         strftime ("%Y-%m-%d", localtime ($1)), $2;
349
350       my @coauthors = grep /^Co-authored-by:.*$/, @line;
351       # Omit meta-data lines we've already interpreted.
352       @line = grep !/^(?:Signed-off-by:[ ].*>$
353                        |Co-authored-by:[ ]
354                        |Copyright-paperwork-exempt:[ ]
355                        |Tiny-change:[ ]
356                        )/x, @line;
357
358       # Remove leading and trailing blank lines.
359       if (@line)
360         {
361           while ($line[0] =~ /^\s*$/) { shift @line; }
362           while ($line[$#line] =~ /^\s*$/) { pop @line; }
363         }
364
365       # Handle Emacs gitmerge.el "skipped" commits.
366       # Yes, this should be controlled by an option.  So sue me.
367       if ( grep /^(; )?Merge from /, @line )
368       {
369           my $found = 0;
370           foreach (@line)
371           {
372               if (grep /^The following commit.*skipped:$/, $_)
373               {
374                   $found = 1;
375                   ## Reset at each merge to reduce chance of false matches.
376                   @skipshas = ();
377                   next;
378               }
379               if ($found && $_ =~ /^([0-9a-fA-F]{7,}) [^ ]/)
380               {
381                   push ( @skipshas, $1 );
382               }
383           }
384       }
385
386       # Ignore commits that match the --ignore-matching pattern, if specified.
387       if (defined $ignore_matching && @line && $line[0] =~ /$ignore_matching/)
388         {
389           $skipflag = 1;
390         }
391       elsif ($skipflag)
392         {
393           ## Perhaps only warn if a pattern matches more than once?
394           warn "$ME: warning: skipping $sha due to $skipflag\n";
395         }
396
397       if (! $skipflag)
398         {
399           if (defined $ignore_line && @line)
400             {
401               @line = grep ! /$ignore_line/, @line;
402               while ($line[$#line] =~ /^\s*$/) { pop @line; }
403             }
404
405           # Record whether there are two or more paragraphs.
406           my $multi_paragraph = grep /^\s*$/, @line;
407
408           # Format 'Co-authored-by: A U Thor <email@example.com>' lines in
409           # standard multi-author ChangeLog format.
410           for (@coauthors)
411             {
412               s/^Co-authored-by:\s*/\t    /;
413               s/\s*</  </;
414
415               /<.*?@.*\..*>/
416                 or warn "$ME: warning: missing email address for "
417                   . substr ($_, 5) . "\n";
418             }
419
420           # If clustering of commit messages has been disabled, if this header
421           # would be different from the previous date/name/etc. header,
422           # or if this or the previous entry consists of two or more paragraphs,
423           # then print the header.
424           if ( ! $cluster
425               || $date_line ne $prev_date_line
426               || "@coauthors" ne "@prev_coauthors"
427               || $multi_paragraph
428               || $prev_multi_paragraph)
429             {
430               $prev_date_line eq ''
431                 or print "\n";
432               print $date_line;
433               @coauthors
434                 and print join ("\n", @coauthors), "\n";
435             }
436           $prev_date_line = $date_line;
437           @prev_coauthors = @coauthors;
438           $prev_multi_paragraph = $multi_paragraph;
439
440           # If there were any lines
441           if (@line == 0)
442             {
443               warn "$ME: warning: empty commit message:\n  $date_line\n";
444             }
445           else
446             {
447               if ($append_dot)
448                 {
449                   # If the first line of the message has enough room, then
450                   if (length $line[0] < 72)
451                     {
452                       # append a dot if there is no other punctuation or blank
453                       # at the end.
454                       $line[0] =~ /[[:punct:]\s]$/
455                         or $line[0] .= '.';
456                     }
457                 }
458
459               # Remove one additional leading TAB from each line.
460               $strip_tab
461                 and map { s/^\t// } @line;
462
463               # Prefix each non-empty line with a TAB.
464               @line = map { length $_ ? "\t$_" : '' } @line;
465
466               print "\n", join ("\n", @line), "\n";
467             }
468         }
469
470       defined ($in = <PIPE>)
471         or last;
472       $in ne "\n"
473         and die "$ME:$.: unexpected line:\n$in";
474     }
475
476   close PIPE
477     or die "$ME: error closing pipe from " . quoted_cmd (@cmd) . "\n";
478   # FIXME-someday: include $PROCESS_STATUS in the diagnostic
479
480   # Complain about any unused entry in the --amend=F specified file.
481   my $fail = 0;
482   foreach my $sha (keys %$amend_code)
483     {
484       warn "$ME:$amend_file: unused entry: $sha\n";
485       $fail = 1;
486     }
487
488   exit $fail;
489 }
490
491 # Local Variables:
492 # mode: perl
493 # indent-tabs-mode: nil
494 # eval: (add-hook 'write-file-hooks 'time-stamp)
495 # time-stamp-start: "my $VERSION = '"
496 # time-stamp-format: "%:y-%02m-%02d %02H:%02M"
497 # time-stamp-time-zone: "UTC0"
498 # time-stamp-end: "'; # UTC"
499 # End: