simple euristic for further free packing improvements
[gitweb.git] / git-annotate.perl
index 3800c4654b7f04a0fbd47fe4c5832f0ac6b0692b..a6a7a482cdcf34e3a1d545c7d5deab599a7c0d2f 100755 (executable)
@@ -8,44 +8,66 @@
 
 use warnings;
 use strict;
-use Getopt::Std;
+use Getopt::Long;
 use POSIX qw(strftime gmtime);
+use File::Basename qw(basename dirname);
 
 sub usage() {
-       print STDERR 'Usage: ${\basename $0} [-s] [-S revs-file] file
-
-       -l              show long rev
-       -r              follow renames
-       -S commit       use revs from revs-file instead of calling git-rev-list
-';
+       print STDERR "Usage: ${\basename $0} [-s] [-S revs-file] file [ revision ]
+       -l, --long
+                       Show long rev (Defaults off)
+       -t, --time
+                       Show raw timestamp (Defaults off)
+       -r, --rename
+                       Follow renames (Defaults on).
+       -S, --rev-file revs-file
+                       Use revs from revs-file instead of calling git-rev-list
+       -h, --help
+                       This message.
+";
 
        exit(1);
 }
 
-our ($opt_h, $opt_l, $opt_r, $opt_S);
-getopts("hlrS:") or usage();
-$opt_h && usage();
+our ($help, $longrev, $rename, $rawtime, $starting_rev, $rev_file) = (0, 0, 1);
+
+my $rc = GetOptions(   "long|l" => \$longrev,
+                       "time|t" => \$rawtime,
+                       "help|h" => \$help,
+                       "rename|r" => \$rename,
+                       "rev-file|S=s" => \$rev_file);
+if (!$rc or $help or !@ARGV) {
+       usage();
+}
 
 my $filename = shift @ARGV;
+if (@ARGV) {
+       $starting_rev = shift @ARGV;
+}
 
 my @stack = (
        {
-               'rev' => "HEAD",
+               'rev' => defined $starting_rev ? $starting_rev : "HEAD",
                'filename' => $filename,
        },
 );
 
-our (@lineoffsets, @pendinglineoffsets);
 our @filelines = ();
-open(F,"<",$filename)
-       or die "Failed to open filename: $!";
 
-while(<F>) {
-       chomp;
-       push @filelines, $_;
+if (defined $starting_rev) {
+       @filelines = git_cat_file($starting_rev, $filename);
+} else {
+       open(F,"<",$filename)
+               or die "Failed to open filename: $!";
+
+       while(<F>) {
+               chomp;
+               push @filelines, $_;
+       }
+       close(F);
+
 }
-close(F);
-our $leftover_lines = @filelines;
+
 our %revs;
 our @revqueue;
 our $head;
@@ -66,7 +88,7 @@ ()
                        next;
                }
 
-               if (!$opt_r) {
+               if (!$rename) {
                        next;
                }
 
@@ -78,8 +100,18 @@ ()
        }
 }
 push @revqueue, $head;
-init_claim($head);
-$revs{$head}{'lineoffsets'} = {};
+init_claim( defined $starting_rev ? $head : 'dirty');
+unless (defined $starting_rev) {
+       my $diff = open_pipe("git","diff","-R", "HEAD", "--",$filename)
+               or die "Failed to call git diff to check for dirty state: $!";
+
+       _git_diff_parse($diff, $head, "dirty", (
+                               'author' => gitvar_name("GIT_AUTHOR_IDENT"),
+                               'author_date' => sprintf("%s +0000",time()),
+                               )
+                       );
+       close($diff);
+}
 handle_rev();
 
 
