Code

Merge git-mv fixes from 'maint'
[git.git] / git-annotate.perl
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.
9 use warnings;
10 use strict;
11 use Getopt::Long;
12 use POSIX qw(strftime gmtime);
14 sub usage() {
15         print STDERR 'Usage: ${\basename $0} [-s] [-S revs-file] file [ revision ]
16         -l, --long
17                         Show long rev (Defaults off)
18         -r, --rename
19                         Follow renames (Defaults on).
20         -S, --rev-file revs-file
21                         use revs from revs-file instead of calling git-rev-list
22         -h, --help
23                         This message.
24 ';
26         exit(1);
27 }
29 our ($help, $longrev, $rename, $starting_rev, $rev_file) = (0, 0, 1);
31 my $rc = GetOptions(    "long|l" => \$longrev,
32                         "help|h" => \$help,
33                         "rename|r" => \$rename,
34                         "rev-file|S" => \$rev_file);
35 if (!$rc or $help) {
36         usage();
37 }
39 my $filename = shift @ARGV;
40 if (@ARGV) {
41         $starting_rev = shift @ARGV;
42 }
44 my @stack = (
45         {
46                 'rev' => defined $starting_rev ? $starting_rev : "HEAD",
47                 'filename' => $filename,
48         },
49 );
51 our @filelines = ();
53 if (defined $starting_rev) {
54         @filelines = git_cat_file($starting_rev, $filename);
55 } else {
56         open(F,"<",$filename)
57                 or die "Failed to open filename: $!";
59         while(<F>) {
60                 chomp;
61                 push @filelines, $_;
62         }
63         close(F);
65 }
67 our %revs;
68 our @revqueue;
69 our $head;
71 my $revsprocessed = 0;
72 while (my $bound = pop @stack) {
73         my @revisions = git_rev_list($bound->{'rev'}, $bound->{'filename'});
74         foreach my $revinst (@revisions) {
75                 my ($rev, @parents) = @$revinst;
76                 $head ||= $rev;
78                 if (!defined($rev)) {
79                         $rev = "";
80                 }
81                 $revs{$rev}{'filename'} = $bound->{'filename'};
82                 if (scalar @parents > 0) {
83                         $revs{$rev}{'parents'} = \@parents;
84                         next;
85                 }
87                 if (!$rename) {
88                         next;
89                 }
91                 my $newbound = find_parent_renames($rev, $bound->{'filename'});
92                 if ( exists $newbound->{'filename'} && $newbound->{'filename'} ne $bound->{'filename'}) {
93                         push @stack, $newbound;
94                         $revs{$rev}{'parents'} = [$newbound->{'rev'}];
95                 }
96         }
97 }
98 push @revqueue, $head;
99 init_claim( defined $starting_rev ? $starting_rev : 'dirty');
100 unless (defined $starting_rev) {
101         my $diff = open_pipe("git","diff","-R", "HEAD", "--",$filename)
102                 or die "Failed to call git diff to check for dirty state: $!";
104         _git_diff_parse($diff, $head, "dirty", (
105                                 'author' => gitvar_name("GIT_AUTHOR_IDENT"),
106                                 'author_date' => sprintf("%s +0000",time()),
107                                 )
108                         );
109         close($diff);
111 handle_rev();
114 my $i = 0;
115 foreach my $l (@filelines) {
116         my ($output, $rev, $committer, $date);
117         if (ref $l eq 'ARRAY') {
118                 ($output, $rev, $committer, $date) = @$l;
119                 if (!$longrev && length($rev) > 8) {
120                         $rev = substr($rev,0,8);
121                 }
122         } else {
123                 $output = $l;
124                 ($rev, $committer, $date) = ('unknown', 'unknown', 'unknown');
125         }
127         printf("%s\t(%10s\t%10s\t%d)%s\n", $rev, $committer,
128                 format_date($date), $i++, $output);
131 sub init_claim {
132         my ($rev) = @_;
133         for (my $i = 0; $i < @filelines; $i++) {
134                 $filelines[$i] = [ $filelines[$i], '', '', '', 1];
135                         # line,
136                         # rev,
137                         # author,
138                         # date,
139                         # 1 <-- belongs to the original file.
140         }
141         $revs{$rev}{'lines'} = \@filelines;
145 sub handle_rev {
146         my $i = 0;
147         my %seen;
148         while (my $rev = shift @revqueue) {
149                 next if $seen{$rev}++;
151                 my %revinfo = git_commit_info($rev);
153                 foreach my $p (@{$revs{$rev}{'parents'}}) {
155                         git_diff_parse($p, $rev, %revinfo);
156                         push @revqueue, $p;
157                 }
160                 if (scalar @{$revs{$rev}{parents}} == 0) {
161                         # We must be at the initial rev here, so claim everything that is left.
162                         for (my $i = 0; $i < @{$revs{$rev}{lines}}; $i++) {
163                                 if (ref ${$revs{$rev}{lines}}[$i] eq '' || ${$revs{$rev}{lines}}[$i][1] eq '') {
164                                         claim_line($i, $rev, $revs{$rev}{lines}, %revinfo);
165                                 }
166                         }
167                 }
168         }
172 sub git_rev_list {
173         my ($rev, $file) = @_;
175         my $revlist;
176         if ($rev_file) {
177                 open($revlist, '<' . $rev_file);
178         } else {
179                 $revlist = open_pipe("git-rev-list","--parents","--remove-empty",$rev,"--",$file)
180                         or die "Failed to exec git-rev-list: $!";
181         }
183         my @revs;
184         while(my $line = <$revlist>) {
185                 chomp $line;
186                 my ($rev, @parents) = split /\s+/, $line;
187                 push @revs, [ $rev, @parents ];
188         }
189         close($revlist);
191         printf("0 revs found for rev %s (%s)\n", $rev, $file) if (@revs == 0);
192         return @revs;
195 sub find_parent_renames {
196         my ($rev, $file) = @_;
198         my $patch = open_pipe("git-diff-tree", "-M50", "-r","--name-status", "-z","$rev")
199                 or die "Failed to exec git-diff: $!";
201         local $/ = "\0";
202         my %bound;
203         my $junk = <$patch>;
204         while (my $change = <$patch>) {
205                 chomp $change;
206                 my $filename = <$patch>;
207                 chomp $filename;
209                 if ($change =~ m/^[AMD]$/ ) {
210                         next;
211                 } elsif ($change =~ m/^R/ ) {
212                         my $oldfilename = $filename;
213                         $filename = <$patch>;
214                         chomp $filename;
215                         if ( $file eq $filename ) {
216                                 my $parent = git_find_parent($rev, $oldfilename);
217                                 @bound{'rev','filename'} = ($parent, $oldfilename);
218                                 last;
219                         }
220                 }
221         }
222         close($patch);
224         return \%bound;
228 sub git_find_parent {
229         my ($rev, $filename) = @_;
231         my $revparent = open_pipe("git-rev-list","--remove-empty", "--parents","--max-count=1","$rev","--",$filename)
232                 or die "Failed to open git-rev-list to find a single parent: $!";
234         my $parentline = <$revparent>;
235         chomp $parentline;
236         my ($revfound,$parent) = split m/\s+/, $parentline;
238         close($revparent);
240         return $parent;
244 # Get a diff between the current revision and a parent.
245 # Record the commit information that results.
246 sub git_diff_parse {
247         my ($parent, $rev, %revinfo) = @_;
249         my $diff = open_pipe("git-diff-tree","-M","-p",$rev,$parent,"--",
250                         $revs{$rev}{'filename'}, $revs{$parent}{'filename'})
251                 or die "Failed to call git-diff for annotation: $!";
253         _git_diff_parse($diff, $parent, $rev, %revinfo);
255         close($diff);
258 sub _git_diff_parse {
259         my ($diff, $parent, $rev, %revinfo) = @_;
261         my ($ri, $pi) = (0,0);
262         my $slines = $revs{$rev}{'lines'};
263         my @plines;
265         my $gotheader = 0;
266         my ($remstart);
267         my ($hunk_start, $hunk_index);
268         while(<$diff>) {
269                 chomp;
270                 if (m/^@@ -(\d+),(\d+) \+(\d+),(\d+)/) {
271                         $remstart = $1;
272                         # Adjust for 0-based arrays
273                         $remstart--;
274                         # Reinit hunk tracking.
275                         $hunk_start = $remstart;
276                         $hunk_index = 0;
277                         $gotheader = 1;
279                         for (my $i = $ri; $i < $remstart; $i++) {
280                                 $plines[$pi++] = $slines->[$i];
281                                 $ri++;
282                         }
283                         next;
284                 } elsif (!$gotheader) {
285                         next;
286                 }
288                 if (m/^\+(.*)$/) {
289                         my $line = $1;
290                         $plines[$pi++] = [ $line, '', '', '', 0 ];
291                         next;
293                 } elsif (m/^-(.*)$/) {
294                         my $line = $1;
295                         if (get_line($slines, $ri) eq $line) {
296                                 # Found a match, claim
297                                 claim_line($ri, $rev, $slines, %revinfo);
298                         } else {
299                                 die sprintf("Sync error: %d/%d\n|%s\n|%s\n%s => %s\n",
300                                                 $ri, $hunk_start + $hunk_index,
301                                                 $line,
302                                                 get_line($slines, $ri),
303                                                 $rev, $parent);
304                         }
305                         $ri++;
307                 } else {
308                         if (substr($_,1) ne get_line($slines,$ri) ) {
309                                 die sprintf("Line %d (%d) does not match:\n|%s\n|%s\n%s => %s\n",
310                                                 $hunk_start + $hunk_index, $ri,
311                                                 substr($_,1),
312                                                 get_line($slines,$ri),
313                                                 $rev, $parent);
314                         }
315                         $plines[$pi++] = $slines->[$ri++];
316                 }
317                 $hunk_index++;
318         }
319         for (my $i = $ri; $i < @{$slines} ; $i++) {
320                 push @plines, $slines->[$ri++];
321         }
323         $revs{$parent}{lines} = \@plines;
324         return;
327 sub get_line {
328         my ($lines, $index) = @_;
330         return ref $lines->[$index] ne '' ? $lines->[$index][0] : $lines->[$index];
333 sub git_cat_file {
334         my ($rev, $filename) = @_;
335         return () unless defined $rev && defined $filename;
337         my $blob = git_ls_tree($rev, $filename);
339         my $catfile = open_pipe("git","cat-file", "blob", $blob)
340                 or die "Failed to git-cat-file blob $blob (rev $rev, file $filename): " . $!;
342         my @lines;
343         while(<$catfile>) {
344                 chomp;
345                 push @lines, $_;
346         }
347         close($catfile);
349         return @lines;
352 sub git_ls_tree {
353         my ($rev, $filename) = @_;
355         my $lstree = open_pipe("git","ls-tree",$rev,$filename)
356                 or die "Failed to call git ls-tree: $!";
358         my ($mode, $type, $blob, $tfilename);
359         while(<$lstree>) {
360                 ($mode, $type, $blob, $tfilename) = split(/\s+/, $_, 4);
361                 last if ($tfilename eq $filename);
362         }
363         close($lstree);
365         return $blob if $filename eq $filename;
366         die "git-ls-tree failed to find blob for $filename";
372 sub claim_line {
373         my ($floffset, $rev, $lines, %revinfo) = @_;
374         my $oline = get_line($lines, $floffset);
375         @{$lines->[$floffset]} = ( $oline, $rev,
376                 $revinfo{'author'}, $revinfo{'author_date'} );
377         #printf("Claiming line %d with rev %s: '%s'\n",
378         #               $floffset, $rev, $oline) if 1;
381 sub git_commit_info {
382         my ($rev) = @_;
383         my $commit = open_pipe("git-cat-file", "commit", $rev)
384                 or die "Failed to call git-cat-file: $!";
386         my %info;
387         while(<$commit>) {
388                 chomp;
389                 last if (length $_ == 0);
391                 if (m/^author (.*) <(.*)> (.*)$/) {
392                         $info{'author'} = $1;
393                         $info{'author_email'} = $2;
394                         $info{'author_date'} = $3;
395                 } elsif (m/^committer (.*) <(.*)> (.*)$/) {
396                         $info{'committer'} = $1;
397                         $info{'committer_email'} = $2;
398                         $info{'committer_date'} = $3;
399                 }
400         }
401         close($commit);
403         return %info;
406 sub format_date {
407         my ($timestamp, $timezone) = split(' ', $_[0]);
409         return strftime("%Y-%m-%d %H:%M:%S " . $timezone, gmtime($timestamp));
412 # Copied from git-send-email.perl - We need a Git.pm module..
413 sub gitvar {
414     my ($var) = @_;
415     my $fh;
416     my $pid = open($fh, '-|');
417     die "$!" unless defined $pid;
418     if (!$pid) {
419         exec('git-var', $var) or die "$!";
420     }
421     my ($val) = <$fh>;
422     close $fh or die "$!";
423     chomp($val);
424     return $val;
427 sub gitvar_name {
428     my ($name) = @_;
429     my $val = gitvar($name);
430     my @field = split(/\s+/, $val);
431     return join(' ', @field[0...(@field-4)]);
434 sub open_pipe {
435         if ($^O eq '##INSERT_ACTIVESTATE_STRING_HERE##') {
436                 return open_pipe_activestate(@_);
437         } else {
438                 return open_pipe_normal(@_);
439         }
442 sub open_pipe_activestate {
443         tie *fh, "Git::ActiveStatePipe", @_;
444         return *fh;
447 sub open_pipe_normal {
448         my (@execlist) = @_;
450         my $pid = open my $kid, "-|";
451         defined $pid or die "Cannot fork: $!";
453         unless ($pid) {
454                 exec @execlist;
455                 die "Cannot exec @execlist: $!";
456         }
458         return $kid;
461 package Git::ActiveStatePipe;
462 use strict;
464 sub TIEHANDLE {
465         my ($class, @params) = @_;
466         my $cmdline = join " ", @params;
467         my  @data = qx{$cmdline};
468         bless { i => 0, data => \@data }, $class;
471 sub READLINE {
472         my $self = shift;
473         if ($self->{i} >= scalar @{$self->{data}}) {
474                 return undef;
475         }
476         return $self->{'data'}->[ $self->{i}++ ];
479 sub CLOSE {
480         my $self = shift;
481         delete $self->{data};
482         delete $self->{i};
485 sub EOF {
486         my $self = shift;
487         return ($self->{i} >= scalar @{$self->{data}});