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