gitweb: Use --git-dir parameter instead of setting $ENV{'GIT_DIR'}
[gitweb.git] / git-annotate.perl
index d93ee19c7e7ff42762071c9df6f31da5dfa0fe80..215ed26f3aff4b12139359ca841a9a80c567a6e6 100755 (executable)
 use strict;
 use Getopt::Long;
 use POSIX qw(strftime gmtime);
+use File::Basename qw(basename dirname);
 
 sub usage() {
-       print STDERR 'Usage: ${\basename $0} [-s] [-S revs-file] file [ revision ]
+       print STDERR "Usage: ${\basename $0} [-s] [-S revs-file] file [ revision ]
        -l, --long
                        Show long rev (Defaults off)
        -t, --time
@@ -20,10 +21,10 @@ ()
        -r, --rename
                        Follow renames (Defaults on).
        -S, --rev-file revs-file
-                       use revs from revs-file instead of calling git-rev-list
+                       Use revs from revs-file instead of calling git-rev-list
        -h, --help
                        This message.
-';
+";
 
        exit(1);
 }
@@ -35,7 +36,7 @@ ()
                        "help|h" => \$help,
                        "rename|r" => \$rename,
                        "rev-file|S=s" => \$rev_file);
-if (!$rc or $help) {
+if (!$rc or $help or !@ARGV) {
        usage();
 }
 
@@ -99,12 +100,12 @@ ()
        }
 }
 push @revqueue, $head;
