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 }