]> git.ipfire.org Git - thirdparty/git.git/blame - git-rerere.perl
Merge branch 'ml/cvsserver'
[thirdparty/git.git] / git-rerere.perl
CommitLineData
8389b52b
JH
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";
fedd273b
JH
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 }
8389b52b
JH
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
154sub merge {
155 my ($name, $path) = @_;
156 record_preimage($path, "$rr_dir/$name/thisimage");
157 unless (system('merge', 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-d "$rr_dir" || exit(0);
173
174read_rr();
175my %conflict = map { $_ => 1 } find_conflict();
176
177# MERGE_RR records paths with conflicts immediately after merge
178# failed. Some of the conflicted paths might have been hand resolved
179# in the working tree since then, but the initial run would catch all
180# and register their preimages.
181
182for my $path (keys %conflict) {
183 # This path has conflict. If it is not recorded yet,
184 # record the pre-image.
185 if (!exists $merge_rr{$path}) {
186 my ($name, $hunk) = compute_conflict_name($path);
187 next unless ($hunk);
188 $merge_rr{$path} = $name;
189 if (! -d "$rr_dir/$name") {
190 mkpath("$rr_dir/$name", 0, 0777);
191 print STDERR "Recorded preimage for '$path'\n";
192 record_preimage($path, "$rr_dir/$name/preimage");
193 }
194 }
195}
196
197# Now some of the paths that had conflicts earlier might have been
198# hand resolved. Others may be similar to a conflict already that
199# was resolved before.
200
201for my $path (keys %merge_rr) {
202 my $name = $merge_rr{$path};
203
204 # We could resolve this automatically if we have images.
205 if (-f "$rr_dir/$name/preimage" &&
206 -f "$rr_dir/$name/postimage") {
207 if (merge($name, $path)) {
208 print STDERR "Resolved '$path' using previous resolution.\n";
209 # Then we do not have to worry about this path
210 # anymore.
211 delete $merge_rr{$path};
212 next;
213 }
214 }
215
216 # Let's see if we have resolved it.
217 (undef, my $hunk) = compute_conflict_name($path);
218 next if ($hunk);
219
220 print STDERR "Recorded resolution for '$path'.\n";
221 copy($path, "$rr_dir/$name/postimage");
222 # And we do not have to worry about this path anymore.
223 delete $merge_rr{$path};
224}
225
226# Write out the rest.
227write_rr();