git-rerere.perl

   1 #!/usr/bin/perl
   2 #
   3 # REuse REcorded REsolve.  This tool records a conflicted automerge
   4 # result and its hand resolution, and helps to resolve future
   5 # automerge that results in the same conflict.
   6 #
   7 # To enable this feature, create a directory 'rr-cache' under your
   8 # .git/ directory.
   9
  10 use Digest;
  11 use File::Path;
  12 use File::Copy;
  13
  14 my $git_dir = $::ENV{GIT_DIR} || ".git";
  15 my $rr_dir = "$git_dir/rr-cache";
  16 my $merge_rr = "$git_dir/rr-cache/MERGE_RR";
  17
  18 my %merge_rr = ();
  19
  20 sub read_rr {
  21         if (!-f $merge_rr) {
  22                 %merge_rr = ();
  23                 return;
  24         }
  25         my $in;
  26         local $/ = "\0";
  27         open $in, "<$merge_rr" or die "$!: $merge_rr";
  28         while (<$in>) {
  29                 chomp;
  30                 my ($name, $path) = /^([0-9a-f]{40})\t(.*)$/s;
  31                 $merge_rr{$path} = $name;
  32         }
  33         close $in;
  34 }
  35
  36 sub write_rr {
  37         my $out;
  38         open $out, ">$merge_rr" or die "$!: $merge_rr";
  39         for my $path (sort keys %merge_rr) {
  40                 my $name = $merge_rr{$path};
  41                 print $out "$name\t$path\0";
  42         }
  43         close $out;
  44 }
  45
  46 sub compute_conflict_name {
  47         my ($path) = @_;
  48         my @side = ();
  49         my $in;
  50         open $in, "<$path"  or die "$!: $path";
  51
  52         my $sha1 = Digest->new("SHA-1");
  53         my $hunk = 0;
  54         while (<$in>) {
  55                 if (/^<<<<<<< .*/) {
  56                         $hunk++;
  57                         @side = ([], undef);
  58                 }
  59                 elsif (/^=======$/) {
  60                         $side[1] = [];
  61                 }
  62                 elsif (/^>>>>>>> .*/) {
  63                         my ($one, $two);
  64                         $one = join('', @{$side[0]});
  65                         $two = join('', @{$side[1]});
  66                         if ($two le $one) {
  67                                 ($one, $two) = ($two, $one);
  68                         }
  69                         $sha1->add($one);
  70                         $sha1->add("\0");
  71                         $sha1->add($two);
  72                         $sha1->add("\0");
  73                         @side = ();
  74                 }
  75                 elsif (@side == 0) {
  76                         next;
  77                 }
  78                 elsif (defined $side[1]) {
  79                         push @{$side[1]}, $_;
  80                 }
  81                 else {
  82                         push @{$side[0]}, $_;
  83                 }
  84         }
  85         close $in;
  86         return ($sha1->hexdigest, $hunk);
  87 }
  88
  89 sub record_preimage {
  90         my ($path, $name) = @_;
  91         my @side = ();
  92         my ($in, $out);
  93         open $in, "<$path"  or die "$!: $path";
  94         open $out, ">$name" or die "$!: $name";
  95
  96         while (<$in>) {
  97                 if (/^<<<<<<< .*/) {
  98                         @side = ([], undef);
  99                 }
 100                 elsif (/^=======$/) {
 101                         $side[1] = [];
 102                 }
 103                 elsif (/^>>>>>>> .*/) {
 104                         my ($one, $two);
 105                         $one = join('', @{$side[0]});
 106                         $two = join('', @{$side[1]});
 107                         if ($two le $one) {
 108                                 ($one, $two) = ($two, $one);
 109                         }
 110                         print $out "<<<<<<<\n";
 111                         print $out $one;
 112                         print $out "=======\n";
 113                         print $out $two;
 114                         print $out ">>>>>>>\n";
 115                         @side = ();
 116                 }
 117                 elsif (@side == 0) {
 118                         print $out $_;
 119                 }
 120                 elsif (defined $side[1]) {
 121                         push @{$side[1]}, $_;
 122                 }
 123                 else {
 124                         push @{$side[0]}, $_;
 125                 }
 126         }
 127         close $out;
 128         close $in;
 129 }
 130
 131 sub find_conflict {
 132         my $in;
 133         local $/ = "\0";
 134         open $in, '-|', qw(git ls-files -z -u) or die "$!: ls-files";
 135         my %path = ();
 136         my @path = ();
 137         while (<$in>) {
 138                 chomp;
 139                 my ($mode, $sha1, $stage, $path) =
 140                     /^([0-7]+) ([0-9a-f]{40}) ([123])\t(.*)$/s;
 141                 $path{$path} |= (1 << $stage);
 142         }
 143         close $in;
 144         while (my ($path, $status) = each %path) {
 145                 if ($status == 14) { push @path, $path; }
 146         }
 147         return @path;
 148 }
 149
 150 sub merge {
 151         my ($name, $path) = @_;
 152         record_preimage($path, "$rr_dir/$name/thisimage");
 153         unless (system('merge', map { "$rr_dir/$name/${_}image" }
 154                        qw(this pre post))) {
 155                 my $in;
 156                 open $in, "<$rr_dir/$name/thisimage" or
 157                     die "$!: $name/thisimage";
 158                 my $out;
 159                 open $out, ">$path" or die "$!: $path";
 160                 while (<$in>) { print $out $_; }
 161                 close $in;
 162                 close $out;
 163                 return 1;
 164         }
 165         return 0;
 166 }
 167
 168 -d "$rr_dir" || exit(0);
 169
 170 read_rr();
 171 my %conflict = map { $_ => 1 } find_conflict();
 172
 173 # MERGE_RR records paths with conflicts immediately after merge
 174 # failed.  Some of the conflicted paths might have been hand resolved
 175 # in the working tree since then, but the initial run would catch all
 176 # and register their preimages.
 177
 178 for my $path (keys %conflict) {
 179         # This path has conflict.  If it is not recorded yet,
 180         # record the pre-image.
 181         if (!exists $merge_rr{$path}) {
 182                 my ($name, $hunk) = compute_conflict_name($path);
 183                 next unless ($hunk);
 184                 $merge_rr{$path} = $name;
 185                 if (! -d "$rr_dir/$name") {
 186                         mkpath("$rr_dir/$name", 0, 0777);
 187                         print STDERR "Recorded preimage for '$path'\n";
 188                         record_preimage($path, "$rr_dir/$name/preimage");
 189                 }
 190         }
 191 }
 192
 193 # Now some of the paths that had conflicts earlier might have been
 194 # hand resolved.  Others may be similar to a conflict already that
 195 # was resolved before.
 196
 197 for my $path (keys %merge_rr) {
 198         my $name = $merge_rr{$path};
 199
 200         # We could resolve this automatically if we have images.
 201         if (-f "$rr_dir/$name/preimage" &&
 202             -f "$rr_dir/$name/postimage") {
 203                 if (merge($name, $path)) {
 204                         print STDERR "Resolved '$path' using previous resolution.\n";
 205                         # Then we do not have to worry about this path
 206                         # anymore.
 207                         delete $merge_rr{$path};
 208                         next;
 209                 }
 210         }
 211
 212         # Let's see if we have resolved it.
 213         (undef, my $hunk) = compute_conflict_name($path);
 214         next if ($hunk);
 215
 216         print STDERR "Recorded resolution for '$path'.\n";
 217         copy($path, "$rr_dir/$name/postimage");
 218         # And we do not have to worry about this path anymore.
 219         delete $merge_rr{$path};
 220 }
 221
 222 # Write out the rest.
 223 write_rr();