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