git-tar-tree: no more void pointer arithmetic
[git.git] / 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('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
174 read_rr();
175 my %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
182 for 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
201 for 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.
227 write_rr();