File Coverage

File:dpkg-mergechangelogs.pl
Coverage:77.5%

linestmtbrancondsubpodtimecode
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
12
12
12
12
21514
10
431
use warnings;
20
12
12
12
12
28
4
212
use strict;
21
22
12
12
12
12
21
5
626
use Scalar::Util qw(blessed);
23
12
12
12
12
2415
76413
28
use Getopt::Long qw(:config posix_default bundling_values no_ignorecase);
24
25
12
12
12
12
2996
8
143
use Dpkg ();
26
12
12
12
12
1605
17
351
use Dpkg::Changelog::Debian;
27
12
12
12
12
39
10
597
use Dpkg::ErrorHandling;
28
12
12
12
12
31
4
296
use Dpkg::Gettext;
29
12
12
12
12
25
4
374
use Dpkg::Version;
30
12
12
12
12
24
6
1175
use Dpkg::Vendor qw(run_vendor_hook);
31
32
12
557526
textdomain('dpkg-dev');
33
34sub merge_entries($$$);
35sub merge_block($$$;&);
36sub merge_entry_item($$$$);
37sub merge_conflict($$);
38sub get_conflict_block($$);
39sub join_lines($);
40
41BEGIN {
42
12
12
12
12
12
12
397
2329
99638
363
    eval q{
43        use Algorithm::Merge qw(merge);
44    };
45
12
50
20183
    if ($@) {
46        *merge = sub {
47
0
0
            my ($o, $a, $b) = @_;
48
0
0
0
            return @$a if join("\n", @$a) eq join("\n", @$b);
49
0
0
            return get_conflict_block($a, $b);
50
0
0
        };
51    }
52}
53
54sub version {
55
0
0
0
    printf g_("Debian %s version %s.\n"), $Dpkg::PROGNAME, $Dpkg::PROGVERSION;
56
57
0
0
    printf "\n" . g_(
58'This is free software; see the GNU General Public License version 2 or
59later for copying conditions. There is NO warranty.
60');
61}
62
63sub usage {
64
0
0
0
    printf g_(
65"Usage: %s [<option>...] <old> <new-a> <new-b> [<out>]
66
67Options:
68  -m, --merge-prereleases  merge pre-releases together, ignores everything
69                             after the last '~' in the version.
70      --merge-unreleased   merge UNRELEASED entries together, ignoring their
71                             version numbers.
72  -?, --help               show this help message.
73      --version            show the version.
74"), $Dpkg::PROGNAME;
75}
76
77
12
17
my $merge_prereleases;
78my $merge_unreleased;
79
80my @options_spec = (
81
0
0
0
0
0
    'help|?' => sub { usage(); exit(0) },
82
0
0
0
0
0
    'version' => sub { version(); exit(0) },
83
12
83
    'merge-prereleases|m' => \$merge_prereleases,
84    'merge-unreleased' => \$merge_unreleased,
85);
86
87{
88
12
12
0
0
8
44
0
    local $SIG{__WARN__} = sub { usageerr($_[0]) };
89
12
34
    GetOptions(@options_spec);
90}
91
92
12
2509
my $backport_version_regex = run_vendor_hook('backport-version-regex');
93
94
12
22
my ($old, $new_a, $new_b, $out_file) = @ARGV;
95
12
50
25
105
unless (defined $old and defined $new_a and defined $new_b)
96{
97
0
0
    usageerr(g_('needs at least three arguments'));
98}
99
12
50
25
157
unless (-e $old and -e $new_a and -e $new_b)
100{
101
0
0
    usageerr(g_('file arguments need to exist'));
102}
103
104
12
12
my ($cho, $cha, $chb);
105
12
81
$cho = Dpkg::Changelog::Debian->new();
106
12
39
$cho->load($old);
107
12
80
$cha = Dpkg::Changelog::Debian->new();
108
12
21
$cha->load($new_a);
109
12
70
$chb = Dpkg::Changelog::Debian->new();
110
12
24
$chb->load($new_b);
111
112
12
37
my @o = reverse @$cho;
113
12
14
my @a = reverse @$cha;
114
12
11
my @b = reverse @$chb;
115
116
12
12
my @result; # Lines to output
117
12
7
my $exitcode = 0; # 1 if conflict encountered
118
119sub merge_tail {
120
36
36
21
    my $changes = shift;
121
36
65
    my $tail = $changes->get_unparsed_tail();
122
36
100
31
    chomp $tail if defined $tail;
123
36
35
    return $tail;
124};
125
126
12
50
29
unless (merge_block($cho, $cha, $chb, \&merge_tail)) {
127
0
0
    merge_conflict($cha->get_unparsed_tail(), $chb->get_unparsed_tail());
128}
129
130
12
10
while (1) {
131
108
88
    my ($o, $a, $b) = get_items_to_merge();
132
108
100
100
257
    last unless defined $o or defined $a or defined $b;
133
96
100
86
    next if merge_block($o, $a, $b);
134    # We only have the usually conflicting cases left
135
30
50
33
69
    if (defined $a and defined $b) {
136        # Same entry, merge sub-items separately for a nicer result
137
30
35
        merge_entries($o, $a, $b);
138    } else {
139        # Non-existing on one side, changed on the other side
140
0
0
        merge_conflict($a, $b);
141    }
142}
143
144
12
50
33
29
if (defined($out_file) and $out_file ne '-') {
145
0
0
0
    open(my $out_fh, '>', $out_file)
146        or syserr(g_('cannot write %s'), $out_file);
147
0
0
0
0
0
    print { $out_fh } ((blessed $_) ? "$_" : "$_\n") foreach @result;
148
0
0
0
    close($out_fh) or syserr(g_('cannot write %s'), $out_file);
149} else {
150
12
100
132
    print ((blessed $_) ? "$_" : "$_\n") foreach @result;
151}
152
153
12
235
exit $exitcode;
154
155# Returns the next items to merge, all items returned correspond to the
156# same minimal version among the 3 possible next items (undef is returned
157# if the next item on the given changelog is skipped)
158sub get_items_to_merge {
159
108
108
95
    my @items = (shift @o, shift @a, shift @b);
160
108
97
    my @arrays = (\@o, \@a, \@b);
161
108
57
    my $minitem;
162
108
105
    foreach my $i (0 .. 2) {
163
324
100
100
421
        if (defined $minitem and defined $items[$i]) {
164
162
130
            my $cmp = compare_versions($minitem, $items[$i]);
165
162
100
100
218
            if ($cmp > 0) {
166
15
13
                $minitem = $items[$i];
167
15
20
                foreach my $j (0 .. $i - 1) {
168
24
24
14
21
                    unshift @{$arrays[$j]}, $items[$j];
169
24
21
                    $items[$j] = undef;
170                }
171            } elsif ($cmp < 0) {
172
36
36
19
34
                unshift @{$arrays[$i]}, $items[$i];
173
36
33
                $items[$i] = undef;
174            }
175        } else {
176
162
100
178
            $minitem = $items[$i] if defined $items[$i];
177        }
178    }
179
108
132
    return @items;
180}
181
182# Compares the versions taking into account some oddities like the fact
183# that we want backport versions to sort higher than the version
184# on which they are based.
185sub compare_versions {
186
162
162
104
    my ($a, $b) = @_;
187
188
162
0
33
119
    return 0 if not defined $a and not defined $b;
189
162
50
119
    return 1 if not defined $b;
190
162
50
100
    return -1 if not defined $a;
191
192
162
105
    my ($av, $bv) = ($a, $b);
193
194
162
50
33
495
    $av = $a->get_version() if ref $a and $a->isa('Dpkg::Changelog::Entry');
195
162
50
33
325
    $bv = $b->get_version() if ref $b and $b->isa('Dpkg::Changelog::Entry');
196
197
162
100
129
    if ($merge_unreleased) {
198
12
100
67
13
        return 0 if $a->get_distributions() eq 'UNRELEASED' and
199                    $b->get_distributions() eq 'UNRELEASED';
200    }
201    # Backports are not real prereleases.
202
159
50
105
    if (defined $backport_version_regex) {
203
159
280
        $a =~ s/$backport_version_regex/+$1/;
204
159
190
        $b =~ s/$backport_version_regex/+$1/;
205    }
206
159
100
127
    if ($merge_prereleases) {
207
72
68
        $av =~ s/~[^~]*$//;
208
72
53
        $bv =~ s/~[^~]*$//;
209    }
210
159
185
    $av = Dpkg::Version->new($av);
211
159
143
    $bv = Dpkg::Version->new($bv);
212
159
138
    return $av <=> $bv;
213}
214
215# Merge changelog entries smartly by merging individually the different
216# parts constituting an entry
217sub merge_entries($$$) {
218
30
30
26
    my ($o, $a, $b) = @_;
219    # NOTE: Only $o can be undef
220
221    # Merge the trailer line
222
30
50
35
    unless (merge_entry_item('blank_after_trailer', $o, $a, $b)) {
223
0
0
        unshift @result, '';
224    }
225
30
100
89
    unless (merge_entry_item('trailer', $o, $a, $b)) {
226
9
10
        merge_conflict($a->get_part('trailer'), $b->get_part('trailer'));
227    }
228
229    # Merge the changes
230
30
50
62
    unless (merge_entry_item('blank_after_changes', $o, $a, $b)) {
231
0
0
        unshift @result, '';
232    }
233    my @merged = merge(defined $o ? $o->get_part('changes') : [],
234                       $a->get_part('changes'), $b->get_part('changes'),
235                       {
236                           CONFLICT => sub {
237
9
9
3364
                                my ($ca, $cb) = @_;
238
9
7
                                $exitcode = 1;
239
9
12
                                return get_conflict_block($ca, $cb);
240                           }
241
30
100
50
                       });
242
30
19750
    unshift @result, @merged;
243
244    # Merge the header line
245
30
50
41
    unless (merge_entry_item('blank_after_header', $o, $a, $b)) {
246
0
0
        unshift @result, '';
247    }
248
30
100
35
    unless (merge_entry_item('header', $o, $a, $b)) {
249
12
23
        merge_conflict($a->get_part('header'), $b->get_part('header'));
250    }
251}
252
253sub join_lines($) {
254
627
627
282
    my $array = shift;
255
627
100
554
    return join("\n", @$array) if ref($array) eq 'ARRAY';
256
375
202
    return $array;
257}
258
259# Try to merge the obvious cases, return 1 on success and 0 on failure
260# O A B
261# - x x => x
262# o o b => b
263# - - b => b
264# o a o => a
265# - a - => a
266sub merge_block($$$;&) {
267
258
258
199
    my ($o, $a, $b, $preprocess) = @_;
268
258
100
476
    $preprocess //= \&join_lines;
269
258
100
239
    $o = $preprocess->($o) if defined $o;
270
258
100
229
    $a = $preprocess->($a) if defined $a;
271
258
100
224
    $b = $preprocess->($b) if defined $b;
272
258
100
100
258
    return 1 if not defined($a) and not defined($b);
273
246
100
100
100
100
100
100
67
100
100
100
867
    if (defined($a) and defined($b) and ($a eq $b)) {
274
144
151
        unshift @result, $a;
275    } elsif ((defined($a) and defined($o) and ($a eq $o)) or
276             (not defined($a) and not defined($o))) {
277
18
100
31
        unshift @result, $b if defined $b;
278    } elsif ((defined($b) and defined($o) and ($b eq $o)) or
279             (not defined($b) and not defined($o))) {
280
33
100
35
        unshift @result, $a if defined $a;
281    } else {
282
51
71
        return 0;
283    }
284
195
265
    return 1;
285}
286
287sub merge_entry_item($$$$) {
288
150
150
142
    my ($item, $o, $a, $b) = @_;
289
150
100
50
67
407
    if (blessed($o) and $o->isa('Dpkg::Changelog::Entry')) {
290
120
127
        $o = $o->get_part($item);
291    } elsif (ref $o) {
292
0
0
        $o = $o->{$item};
293    }
294
150
50
0
33
373
    if (blessed($a) and $a->isa('Dpkg::Changelog::Entry')) {
295
150
118
        $a = $a->get_part($item);
296    } elsif (ref $a) {
297
0
0
        $a = $a->{$item};
298    }
299
150
50
0
33
342
    if (blessed($b) and $b->isa('Dpkg::Changelog::Entry')) {
300
150
106
        $b = $b->get_part($item);
301    } elsif (ref $b) {
302
0
0
        $b = $b->{$item};
303    }
304
150
128
    return merge_block($o, $a, $b);
305}
306
307sub merge_conflict($$) {
308
21
21
17
    my ($a, $b) = @_;
309
21
32
    unshift @result, get_conflict_block($a, $b);
310
21
27
    $exitcode = 1;
311}
312
313sub get_conflict_block($$) {
314
30
30
24
    my ($a, $b) = @_;
315
30
20
    my (@a, @b);
316
30
50
36
    push @a, $a if defined $a;
317
30
50
25
    push @b, $b if defined $b;
318
30
9
100
35
10
    @a = @{$a} if ref($a) eq 'ARRAY';
319
30
9
100
30
9
    @b = @{$b} if ref($b) eq 'ARRAY';
320
30
68
    return ('<<<<<<<', @a, '=======', @b, '>>>>>>>');
321}