git-annotate.perlon commit Fix crash when reading the empty tree (b6c4a48)
   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
   9use warnings;
  10use strict;
  11use Getopt::Long;
  12use POSIX qw(strftime gmtime);
  13
  14sub 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
  31our ($help, $longrev, $rename, $rawtime, $starting_rev, $rev_file) = (0, 0, 1);
  32
  33my $rc = GetOptions(    "long|l" => \$longrev,
  34                        "time|t" => \$rawtime,
  35                        "help|h" => \$help,
  36                        "rename|r" => \$rename,
  37                        "rev-file|S=s" => \$rev_file);
  38if (!$rc or $help) {
  39        usage();
  40}
  41
  42my $filename = shift @ARGV;
  43if (@ARGV) {
  44        $starting_rev = shift @ARGV;
  45}
  46
  47my @stack = (
  48        {
  49                'rev' => defined $starting_rev ? $starting_rev : "HEAD",
  50                'filename' => $filename,
  51        },
  52);
  53
  54our @filelines = ();
  55
  56if (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
  70our %revs;
  71our @revqueue;
  72our $head;
  73
  74my $revsprocessed = 0;
  75while (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}
 101push @revqueue, $head;
 102init_claim( defined $starting_rev ? $head : 'dirty');
 103unless (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}
 114handle_rev();
 115
 116
 117my $i = 0;
 118foreach 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
 134sub 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
 148sub 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
 175sub 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
 199sub 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
 232sub 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.
 250sub 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
 262sub _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
 337sub get_line {
 338        my ($lines, $index) = @_;
 339
 340        return ref $lines->[$index] ne '' ? $lines->[$index][0] : $lines->[$index];
 341}
 342
 343sub git_cat_file {
 344        my ($rev, $filename) = @_;
 345        return () unless defined $rev && defined $filename;
 346
 347        my $blob = git_ls_tree($rev, $filename);
 348        die "Failed to find a blob for $filename in rev $rev\n" if !defined $blob;
 349
 350        my $catfile = open_pipe("git","cat-file", "blob", $blob)
 351                or die "Failed to git-cat-file blob $blob (rev $rev, file $filename): " . $!;
 352
 353        my @lines;
 354        while(<$catfile>) {
 355                chomp;
 356                push @lines, $_;
 357        }
 358        close($catfile);
 359
 360        return @lines;
 361}
 362
 363sub git_ls_tree {
 364        my ($rev, $filename) = @_;
 365
 366        my $lstree = open_pipe("git","ls-tree",$rev,$filename)
 367                or die "Failed to call git ls-tree: $!";
 368
 369        my ($mode, $type, $blob, $tfilename);
 370        while(<$lstree>) {
 371                chomp;
 372                ($mode, $type, $blob, $tfilename) = split(/\s+/, $_, 4);
 373                last if ($tfilename eq $filename);
 374        }
 375        close($lstree);
 376
 377        return $blob if ($tfilename eq $filename);
 378        die "git-ls-tree failed to find blob for $filename";
 379
 380}
 381
 382
 383
 384sub claim_line {
 385        my ($floffset, $rev, $lines, %revinfo) = @_;
 386        my $oline = get_line($lines, $floffset);
 387        @{$lines->[$floffset]} = ( $oline, $rev,
 388                $revinfo{'author'}, $revinfo{'author_date'} );
 389        #printf("Claiming line %d with rev %s: '%s'\n",
 390        #               $floffset, $rev, $oline) if 1;
 391}
 392
 393sub git_commit_info {
 394        my ($rev) = @_;
 395        my $commit = open_pipe("git-cat-file", "commit", $rev)
 396                or die "Failed to call git-cat-file: $!";
 397
 398        my %info;
 399        while(<$commit>) {
 400                chomp;
 401                last if (length $_ == 0);
 402
 403                if (m/^author (.*) <(.*)> (.*)$/) {
 404                        $info{'author'} = $1;
 405                        $info{'author_email'} = $2;
 406                        $info{'author_date'} = $3;
 407                } elsif (m/^committer (.*) <(.*)> (.*)$/) {
 408                        $info{'committer'} = $1;
 409                        $info{'committer_email'} = $2;
 410                        $info{'committer_date'} = $3;
 411                }
 412        }
 413        close($commit);
 414
 415        return %info;
 416}
 417
 418sub format_date {
 419        if ($rawtime) {
 420                return $_[0];
 421        }
 422        my ($timestamp, $timezone) = split(' ', $_[0]);
 423        my $minutes = abs($timezone);
 424        $minutes = int($minutes / 100) * 60 + ($minutes % 100);
 425        if ($timezone < 0) {
 426            $minutes = -$minutes;
 427        }
 428        my $t = $timestamp + $minutes * 60;
 429        return strftime("%Y-%m-%d %H:%M:%S " . $timezone, gmtime($t));
 430}
 431
 432# Copied from git-send-email.perl - We need a Git.pm module..
 433sub gitvar {
 434    my ($var) = @_;
 435    my $fh;
 436    my $pid = open($fh, '-|');
 437    die "$!" unless defined $pid;
 438    if (!$pid) {
 439        exec('git-var', $var) or die "$!";
 440    }
 441    my ($val) = <$fh>;
 442    close $fh or die "$!";
 443    chomp($val);
 444    return $val;
 445}
 446
 447sub gitvar_name {
 448    my ($name) = @_;
 449    my $val = gitvar($name);
 450    my @field = split(/\s+/, $val);
 451    return join(' ', @field[0...(@field-4)]);
 452}
 453
 454sub open_pipe {
 455        if ($^O eq '##INSERT_ACTIVESTATE_STRING_HERE##') {
 456                return open_pipe_activestate(@_);
 457        } else {
 458                return open_pipe_normal(@_);
 459        }
 460}
 461
 462sub open_pipe_activestate {
 463        tie *fh, "Git::ActiveStatePipe", @_;
 464        return *fh;
 465}
 466
 467sub open_pipe_normal {
 468        my (@execlist) = @_;
 469
 470        my $pid = open my $kid, "-|";
 471        defined $pid or die "Cannot fork: $!";
 472
 473        unless ($pid) {
 474                exec @execlist;
 475                die "Cannot exec @execlist: $!";
 476        }
 477
 478        return $kid;
 479}
 480
 481package Git::ActiveStatePipe;
 482use strict;
 483
 484sub TIEHANDLE {
 485        my ($class, @params) = @_;
 486        my $cmdline = join " ", @params;
 487        my  @data = qx{$cmdline};
 488        bless { i => 0, data => \@data }, $class;
 489}
 490
 491sub READLINE {
 492        my $self = shift;
 493        if ($self->{i} >= scalar @{$self->{data}}) {
 494                return undef;
 495        }
 496        return $self->{'data'}->[ $self->{i}++ ];
 497}
 498
 499sub CLOSE {
 500        my $self = shift;
 501        delete $self->{data};
 502        delete $self->{i};
 503}
 504
 505sub EOF {
 506        my $self = shift;
 507        return ($self->{i} >= scalar @{$self->{data}});
 508}