git.oblomov.eu Git - git/blob - contrib/examples/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         my $pid = open($in, '-|');
 135         die "$!" unless defined $pid;
 136         if (!$pid) {
 137                 exec(qw(git ls-files -z -u)) or die "$!: ls-files";
 138         }
 139         my %path = ();
 140         my @path = ();
 141         while (<$in>) {
 142                 chomp;
 143                 my ($mode, $sha1, $stage, $path) =
 144                     /^([0-7]+) ([0-9a-f]{40}) ([123])\t(.*)$/s;
 145                 $path{$path} |= (1 << $stage);
 146         }
 147         close $in;
 148         while (my ($path, $status) = each %path) {
 149                 if ($status == 14) { push @path, $path; }
 150         }
 151         return @path;
 152 }
 153
 154 sub merge {
 155         my ($name, $path) = @_;
 156         record_preimage($path, "$rr_dir/$name/thisimage");
 157         unless (system('git', 'merge-file', map { "$rr_dir/$name/${_}image" }
 158                        qw(this pre post))) {
 159                 my $in;
 160                 open $in, "<$rr_dir/$name/thisimage" or
 161                     die "$!: $name/thisimage";
 162                 my $out;
 163                 open $out, ">$path" or die "$!: $path";
 164                 while (<$in>) { print $out $_; }
 165                 close $in;
 166                 close $out;
 167                 return 1;
 168         }
 169         return 0;
 170 }
 171
 172 sub garbage_collect_rerere {
 173         # We should allow specifying these from the command line and
 174         # that is why the caller gives @ARGV to us, but I am lazy.
 175
 176         my $cutoff_noresolve = 15; # two weeks
 177         my $cutoff_resolve = 60; # two months
 178         my @to_remove;
 179         while (<$rr_dir/*/preimage>) {
 180                 my ($dir) = /^(.*)\/preimage$/;
 181                 my $cutoff = ((-f "$dir/postimage")
 182                               ? $cutoff_resolve
 183                               : $cutoff_noresolve);
 184                 my $age = -M "$_";
 185                 if ($cutoff <= $age) {
 186                         push @to_remove, $dir;
 187                 }
 188         }
 189         if (@to_remove) {
 190                 rmtree(\@to_remove);
 191         }
 192 }
 193
 194 -d "$rr_dir" || exit(0);
 195
 196 read_rr();
 197
 198 if (@ARGV) {
 199         my $arg = shift @ARGV;
 200         if ($arg eq 'clear') {
 201                 for my $path (keys %merge_rr) {
 202                         my $name = $merge_rr{$path};
 203                         if (-d "$rr_dir/$name" &&
 204                             ! -f "$rr_dir/$name/postimage") {
 205                                 rmtree(["$rr_dir/$name"]);
 206                         }
 207                 }
 208                 unlink $merge_rr;
 209         }
 210         elsif ($arg eq 'status') {
 211                 for my $path (keys %merge_rr) {
 212                         print $path, "\n";
 213                 }
 214         }
 215         elsif ($arg eq 'diff') {
 216                 for my $path (keys %merge_rr) {
 217                         my $name = $merge_rr{$path};
 218                         system('diff', ((@ARGV == 0) ? ('-u') : @ARGV),
 219                                 '-L', "a/$path", '-L', "b/$path",
 220                                 "$rr_dir/$name/preimage", $path);
 221                 }
 222         }
 223         elsif ($arg eq 'gc') {
 224                 garbage_collect_rerere(@ARGV);
 225         }
 226         else {
 227                 die "$0 unknown command: $arg\n";
 228         }
 229         exit 0;
 230 }
 231
 232 my %conflict = map { $_ => 1 } find_conflict();
 233
 234 # MERGE_RR records paths with conflicts immediately after merge
 235 # failed.  Some of the conflicted paths might have been hand resolved
 236 # in the working tree since then, but the initial run would catch all
 237 # and register their preimages.
 238
 239 for my $path (keys %conflict) {
 240         # This path has conflict.  If it is not recorded yet,
 241         # record the pre-image.
 242         if (!exists $merge_rr{$path}) {
 243                 my ($name, $hunk) = compute_conflict_name($path);
 244                 next unless ($hunk);
 245                 $merge_rr{$path} = $name;
 246                 if (! -d "$rr_dir/$name") {
 247                         mkpath("$rr_dir/$name", 0, 0777);
 248                         print STDERR "Recorded preimage for '$path'\n";
 249                         record_preimage($path, "$rr_dir/$name/preimage");
 250                 }
 251         }
 252 }
 253
 254 # Now some of the paths that had conflicts earlier might have been
 255 # hand resolved.  Others may be similar to a conflict already that
 256 # was resolved before.
 257
 258 for my $path (keys %merge_rr) {
 259         my $name = $merge_rr{$path};
 260
 261         # We could resolve this automatically if we have images.
 262         if (-f "$rr_dir/$name/preimage" &&
 263             -f "$rr_dir/$name/postimage") {
 264                 if (merge($name, $path)) {
 265                         print STDERR "Resolved '$path' using previous resolution.\n";
 266                         # Then we do not have to worry about this path
 267                         # anymore.
 268                         delete $merge_rr{$path};
 269                         next;
 270                 }
 271         }
 272
 273         # Let's see if we have resolved it.
 274         (undef, my $hunk) = compute_conflict_name($path);
 275         next if ($hunk);
 276
 277         print STDERR "Recorded resolution for '$path'.\n";
 278         copy($path, "$rr_dir/$name/postimage");
 279         # And we do not have to worry about this path anymore.
 280         delete $merge_rr{$path};
 281 }
 282
 283 # Write out the rest.
 284 write_rr();