git-rerere.perlon commit git-rev-parse: Fix --short= option parsing (44de0da)
   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
  10use Digest;
  11use File::Path;
  12use File::Copy;
  13
  14my $git_dir = $::ENV{GIT_DIR} || ".git";
  15my $rr_dir = "$git_dir/rr-cache";
  16my $merge_rr = "$git_dir/rr-cache/MERGE_RR";
  17
  18my %merge_rr = ();
  19
  20sub 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
  36sub 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
  46sub 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
  89sub 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
 131sub 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
 150sub 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
 170read_rr();
 171my %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
 178for 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
 197for 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.
 223write_rr();