@@ -88,7 +120,7 @@ ()
        my ($output, $rev, $committer, $date);
        if (ref $l eq 'ARRAY') {
                ($output, $rev, $committer, $date) = @$l;
-               if (!$opt_l && length($rev) > 8) {
+               if (!$longrev && length($rev) > 8) {
                        $rev = substr($rev,0,8);
                }
        } else {
@@ -97,12 +129,11 @@ ()
        }
 
        printf("%s\t(%10s\t%10s\t%d)%s\n", $rev, $committer,
-               format_date($date), $i++, $output);
+               format_date($date), ++$i, $output);
 }
 
 sub init_claim {
        my ($rev) = @_;
-       my %revinfo = git_commit_info($rev);
        for (my $i = 0; $i < @filelines; $i++) {
                $filelines[$i] = [ $filelines[$i], '', '', '', 1];
                        # line,
@@ -117,7 +148,9 @@ sub init_claim {
 
 sub handle_rev {
        my $i = 0;
+       my %seen;
        while (my $rev = shift @revqueue) {
+               next if $seen{$rev}++;
 
                my %revinfo = git_commit_info($rev);
 
@@ -143,20 +176,22 @@ sub handle_rev {
 sub git_rev_list {
        my ($rev, $file) = @_;
 
-       if ($opt_S) {
-               open(P, '<' . $opt_S);
+       my $revlist;
+       if ($rev_file) {
+               open($revlist, '<' . $rev_file)
+                   or die "Failed to open $rev_file : $!";
        } else {
-               open(P,"-|","git-rev-list","--parents","--remove-empty",$rev,"--",$file)
+               $revlist = open_pipe("git-rev-list","--parents","--remove-empty",$rev,"--",$file)
                        or die "Failed to exec git-rev-list: $!";
        }
 
        my @revs;
-       while(my $line = <P>) {
+       while(my $line = <$revlist>) {
                chomp $line;
                my ($rev, @parents) = split /\s+/, $line;
                push @revs, [ $rev, @parents ];
        }
-       close(P);
+       close($revlist);
 
        printf("0 revs found for rev %s (%s)\n", $rev, $file) if (@revs == 0);
        return @revs;
@@ -165,22 +200,25 @@ sub git_rev_list {
 sub find_parent_renames {
        my ($rev, $file) = @_;
 
-       open(P,"-|","git-diff-tree", "-M50", "-r","--name-status", "-z","$rev")
+       my $patch = open_pipe("git-diff-tree", "-M50", "-r","--name-status", "-z","$rev")
                or die "Failed to exec git-diff: $!";
 
        local $/ = "\0";
        my %bound;
-       my $junk = <P>;
-       while (my $change = <P>) {
+       my $junk = <$patch>;
+       while (my $change = <$patch>) {
                chomp $change;
-               my $filename = <P>;
+               my $filename = <$patch>;
+               if (!defined $filename) {
+                       next;
+               }
                chomp $filename;
 
                if ($change =~ m/^[AMD]$/ ) {
                        next;
                } elsif ($change =~ m/^R/ ) {
                        my $oldfilename = $filename;
-                       $filename = <P>;
+                       $filename = <$patch>;
                        chomp $filename;
                        if ( $file eq $filename ) {
                                my $parent = git_find_parent($rev, $oldfilename);
@@ -189,7 +227,7 @@ sub find_parent_renames {
                        }
                }
        }
-       close(P);
+       close($patch);
 
        return \%bound;
 }
@@ -198,14 +236,14 @@ sub find_parent_renames {
 sub git_find_parent {
        my ($rev, $filename) = @_;
 
-       open(REVPARENT,"-|","git-rev-list","--remove-empty", "--parents","--max-count=1","$rev","--",$filename)
+       my $revparent = open_pipe("git-rev-list","--remove-empty", "--parents","--max-count=1","$rev","--",$filename)
                or die "Failed to open git-rev-list to find a single parent: $!";
 
-       my $parentline = <REVPARENT>;
+       my $parentline = <$revparent>;
        chomp $parentline;
        my ($revfound,$parent) = split m/\s+/, $parentline;
 
-       close(REVPARENT);
+       close($revparent);
 
        return $parent;
 }
@@ -216,24 +254,31 @@ sub git_find_parent {
 sub git_diff_parse {
        my ($parent, $rev, %revinfo) = @_;
 
-       my ($ri, $pi) = (0,0);
-       open(DIFF,"-|","git-diff-tree","-M","-p",$rev,$parent,"--",
+       my $diff = open_pipe("git-diff-tree","-M","-p",$rev,$parent,"--",
                        $revs{$rev}{'filename'}, $revs{$parent}{'filename'})
                or die "Failed to call git-diff for annotation: $!";
 
+       _git_diff_parse($diff, $parent, $rev, %revinfo);
+
+       close($diff);
+}
+
+sub _git_diff_parse {
+       my ($diff, $parent, $rev, %revinfo) = @_;
+
+       my ($ri, $pi) = (0,0);
        my $slines = $revs{$rev}{'lines'};
        my @plines;
 
        my $gotheader = 0;
-       my ($remstart, $remlength, $addstart, $addlength);
-       my ($hunk_start, $hunk_index, $hunk_adds);
-       while(<DIFF>) {
+       my ($remstart);
+       my ($hunk_start, $hunk_index);
+       while(<$diff>) {
                chomp;
                if (m/^@@ -(\d+),(\d+) \+(\d+),(\d+)/) {
-                       ($remstart, $remlength, $addstart, $addlength) = ($1, $2, $3, $4);
+                       $remstart = $1;
                        # Adjust for 0-based arrays
                        $remstart--;
-                       $addstart--;
                        # Reinit hunk tracking.
                        $hunk_start = $remstart;
                        $hunk_index = 0;
@@ -267,6 +312,12 @@ sub git_diff_parse {
                        }
                        $ri++;
 
+               } elsif (m/^\\/) {
+                       ;
+                       # Skip \No newline at end of file.
+                       # But this can be internationalized, so only look
+                       # for an initial \
+
                } else {
                        if (substr($_,1) ne get_line($slines,$ri) ) {
                                die sprintf("Line %d (%d) does not match:\n|%s\n|%s\n%s => %s\n",
@@ -279,7 +330,6 @@ sub git_diff_parse {
                }
                $hunk_index++;
        }
-       close(DIFF);
        for (my $i = $ri; $i < @{$slines} ; $i++) {
                push @plines, $slines->[$ri++];
        }
@@ -295,24 +345,45 @@ sub get_line {
 }
 
 sub git_cat_file {
-       my ($parent, $filename) = @_;
-       return () unless defined $parent && defined $filename;
-       my $blobline = `git-ls-tree $parent $filename`;
-       my ($mode, $type, $blob, $tfilename) = split(/\s+/, $blobline, 4);
+       my ($rev, $filename) = @_;
+       return () unless defined $rev && defined $filename;
+
+       my $blob = git_ls_tree($rev, $filename);
+       die "Failed to find a blob for $filename in rev $rev\n" if !defined $blob;
 
-       open(C,"-|","git-cat-file", "blob", $blob)
-               or die "Failed to git-cat-file blob $blob (rev $parent, file $filename): " . $!;
+       my $catfile = open_pipe("git","cat-file", "blob", $blob)
+               or die "Failed to git-cat-file blob $blob (rev $rev, file $filename): " . $!;
 
        my @lines;
-       while(<C>) {
+       while(<$catfile>) {
                chomp;
                push @lines, $_;
        }
-       close(C);
+       close($catfile);
 
        return @lines;
 }
 
+sub git_ls_tree {
+       my ($rev, $filename) = @_;
+
+       my $lstree = open_pipe("git","ls-tree",$rev,$filename)
+               or die "Failed to call git ls-tree: $!";
+
+       my ($mode, $type, $blob, $tfilename);
+       while(<$lstree>) {
+               chomp;
+               ($mode, $type, $blob, $tfilename) = split(/\s+/, $_, 4);
+               last if ($tfilename eq $filename);
+       }
+       close($lstree);
+
+       return $blob if ($tfilename eq $filename);
+       die "git-ls-tree failed to find blob for $filename";
+
+}
+
+
 
 sub claim_line {
        my ($floffset, $rev, $lines, %revinfo) = @_;
@@ -325,11 +396,11 @@ sub claim_line {
 
 sub git_commit_info {
        my ($rev) = @_;
-       open(COMMIT, "-|","git-cat-file", "commit", $rev)
+       my $commit = open_pipe("git-cat-file", "commit", $rev)
                or die "Failed to call git-cat-file: $!";
 
        my %info;
-       while(<COMMIT>) {
+       while(<$commit>) {
                chomp;
                last if (length $_ == 0);
 
@@ -343,14 +414,99 @@ sub git_commit_info {
                        $info{'committer_date'} = $3;
                }
        }
-       close(COMMIT);
+       close($commit);
 
        return %info;
 }
 
 sub format_date {
+       if ($rawtime) {
+               return $_[0];
+       }
        my ($timestamp, $timezone) = split(' ', $_[0]);
+       my $minutes = abs($timezone);
+       $minutes = int($minutes / 100) * 60 + ($minutes % 100);
+       if ($timezone < 0) {
+           $minutes = -$minutes;
+       }
+       my $t = $timestamp + $minutes * 60;
+       return strftime("%Y-%m-%d %H:%M:%S " . $timezone, gmtime($t));
+}
+
+# Copied from git-send-email.perl - We need a Git.pm module..
+sub gitvar {
+    my ($var) = @_;
+    my $fh;
+    my $pid = open($fh, '-|');
+    die "$!" unless defined $pid;
+    if (!$pid) {
+       exec('git-var', $var) or die "$!";
+    }
+    my ($val) = <$fh>;
+    close $fh or die "$!";
+    chomp($val);
+    return $val;
+}
 
-       return strftime("%Y-%m-%d %H:%M:%S " . $timezone, gmtime($timestamp));
+sub gitvar_name {
+    my ($name) = @_;
+    my $val = gitvar($name);
+    my @field = split(/\s+/, $val);
+    return join(' ', @field[0...(@field-4)]);
 }
 
+sub open_pipe {
+       if ($^O eq '##INSERT_ACTIVESTATE_STRING_HERE##') {
+               return open_pipe_activestate(@_);
+       } else {
+               return open_pipe_normal(@_);
+       }
+}
+
+sub open_pipe_activestate {
+       tie *fh, "Git::ActiveStatePipe", @_;
+       return *fh;
+}
+
+sub open_pipe_normal {
+       my (@execlist) = @_;
+
+       my $pid = open my $kid, "-|";
+       defined $pid or die "Cannot fork: $!";
+
+       unless ($pid) {
+               exec @execlist;
+               die "Cannot exec @execlist: $!";
+       }
+
+       return $kid;
+}
+
+package Git::ActiveStatePipe;
+use strict;
+
+sub TIEHANDLE {
+       my ($class, @params) = @_;
+       my $cmdline = join " ", @params;
+       my  @data = qx{$cmdline};
+       bless { i => 0, data => \@data }, $class;
+}
+
+sub READLINE {
+       my $self = shift;
+       if ($self->{i} >= scalar @{$self->{data}}) {
+               return undef;
+       }
+       return $self->{'data'}->[ $self->{i}++ ];
+}
+
+sub CLOSE {
+       my $self = shift;
+       delete $self->{data};
+       delete $self->{i};
+}
+
+sub EOF {
+       my $self = shift;
+       return ($self->{i} >= scalar @{$self->{data}});
+}