Merge branch 'jc/tag'
[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.
8
9 use warnings;
10 use strict;
11 use Getopt::Long;
12 use POSIX qw(strftime gmtime);
13
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 ';
25
26         exit(1);
27 }
28
29 our ($help, $longrev, $rename, $starting_rev, $rev_file) = (0, 0, 1);
30
31 my $rc = GetOptions(    "long|l" => \$longrev,
32                         "help|h" => \$help,
33                         "rename|r" => \$rename,
34                         "rev-file|S=s" => \$rev_file);
35 if (!$rc or $help) {
36         usage();
37 }
38
39 my $filename = shift @ARGV;
40 if (@ARGV) {
41         $starting_rev = shift @ARGV;
42 }
43
44 my @stack = (
45         {
46                 'rev' => defined $starting_rev ? $starting_rev : "HEAD",
47                 'filename' => $filename,
48         },
49 );
50
51 our @filelines = ();
52
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: $!";
58
59         while(<F>) {
60                 chomp;
61                 push @filelines, $_;
62         }
63         close(F);
64
65 }
66
67 our %revs;
68 our @revqueue;
69 our $head;
70
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;
77
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                 }
86
87                 if (!$rename) {
88                         next;
89                 }
90
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: $!";
103
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);
110 }
111 handle_rev();
112
113
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         }
126
127         printf("%s\t(%10s\t%10s\t%d)%s\n", $rev, $committer,
128                 format_date($date), $i++, $output);
129 }
130
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;
142 }
143
144
145 sub handle_rev {
146         my $i = 0;
147         my %seen;
148         while (my $rev = shift @revqueue) {
149                 next if $seen{$rev}++;
150
151                 my %revinfo = git_commit_info($rev);
152
153                 foreach my $p (@{$revs{$rev}{'parents'}}) {
154
155                         git_diff_parse($p, $rev, %revinfo);
156                         push @revqueue, $p;
157                 }
158
159
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         }
169 }
170
171
172 sub git_rev_list {
173         my ($rev, $file) = @_;
174
175         my $revlist;
176         if ($rev_file) {
177                 open($revlist, '<' . $rev_file)
178                     or die "Failed to open $rev_file : $!";
179         } else {
180                 $revlist = open_pipe("git-rev-list","--parents","--remove-empty",$rev,"--",$file)
181                         or die "Failed to exec git-rev-list: $!";
182         }
183
184         my @revs;
185         while(my $line = <$revlist>) {
186                 chomp $line;
187                 my ($rev, @parents) = split /\s+/, $line;
188                 push @revs, [ $rev, @parents ];
189         }
190         close($revlist);
191
192         printf("0 revs found for rev %s (%s)\n", $rev, $file) if (@revs == 0);
193         return @revs;
194 }
195
196 sub find_parent_renames {
197         my ($rev, $file) = @_;
198
199         my $patch = open_pipe("git-diff-tree", "-M50", "-r","--name-status", "-z","$rev")
200                 or die "Failed to exec git-diff: $!";
201
202         local $/ = "\0";
203         my %bound;
204         my $junk = <$patch>;
205         while (my $change = <$patch>) {
206                 chomp $change;
207                 my $filename = <$patch>;
208                 chomp $filename;
209
210                 if ($change =~ m/^[AMD]$/ ) {
211                         next;
212                 } elsif ($change =~ m/^R/ ) {
213                         my $oldfilename = $filename;
214                         $filename = <$patch>;
215                         chomp $filename;
216                         if ( $file eq $filename ) {
217                                 my $parent = git_find_parent($rev, $oldfilename);
218                                 @bound{'rev','filename'} = ($parent, $oldfilename);
219                                 last;
220                         }
221                 }
222         }
223         close($patch);
224
225         return \%bound;
226 }
227
228
229 sub git_find_parent {
230         my ($rev, $filename) = @_;
231
232         my $revparent = open_pipe("git-rev-list","--remove-empty", "--parents","--max-count=1","$rev","--",$filename)
233                 or die "Failed to open git-rev-list to find a single parent: $!";
234
235         my $parentline = <$revparent>;
236         chomp $parentline;
237         my ($revfound,$parent) = split m/\s+/, $parentline;
238
239         close($revparent);
240
241         return $parent;
242 }
243
244
245 # Get a diff between the current revision and a parent.
246 # Record the commit information that results.
247 sub git_diff_parse {
248         my ($parent, $rev, %revinfo) = @_;
249
250         my $diff = open_pipe("git-diff-tree","-M","-p",$rev,$parent,"--",
251                         $revs{$rev}{'filename'}, $revs{$parent}{'filename'})
252                 or die "Failed to call git-diff for annotation: $!";
253
254         _git_diff_parse($diff, $parent, $rev, %revinfo);
255
256         close($diff);
257 }
258
259 sub _git_diff_parse {
260         my ($diff, $parent, $rev, %revinfo) = @_;
261
262         my ($ri, $pi) = (0,0);
263         my $slines = $revs{$rev}{'lines'};
264         my @plines;
265
266         my $gotheader = 0;
267         my ($remstart);
268         my ($hunk_start, $hunk_index);
269         while(<$diff>) {
270                 chomp;
271                 if (m/^@@ -(\d+),(\d+) \+(\d+),(\d+)/) {
272                         $remstart = $1;
273                         # Adjust for 0-based arrays
274                         $remstart--;
275                         # Reinit hunk tracking.
276                         $hunk_start = $remstart;
277                         $hunk_index = 0;
278                         $gotheader = 1;
279
280                         for (my $i = $ri; $i < $remstart; $i++) {
281                                 $plines[$pi++] = $slines->[$i];
282                                 $ri++;
283                         }
284                         next;
285                 } elsif (!$gotheader) {
286                         next;
287                 }
288
289                 if (m/^\+(.*)$/) {
290                         my $line = $1;
291                         $plines[$pi++] = [ $line, '', '', '', 0 ];
292                         next;
293
294                 } elsif (m/^-(.*)$/) {
295                         my $line = $1;
296                         if (get_line($slines, $ri) eq $line) {
297                                 # Found a match, claim
298                                 claim_line($ri, $rev, $slines, %revinfo);
299                         } else {
300                                 die sprintf("Sync error: %d/%d\n|%s\n|%s\n%s => %s\n",
301                                                 $ri, $hunk_start + $hunk_index,
302                                                 $line,
303                                                 get_line($slines, $ri),
304                                                 $rev, $parent);
305                         }
306                         $ri++;
307
308                 } elsif (m/^\\/) {
309                         ;
310                         # Skip \No newline at end of file.
311                         # But this can be internationalized, so only look
312                         # for an initial \
313
314                 } else {
315                         if (substr($_,1) ne get_line($slines,$ri) ) {
316                                 die sprintf("Line %d (%d) does not match:\n|%s\n|%s\n%s => %s\n",
317                                                 $hunk_start + $hunk_index, $ri,
318                                                 substr($_,1),
319                                                 get_line($slines,$ri),
320                                                 $rev, $parent);
321                         }
322                         $plines[$pi++] = $slines->[$ri++];
323                 }
324                 $hunk_index++;
325         }
326         for (my $i = $ri; $i < @{$slines} ; $i++) {
327                 push @plines, $slines->[$ri++];
328         }
329
330         $revs{$parent}{lines} = \@plines;
331         return;
332 }
333
334 sub get_line {
335         my ($lines, $index) = @_;
336
337         return ref $lines->[$index] ne '' ? $lines->[$index][0] : $lines->[$index];
338 }
339
340 sub git_cat_file {
341         my ($rev, $filename) = @_;
342         return () unless defined $rev && defined $filename;
343
344         my $blob = git_ls_tree($rev, $filename);
345
346         my $catfile = open_pipe("git","cat-file", "blob", $blob)
347                 or die "Failed to git-cat-file blob $blob (rev $rev, file $filename): " . $!;
348
349         my @lines;
350         while(<$catfile>) {
351                 chomp;
352                 push @lines, $_;
353         }
354         close($catfile);
355
356         return @lines;
357 }
358
359 sub git_ls_tree {
360         my ($rev, $filename) = @_;
361
362         my $lstree = open_pipe("git","ls-tree",$rev,$filename)
363                 or die "Failed to call git ls-tree: $!";
364
365         my ($mode, $type, $blob, $tfilename);
366         while(<$lstree>) {
367                 ($mode, $type, $blob, $tfilename) = split(/\s+/, $_, 4);
368                 last if ($tfilename eq $filename);
369         }
370         close($lstree);
371
372         return $blob if $filename eq $filename;
373         die "git-ls-tree failed to find blob for $filename";
374
375 }
376
377
378
379 sub claim_line {
380         my ($floffset, $rev, $lines, %revinfo) = @_;
381         my $oline = get_line($lines, $floffset);
382         @{$lines->[$floffset]} = ( $oline, $rev,
383                 $revinfo{'author'}, $revinfo{'author_date'} );
384         #printf("Claiming line %d with rev %s: '%s'\n",
385         #               $floffset, $rev, $oline) if 1;
386 }
387
388 sub git_commit_info {
389         my ($rev) = @_;
390         my $commit = open_pipe("git-cat-file", "commit", $rev)
391                 or die "Failed to call git-cat-file: $!";
392
393         my %info;
394         while(<$commit>) {
395                 chomp;
396                 last if (length $_ == 0);
397
398                 if (m/^author (.*) <(.*)> (.*)$/) {
399                         $info{'author'} = $1;
400                         $info{'author_email'} = $2;
401                         $info{'author_date'} = $3;
402                 } elsif (m/^committer (.*) <(.*)> (.*)$/) {
403                         $info{'committer'} = $1;
404                         $info{'committer_email'} = $2;
405                         $info{'committer_date'} = $3;
406                 }
407         }
408         close($commit);
409
410         return %info;
411 }
412
413 sub format_date {
414         my ($timestamp, $timezone) = split(' ', $_[0]);
415
416         return strftime("%Y-%m-%d %H:%M:%S " . $timezone, gmtime($timestamp));
417 }
418
419 # Copied from git-send-email.perl - We need a Git.pm module..
420 sub gitvar {
421     my ($var) = @_;
422     my $fh;
423     my $pid = open($fh, '-|');
424     die "$!" unless defined $pid;
425     if (!$pid) {
426         exec('git-var', $var) or die "$!";
427     }
428     my ($val) = <$fh>;
429     close $fh or die "$!";
430     chomp($val);
431     return $val;
432 }
433
434 sub gitvar_name {
435     my ($name) = @_;
436     my $val = gitvar($name);
437     my @field = split(/\s+/, $val);
438     return join(' ', @field[0...(@field-4)]);
439 }
440
441 sub open_pipe {
442         if ($^O eq '##INSERT_ACTIVESTATE_STRING_HERE##') {
443                 return open_pipe_activestate(@_);
444         } else {
445                 return open_pipe_normal(@_);
446         }
447 }
448
449 sub open_pipe_activestate {
450         tie *fh, "Git::ActiveStatePipe", @_;
451         return *fh;
452 }
453
454 sub open_pipe_normal {
455         my (@execlist) = @_;
456
457         my $pid = open my $kid, "-|";
458         defined $pid or die "Cannot fork: $!";
459
460         unless ($pid) {
461                 exec @execlist;
462                 die "Cannot exec @execlist: $!";
463         }
464
465         return $kid;
466 }
467
468 package Git::ActiveStatePipe;
469 use strict;
470
471 sub TIEHANDLE {
472         my ($class, @params) = @_;
473         my $cmdline = join " ", @params;
474         my  @data = qx{$cmdline};
475         bless { i => 0, data => \@data }, $class;
476 }
477
478 sub READLINE {
479         my $self = shift;
480         if ($self->{i} >= scalar @{$self->{data}}) {
481                 return undef;
482         }
483         return $self->{'data'}->[ $self->{i}++ ];
484 }
485
486 sub CLOSE {
487         my $self = shift;
488         delete $self->{data};
489         delete $self->{i};
490 }
491
492 sub EOF {
493         my $self = shift;
494         return ($self->{i} >= scalar @{$self->{data}});
495 }