git-annotate.perlon commit read-tree: shadowed variable fix. (a91af79)
   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);
  13use File::Basename qw(basename dirname);
  14
  15sub 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
  32our ($help, $longrev, $rename, $rawtime, $starting_rev, $rev_file) = (0, 0, 1);
  33
  34my $rc = GetOptions(    "long|l" => \$longrev,
  35                        "time|t" => \$rawtime,
  36                        "help|h" => \$help,
  37                        "rename|r" => \$rename,
  38                        "rev-file|S=s" => \$rev_file);
  39if (!$rc or $help or !@ARGV) {
  40        usage();
  41}
  42
  43my $filename = shift @ARGV;
  44if (@ARGV) {
  45        $starting_rev = shift @ARGV;
  46}
  47
  48my @stack = (
  49        {
  50                'rev' => defined $starting_rev ? $starting_rev : "HEAD",
  51                'filename' => $filename,
  52        },
  53);
  54
  55our @filelines = ();
  56
  57if (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
  71our %revs;
  72our @revqueue;
  73our $head;
  74
  75my $revsprocessed = 0;
  76while (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}
 102push @revqueue, $head;
 103init_claim( defined $starting_rev ? $head : 'dirty');
 104unless (defined $starting_rev) {
 105        my $diff = open_pipe("git","diff","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}
 115handle_rev();
 116
 117
 118my $i = 0;
 119foreach 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
 135sub 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
 149sub 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                if (exists $revs{$rev}{parents} &&
 158                    scalar @{$revs{$rev}{parents}} != 0) {
 159
 160                        git_diff_parse($revs{$rev}{'parents'}, $rev, %revinfo);
 161                        push @revqueue, @{$revs{$rev}{'parents'}};
 162
 163                } else {
 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                if (!defined $filename) {
 212                        next;
 213                }
 214                chomp $filename;
 215
 216                if ($change =~ m/^[AMD]$/ ) {
 217                        next;
 218                } elsif ($change =~ m/^R/ ) {
 219                        my $oldfilename = $filename;
 220                        $filename = <$patch>;
 221                        chomp $filename;
 222                        if ( $file eq $filename ) {
 223                                my $parent = git_find_parent($rev, $oldfilename);
 224                                @bound{'rev','filename'} = ($parent, $oldfilename);
 225                                last;
 226                        }
 227                }
 228        }
 229        close($patch);
 230
 231        return \%bound;
 232}
 233
 234
 235sub git_find_parent {
 236        my ($rev, $filename) = @_;
 237
 238        my $revparent = open_pipe("git-rev-list","--remove-empty", "--parents","--max-count=1","$rev","--",$filename)
 239                or die "Failed to open git-rev-list to find a single parent: $!";
 240
 241        my $parentline = <$revparent>;
 242        chomp $parentline;
 243        my ($revfound,$parent) = split m/\s+/, $parentline;
 244
 245        close($revparent);
 246
 247        return $parent;
 248}
 249
 250
 251# Get a diff between the current revision and a parent.
 252# Record the commit information that results.
 253sub git_diff_parse {
 254        my ($parents, $rev, %revinfo) = @_;
 255
 256        my @filenames = ( $revs{$rev}{'filename'} );
 257        foreach my $parent (@$parents) {
 258                push @filenames, $revs{$parent}{'filename'};
 259        }
 260
 261        my $diff = open_pipe("git-diff-tree","-M","-p","-c",$rev,"--",
 262                                @filenames )
 263                or die "Failed to call git-diff for annotation: $!";
 264
 265        _git_diff_parse($diff, $parents, $rev, %revinfo);
 266
 267        close($diff);
 268}
 269
 270sub _git_diff_parse {
 271        my ($diff, $parents, $rev, %revinfo) = @_;
 272
 273        my $ri = 0;
 274
 275        my $slines = $revs{$rev}{'lines'};
 276        my (%plines, %pi);
 277
 278        my $gotheader = 0;
 279        my ($remstart);
 280        my $parent_count = @$parents;
 281
 282        my $diff_header_regexp = "^@";
 283        $diff_header_regexp .= "@" x @$parents;
 284        $diff_header_regexp .= ' -\d+,\d+' x @$parents;
 285        $diff_header_regexp .= ' \+(\d+),\d+';
 286
 287        my %claim_regexps;
 288        my $allparentplus = '^' . '\\+' x @$parents . '(.*)$';
 289
 290        {
 291                my $i = 0;
 292                foreach my $parent (@$parents) {
 293
 294                        $pi{$parent} = 0;
 295                        my $r = '^' . '.' x @$parents . '(.*)$';
 296                        my $p = $r;
 297                        substr($p,$i+1, 1) = '\\+';
 298
 299                        my $m = $r;
 300                        substr($m,$i+1, 1) = '-';
 301
 302                        $claim_regexps{$parent}{plus} = $p;
 303                        $claim_regexps{$parent}{minus} = $m;
 304
 305                        $plines{$parent} = [];
 306
 307                        $i++;
 308                }
 309        }
 310
 311        DIFF:
 312        while(<$diff>) {
 313                chomp;
 314                if (m/$diff_header_regexp/) {
 315                        $remstart = $1 - 1;
 316                        # (0-based arrays)
 317
 318                        $gotheader = 1;
 319
 320                        foreach my $parent (@$parents) {
 321                                for (my $i = $ri; $i < $remstart; $i++) {
 322                                        $plines{$parent}[$pi{$parent}++] = $slines->[$i];
 323                                }
 324                        }
 325                        $ri = $remstart;
 326
 327                        next DIFF;
 328
 329                } elsif (!$gotheader) {
 330                        # Skip over the leadin.
 331                        next DIFF;
 332                }
 333
 334                if (m/^\\/) {
 335                        ;
 336                        # Skip \No newline at end of file.
 337                        # But this can be internationalized, so only look
 338                        # for an initial \
 339
 340                } else {
 341                        my %claims = ();
 342                        my $negclaim = 0;
 343                        my $allclaimed = 0;
 344                        my $line;
 345
 346                        if (m/$allparentplus/) {
 347                                claim_line($ri, $rev, $slines, %revinfo);
 348                                $allclaimed = 1;
 349
 350                        }
 351
 352                        PARENT:
 353                        foreach my $parent (keys %claim_regexps) {
 354                                my $m = $claim_regexps{$parent}{minus};
 355                                my $p = $claim_regexps{$parent}{plus};
 356
 357                                if (m/$m/) {
 358                                        $line = $1;
 359                                        $plines{$parent}[$pi{$parent}++] = [ $line, '', '', '', 0 ];
 360                                        $negclaim++;
 361
 362                                } elsif (m/$p/) {
 363                                        $line = $1;
 364                                        if (get_line($slines, $ri) eq $line) {
 365                                                # Found a match, claim
 366                                                $claims{$parent}++;
 367
 368                                        } else {
 369                                                die sprintf("Sync error: %d\n|%s\n|%s\n%s => %s\n",
 370                                                                $ri, $line,
 371                                                                get_line($slines, $ri),
 372                                                                $rev, $parent);
 373                                        }
 374                                }
 375                        }
 376
 377                        if (%claims) {
 378                                foreach my $parent (@$parents) {
 379                                        next if $claims{$parent} || $allclaimed;
 380                                        $plines{$parent}[$pi{$parent}++] = $slines->[$ri];
 381                                            #[ $line, '', '', '', 0 ];
 382                                }
 383                                $ri++;
 384
 385                        } elsif ($negclaim) {
 386                                next DIFF;
 387
 388                        } else {
 389                                if (substr($_,scalar @$parents) ne get_line($slines,$ri) ) {
 390                                        foreach my $parent (@$parents) {
 391                                                printf("parent %s is on line %d\n", $parent, $pi{$parent});
 392                                        }
 393
 394                                        die sprintf("Line %d, does not match:\n|%s|\n|%s|\n%s\n",
 395                                                    $ri,
 396                                                substr($_,scalar @$parents),
 397                                                get_line($slines,$ri), $rev);
 398                                }
 399                                foreach my $parent (@$parents) {
 400                                        $plines{$parent}[$pi{$parent}++] = $slines->[$ri];
 401                                }
 402                                $ri++;
 403                        }
 404                }
 405        }
 406
 407        for (my $i = $ri; $i < @{$slines} ; $i++) {
 408                foreach my $parent (@$parents) {
 409                        push @{$plines{$parent}}, $slines->[$ri];
 410                }
 411                $ri++;
 412        }
 413
 414        foreach my $parent (@$parents) {
 415                $revs{$parent}{lines} = $plines{$parent};
 416        }
 417
 418        return;
 419}
 420
 421sub get_line {
 422        my ($lines, $index) = @_;
 423
 424        return ref $lines->[$index] ne '' ? $lines->[$index][0] : $lines->[$index];
 425}
 426
 427sub git_cat_file {
 428        my ($rev, $filename) = @_;
 429        return () unless defined $rev && defined $filename;
 430
 431        my $blob = git_ls_tree($rev, $filename);
 432        die "Failed to find a blob for $filename in rev $rev\n" if !defined $blob;
 433
 434        my $catfile = open_pipe("git","cat-file", "blob", $blob)
 435                or die "Failed to git-cat-file blob $blob (rev $rev, file $filename): " . $!;
 436
 437        my @lines;
 438        while(<$catfile>) {
 439                chomp;
 440                push @lines, $_;
 441        }
 442        close($catfile);
 443
 444        return @lines;
 445}
 446
 447sub git_ls_tree {
 448        my ($rev, $filename) = @_;
 449
 450        my $lstree = open_pipe("git","ls-tree",$rev,$filename)
 451                or die "Failed to call git ls-tree: $!";
 452
 453        my ($mode, $type, $blob, $tfilename);
 454        while(<$lstree>) {
 455                chomp;
 456                ($mode, $type, $blob, $tfilename) = split(/\s+/, $_, 4);
 457                last if ($tfilename eq $filename);
 458        }
 459        close($lstree);
 460
 461        return $blob if ($tfilename eq $filename);
 462        die "git-ls-tree failed to find blob for $filename";
 463
 464}
 465
 466
 467
 468sub claim_line {
 469        my ($floffset, $rev, $lines, %revinfo) = @_;
 470        my $oline = get_line($lines, $floffset);
 471        @{$lines->[$floffset]} = ( $oline, $rev,
 472                $revinfo{'author'}, $revinfo{'author_date'} );
 473        #printf("Claiming line %d with rev %s: '%s'\n",
 474        #               $floffset, $rev, $oline) if 1;
 475}
 476
 477sub git_commit_info {
 478        my ($rev) = @_;
 479        my $commit = open_pipe("git-cat-file", "commit", $rev)
 480                or die "Failed to call git-cat-file: $!";
 481
 482        my %info;
 483        while(<$commit>) {
 484                chomp;
 485                last if (length $_ == 0);
 486
 487                if (m/^author (.*) <(.*)> (.*)$/) {
 488                        $info{'author'} = $1;
 489                        $info{'author_email'} = $2;
 490                        $info{'author_date'} = $3;
 491                } elsif (m/^committer (.*) <(.*)> (.*)$/) {
 492                        $info{'committer'} = $1;
 493                        $info{'committer_email'} = $2;
 494                        $info{'committer_date'} = $3;
 495                }
 496        }
 497        close($commit);
 498
 499        return %info;
 500}
 501
 502sub format_date {
 503        if ($rawtime) {
 504                return $_[0];
 505        }
 506        my ($timestamp, $timezone) = split(' ', $_[0]);
 507        my $minutes = abs($timezone);
 508        $minutes = int($minutes / 100) * 60 + ($minutes % 100);
 509        if ($timezone < 0) {
 510            $minutes = -$minutes;
 511        }
 512        my $t = $timestamp + $minutes * 60;
 513        return strftime("%Y-%m-%d %H:%M:%S " . $timezone, gmtime($t));
 514}
 515
 516# Copied from git-send-email.perl - We need a Git.pm module..
 517sub gitvar {
 518    my ($var) = @_;
 519    my $fh;
 520    my $pid = open($fh, '-|');
 521    die "$!" unless defined $pid;
 522    if (!$pid) {
 523        exec('git-var', $var) or die "$!";
 524    }
 525    my ($val) = <$fh>;
 526    close $fh or die "$!";
 527    chomp($val);
 528    return $val;
 529}
 530
 531sub gitvar_name {
 532    my ($name) = @_;
 533    my $val = gitvar($name);
 534    my @field = split(/\s+/, $val);
 535    return join(' ', @field[0...(@field-4)]);
 536}
 537
 538sub open_pipe {
 539        if ($^O eq '##INSERT_ACTIVESTATE_STRING_HERE##') {
 540                return open_pipe_activestate(@_);
 541        } else {
 542                return open_pipe_normal(@_);
 543        }
 544}
 545
 546sub open_pipe_activestate {
 547        tie *fh, "Git::ActiveStatePipe", @_;
 548        return *fh;
 549}
 550
 551sub open_pipe_normal {
 552        my (@execlist) = @_;
 553
 554        my $pid = open my $kid, "-|";
 555        defined $pid or die "Cannot fork: $!";
 556
 557        unless ($pid) {
 558                exec @execlist;
 559                die "Cannot exec @execlist: $!";
 560        }
 561
 562        return $kid;
 563}
 564
 565package Git::ActiveStatePipe;
 566use strict;
 567
 568sub TIEHANDLE {
 569        my ($class, @params) = @_;
 570        my $cmdline = join " ", @params;
 571        my  @data = qx{$cmdline};
 572        bless { i => 0, data => \@data }, $class;
 573}
 574
 575sub READLINE {
 576        my $self = shift;
 577        if ($self->{i} >= scalar @{$self->{data}}) {
 578                return undef;
 579        }
 580        return $self->{'data'}->[ $self->{i}++ ];
 581}
 582
 583sub CLOSE {
 584        my $self = shift;
 585        delete $self->{data};
 586        delete $self->{i};
 587}
 588
 589sub EOF {
 590        my $self = shift;
 591        return ($self->{i} >= scalar @{$self->{data}});
 592}