Merge branch 'jc/perl' into next
[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
12 my $filename = shift @ARGV;
13
14
15 my @stack = (
16         {
17                 'rev' => "HEAD",
18                 'filename' => $filename,
19         },
20 );
21
22 our (@lineoffsets, @pendinglineoffsets);
23 our @filelines = ();
24 open(F,"<",$filename)
25         or die "Failed to open filename: $!";
26
27 while(<F>) {
28         chomp;
29         push @filelines, $_;
30 }
31 close(F);
32 our $leftover_lines = @filelines;
33 our %revs;
34 our @revqueue;
35 our $head;
36
37 my $revsprocessed = 0;
38 while (my $bound = pop @stack) {
39         my @revisions = git_rev_list($bound->{'rev'}, $bound->{'filename'});
40         foreach my $revinst (@revisions) {
41                 my ($rev, @parents) = @$revinst;
42                 $head ||= $rev;
43
44                 $revs{$rev}{'filename'} = $bound->{'filename'};
45                 if (scalar @parents > 0) {
46                         $revs{$rev}{'parents'} = \@parents;
47                         next;
48                 }
49
50                 my $newbound = find_parent_renames($rev, $bound->{'filename'});
51                 if ( exists $newbound->{'filename'} && $newbound->{'filename'} ne $bound->{'filename'}) {
52                         push @stack, $newbound;
53                         $revs{$rev}{'parents'} = [$newbound->{'rev'}];
54                 }
55         }
56 }
57 push @revqueue, $head;
58 init_claim($head);
59 $revs{$head}{'lineoffsets'} = {};
60 handle_rev();
61
62
63 my $i = 0;
64 foreach my $l (@filelines) {
65         my ($output, $rev, $committer, $date);
66         if (ref $l eq 'ARRAY') {
67                 ($output, $rev, $committer, $date) = @$l;
68                 if (length($rev) > 8) {
69                         $rev = substr($rev,0,8);
70                 }
71         } else {
72                 $output = $l;
73                 ($rev, $committer, $date) = ('unknown', 'unknown', 'unknown');
74         }
75
76         printf("(%8s %10s %10s %d)%s\n", $rev, $committer, $date, $i++, $output);
77 }
78
79 sub init_claim {
80         my ($rev) = @_;
81         my %revinfo = git_commit_info($rev);
82         for (my $i = 0; $i < @filelines; $i++) {
83                 $filelines[$i] = [ $filelines[$i], '', '', '', 1];
84                         # line,
85                         # rev,
86                         # author,
87                         # date,
88                         # 1 <-- belongs to the original file.
89         }
90         $revs{$rev}{'lines'} = \@filelines;
91 }
92
93
94 sub handle_rev {
95         my $i = 0;
96         while (my $rev = shift @revqueue) {
97
98                 my %revinfo = git_commit_info($rev);
99
100                 foreach my $p (@{$revs{$rev}{'parents'}}) {
101
102                         git_diff_parse($p, $rev, %revinfo);
103                         push @revqueue, $p;
104                 }
105
106
107                 if (scalar @{$revs{$rev}{parents}} == 0) {
108                         # We must be at the initial rev here, so claim everything that is left.
109                         for (my $i = 0; $i < @{$revs{$rev}{lines}}; $i++) {
110                                 if (ref ${$revs{$rev}{lines}}[$i] eq '' || ${$revs{$rev}{lines}}[$i][1] eq '') {
111                                         claim_line($i, $rev, $revs{$rev}{lines}, %revinfo);
112                                 }
113                         }
114                 }
115         }
116 }
117
118
119 sub git_rev_list {
120         my ($rev, $file) = @_;
121
122         open(P,"-|","git-rev-list","--parents","--remove-empty",$rev,"--",$file)
123                 or die "Failed to exec git-rev-list: $!";
124
125         my @revs;
126         while(my $line = <P>) {
127                 chomp $line;
128                 my ($rev, @parents) = split /\s+/, $line;
129                 push @revs, [ $rev, @parents ];
130         }
131         close(P);
132
133         printf("0 revs found for rev %s (%s)\n", $rev, $file) if (@revs == 0);
134         return @revs;
135 }
136
137 sub find_parent_renames {
138         my ($rev, $file) = @_;
139
140         open(P,"-|","git-diff-tree", "-M50", "-r","--name-status", "-z","$rev")
141                 or die "Failed to exec git-diff: $!";
142
143         local $/ = "\0";
144         my %bound;
145         my $junk = <P>;
146         while (my $change = <P>) {
147                 chomp $change;
148                 my $filename = <P>;
149                 chomp $filename;
150
151                 if ($change =~ m/^[AMD]$/ ) {
152                         next;
153                 } elsif ($change =~ m/^R/ ) {
154                         my $oldfilename = $filename;
155                         $filename = <P>;
156                         chomp $filename;
157                         if ( $file eq $filename ) {
158                                 my $parent = git_find_parent($rev, $oldfilename);
159                                 @bound{'rev','filename'} = ($parent, $oldfilename);
160                                 last;
161                         }
162                 }
163         }
164         close(P);
165
166         return \%bound;
167 }
168
169
170 sub git_find_parent {
171         my ($rev, $filename) = @_;
172
173         open(REVPARENT,"-|","git-rev-list","--remove-empty", "--parents","--max-count=1","$rev","--",$filename)
174                 or die "Failed to open git-rev-list to find a single parent: $!";
175
176         my $parentline = <REVPARENT>;
177         chomp $parentline;
178         my ($revfound,$parent) = split m/\s+/, $parentline;
179
180         close(REVPARENT);
181
182         return $parent;
183 }
184
185
186 # Get a diff between the current revision and a parent.
187 # Record the commit information that results.
188 sub git_diff_parse {
189         my ($parent, $rev, %revinfo) = @_;
190
191         my ($ri, $pi) = (0,0);
192         open(DIFF,"-|","git-diff-tree","-M","-p",$rev,$parent,"--",
193                         $revs{$rev}{'filename'}, $revs{$parent}{'filename'})
194                 or die "Failed to call git-diff for annotation: $!";
195
196         my $slines = $revs{$rev}{'lines'};
197         my @plines;
198
199         my $gotheader = 0;
200         my ($remstart, $remlength, $addstart, $addlength);
201         my ($hunk_start, $hunk_index, $hunk_adds);
202         while(<DIFF>) {
203                 chomp;
204                 if (m/^@@ -(\d+),(\d+) \+(\d+),(\d+)/) {
205                         ($remstart, $remlength, $addstart, $addlength) = ($1, $2, $3, $4);
206                         # Adjust for 0-based arrays
207                         $remstart--;
208                         $addstart--;
209                         # Reinit hunk tracking.
210                         $hunk_start = $remstart;
211                         $hunk_index = 0;
212                         $gotheader = 1;
213
214                         for (my $i = $ri; $i < $remstart; $i++) {
215                                 $plines[$pi++] = $slines->[$i];
216                                 $ri++;
217                         }
218                         next;
219                 } elsif (!$gotheader) {
220                         next;
221                 }
222
223                 if (m/^\+(.*)$/) {
224                         my $line = $1;
225                         $plines[$pi++] = [ $line, '', '', '', 0 ];
226                         next;
227
228                 } elsif (m/^-(.*)$/) {
229                         my $line = $1;
230                         if (get_line($slines, $ri) eq $line) {
231                                 # Found a match, claim
232                                 claim_line($ri, $rev, $slines, %revinfo);
233                         } else {
234                                 die sprintf("Sync error: %d/%d\n|%s\n|%s\n%s => %s\n",
235                                                 $ri, $hunk_start + $hunk_index,
236                                                 $line,
237                                                 get_line($slines, $ri),
238                                                 $rev, $parent);
239                         }
240                         $ri++;
241
242                 } else {
243                         if (substr($_,1) ne get_line($slines,$ri) ) {
244                                 die sprintf("Line %d (%d) does not match:\n|%s\n|%s\n%s => %s\n",
245                                                 $hunk_start + $hunk_index, $ri,
246                                                 substr($_,1),
247                                                 get_line($slines,$ri),
248                                                 $rev, $parent);
249                         }
250                         $plines[$pi++] = $slines->[$ri++];
251                 }
252                 $hunk_index++;
253         }
254         close(DIFF);
255         for (my $i = $ri; $i < @{$slines} ; $i++) {
256                 push @plines, $slines->[$ri++];
257         }
258
259         $revs{$parent}{lines} = \@plines;
260         return;
261 }
262
263 sub get_line {
264         my ($lines, $index) = @_;
265
266         return ref $lines->[$index] ne '' ? $lines->[$index][0] : $lines->[$index];
267 }
268
269 sub git_cat_file {
270         my ($parent, $filename) = @_;
271         return () unless defined $parent && defined $filename;
272         my $blobline = `git-ls-tree $parent $filename`;
273         my ($mode, $type, $blob, $tfilename) = split(/\s+/, $blobline, 4);
274
275         open(C,"-|","git-cat-file", "blob", $blob)
276                 or die "Failed to git-cat-file blob $blob (rev $parent, file $filename): " . $!;
277
278         my @lines;
279         while(<C>) {
280                 chomp;
281                 push @lines, $_;
282         }
283         close(C);
284
285         return @lines;
286 }
287
288
289 sub claim_line {
290         my ($floffset, $rev, $lines, %revinfo) = @_;
291         my $oline = get_line($lines, $floffset);
292         @{$lines->[$floffset]} = ( $oline, $rev,
293                 $revinfo{'author'}, $revinfo{'author_date'} );
294         #printf("Claiming line %d with rev %s: '%s'\n",
295         #               $floffset, $rev, $oline) if 1;
296 }
297
298 sub git_commit_info {
299         my ($rev) = @_;
300         open(COMMIT, "-|","git-cat-file", "commit", $rev)
301                 or die "Failed to call git-cat-file: $!";
302
303         my %info;
304         while(<COMMIT>) {
305                 chomp;
306                 last if (length $_ == 0);
307
308                 if (m/^author (.*) <(.*)> (.*)$/) {
309                         $info{'author'} = $1;
310                         $info{'author_email'} = $2;
311                         $info{'author_date'} = $3;
312                 } elsif (m/^committer (.*) <(.*)> (.*)$/) {
313                         $info{'committer'} = $1;
314                         $info{'committer_email'} = $2;
315                         $info{'committer_date'} = $3;
316                 }
317         }
318         close(COMMIT);
319
320         return %info;
321 }