RR.perl

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