Commit | Line | Data |
---|---|---|
1479465f GJ |
1 | #!/usr/bin/perl |
2 | ||
3 | # Copyright © 2009-2010 Raphaël Hertzog <hertzog@debian.org> | |
4 | # Copyright © 2012 Guillem Jover <guillem@debian.org> | |
5 | # | |
6 | # This program is free software; you can redistribute it and/or modify | |
7 | # it under the terms of the GNU General Public License as published by | |
8 | # the Free Software Foundation; either version 2 of the License, or | |
9 | # (at your option) any later version. | |
10 | # | |
11 | # This program is distributed in the hope that it will be useful, | |
12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
14 | # GNU General Public License for more details. | |
15 | # | |
16 | # You should have received a copy of the GNU General Public License | |
17 | # along with this program. If not, see <https://www.gnu.org/licenses/>. | |
18 | ||
19 | use warnings; | |
20 | use strict; | |
21 | ||
22 | use Scalar::Util qw(blessed); | |
23 | use Getopt::Long qw(:config posix_default bundling no_ignorecase); | |
24 | ||
25 | use Dpkg (); | |
26 | use Dpkg::Changelog::Debian; | |
27 | use Dpkg::ErrorHandling; | |
28 | use Dpkg::Gettext; | |
29 | use Dpkg::Version; | |
30 | ||
31 | textdomain('dpkg-dev'); | |
32 | ||
33 | sub merge_entries($$$); | |
34 | sub merge_block($$$;&); | |
35 | sub merge_entry_item($$$$); | |
36 | sub merge_conflict($$); | |
37 | sub get_conflict_block($$); | |
38 | sub join_lines($); | |
39 | ||
40 | BEGIN { | |
41 | eval q{ | |
42 | pop @INC if $INC[-1] eq '.'; | |
43 | use Algorithm::Merge qw(merge); | |
44 | }; | |
45 | if ($@) { | |
46 | eval q{ | |
47 | sub merge { | |
48 | my ($o, $a, $b) = @_; | |
49 | return @$a if join("\n", @$a) eq join("\n", @$b); | |
50 | return get_conflict_block($a, $b); | |
51 | } | |
52 | }; | |
53 | } | |
54 | } | |
55 | ||
56 | sub version { | |
57 | printf g_("Debian %s version %s.\n"), $Dpkg::PROGNAME, $Dpkg::PROGVERSION; | |
58 | ||
59 | printf "\n" . g_( | |
60 | 'This is free software; see the GNU General Public License version 2 or | |
61 | later for copying conditions. There is NO warranty. | |
62 | '); | |
63 | } | |
64 | ||
65 | sub usage { | |
66 | printf g_( | |
67 | "Usage: %s [<option>...] <old> <new-a> <new-b> [<out>] | |
68 | ||
69 | Options: | |
70 | -m, --merge-prereleases merge pre-releases together, ignores everything | |
71 | after the last '~' in the version. | |
72 | -?, --help show this help message. | |
73 | --version show the version. | |
74 | "), $Dpkg::PROGNAME; | |
75 | } | |
76 | ||
77 | my $merge_prereleases; | |
78 | ||
79 | my @options_spec = ( | |
80 | 'help|?' => sub { usage(); exit(0) }, | |
81 | 'version' => sub { version(); exit(0) }, | |
82 | 'merge-prereleases|m' => \$merge_prereleases, | |
83 | ); | |
84 | ||
85 | { | |
86 | local $SIG{__WARN__} = sub { usageerr($_[0]) }; | |
87 | GetOptions(@options_spec); | |
88 | } | |
89 | ||
90 | my ($old, $new_a, $new_b, $out_file) = @ARGV; | |
91 | unless (defined $old and defined $new_a and defined $new_b) | |
92 | { | |
93 | usageerr(g_('needs at least three arguments')); | |
94 | } | |
95 | unless (-e $old and -e $new_a and -e $new_b) | |
96 | { | |
97 | usageerr(g_('file arguments need to exist')); | |
98 | } | |
99 | ||
100 | my ($cho, $cha, $chb); | |
101 | $cho = Dpkg::Changelog::Debian->new(); | |
102 | $cho->load($old); | |
103 | $cha = Dpkg::Changelog::Debian->new(); | |
104 | $cha->load($new_a); | |
105 | $chb = Dpkg::Changelog::Debian->new(); | |
106 | $chb->load($new_b); | |
107 | ||
108 | my @o = reverse @$cho; | |
109 | my @a = reverse @$cha; | |
110 | my @b = reverse @$chb; | |
111 | ||
112 | my @result; # Lines to output | |
113 | my $exitcode = 0; # 1 if conflict encountered | |
114 | ||
115 | unless (merge_block($cho, $cha, $chb, sub { | |
116 | my $changes = shift; | |
117 | my $tail = $changes->get_unparsed_tail(); | |
118 | chomp $tail if defined $tail; | |
119 | return $tail; | |
120 | })) | |
121 | { | |
122 | merge_conflict($cha->get_unparsed_tail(), $chb->get_unparsed_tail()); | |
123 | } | |
124 | ||
125 | while (1) { | |
126 | my ($o, $a, $b) = get_items_to_merge(); | |
127 | last unless defined $o or defined $a or defined $b; | |
128 | next if merge_block($o, $a, $b); | |
129 | # We only have the usually conflicting cases left | |
130 | if (defined $a and defined $b) { | |
131 | # Same entry, merge sub-items separately for a nicer result | |
132 | merge_entries($o, $a, $b); | |
133 | } else { | |
134 | # Non-existing on one side, changed on the other side | |
135 | merge_conflict($a, $b); | |
136 | } | |
137 | } | |
138 | ||
139 | if (defined($out_file) and $out_file ne '-') { | |
140 | open(my $out_fh, '>', $out_file) | |
141 | or syserr(g_('cannot write %s'), $out_file); | |
142 | print { $out_fh } ((blessed $_) ? "$_" : "$_\n") foreach @result; | |
143 | close($out_fh) or syserr(g_('cannot write %s'), $out_file); | |
144 | } else { | |
145 | print ((blessed $_) ? "$_" : "$_\n") foreach @result; | |
146 | } | |
147 | ||
148 | exit $exitcode; | |
149 | ||
150 | # Returns the next items to merge, all items returned correspond to the | |
151 | # same minimal version among the 3 possible next items (undef is returned | |
152 | # if the next item on the given changelog is skipped) | |
153 | sub get_items_to_merge { | |
154 | my @items = (shift @o, shift @a, shift @b); | |
155 | my @arrays = (\@o, \@a, \@b); | |
156 | my $minver; | |
157 | foreach my $i (0 .. 2) { | |
158 | if (defined $minver and defined $items[$i]) { | |
159 | my $cmp = compare_versions($minver, $items[$i]->get_version()); | |
160 | if ($cmp > 0) { | |
161 | $minver = $items[$i]->get_version(); | |
162 | foreach my $j (0 .. $i - 1) { | |
163 | unshift @{$arrays[$j]}, $items[$j]; | |
164 | $items[$j] = undef; | |
165 | } | |
166 | } elsif ($cmp < 0) { | |
167 | unshift @{$arrays[$i]}, $items[$i]; | |
168 | $items[$i] = undef; | |
169 | } | |
170 | } else { | |
171 | $minver = $items[$i]->get_version() if defined $items[$i]; | |
172 | } | |
173 | } | |
174 | return @items; | |
175 | } | |
176 | ||
177 | # Compares the versions taking into account some oddities like the fact | |
178 | # that we want backport/volatile versions to sort higher than the version | |
179 | # on which they are based. | |
180 | sub compare_versions { | |
181 | my ($a, $b) = @_; | |
182 | return 0 if not defined $a and not defined $b; | |
183 | return 1 if not defined $b; | |
184 | return -1 if not defined $a; | |
185 | $a = $a->get_version() if ref($a) and $a->isa('Dpkg::Changelog::Entry'); | |
186 | $b = $b->get_version() if ref($b) and $b->isa('Dpkg::Changelog::Entry'); | |
187 | # Backport and volatile are not real prereleases | |
188 | $a =~ s/~(bpo|vola)/+$1/; | |
189 | $b =~ s/~(bpo|vola)/+$1/; | |
190 | if ($merge_prereleases) { | |
191 | $a =~ s/~[^~]*$//; | |
192 | $b =~ s/~[^~]*$//; | |
193 | } | |
194 | $a = Dpkg::Version->new($a); | |
195 | $b = Dpkg::Version->new($b); | |
196 | return $a <=> $b; | |
197 | } | |
198 | ||
199 | # Merge changelog entries smartly by merging individually the different | |
200 | # parts constituting an entry | |
201 | sub merge_entries($$$) { | |
202 | my ($o, $a, $b) = @_; | |
203 | # NOTE: Only $o can be undef | |
204 | ||
205 | # Merge the trailer line | |
206 | unless (merge_entry_item('blank_after_trailer', $o, $a, $b)) { | |
207 | unshift @result, ''; | |
208 | } | |
209 | unless (merge_entry_item('trailer', $o, $a, $b)) { | |
210 | merge_conflict($a->get_part('trailer'), $b->get_part('trailer')); | |
211 | } | |
212 | ||
213 | # Merge the changes | |
214 | unless (merge_entry_item('blank_after_changes', $o, $a, $b)) { | |
215 | unshift @result, ''; | |
216 | } | |
217 | my @merged = merge(defined $o ? $o->get_part('changes') : [], | |
218 | $a->get_part('changes'), $b->get_part('changes'), | |
219 | { | |
220 | CONFLICT => sub { | |
221 | my ($ca, $cb) = @_; | |
222 | $exitcode = 1; | |
223 | return get_conflict_block($ca, $cb); | |
224 | } | |
225 | }); | |
226 | unshift @result, @merged; | |
227 | ||
228 | # Merge the header line | |
229 | unless (merge_entry_item('blank_after_header', $o, $a, $b)) { | |
230 | unshift @result, ''; | |
231 | } | |
232 | unless (merge_entry_item('header', $o, $a, $b)) { | |
233 | merge_conflict($a->get_part('header'), $b->get_part('header')); | |
234 | } | |
235 | } | |
236 | ||
237 | sub join_lines($) { | |
238 | my $array = shift; | |
239 | return join("\n", @$array) if ref($array) eq 'ARRAY'; | |
240 | return $array; | |
241 | } | |
242 | ||
243 | # Try to merge the obvious cases, return 1 on success and 0 on failure | |
244 | # O A B | |
245 | # - x x => x | |
246 | # o o b => b | |
247 | # - - b => b | |
248 | # o a o => a | |
249 | # - a - => a | |
250 | sub merge_block($$$;&) { | |
251 | my ($o, $a, $b, $preprocess) = @_; | |
252 | $preprocess //= \&join_lines; | |
253 | $o = &$preprocess($o) if defined($o); | |
254 | $a = &$preprocess($a) if defined($a); | |
255 | $b = &$preprocess($b) if defined($b); | |
256 | return 1 if not defined($a) and not defined($b); | |
257 | if (defined($a) and defined($b) and ($a eq $b)) { | |
258 | unshift @result, $a; | |
259 | } elsif ((defined($a) and defined($o) and ($a eq $o)) or | |
260 | (not defined($a) and not defined($o))) { | |
261 | unshift @result, $b if defined $b; | |
262 | } elsif ((defined($b) and defined($o) and ($b eq $o)) or | |
263 | (not defined($b) and not defined($o))) { | |
264 | unshift @result, $a if defined $a; | |
265 | } else { | |
266 | return 0; | |
267 | } | |
268 | return 1; | |
269 | } | |
270 | ||
271 | sub merge_entry_item($$$$) { | |
272 | my ($item, $o, $a, $b) = @_; | |
273 | if (blessed($o) and $o->isa('Dpkg::Changelog::Entry')) { | |
274 | $o = $o->get_part($item); | |
275 | } elsif (ref $o) { | |
276 | $o = $o->{$item}; | |
277 | } | |
278 | if (blessed($a) and $a->isa('Dpkg::Changelog::Entry')) { | |
279 | $a = $a->get_part($item); | |
280 | } elsif (ref $a) { | |
281 | $a = $a->{$item}; | |
282 | } | |
283 | if (blessed($b) and $b->isa('Dpkg::Changelog::Entry')) { | |
284 | $b = $b->get_part($item); | |
285 | } elsif (ref $b) { | |
286 | $b = $b->{$item}; | |
287 | } | |
288 | return merge_block($o, $a, $b); | |
289 | } | |
290 | ||
291 | sub merge_conflict($$) { | |
292 | my ($a, $b) = @_; | |
293 | unshift @result, get_conflict_block($a, $b); | |
294 | $exitcode = 1; | |
295 | } | |
296 | ||
297 | sub get_conflict_block($$) { | |
298 | my ($a, $b) = @_; | |
299 | my (@a, @b); | |
300 | push @a, $a if defined $a; | |
301 | push @b, $b if defined $b; | |
302 | @a = @{$a} if ref($a) eq 'ARRAY'; | |
303 | @b = @{$b} if ref($b) eq 'ARRAY'; | |
304 | return ('<<<<<<<', @a, '=======', @b, '>>>>>>>'); | |
305 | } |