cg-Xfollowrenames

   1 #!/usr/bin/env perl
   2 #
   3 # git-rev-list | git-diff-tree --stdin following renames
   4 # Copyright (c) Petr Baudis, 2006
   5 # Uses bits of git-annotate.perl by Ryan Anderson.
   6 #
   7 # This script will efficiently show output as of the
   8 #
   9 #       git-rev-list --remove-empty ARGS -- FILE... |
  10 #       git-diff-tree -M -r -m --stdin --pretty=raw ARGS
  11 #
  12 # pipeline, except that it follows renames of individual files listed
  13 # in the FILE... set.
  14 #
  15 # Usage:
  16 #
  17 #       cg-Xfollowrenames revlistargs -- difftreeargs -- revs -- files
  18
  19 # Testsuite: TODO
  20
  21 # TODO: BROKEN - if a file is removed (that is, added) on one branch,
  22 # we will stop watching for the renames on all the other branches. We need
  23 # to separate the heads and pipes.
  24
  25 # TODO: Does not work on multiple files properly yet - most probably
  26 # (I didn't test it!). We want git-rev-list to stop traversing the history
  27 # when _any_ file disappears while now it probably stops traversing when
  28 # _all_ files disappear.
  29
  30 use warnings;
  31 use strict;
  32
  33 $| = 1;
  34
  35 our (@revlist_args, @difftree_args, @revs, @files);
  36
  37 { # Load arguments
  38         my @argp = (\@revlist_args, \@difftree_args, \@revs, \@files);
  39         my $argi = 0;
  40         for my $arg (@ARGV) {
  41                 if ($arg eq '--' and $argi < $#argp) {
  42                         $argi++;
  43                         next;
  44                 }
  45                 push(@{$argp[$argi]}, $arg);
  46         }
  47 }
  48
  49
  50 # The heads we watch (sorted by commit time)
  51 our @heads;
  52 # Each head is: {
  53 #       # Persistent for the whole line of development:
  54 #       pipe => $pipe,
  55 #       files => \@files, # to watch for
  56 #
  57 #       id => $sha1, # useful actually only for debugging
  58 #       time => $timestamp,
  59 #       str => $prettyoutput,
  60 #       parents => \@sha1s,
  61 #
  62 #       # When the commit is processed, spawn these extra heads:
  63 #       recurse => {$sha1id => \@files, ...},
  64 # }
  65
  66 # To avoid printing duplicate commits
  67 # FIXME: Currently, we will not handle merge commits properly since
  68 # we hit them multiple times.
  69 our %commits;
  70
  71
  72 sub open_pipe($@) {
  73         my ($stdin, @execlist) = @_;
  74
  75         my $pid = open my $kid, "-|";
  76         defined $pid or die "Cannot fork: $!";
  77
  78         unless ($pid) {
  79                 if (defined $stdin) {
  80                         open STDIN, "<&", $stdin or die "Cannot dup(): $!";
  81                 }
  82                 exec @execlist;
  83                 die "Cannot exec @execlist: $!";
  84         }
  85
  86         return $kid;
  87 }
  88
  89 sub revlist($@) {
  90         my ($rev, @files) = @_;
  91         open_pipe(undef, "git-rev-list", "--remove-empty",
  92                          @revlist_args, $rev, "--", @files)
  93                 or die "Failed to exec git-rev-list: $!";
  94 }
  95
  96 sub difftree($) {
  97         my ($revlist) = @_;
  98         open_pipe($revlist, "git-diff-tree", "-r", "-m", "--stdin", "-M",
  99                             "--pretty=raw", @difftree_args)
 100                 or die "Failed to exec git-diff-tree: $!";
 101 }
 102
 103 sub revdiffpipe($@) {
 104         my ($rev, @files) = @_;
 105         my $pipe = difftree(revlist($rev, @files));
 106 }
 107
 108
 109 sub read_commit($$) {
 110         my ($head, $tolerant) = @_;
 111         my $pipe = $head->{'pipe'};
 112         my $against;
 113         my @oldset = @{$head->{'files'}};
 114         my @newset;
 115         my $rename;
 116
 117         # Load header
 118         while (my $line = <$pipe>) {
 119                 $head->{'str'} .= $line;
 120                 chomp $line;
 121                 $line eq '' and goto header_loaded;
 122
 123                 if ($line =~ /^diff-tree (\S+) \(from (root|\S+)\)/) {
 124                         $head->{'id'} = $1;
 125                         if (not $tolerant and $commits{$1}++) {
 126                                 close $pipe;
 127                                 return undef;
 128                         }
 129                         # The 'root' case is harmless since there'll be no renames.
 130                         $against = $2;
 131                 } elsif ($line =~ /^parent (\S+)/) {
 132                         push (@{$head->{'parents'}}, $1);
 133                 } elsif ($line =~ /^committer .*?> (\d+)/) {
 134                         $head->{'time'} = $1;
 135                 }
 136         }
 137         return undef;
 138 header_loaded:
 139
 140         # Load message
 141         while (my $line = <$pipe>) {
 142                 $head->{'str'} .= $line;
 143                 chomp $line;
 144                 $line eq '' and goto message_loaded;
 145         }
 146         return undef;
 147 message_loaded:
 148
 149         # Load delta
 150         # Note that we must interpret the patch we are seeing _reverse_.
 151         while (my $line = <$pipe>) {
 152                 $head->{'str'} .= $line;
 153                 chomp $line;
 154                 $line eq '' and goto delta_loaded;
 155
 156                 $line =~ /^:/ or return undef;
 157                 my ($info, $newfile, $oldfile) = split("\t", $line);
 158                 if ($info =~ /[RC]\d*$/) {
 159                         # Behold, a rename!
 160                         # (Or a copy, it's all the same for us.)
 161                         my $i;
 162                         for ($i = 0; $i <= $#oldset; $i++) {
 163                                 $oldfile eq $oldset[$i] or next;
 164                                 $rename = 1;
 165                                 splice(@oldset, $i, 1);
 166                                 push(@newset, $newfile);
 167                                 last;
 168                         }
 169                         # In case of multiple candidates, follow
 170                         # all of them:
 171                         # (TODO: This might be a policy decision
 172                         # best left on the user.)
 173                         if ($i > $#oldset and grep { $oldfile eq $_ } @newset) {
 174                                 $rename = 1;
 175                                 push(@newset, $newfile);
 176                         }
 177                 } elsif ($info =~ /A$/) {
 178                         # Not weeding out deleted files (the patch is reversed
 179                         # so they appear as added to us) might cause bizarre
 180                         # results when following multiple files since
 181                         # git-rev-list weeds them out too (probably?).
 182                         #print STDERR "grepping - @oldset, @{$head->{files}} > MINUS $newfile <\n";
 183                         @oldset = grep { $newfile ne $_ } @oldset;
 184                         @{$head->{'files'}} = grep { $newfile ne $_ } @{$head->{'files'}};
 185                         #print STDERR "post-grepping - @oldset, @{$head->{files}} <\n";
 186                 }
 187         }
 188         $head->{'str'} .= "\n";
 189 delta_loaded:
 190
 191         if ($rename) {
 192                 $head->{'recurse'}->{$against} = [@newset, @oldset];
 193         }
 194         return 1;
 195 }
 196
 197 sub load_commit($) {
 198         my ($head) = @_;
 199         $head->{'time'} = undef;
 200         $head->{'str'} = '';
 201         $head->{'parents'} = ();
 202
 203         read_commit($head, 0) or return undef;
 204
 205         # In case there was a merge, the commit will be multiple times
 206         # here, each time with a different delta section. Read them all.
 207         for (1 .. $#{$head->{'parents'}}) { # stupid vim syntax highlighting
 208                 read_commit($head, 1) or return undef;
 209         }
 210
 211         # Cut the last \n. We don't want it for the last commit.
 212         substr($head->{'str'}, -1, 1, '');
 213
 214         return 1;
 215 }
 216
 217
 218 # Add head at the proper position
 219 sub add_head($) {
 220         my ($head) = @_;
 221         my $i;
 222         for ($i = 0; $i <= $#heads; $i++) {
 223                 last if ($head->{'time'} > $heads[$i]->{'time'})
 224         }
 225         splice(@heads, $i, 0, $head);
 226 }
 227
 228 # Create new head
 229 sub init_head($@) {
 230         my ($rev, @files) = @_;
 231         my $head = { files => \@files, 'pipe' => revdiffpipe($rev, @files) };
 232         load_commit($head) or return;
 233         add_head($head);
 234 }
 235
 236
 237
 238 { # Seed the heads list
 239         for my $rev (@revs) {
 240                 init_head($rev, @files);
 241         }
 242 }
 243
 244 # Process the heads
 245 {
 246         my $first = 1;
 247         while (@heads) {
 248                 my $head = shift(@heads);
 249
 250                 print "\n" unless $first; $first = 0;
 251                 print $head->{'str'};
 252
 253                 foreach my $parent (keys %{$head->{'recurse'}}) {
 254                         init_head($parent, @{$head->{'recurse'}->{$parent}});
 255                 }
 256                 $head->{'recurse'} = undef;
 257
 258                 load_commit($head) or next;
 259                 add_head($head);
 260         }
 261 }