share/msysGit/implied-commit-order.perl

   1 #!/usr/bin/perl
   2
   3 # List the given commit range similar to "git log --graph" but instead of
   4 # showing the branches as recorded in the commits, show the implicit commit
   5 # hierarchy as far as merge conflicts are concerned: a commit is considered an
   6 # "implicit ancestor" of a descendant commit if exchanging both in the commit
   7 # history would cause merge conflicts, i.e. if their changes overlap.
   8 #
   9 # The idea originates from the Darcs SCM which -- while its underlying idea is
  10 # cool, and replicated in this Perl script -- was doomed by the choice of
  11 # programming language and by trying to describe the principle via quantum
  12 # physics (when the proper scientific background would have been group theory,
  13 # really, although that would have been even worse a vehicle to document the
  14 # motivation and implementation).
  15
  16 # list of all commits, in order
  17 my @commits = ();
  18 # maps short commit names to long ones
  19 my %short2long = ();
  20 # maps commit -> parents
  21 my %forward = ();
  22 # maps commit -> children
  23 my %backward = ();
  24 # maps commit -> file_name -> hunk list
  25 # where hunk list is a struct returned by hunks_data()
  26 my %commit_changes = ();
  27
  28 sub ordered_set () {
  29         my @list = ();
  30         my %seen = ();
  31         my $add = sub ($) {
  32                 if ($seen{$_[0]} eq undef) {
  33                         push(@list, $_[0]);
  34                         $seen{$_[0]} = $#list;
  35                 }
  36         };
  37         return {
  38                 'add' => $add,
  39                 'contains' => sub ($) {
  40                         return $seen{$_[0]} ne undef;
  41                 },
  42                 'merge' => sub ($) {
  43                         map { &$add($_) } @{$_[0]->{'list'}()};
  44                 },
  45                 'clone' => sub () {
  46                         my $cloned = ordered_set();
  47                         map { $cloned->{'add'}($_) } @list;
  48                         return $cloned;
  49                 },
  50                 'list' => sub () {
  51                         return \@list;
  52                 }
  53         };
  54 }
  55
  56 sub imply_parents ($$) {
  57         my $child = $_[0];
  58         my $parents = $_[1];
  59
  60         foreach my $parent(@$parents) {
  61                 next if $child eq $parent;
  62
  63                 $forward{$child} = ordered_set() if $forward{$child} eq undef;
  64                 return if ($forward{$child}->{'contains'}($parent));
  65                 $forward{$child}->{'add'}($parent);
  66                 $backward{$parent} = ordered_set() if $backward{$parent} eq undef;
  67                 $backward{$parent}->{'add'}($child);
  68         }
  69 }
  70
  71 sub hunks_data () {
  72         my @begin = ();
  73         my @end = ();
  74         my @revisions = ();
  75
  76         my $insert = sub ($$$$) {
  77                 splice(@begin, $_[0], 0, $_[1]);
  78                 splice(@end, $_[0], 0, $_[2]);
  79                 splice(@revisions, $_[0], 0, $_[3]);
  80         };
  81         return {
  82                 'size' => sub () {
  83                         return $#end;
  84                 },
  85                 'begin' => \@begin,
  86                 'end' => \@end,
  87                 'revisions' => \@revisions,
  88                 'add' => sub ($$$) {
  89                         push(@begin, $_[0]);
  90                         push(@end, $_[1]);
  91                         if (ref($_[2]) ne 'HASH') {
  92                                 my $set = ordered_set();
  93                                 $set->{'add'}($_[2]);
  94                                 $_[2] = $set;
  95                         }
  96                         push(@revisions, $_[2]);
  97                 },
  98                 'merge' => sub ($) {
  99                         my @begin2 = @{$_[0]->{'begin'}};
 100                         my @end2 = @{$_[0]->{'end'}};
 101                         my @revisions2 = @{$_[0]->{'revisions'}};
 102                         my $i = 0;
 103                         my $j = 0;
 104                         while ($i <= $#end && $j <= $#end2) {
 105                                 if ($begin[$i] >= $end2[$j]) {
 106                                         &$insert($i, $begin2[$j], $end2[$j], $revisions2[$j]);
 107                                         $j++;
 108                                 } elsif ($end[$i] > $begin2[$j]) {
 109                                         if ($begin[$i] < $begin2[$j]) {
 110                                                 &$insert($i, $begin[$i], $begin2[$j], $revisions[$i]->{'clone'}());
 111                                                 $i++;
 112                                         } elsif ($begin1 > $begin2[$j]) {
 113                                                 &$insert($i, $begin2[$j], $begin[$i], $revisions2[$j]->{'clone'}());
 114                                                 $i++;
 115                                         }
 116                                         if ($end[$i] < $end2[$j]) {
 117                                                 &$insert($i + 1, $end[$i], $end2[$j], $revisions2[$j]->{'clone'}());
 118                                                 $revisions[$i]->{'merge'}($revisions2[$j]);
 119                                                 $i++;
 120                                         } elsif ($end[$i] > $end2[$j]) {
 121                                                 &$insert($i + 1, $end2[$j], $end[$i], $revisions[$i]->{'clone'}());
 122                                                 $revisions[$i]->{'merge'}($revisions2[$j]);
 123                                                 $i++;
 124                                         } else {
 125                                                 $revisions[$i]->{'merge'}($revisions2[$j]);
 126                                         }
 127                                 }
 128                                 $i++;
 129                         }
 130                         while ($j <= $#end2) {
 131                                 push(@begin, $begin2[$j]);
 132                                 push(@end, $end2[$j]);
 133                                 push(@revisions, $revisions2[$j]);
 134                                 $j++;
 135                         }
 136                 },
 137                 # merge-weakly merges only the specified hunks which do not overlap with the current ones.
 138                 'merge-weakly' => sub ($) {
 139                         my @begin2 = @{$_[0]->{'begin'}};
 140                         my @end2 = @{$_[0]->{'end'}};
 141                         my @revisions2 = @{$_[0]->{'revisions'}};
 142                         my $i = 0;
 143                         my $j = 0;
 144                         while ($i <= $#end && $j <= $#end2) {
 145                                 if ($begin[$i] >= $end2[$j]) {
 146                                         &$insert($i, $begin2[$j], $end2[$j], $revisions2[$j]);
 147                                         $j++;
 148                                 } elsif ($end[$i] > $begin2[$j]) {
 149                                         if ($begin1 > $begin2[$j]) {
 150                                                 &$insert($i, $begin2[$j], $begin[$i], $revisions2[$j]->{'clone'}());
 151                                                 $i++;
 152                                         }
 153                                         if ($end[$i] < $end2[$j]) {
 154                                                 &$insert($i + 1, $end[$i], $end2[$j], $revisions2[$j]->{'clone'}());
 155                                                 $i++;
 156                                         }
 157                                 }
 158                                 $i++;
 159                         }
 160                         while ($j <= $#end2) {
 161                                 push(@begin, $begin2[$j]);
 162                                 push(@end, $end2[$j]);
 163                                 push(@revisions, $revisions2[$j]);
 164                                 $j++;
 165                         }
 166                 },
 167                 'clone-for-hunk-adjustment' => sub () {
 168                         my $clone = hunks_data();
 169                         my @hunks = ();
 170                         $clone->{'hunk'} = sub ($$$$) {
 171                                 push(@hunks, @_);
 172                         };
 173                         $clone->{'finish'} = sub () {
 174                                 my $i = 0, $offset = 0;
 175                                 while ($i <= $#end) {
 176                                         last if $#hunks < 0;
 177                                         if ($end[$i] < $hunks[0]) {
 178                                                 $clone->{'add'}($offset + $begin[$i], $offset + $end[$i], $revisions[$i]);
 179                                         } elsif ($begin[$i] > $hunks[1]) {
 180                                                 $offset = $hunks[3] - $hunks[1];
 181                                                 splice(@hunks, 0, 4);
 182                                                 next;
 183                                         } else {
 184                                                 my $begin2 = $begin[$i] < $hunks[0] ? $begin[$i] + $offset : $hunks[2];
 185                                                 $offset = $hunks[3] - $hunks[1];
 186                                                 my $end2 = $end[$i] <= $hunks[1] ? $hunks[2] : $end[$i] + $offset;
 187                                                 $clone->{'add'}($begin2, $end2, $revisions[$i]);
 188                                         }
 189                                         $i++;
 190                                 }
 191                                 while ($i <= $#end) {
 192                                         $clone->{'add'}($offset + $begin[$i], $offset + $end[$i], $revisions[$i]);
 193                                         $i++;
 194                                 }
 195                                 delete $clone->{'hunk'};
 196                                 delete $clone->{'finish'};
 197                         };
 198                         return $clone;
 199                 },
 200                 'implied-revisions' => sub ($) {
 201                         my @begin2 = @{$_[0]->{'begin'}};
 202                         my @end2 = @{$_[0]->{'end'}};
 203                         my @revisions2 = @{$_[0]->{'revisions'}};
 204                         my $i = 0;
 205                         my $j = 0;
 206                         my $result = ordered_set();
 207                         while ($i <= $#end && $j <= $#end2) {
 208                                 if ($end[$i] < $begin2[$j]) {
 209                                         $i++;
 210                                 } elsif ($begin[$i] > $end2[$j]) {
 211                                         $j++;
 212                                 } else {
 213                                         $result->{'merge'}($revisions2[$j]);
 214                                         $j++;
 215                                 }
 216                         }
 217                         return $result->{'list'}();
 218                 }
 219         };
 220 }
 221
 222 sub handle_single_parent ($$$$$) {
 223         my $current_commit = $_[0];
 224         my $in = $_[1];
 225         my %original_parent_changes = %{$_[2]};
 226         my $changes = $_[3];
 227         my $parent_changes = $_[4];
 228
 229         my $file_name;
 230         my $hunks = undef;
 231         my $parent_hunks = undef;
 232         my %handled_files = ();
 233
 234         my $finish_file = sub () {
 235                 if ($hunks ne undef) {
 236                         if ($changes->{$file_name} eq undef) {
 237                                 $changes->{$file_name} = $hunks;
 238                         } else {
 239                                 $changes->{$file_name}->{'merge'}($hunks);
 240                         }
 241                 }
 242                 if ($parent_hunks ne undef) {
 243                         $parent_hunks->{'finish'}();
 244                         if ($parent_changes->{$file_name} eq undef) {
 245                                 $parent_changes->{$file_name} = $parent_hunks;
 246                         } else {
 247                                 $parent_changes->{$file_name}->{'merge'}($parent_hunks);
 248                         }
 249                 }
 250                 $handled_files{$file_name} = 1 if $file_name ne undef;
 251         };
 252
 253         while (<$in>) {
 254                 # TODO: handle spaces and even " b/" as part of a filename
 255                 if (/^diff --git a\/.* b\/(.*)$/) {
 256                         &$finish_file();
 257                         $file_name = $1;
 258                         $hunks = hunks_data();
 259                         $parent_hunks = $original_parent_changes{$file_name};
 260                         $parent_hunks = $parent_hunks->{'clone-for-hunk-adjustment'}() if $parent_hunks ne undef;
 261                 } elsif (/^@@ -(\d+)(,(\d+))? \+(\d+)(,(\d+))? @@/) {
 262                         my $length0 = $3 ne '' ? $3 : 1;
 263                         my $begin0 = $1 + ($3 eq '0' ? 1 : 0);
 264                         my $end0 = $begin0 + $length0;
 265                         my $length1 = $6 ne '' ? $6 : 1;
 266                         my $begin1 = $4 + ($6 eq '0' ? 1 : 0);
 267                         my $end1 = $begin1 + $length1;
 268
 269                         $hunks->{'add'}($begin1, $end1, $current_commit);
 270                         $parent_hunks->{'hunk'}($begin0, $end0, $begin1, $end1) if $parent_hunks ne undef;
 271                 }
 272         }
 273         &$finish_file();
 274
 275         foreach my $file_name (keys %original_parent_changes) {
 276                 if ($handled_files{$file_name} eq undef) {
 277                         my $hunks = $original_parent_changes{$file_name};
 278                         if ($parent_changes->{$file_name} eq undef) {
 279                                 $parent_changes->{$file_name} = $hunks;
 280                         } else {
 281                                 $parent_changes->{$file_name}->{'merge'}($hunks);
 282                         }
 283                 }
 284         }
 285 }
 286
 287 # Reads the diff(s) associated with the (merge) commit into the global data
 288 # structures. Takes previously read information about ancestors into account.
 289 # After this method has been called on all the commits of interest,
 290 # $commit_changes{$commit} will refer to a hash that maps all touched files to
 291 # the respective hunk lists (that document what commits touched which parts,
 292 # sort of a simultaneous `git blame`).
 293
 294 sub read_commit ($$) {
 295         my $current_commit = $_[0];
 296         my @parents = @{$_[1]};
 297         my %changes = ();
 298         my %parent_changes = ();
 299         $commit_changes{$current_commit} = \%changes;
 300
 301         # use the empty tree to compare initial commits against
 302         @parents = ( '4b825dc642cb6eb9a060e54bf8d69288fbee4904' ) if $#parents < 0;
 303         foreach my $parent (@parents) {
 304                 my $original_parent_changes = $commit_changes{$parent};
 305
 306                 my @command = ('git', 'diff', '-U0', # '-M',
 307                         $parent, $current_commit);
 308                 open(my $in, '-|', @command);
 309                 handle_single_parent($current_commit, $in, $original_parent_changes, \%changes, \%parent_changes);
 310                 close($in);
 311         }
 312
 313         foreach my $file_name (keys %changes) {
 314                 my $parent_hunks = $parent_changes{$file_name};
 315                 next if $parent_hunks eq undef;
 316                 my $hunks = $changes{$file_name};
 317                 imply_parents($current_commit, $hunks->{'implied-revisions'}($parent_hunks));
 318                 $hunks->{'merge-weakly'}($parent_hunks);
 319         }
 320
 321         map { $changes{$_} = $parent_changes{$_} if $changes{$_} eq undef; } keys %parent_changes;
 322
 323 }
 324
 325 # Reads all necessary information for the commit range specified by the argument
 326 # which is expected to be a reference to an array of command-line arguments
 327 # appropriate for being called with `git log`.
 328
 329 sub read_commits ($) {
 330         my $commit_range = $_[0];
 331         my $current;
 332         my @parents;
 333         my %parent_changes;
 334
 335         my $previous_file_name;
 336         my $current_file;
 337         my @current_file_changes;
 338         my @parent_file_changes;
 339         my $offset;
 340
 341         my @command = ('git', 'log', '--reverse', '--topo-order',
 342                 '--format=%H %h %p');
 343         # TODO: filter out --graph and stuff
 344         push(@command, @$commit_range);
 345         my $i = 1;
 346         open (my $in, '-|', @command);
 347         while (<$in>) {
 348                 next if (/^$/);
 349                 print $i++ . "...\r";
 350                 chomp;
 351                 if (/^([0-9a-f]+) ([0-9a-f]+) ([0-9a-f ]*)$/) {
 352                         my $sha1 = $1;
 353                         $current = $2;
 354                         @parents = split(/ /, $3);
 355
 356                         push(@commits, $current);
 357                         $short2long{$current} = $sha1;
 358                         read_commit($current, \@parents);
 359                 }
 360         }
 361         close($in);
 362 }
 363
 364 my $use_gitk = 0;
 365 my $dashdash = -1;
 366 for (my $i = 0; $i <= $#ARGV; $i++) {
 367         if ($ARGV[$i] eq '--') {
 368                 $dashdash = $i;
 369                 last;
 370         }
 371         if ($ARGV[$i] eq '--gitk') {
 372                 $use_gitk = 1;
 373                 splice(@ARGV, $i, 1);
 374                 $i--;
 375         }
 376 }
 377
 378 read_commits(\@ARGV);
 379
 380 # Unfortunately, there is no scriptable way to use the --graph support of `git
 381 # log`.
 382 #
 383 # Fortunately, however, there is a way to circumvent that: by defining the
 384 # commit order using temporary grafts, written into a temporary file and used
 385 # via a temporary GIT_GRAFT_FILE env variable.
 386
 387 my $git_dir = `git rev-parse --git-dir`;
 388 chomp $git_dir;
 389
 390 sub show () {
 391         my $grafts_file = $git_dir . '/TEMP-GRAFTS';
 392         my @args = ('log', '--graph', '--format=%h %s%n');
 393         open(my $grafts, '>', $grafts_file);
 394         foreach my $current (@commits) {
 395                 push(@args, $current) if $backward{$current} eq undef;
 396                 print $grafts $short2long{$current};
 397                 if (ref($forward{$current}) eq 'HASH') {
 398                         foreach my $parent (@{$forward{$current}->{'list'}()}) {
 399                                 my $sha1 = $short2long{$parent};
 400                                 if ($sha1 ne undef) {
 401                                         print $grafts ' ' . $sha1;
 402                                 }
 403                         }
 404                 }
 405                 print $grafts "\n";
 406         }
 407         close($grafts);
 408         $ENV{'GIT_GRAFT_FILE'} = $grafts_file;
 409         push(@args, '--');
 410         # add file arguments from @ARGV
 411         for (my $i = 0; $i <= $#ARGV; $i++) {
 412                 next if $ARGV[$i] ne '--';
 413                 $i++;
 414                 push(@args, @ARGV[$i..$#ARGV]) if $i <= $#ARGV;
 415                 last;
 416         }
 417         if ($use_gitk) {
 418                 splice(@args, 0, 3);
 419                 exec('gitk', @args);
 420         }
 421         exec('git', @args);
 422 }
 423
 424 show();