Andrew's git - gitweb.git/blob

   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        -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
  29our ($help, $longrev, $rename, $starting_rev, $rev_file) = (0, 0, 1);
  30
  31my $rc = GetOptions(    "long|l" => \$longrev,
  32                        "help|h" => \$help,
  33                        "rename|r" => \$rename,
  34                        "rev-file|S" => \$rev_file);
  35if (!$rc or $help) {
  36        usage();
  37}
  38
  39my $filename = shift @ARGV;
  40if (@ARGV) {
  41        $starting_rev = shift @ARGV;
  42}
  43
  44my @stack = (
  45        {
  46                'rev' => defined $starting_rev ? $starting_rev : "HEAD",
  47                'filename' => $filename,
  48        },
  49);
  50
  51our @filelines = ();
  52
  53if (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
  67our %revs;
  68our @revqueue;
  69our $head;
  70
  71my $revsprocessed = 0;
  72while (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}
  98push @revqueue, $head;
  99init_claim( defined $starting_rev ? $starting_rev : 'dirty');
 100unless (defined $starting_rev) {
 101        open(DIFF,"-|","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}
 111handle_rev();
 112
 113
 114my $i = 0;
 115foreach 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
 131sub 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
 145sub 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
 172sub git_rev_list {
 173        my ($rev, $file) = @_;
 174
 175        if ($rev_file) {
 176                open(P, '<' . $rev_file);
 177        } else {
 178                open(P,"-|","git-rev-list","--parents","--remove-empty",$rev,"--",$file)
 179                        or die "Failed to exec git-rev-list: $!";
 180        }
 181
 182        my @revs;
 183        while(my $line = <P>) {
 184                chomp $line;
 185                my ($rev, @parents) = split /\s+/, $line;
 186                push @revs, [ $rev, @parents ];
 187        }
 188        close(P);
 189
 190        printf("0 revs found for rev %s (%s)\n", $rev, $file) if (@revs == 0);
 191        return @revs;
 192}
 193
 194sub find_parent_renames {
 195        my ($rev, $file) = @_;
 196
 197        open(P,"-|","git-diff-tree", "-M50", "-r","--name-status", "-z","$rev")
 198                or die "Failed to exec git-diff: $!";
 199
 200        local $/ = "\0";
 201        my %bound;
 202        my $junk = <P>;
 203        while (my $change = <P>) {
 204                chomp $change;
 205                my $filename = <P>;
 206                chomp $filename;
 207
 208                if ($change =~ m/^[AMD]$/ ) {
 209                        next;
 210                } elsif ($change =~ m/^R/ ) {
 211                        my $oldfilename = $filename;
 212                        $filename = <P>;
 213                        chomp $filename;
 214                        if ( $file eq $filename ) {
 215                                my $parent = git_find_parent($rev, $oldfilename);
 216                                @bound{'rev','filename'} = ($parent, $oldfilename);
 217                                last;
 218                        }
 219                }
 220        }
 221        close(P);
 222
 223        return \%bound;
 224}
 225
 226
 227sub git_find_parent {
 228        my ($rev, $filename) = @_;
 229
 230        open(REVPARENT,"-|","git-rev-list","--remove-empty", "--parents","--max-count=1","$rev","--",$filename)
 231                or die "Failed to open git-rev-list to find a single parent: $!";
 232
 233        my $parentline = <REVPARENT>;
 234        chomp $parentline;
 235        my ($revfound,$parent) = split m/\s+/, $parentline;
 236
 237        close(REVPARENT);
 238
 239        return $parent;
 240}
 241
 242
 243# Get a diff between the current revision and a parent.
 244# Record the commit information that results.
 245sub git_diff_parse {
 246        my ($parent, $rev, %revinfo) = @_;
 247
 248        open(DIFF,"-|","git-diff-tree","-M","-p",$rev,$parent,"--",
 249                        $revs{$rev}{'filename'}, $revs{$parent}{'filename'})
 250                or die "Failed to call git-diff for annotation: $!";
 251
 252        _git_diff_parse(*DIFF, $parent, $rev, %revinfo);
 253
 254        close(DIFF);
 255}
 256
 257sub _git_diff_parse {
 258        my ($diff, $parent, $rev, %revinfo) = @_;
 259
 260        my ($ri, $pi) = (0,0);
 261        my $slines = $revs{$rev}{'lines'};
 262        my @plines;
 263
 264        my $gotheader = 0;
 265        my ($remstart);
 266        my ($hunk_start, $hunk_index);
 267        while(<DIFF>) {
 268                chomp;
 269                if (m/^@@ -(\d+),(\d+) \+(\d+),(\d+)/) {
 270                        $remstart = $1;
 271                        # Adjust for 0-based arrays
 272                        $remstart--;
 273                        # Reinit hunk tracking.
 274                        $hunk_start = $remstart;
 275                        $hunk_index = 0;
 276                        $gotheader = 1;
 277
 278                        for (my $i = $ri; $i < $remstart; $i++) {
 279                                $plines[$pi++] = $slines->[$i];
 280                                $ri++;
 281                        }
 282                        next;
 283                } elsif (!$gotheader) {
 284                        next;
 285                }
 286
 287                if (m/^\+(.*)$/) {
 288                        my $line = $1;
 289                        $plines[$pi++] = [ $line, '', '', '', 0 ];
 290                        next;
 291
 292                } elsif (m/^-(.*)$/) {
 293                        my $line = $1;
 294                        if (get_line($slines, $ri) eq $line) {
 295                                # Found a match, claim
 296                                claim_line($ri, $rev, $slines, %revinfo);
 297                        } else {
 298                                die sprintf("Sync error: %d/%d\n|%s\n|%s\n%s => %s\n",
 299                                                $ri, $hunk_start + $hunk_index,
 300                                                $line,
 301                                                get_line($slines, $ri),
 302                                                $rev, $parent);
 303                        }
 304                        $ri++;
 305
 306                } else {
 307                        if (substr($_,1) ne get_line($slines,$ri) ) {
 308                                die sprintf("Line %d (%d) does not match:\n|%s\n|%s\n%s => %s\n",
 309                                                $hunk_start + $hunk_index, $ri,
 310                                                substr($_,1),
 311                                                get_line($slines,$ri),
 312                                                $rev, $parent);
 313                        }
 314                        $plines[$pi++] = $slines->[$ri++];
 315                }
 316                $hunk_index++;
 317        }
 318        for (my $i = $ri; $i < @{$slines} ; $i++) {
 319                push @plines, $slines->[$ri++];
 320        }
 321
 322        $revs{$parent}{lines} = \@plines;
 323        return;
 324}
 325
 326sub get_line {
 327        my ($lines, $index) = @_;
 328
 329        return ref $lines->[$index] ne '' ? $lines->[$index][0] : $lines->[$index];
 330}
 331
 332sub git_cat_file {
 333        my ($rev, $filename) = @_;
 334        return () unless defined $rev && defined $filename;
 335
 336        my $blob = git_ls_tree($rev, $filename);
 337
 338        open(C,"-|","git","cat-file", "blob", $blob)
 339                or die "Failed to git-cat-file blob $blob (rev $rev, file $filename): " . $!;
 340
 341        my @lines;
 342        while(<C>) {
 343                chomp;
 344                push @lines, $_;
 345        }
 346        close(C);
 347
 348        return @lines;
 349}
 350
 351sub git_ls_tree {
 352        my ($rev, $filename) = @_;
 353
 354        open(T,"-|","git","ls-tree",$rev,$filename)
 355                or die "Failed to call git ls-tree: $!";
 356
 357        my ($mode, $type, $blob, $tfilename);
 358        while(<T>) {
 359                ($mode, $type, $blob, $tfilename) = split(/\s+/, $_, 4);
 360                last if ($tfilename eq $filename);
 361        }
 362        close(T);
 363
 364        return $blob if $filename eq $filename;
 365        die "git-ls-tree failed to find blob for $filename";
 366
 367}
 368
 369
 370
 371sub claim_line {
 372        my ($floffset, $rev, $lines, %revinfo) = @_;
 373        my $oline = get_line($lines, $floffset);
 374        @{$lines->[$floffset]} = ( $oline, $rev,
 375                $revinfo{'author'}, $revinfo{'author_date'} );
 376        #printf("Claiming line %d with rev %s: '%s'\n",
 377        #               $floffset, $rev, $oline) if 1;
 378}
 379
 380sub git_commit_info {
 381        my ($rev) = @_;
 382        open(COMMIT, "-|","git-cat-file", "commit", $rev)
 383                or die "Failed to call git-cat-file: $!";
 384
 385        my %info;
 386        while(<COMMIT>) {
 387                chomp;
 388                last if (length $_ == 0);
 389
 390                if (m/^author (.*) <(.*)> (.*)$/) {
 391                        $info{'author'} = $1;
 392                        $info{'author_email'} = $2;
 393                        $info{'author_date'} = $3;
 394                } elsif (m/^committer (.*) <(.*)> (.*)$/) {
 395                        $info{'committer'} = $1;
 396                        $info{'committer_email'} = $2;
 397                        $info{'committer_date'} = $3;
 398                }
 399        }
 400        close(COMMIT);
 401
 402        return %info;
 403}
 404
 405sub format_date {
 406        my ($timestamp, $timezone) = split(' ', $_[0]);
 407
 408        return strftime("%Y-%m-%d %H:%M:%S " . $timezone, gmtime($timestamp));
 409}
 410
 411# Copied from git-send-email.perl - We need a Git.pm module..
 412sub gitvar {
 413    my ($var) = @_;
 414    my $fh;
 415    my $pid = open($fh, '-|');
 416    die "$!" unless defined $pid;
 417    if (!$pid) {
 418        exec('git-var', $var) or die "$!";
 419    }
 420    my ($val) = <$fh>;
 421    close $fh or die "$!";
 422    chomp($val);
 423    return $val;
 424}
 425
 426sub gitvar_name {
 427    my ($name) = @_;
 428    my $val = gitvar($name);
 429    my @field = split(/\s+/, $val);
 430    return join(' ', @field[0...(@field-4)]);
 431}
 432