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 }