annotate: Fix bug when parsing merges with differing real and logical parents.
[git/git.git] / git-annotate.perl
CommitLineData
c65e8987
RA
1#!/usr/bin/perl
2# Copyright 2006, Ryan Anderson <ryan@michonline.com>
3#
4# GPL v2 (See COPYING)
5#
6# This file is licensed under the GPL v2, or a later version
7# at the discretion of Linus Torvalds.
8
9use warnings;
10use strict;
87475f4d 11use Getopt::Long;
4788d11a 12use POSIX qw(strftime gmtime);
fe77bb1a 13use File::Basename qw(basename dirname);
c65e8987 14
4788d11a 15sub usage() {
fe77bb1a 16 print STDERR "Usage: ${\basename $0} [-s] [-S revs-file] file [ revision ]
87475f4d
RA
17 -l, --long
18 Show long rev (Defaults off)
d920e18f
JH
19 -t, --time
20 Show raw timestamp (Defaults off)
87475f4d
RA
21 -r, --rename
22 Follow renames (Defaults on).
23 -S, --rev-file revs-file
be767c91 24 Use revs from revs-file instead of calling git-rev-list
87475f4d
RA
25 -h, --help
26 This message.
fe77bb1a 27";
4788d11a
JS
28
29 exit(1);
30}
c65e8987 31
d920e18f 32our ($help, $longrev, $rename, $rawtime, $starting_rev, $rev_file) = (0, 0, 1);
87475f4d
RA
33
34my $rc = GetOptions( "long|l" => \$longrev,
d920e18f 35 "time|t" => \$rawtime,
87475f4d
RA
36 "help|h" => \$help,
37 "rename|r" => \$rename,
00931549 38 "rev-file|S=s" => \$rev_file);
fe77bb1a 39if (!$rc or $help or !@ARGV) {
87475f4d
RA
40 usage();
41}
4788d11a
JS
42
43my $filename = shift @ARGV;
87475f4d
RA
44if (@ARGV) {
45 $starting_rev = shift @ARGV;
46}
c65e8987
RA
47
48my @stack = (
49 {
87475f4d 50 'rev' => defined $starting_rev ? $starting_rev : "HEAD",
c65e8987
RA
51 'filename' => $filename,
52 },
53);
54
c65e8987 55our @filelines = ();
c65e8987 56
87475f4d
RA
57if (defined $starting_rev) {
58 @filelines = git_cat_file($starting_rev, $filename);
59} else {
60 open(F,"<",$filename)
61 or die "Failed to open filename: $!";
62
63 while(<F>) {
64 chomp;
65 push @filelines, $_;
66 }
67 close(F);
68
c65e8987 69}
87475f4d 70
c65e8987
RA
71our %revs;
72our @revqueue;
73our $head;
74
75my $revsprocessed = 0;
76while (my $bound = pop @stack) {
77 my @revisions = git_rev_list($bound->{'rev'}, $bound->{'filename'});
78 foreach my $revinst (@revisions) {
79 my ($rev, @parents) = @$revinst;
80 $head ||= $rev;
81
4788d11a
JS
82 if (!defined($rev)) {
83 $rev = "";
84 }
c65e8987
RA
85 $revs{$rev}{'filename'} = $bound->{'filename'};
86 if (scalar @parents > 0) {
87 $revs{$rev}{'parents'} = \@parents;
88 next;
89 }
90
87475f4d 91 if (!$rename) {
4788d11a
JS
92 next;
93 }
94
c65e8987
RA
95 my $newbound = find_parent_renames($rev, $bound->{'filename'});
96 if ( exists $newbound->{'filename'} && $newbound->{'filename'} ne $bound->{'filename'}) {
97 push @stack, $newbound;
98 $revs{$rev}{'parents'} = [$newbound->{'rev'}];
99 }
100 }
101}
102push @revqueue, $head;
5fcab3d7 103init_claim( defined $starting_rev ? $head : 'dirty');
87475f4d 104unless (defined $starting_rev) {
3f492ba1 105 my $diff = open_pipe("git","diff","HEAD", "--",$filename)
87475f4d
RA
106 or die "Failed to call git diff to check for dirty state: $!";
107
3f492ba1 108 _git_diff_parse($diff, [$head], "dirty", (
87475f4d
RA
109 'author' => gitvar_name("GIT_AUTHOR_IDENT"),
110 'author_date' => sprintf("%s +0000",time()),
111 )
112 );
6b3e21d6 113 close($diff);
87475f4d 114}
c65e8987
RA
115handle_rev();
116
117
118my $i = 0;
119foreach my $l (@filelines) {
120 my ($output, $rev, $committer, $date);
121 if (ref $l eq 'ARRAY') {
122 ($output, $rev, $committer, $date) = @$l;
87475f4d 123 if (!$longrev && length($rev) > 8) {
c65e8987
RA
124 $rev = substr($rev,0,8);
125 }
126 } else {
127 $output = $l;
128 ($rev, $committer, $date) = ('unknown', 'unknown', 'unknown');
129 }
130
4788d11a 131 printf("%s\t(%10s\t%10s\t%d)%s\n", $rev, $committer,
c6d4217e 132 format_date($date), ++$i, $output);
c65e8987
RA
133}
134
135sub init_claim {
136 my ($rev) = @_;
c65e8987
RA
137 for (my $i = 0; $i < @filelines; $i++) {
138 $filelines[$i] = [ $filelines[$i], '', '', '', 1];
139 # line,
140 # rev,
141 # author,
142 # date,
143 # 1 <-- belongs to the original file.
144 }
145 $revs{$rev}{'lines'} = \@filelines;
146}
147
148
149sub handle_rev {
7c49cb28 150 my $revseen = 0;
87475f4d 151 my %seen;
c65e8987 152 while (my $rev = shift @revqueue) {
87475f4d 153 next if $seen{$rev}++;
c65e8987
RA
154
155 my %revinfo = git_commit_info($rev);
156
3f492ba1
RA
157 if (exists $revs{$rev}{parents} &&
158 scalar @{$revs{$rev}{parents}} != 0) {
c65e8987 159
3f492ba1
RA
160 git_diff_parse($revs{$rev}{'parents'}, $rev, %revinfo);
161 push @revqueue, @{$revs{$rev}{'parents'}};
c65e8987 162
3f492ba1 163 } else {
c65e8987
RA
164 # We must be at the initial rev here, so claim everything that is left.
165 for (my $i = 0; $i < @{$revs{$rev}{lines}}; $i++) {
166 if (ref ${$revs{$rev}{lines}}[$i] eq '' || ${$revs{$rev}{lines}}[$i][1] eq '') {
167 claim_line($i, $rev, $revs{$rev}{lines}, %revinfo);
168 }
169 }
170 }
171 }
172}
173
174
175sub git_rev_list {
176 my ($rev, $file) = @_;
177
6b3e21d6 178 my $revlist;
87475f4d 179 if ($rev_file) {
00931549
ML
180 open($revlist, '<' . $rev_file)
181 or die "Failed to open $rev_file : $!";
4788d11a 182 } else {
6b3e21d6 183 $revlist = open_pipe("git-rev-list","--parents","--remove-empty",$rev,"--",$file)
4788d11a
JS
184 or die "Failed to exec git-rev-list: $!";
185 }
c65e8987
RA
186
187 my @revs;
6b3e21d6 188 while(my $line = <$revlist>) {
c65e8987
RA
189 chomp $line;
190 my ($rev, @parents) = split /\s+/, $line;
191 push @revs, [ $rev, @parents ];
192 }
6b3e21d6 193 close($revlist);
c65e8987
RA
194
195 printf("0 revs found for rev %s (%s)\n", $rev, $file) if (@revs == 0);
196 return @revs;
197}
198
199sub find_parent_renames {
200 my ($rev, $file) = @_;
201
6b3e21d6 202 my $patch = open_pipe("git-diff-tree", "-M50", "-r","--name-status", "-z","$rev")
c65e8987
RA
203 or die "Failed to exec git-diff: $!";
204
205 local $/ = "\0";
206 my %bound;
6b3e21d6
RA
207 my $junk = <$patch>;
208 while (my $change = <$patch>) {
c65e8987 209 chomp $change;
6b3e21d6 210 my $filename = <$patch>;
d0ad1653
MK
211 if (!defined $filename) {
212 next;
213 }
c65e8987
RA
214 chomp $filename;
215
216 if ($change =~ m/^[AMD]$/ ) {
217 next;
218 } elsif ($change =~ m/^R/ ) {
219 my $oldfilename = $filename;
6b3e21d6 220 $filename = <$patch>;
c65e8987
RA
221 chomp $filename;
222 if ( $file eq $filename ) {
223 my $parent = git_find_parent($rev, $oldfilename);
224 @bound{'rev','filename'} = ($parent, $oldfilename);
225 last;
226 }
227 }
228 }
6b3e21d6 229 close($patch);
c65e8987
RA
230
231 return \%bound;
232}
233
234
235sub git_find_parent {
236 my ($rev, $filename) = @_;
237
6b3e21d6 238 my $revparent = open_pipe("git-rev-list","--remove-empty", "--parents","--max-count=1","$rev","--",$filename)
c65e8987
RA
239 or die "Failed to open git-rev-list to find a single parent: $!";
240
6b3e21d6 241 my $parentline = <$revparent>;
c65e8987
RA
242 chomp $parentline;
243 my ($revfound,$parent) = split m/\s+/, $parentline;
244
6b3e21d6 245 close($revparent);
c65e8987
RA
246
247 return $parent;
248}
249
7c49cb28
RA
250sub git_find_all_parents {
251 my ($rev) = @_;
252
253 my $revparent = open_pipe("git-rev-list","--remove-empty", "--parents","--max-count=1","$rev")
254 or die "Failed to open git-rev-list to find a single parent: $!";
255
256 my $parentline = <$revparent>;
257 chomp $parentline;
258 my ($origrev, @parents) = split m/\s+/, $parentline;
259
260 close($revparent);
261
262 return @parents;
263}
264
265sub git_merge_base {
266 my ($rev1, $rev2) = @_;
267
268 my $mb = open_pipe("git-merge-base", $rev1, $rev2)
269 or die "Failed to open git-merge-base: $!";
270
271 my $base = <$mb>;
272 chomp $base;
273
274 close($mb);
275
276 return $base;
277}
278
279# Construct a set of pseudo parents that are in the same order,
280# and the same quantity as the real parents,
281# but whose SHA1s are as similar to the logical parents
282# as possible.
283sub get_pseudo_parents {
284 my ($all, $fake) = @_;
285
286 my @all = @$all;
287 my @fake = @$fake;
288
289 my @pseudo;
290
291 my %fake = map {$_ => 1} @fake;
292 my %seenfake;
293
294 my $fakeidx = 0;
295 foreach my $p (@all) {
296 if (exists $fake{$p}) {
297 if ($fake[$fakeidx] ne $p) {
298 die sprintf("parent mismatch: %s != %s\nall:%s\nfake:%s\n",
299 $fake[$fakeidx], $p,
300 join(", ", @all),
301 join(", ", @fake),
302 );
303 }
304
305 push @pseudo, $p;
306 $fakeidx++;
307 $seenfake{$p}++;
308
309 } else {
310 my $base = git_merge_base($fake[$fakeidx], $p);
311 if ($base ne $fake[$fakeidx]) {
312 die sprintf("Result of merge-base doesn't match fake: %s,%s != %s\n",
313 $fake[$fakeidx], $p, $base);
314 }
315
316 # The details of how we parse the diffs
317 # mean that we cannot have a duplicate
318 # revision in the list, so if we've already
319 # seen the revision we would normally add, just use
320 # the actual revision.
321 if ($seenfake{$base}) {
322 push @pseudo, $p;
323 } else {
324 push @pseudo, $base;
325 $seenfake{$base}++;
326 }
327 }
328 }
329
330 return @pseudo;
331}
332
c65e8987
RA
333
334# Get a diff between the current revision and a parent.
335# Record the commit information that results.
336sub git_diff_parse {
3f492ba1 337 my ($parents, $rev, %revinfo) = @_;
c65e8987 338
7c49cb28
RA
339 my @pseudo_parents;
340 my @command = ("git-diff-tree");
341 my $revision_spec;
342
343 if (scalar @$parents == 1) {
344
345 $revision_spec = join("..", $parents->[0], $rev);
346 @pseudo_parents = @$parents;
347 } else {
348 my @all_parents = git_find_all_parents($rev);
349
350 if (@all_parents != @$parents) {
351 @pseudo_parents = get_pseudo_parents(\@all_parents, $parents);
352 } else {
353 @pseudo_parents = @$parents;
354 }
355
356 $revision_spec = $rev;
357 push @command, "-c";
358 }
359
3f492ba1 360 my @filenames = ( $revs{$rev}{'filename'} );
7c49cb28 361
3f492ba1
RA
362 foreach my $parent (@$parents) {
363 push @filenames, $revs{$parent}{'filename'};
364 }
365
7c49cb28
RA
366 push @command, "-p", "-M", $revision_spec, "--", @filenames;
367
368
369 my $diff = open_pipe( @command )
c65e8987
RA
370 or die "Failed to call git-diff for annotation: $!";
371
7c49cb28 372 _git_diff_parse($diff, \@pseudo_parents, $rev, %revinfo);
87475f4d 373
6b3e21d6 374 close($diff);
87475f4d
RA
375}
376
377sub _git_diff_parse {
3f492ba1
RA
378 my ($diff, $parents, $rev, %revinfo) = @_;
379
380 my $ri = 0;
87475f4d 381
c65e8987 382 my $slines = $revs{$rev}{'lines'};
3f492ba1 383 my (%plines, %pi);
c65e8987
RA
384
385 my $gotheader = 0;
87475f4d 386 my ($remstart);
3f492ba1
RA
387 my $parent_count = @$parents;
388
389 my $diff_header_regexp = "^@";
390 $diff_header_regexp .= "@" x @$parents;
391 $diff_header_regexp .= ' -\d+,\d+' x @$parents;
392 $diff_header_regexp .= ' \+(\d+),\d+';
7c49cb28 393 $diff_header_regexp .= " " . ("@" x @$parents);
3f492ba1
RA
394
395 my %claim_regexps;
396 my $allparentplus = '^' . '\\+' x @$parents . '(.*)$';
397
398 {
399 my $i = 0;
400 foreach my $parent (@$parents) {
401
402 $pi{$parent} = 0;
403 my $r = '^' . '.' x @$parents . '(.*)$';
404 my $p = $r;
405 substr($p,$i+1, 1) = '\\+';
406
407 my $m = $r;
408 substr($m,$i+1, 1) = '-';
409
410 $claim_regexps{$parent}{plus} = $p;
411 $claim_regexps{$parent}{minus} = $m;
412
413 $plines{$parent} = [];
414
415 $i++;
416 }
417 }
418
419 DIFF:
6b3e21d6 420 while(<$diff>) {
c65e8987 421 chomp;
7c49cb28 422 #printf("%d:%s:\n", $gotheader, $_);
3f492ba1
RA
423 if (m/$diff_header_regexp/) {
424 $remstart = $1 - 1;
425 # (0-based arrays)
426
c65e8987
RA
427 $gotheader = 1;
428
3f492ba1
RA
429 foreach my $parent (@$parents) {
430 for (my $i = $ri; $i < $remstart; $i++) {
431 $plines{$parent}[$pi{$parent}++] = $slines->[$i];
432 }
c65e8987 433 }
3f492ba1 434 $ri = $remstart;
c65e8987 435
3f492ba1 436 next DIFF;
c65e8987 437
3f492ba1
RA
438 } elsif (!$gotheader) {
439 # Skip over the leadin.
440 next DIFF;
441 }
c65e8987 442
3f492ba1 443 if (m/^\\/) {
e5971d7d
RA
444 ;
445 # Skip \No newline at end of file.
446 # But this can be internationalized, so only look
447 # for an initial \
448
c65e8987 449 } else {
3f492ba1
RA
450 my %claims = ();
451 my $negclaim = 0;
452 my $allclaimed = 0;
453 my $line;
454
455 if (m/$allparentplus/) {
456 claim_line($ri, $rev, $slines, %revinfo);
457 $allclaimed = 1;
458
459 }
460
461 PARENT:
462 foreach my $parent (keys %claim_regexps) {
463 my $m = $claim_regexps{$parent}{minus};
464 my $p = $claim_regexps{$parent}{plus};
465
466 if (m/$m/) {
467 $line = $1;
468 $plines{$parent}[$pi{$parent}++] = [ $line, '', '', '', 0 ];
469 $negclaim++;
470
471 } elsif (m/$p/) {
472 $line = $1;
473 if (get_line($slines, $ri) eq $line) {
474 # Found a match, claim
475 $claims{$parent}++;
476
477 } else {
478 die sprintf("Sync error: %d\n|%s\n|%s\n%s => %s\n",
479 $ri, $line,
480 get_line($slines, $ri),
481 $rev, $parent);
482 }
483 }
484 }
485
486 if (%claims) {
487 foreach my $parent (@$parents) {
488 next if $claims{$parent} || $allclaimed;
489 $plines{$parent}[$pi{$parent}++] = $slines->[$ri];
490 #[ $line, '', '', '', 0 ];
491 }
492 $ri++;
493
494 } elsif ($negclaim) {
495 next DIFF;
496
497 } else {
498 if (substr($_,scalar @$parents) ne get_line($slines,$ri) ) {
499 foreach my $parent (@$parents) {
500 printf("parent %s is on line %d\n", $parent, $pi{$parent});
501 }
502
7c49cb28
RA
503 my @context;
504 for (my $i = -2; $i < 2; $i++) {
505 push @context, get_line($slines, $ri + $i);
506 }
507 my $context = join("\n", @context);
508
509 my $justline = substr($_, scalar @$parents);
3f492ba1
RA
510 die sprintf("Line %d, does not match:\n|%s|\n|%s|\n%s\n",
511 $ri,
7c49cb28
RA
512 $justline,
513 $context);
3f492ba1
RA
514 }
515 foreach my $parent (@$parents) {
516 $plines{$parent}[$pi{$parent}++] = $slines->[$ri];
517 }
518 $ri++;
c65e8987 519 }
c65e8987 520 }
c65e8987 521 }
3f492ba1 522
c65e8987 523 for (my $i = $ri; $i < @{$slines} ; $i++) {
3f492ba1
RA
524 foreach my $parent (@$parents) {
525 push @{$plines{$parent}}, $slines->[$ri];
526 }
527 $ri++;
528 }
529
530 foreach my $parent (@$parents) {
531 $revs{$parent}{lines} = $plines{$parent};
c65e8987
RA
532 }
533
c65e8987
RA
534 return;
535}
536
537sub get_line {
538 my ($lines, $index) = @_;
539
540 return ref $lines->[$index] ne '' ? $lines->[$index][0] : $lines->[$index];
541}
542
543sub git_cat_file {
87475f4d
RA
544 my ($rev, $filename) = @_;
545 return () unless defined $rev && defined $filename;
c65e8987 546
87475f4d 547 my $blob = git_ls_tree($rev, $filename);
5fcab3d7 548 die "Failed to find a blob for $filename in rev $rev\n" if !defined $blob;
87475f4d 549
6b3e21d6 550 my $catfile = open_pipe("git","cat-file", "blob", $blob)
87475f4d 551 or die "Failed to git-cat-file blob $blob (rev $rev, file $filename): " . $!;
c65e8987
RA
552
553 my @lines;
6b3e21d6 554 while(<$catfile>) {
c65e8987
RA
555 chomp;
556 push @lines, $_;
557 }
6b3e21d6 558 close($catfile);
c65e8987
RA
559
560 return @lines;
561}
562
87475f4d
RA
563sub git_ls_tree {
564 my ($rev, $filename) = @_;
565
6b3e21d6 566 my $lstree = open_pipe("git","ls-tree",$rev,$filename)
87475f4d
RA
567 or die "Failed to call git ls-tree: $!";
568
569 my ($mode, $type, $blob, $tfilename);
6b3e21d6 570 while(<$lstree>) {
5fcab3d7 571 chomp;
87475f4d
RA
572 ($mode, $type, $blob, $tfilename) = split(/\s+/, $_, 4);
573 last if ($tfilename eq $filename);
574 }
6b3e21d6 575 close($lstree);
87475f4d 576
5fcab3d7 577 return $blob if ($tfilename eq $filename);
87475f4d
RA
578 die "git-ls-tree failed to find blob for $filename";
579
580}
581
582
c65e8987
RA
583
584sub claim_line {
585 my ($floffset, $rev, $lines, %revinfo) = @_;
586 my $oline = get_line($lines, $floffset);
587 @{$lines->[$floffset]} = ( $oline, $rev,
588 $revinfo{'author'}, $revinfo{'author_date'} );
589 #printf("Claiming line %d with rev %s: '%s'\n",
590 # $floffset, $rev, $oline) if 1;
591}
592
593sub git_commit_info {
594 my ($rev) = @_;
6b3e21d6 595 my $commit = open_pipe("git-cat-file", "commit", $rev)
c65e8987
RA
596 or die "Failed to call git-cat-file: $!";
597
598 my %info;
6b3e21d6 599 while(<$commit>) {
c65e8987
RA
600 chomp;
601 last if (length $_ == 0);
602
603 if (m/^author (.*) <(.*)> (.*)$/) {
604 $info{'author'} = $1;
605 $info{'author_email'} = $2;
606 $info{'author_date'} = $3;
607 } elsif (m/^committer (.*) <(.*)> (.*)$/) {
608 $info{'committer'} = $1;
609 $info{'committer_email'} = $2;
610 $info{'committer_date'} = $3;
611 }
612 }
6b3e21d6 613 close($commit);
c65e8987
RA
614
615 return %info;
616}
4788d11a
JS
617
618sub format_date {
d920e18f
JH
619 if ($rawtime) {
620 return $_[0];
621 }
4788d11a 622 my ($timestamp, $timezone) = split(' ', $_[0]);
cfea8e07
JH
623 my $minutes = abs($timezone);
624 $minutes = int($minutes / 100) * 60 + ($minutes % 100);
625 if ($timezone < 0) {
626 $minutes = -$minutes;
627 }
628 my $t = $timestamp + $minutes * 60;
629 return strftime("%Y-%m-%d %H:%M:%S " . $timezone, gmtime($t));
4788d11a
JS
630}
631
87475f4d
RA
632# Copied from git-send-email.perl - We need a Git.pm module..
633sub gitvar {
634 my ($var) = @_;
635 my $fh;
636 my $pid = open($fh, '-|');
637 die "$!" unless defined $pid;
638 if (!$pid) {
639 exec('git-var', $var) or die "$!";
640 }
641 my ($val) = <$fh>;
642 close $fh or die "$!";
643 chomp($val);
644 return $val;
645}
646
647sub gitvar_name {
648 my ($name) = @_;
649 my $val = gitvar($name);
650 my @field = split(/\s+/, $val);
651 return join(' ', @field[0...(@field-4)]);
652}
653
6b3e21d6 654sub open_pipe {
f60d4691
RA
655 if ($^O eq '##INSERT_ACTIVESTATE_STRING_HERE##') {
656 return open_pipe_activestate(@_);
657 } else {
658 return open_pipe_normal(@_);
659 }
660}
661
662sub open_pipe_activestate {
663 tie *fh, "Git::ActiveStatePipe", @_;
664 return *fh;
665}
666
667sub open_pipe_normal {
6b3e21d6
RA
668 my (@execlist) = @_;
669
670 my $pid = open my $kid, "-|";
671 defined $pid or die "Cannot fork: $!";
672
673 unless ($pid) {
674 exec @execlist;
675 die "Cannot exec @execlist: $!";
676 }
677
678 return $kid;
679}
f60d4691
RA
680
681package Git::ActiveStatePipe;
682use strict;
683
684sub TIEHANDLE {
685 my ($class, @params) = @_;
686 my $cmdline = join " ", @params;
687 my @data = qx{$cmdline};
688 bless { i => 0, data => \@data }, $class;
689}
690
691sub READLINE {
692 my $self = shift;
693 if ($self->{i} >= scalar @{$self->{data}}) {
694 return undef;
695 }
696 return $self->{'data'}->[ $self->{i}++ ];
697}
698
699sub CLOSE {
700 my $self = shift;
701 delete $self->{data};
702 delete $self->{i};
703}
704
705sub EOF {
706 my $self = shift;
707 return ($self->{i} >= scalar @{$self->{data}});
708}