-init_claim( defined $starting_rev ? $starting_rev : 'dirty');
+init_claim( defined $starting_rev ? $head : 'dirty');
 unless (defined $starting_rev) {
-       my $diff = open_pipe("git","diff","-R", "HEAD", "--",$filename)
+       my $diff = open_pipe("git","diff","HEAD", "--",$filename)
                or die "Failed to call git diff to check for dirty state: $!";
 
-       _git_diff_parse($diff, $head, "dirty", (
+       _git_diff_parse($diff, [$head], "dirty", (
                                'author' => gitvar_name("GIT_AUTHOR_IDENT"),
                                'author_date' => sprintf("%s +0000",time()),
                                )
@@ -146,21 +147,20 @@ sub init_claim {
 
 
 sub handle_rev {
-       my $i = 0;
+       my $revseen = 0;
        my %seen;
        while (my $rev = shift @revqueue) {
                next if $seen{$rev}++;
 
                my %revinfo = git_commit_info($rev);
 
-               foreach my $p (@{$revs{$rev}{'parents'}}) {
-
-                       git_diff_parse($p, $rev, %revinfo);
-                       push @revqueue, $p;
-               }
+               if (exists $revs{$rev}{parents} &&
+                   scalar @{$revs{$rev}{parents}} != 0) {
 
+                       git_diff_parse($revs{$rev}{'parents'}, $rev, %revinfo);
+                       push @revqueue, @{$revs{$rev}{'parents'}};
 
-               if (scalar @{$revs{$rev}{parents}} == 0) {
+               } else {
                        # We must be at the initial rev here, so claim everything that is left.
                        for (my $i = 0; $i < @{$revs{$rev}{lines}}; $i++) {
                                if (ref ${$revs{$rev}{lines}}[$i] eq '' || ${$revs{$rev}{lines}}[$i][1] eq '') {
@@ -208,6 +208,9 @@ sub find_parent_renames {
        while (my $change = <$patch>) {
                chomp $change;
                my $filename = <$patch>;
+               if (!defined $filename) {
+                       next;
+               }
                chomp $filename;
 
                if ($change =~ m/^[AMD]$/ ) {
@@ -244,93 +247,290 @@ sub git_find_parent {
        return $parent;
 }
 
+sub git_find_all_parents {
+       my ($rev) = @_;
+
+       my $revparent = open_pipe("git-rev-list","--remove-empty", "--parents","--max-count=1","$rev")
+               or die "Failed to open git-rev-list to find a single parent: $!";
+
+       my $parentline = <$revparent>;
+       chomp $parentline;
+       my ($origrev, @parents) = split m/\s+/, $parentline;
+
+       close($revparent);
+
+       return @parents;
+}
+
+sub git_merge_base {
+       my ($rev1, $rev2) = @_;
+
+       my $mb = open_pipe("git-merge-base", $rev1, $rev2)
+               or die "Failed to open git-merge-base: $!";
+
+       my $base = <$mb>;
+       chomp $base;
+
+       close($mb);
+
+       return $base;
+}
+
+# Construct a set of pseudo parents that are in the same order,
+# and the same quantity as the real parents,
+# but whose SHA1s are as similar to the logical parents
+# as possible.
+sub get_pseudo_parents {
+       my ($all, $fake) = @_;
+
+       my @all = @$all;
+       my @fake = @$fake;
+
+       my @pseudo;
+
+       my %fake = map {$_ => 1} @fake;
+       my %seenfake;
+
+       my $fakeidx = 0;
+       foreach my $p (@all) {
+               if (exists $fake{$p}) {
+                       if ($fake[$fakeidx] ne $p) {
+                               die sprintf("parent mismatch: %s != %s\nall:%s\nfake:%s\n",
+                                           $fake[$fakeidx], $p,
+                                           join(", ", @all),
+                                           join(", ", @fake),
+                                          );
+                       }
+
+                       push @pseudo, $p;
+                       $fakeidx++;
+                       $seenfake{$p}++;
+
+               } else {
+                       my $base = git_merge_base($fake[$fakeidx], $p);
+                       if ($base ne $fake[$fakeidx]) {
+                               die sprintf("Result of merge-base doesn't match fake: %s,%s != %s\n",
+                                      $fake[$fakeidx], $p, $base);
+                       }
+
+                       # The details of how we parse the diffs
+                       # mean that we cannot have a duplicate
+                       # revision in the list, so if we've already
+                       # seen the revision we would normally add, just use
+                       # the actual revision.
+                       if ($seenfake{$base}) {
+                               push @pseudo, $p;
+                       } else {
+                               push @pseudo, $base;
+                               $seenfake{$base}++;
+                       }
+               }
+       }
+
+       return @pseudo;
+}
+
 
 # Get a diff between the current revision and a parent.
 # Record the commit information that results.
 sub git_diff_parse {
-       my ($parent, $rev, %revinfo) = @_;
+       my ($parents, $rev, %revinfo) = @_;
+
+       my @pseudo_parents;
+       my @command = ("git-diff-tree");
+       my $revision_spec;
+
+       if (scalar @$parents == 1) {
+
+               $revision_spec = join("..", $parents->[0], $rev);
+               @pseudo_parents = @$parents;
+       } else {
+               my @all_parents = git_find_all_parents($rev);
+
+               if (@all_parents !=  @$parents) {
+                       @pseudo_parents = get_pseudo_parents(\@all_parents, $parents);
+               } else {
+                       @pseudo_parents = @$parents;
+               }
+
+               $revision_spec = $rev;
+               push @command, "-c";
+       }
+
+       my @filenames = ( $revs{$rev}{'filename'} );
+
+       foreach my $parent (@$parents) {
+               push @filenames, $revs{$parent}{'filename'};
+       }
+
+       push @command, "-p", "-M", $revision_spec, "--", @filenames;
+
 
-       my $diff = open_pipe("git-diff-tree","-M","-p",$rev,$parent,"--",
-                       $revs{$rev}{'filename'}, $revs{$parent}{'filename'})
+       my $diff = open_pipe( @command )
                or die "Failed to call git-diff for annotation: $!";
 
-       _git_diff_parse($diff, $parent, $rev, %revinfo);
+       _git_diff_parse($diff, \@pseudo_parents, $rev, %revinfo);
 
        close($diff);
 }
 
 sub _git_diff_parse {
-       my ($diff, $parent, $rev, %revinfo) = @_;
+       my ($diff, $parents, $rev, %revinfo) = @_;
+
+       my $ri = 0;
 
-       my ($ri, $pi) = (0,0);
        my $slines = $revs{$rev}{'lines'};
-       my @plines;
+       my (%plines, %pi);
 
        my $gotheader = 0;
        my ($remstart);
-       my ($hunk_start, $hunk_index);
+       my $parent_count = @$parents;
+
+       my $diff_header_regexp = "^@";
+       $diff_header_regexp .= "@" x @$parents;
+       $diff_header_regexp .= ' -\d+,\d+' x @$parents;
+       $diff_header_regexp .= ' \+(\d+),\d+';
+       $diff_header_regexp .= " " . ("@" x @$parents);
+
+       my %claim_regexps;
+       my $allparentplus = '^' . '\\+' x @$parents . '(.*)$';
+
+       {
+               my $i = 0;
+               foreach my $parent (@$parents) {
+
+                       $pi{$parent} = 0;
+                       my $r = '^' . '.' x @$parents . '(.*)$';
+                       my $p = $r;
+                       substr($p,$i+1, 1) = '\\+';
+
+                       my $m = $r;
+                       substr($m,$i+1, 1) = '-';
+
+                       $claim_regexps{$parent}{plus} = $p;
+                       $claim_regexps{$parent}{minus} = $m;
+
+                       $plines{$parent} = [];
+
+                       $i++;
+               }
+       }
+
+       DIFF:
        while(<$diff>) {
                chomp;
-               if (m/^@@ -(\d+),(\d+) \+(\d+),(\d+)/) {
-                       $remstart = $1;
-                       # Adjust for 0-based arrays
-                       $remstart--;
-                       # Reinit hunk tracking.
-                       $hunk_start = $remstart;
-                       $hunk_index = 0;
+               #printf("%d:%s:\n", $gotheader, $_);
+               if (m/$diff_header_regexp/) {
+                       $remstart = $1 - 1;
+                       # (0-based arrays)
+
                        $gotheader = 1;
 
-                       for (my $i = $ri; $i < $remstart; $i++) {
-                               $plines[$pi++] = $slines->[$i];
-                               $ri++;
+                       foreach my $parent (@$parents) {
+                               for (my $i = $ri; $i < $remstart; $i++) {
+                                       $plines{$parent}[$pi{$parent}++] = $slines->[$i];
+                               }
                        }
-                       next;
-               } elsif (!$gotheader) {
-                       next;
-               }
+                       $ri = $remstart;
 
-               if (m/^\+(.*)$/) {
-                       my $line = $1;
-                       $plines[$pi++] = [ $line, '', '', '', 0 ];
-                       next;
+                       next DIFF;
 
-               } elsif (m/^-(.*)$/) {
-                       my $line = $1;
-                       if (get_line($slines, $ri) eq $line) {
-                               # Found a match, claim
-                               claim_line($ri, $rev, $slines, %revinfo);
-                       } else {
-                               die sprintf("Sync error: %d/%d\n|%s\n|%s\n%s => %s\n",
-                                               $ri, $hunk_start + $hunk_index,
-                                               $line,
-                                               get_line($slines, $ri),
-                                               $rev, $parent);
-                       }
-                       $ri++;
+               } elsif (!$gotheader) {
+                       # Skip over the leadin.
+                       next DIFF;
+               }
 
-               } elsif (m/^\\/) {
+               if (m/^\\/) {
                        ;
                        # Skip \No newline at end of file.
                        # But this can be internationalized, so only look
                        # for an initial \
 
                } else {
-                       if (substr($_,1) ne get_line($slines,$ri) ) {
-                               die sprintf("Line %d (%d) does not match:\n|%s\n|%s\n%s => %s\n",
-                                               $hunk_start + $hunk_index, $ri,
-                                               substr($_,1),
-                                               get_line($slines,$ri),
-                                               $rev, $parent);
+                       my %claims = ();
+                       my $negclaim = 0;
+                       my $allclaimed = 0;
+                       my $line;
+
+                       if (m/$allparentplus/) {
+                               claim_line($ri, $rev, $slines, %revinfo);
+                               $allclaimed = 1;
+
+                       }
+
+                       PARENT:
+                       foreach my $parent (keys %claim_regexps) {
+                               my $m = $claim_regexps{$parent}{minus};
+                               my $p = $claim_regexps{$parent}{plus};
+
+                               if (m/$m/) {
+                                       $line = $1;
+                                       $plines{$parent}[$pi{$parent}++] = [ $line, '', '', '', 0 ];
+                                       $negclaim++;
+
+                               } elsif (m/$p/) {
+                                       $line = $1;
+                                       if (get_line($slines, $ri) eq $line) {
+                                               # Found a match, claim
+                                               $claims{$parent}++;
+
+                                       } else {
+                                               die sprintf("Sync error: %d\n|%s\n|%s\n%s => %s\n",
+                                                               $ri, $line,
+                                                               get_line($slines, $ri),
+                                                               $rev, $parent);
+                                       }
+                               }
+                       }
+
+                       if (%claims) {
+                               foreach my $parent (@$parents) {
+                                       next if $claims{$parent} || $allclaimed;
+                                       $plines{$parent}[$pi{$parent}++] = $slines->[$ri];
+                                           #[ $line, '', '', '', 0 ];
+                               }
+                               $ri++;
+
+                       } elsif ($negclaim) {
+                               next DIFF;
+
+                       } else {
+                               if (substr($_,scalar @$parents) ne get_line($slines,$ri) ) {
+                                       foreach my $parent (@$parents) {
+                                               printf("parent %s is on line %d\n", $parent, $pi{$parent});
+                                       }
+
+                                       my @context;
+                                       for (my $i = -2; $i < 2; $i++) {
+                                               push @context, get_line($slines, $ri + $i);
+                                       }
+                                       my $context = join("\n", @context);
+
+                                       my $justline = substr($_, scalar @$parents);
+                                       die sprintf("Line %d, does not match:\n|%s|\n|%s|\n%s\n",
+                                                   $ri,
+                                                   $justline,
+                                                   $context);
+                               }
+                               foreach my $parent (@$parents) {
+                                       $plines{$parent}[$pi{$parent}++] = $slines->[$ri];
+                               }
+                               $ri++;
                        }
-                       $plines[$pi++] = $slines->[$ri++];
                }
-               $hunk_index++;
        }
+
        for (my $i = $ri; $i < @{$slines} ; $i++) {
-               push @plines, $slines->[$ri++];
+               foreach my $parent (@$parents) {
+                       push @{$plines{$parent}}, $slines->[$ri];
+               }
+               $ri++;
+       }
+
+       foreach my $parent (@$parents) {
+               $revs{$parent}{lines} = $plines{$parent};
        }
 
-       $revs{$parent}{lines} = \@plines;
        return;
 }
 
@@ -345,6 +545,7 @@ sub git_cat_file {
        return () unless defined $rev && defined $filename;
 
        my $blob = git_ls_tree($rev, $filename);
+       die "Failed to find a blob for $filename in rev $rev\n" if !defined $blob;
 
        my $catfile = open_pipe("git","cat-file", "blob", $blob)
                or die "Failed to git-cat-file blob $blob (rev $rev, file $filename): " . $!;
@@ -367,12 +568,13 @@ sub git_ls_tree {
 
        my ($mode, $type, $blob, $tfilename);
        while(<$lstree>) {
+               chomp;
                ($mode, $type, $blob, $tfilename) = split(/\s+/, $_, 4);
                last if ($tfilename eq $filename);
        }
        close($lstree);
 
-       return $blob if $filename eq $filename;
+       return $blob if ($tfilename eq $filename);
        die "git-ls-tree failed to find blob for $filename";
 
 }
@@ -418,7 +620,13 @@ sub format_date {
                return $_[0];
        }
        my ($timestamp, $timezone) = split(' ', $_[0]);
-       return strftime("%Y-%m-%d %H:%M:%S " . $timezone, gmtime($timestamp));
+       my $minutes = abs($timezone);
+       $minutes = int($minutes / 100) * 60 + ($minutes % 100);
+       if ($timezone < 0) {
+           $minutes = -$minutes;
+       }
+       my $t = $timestamp + $minutes * 60;
+       return strftime("%Y-%m-%d %H:%M:%S " . $timezone, gmtime($t));
 }
 
 # Copied from git-send-email.perl - We need a Git.pm module..