Resurrect git-rerere to contrib/examples
It is handy to have a copy readily available for checking regressions. Signed-off-by: Junio C Hamano <gitster@pobox.com>
Junio C Hamano committed
Mar 15, 2008 at 23:58 UTC
c817faabd7b0d7c0779ad5b34a4411ba3cdccf2d
1 file changed
+284
contrib/examples/git-rerere.perl
new
+284
@@ -0,0 +1,284 @@
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();