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
4
4
4
4
6407
1
86
use warnings;
20
4
4
4
4
8
4
44
use strict;
21
22
4
4
4
4
5
3
173
use Scalar::Util qw(blessed);
23
4
4
4
4
733
21109
9
use Getopt::Long qw(:config posix_default bundling_values no_ignorecase);
24
25
4
4
4
4
785
4
40
use Dpkg ();
26
4
4
4
4
493
4
67
use Dpkg::Changelog::Debian;
27
4
4
4
4
8
3
108
use Dpkg::ErrorHandling;
28
4
4
4
4
8
2
69
use Dpkg::Gettext;
29
4
4
4
4
6
2
87
use Dpkg::Version;
30
4
4
4
4
6
2
290
use Dpkg::Vendor qw(run_vendor_hook);
31
32
4
134000
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
4
4
4
4
4
4
110
560
25439
72
    eval q{
43        pop @INC if $INC[-1] eq '.';
44        use Algorithm::Merge qw(merge);
45    };
46
4
50
5203
    if ($@) {
47        *merge = sub {
48
0
0
            my ($o, $a, $b) = @_;
49
0
0
0
            return @$a if join("\n", @$a) eq join("\n", @$b);
50
0
0
            return get_conflict_block($a, $b);
51
0
0
        };
52    }
53}
54
55sub version {
56
0
0
0
    printf g_("Debian %s version %s.\n"), $Dpkg::PROGNAME, $Dpkg::PROGVERSION;
57
58
0
0
    printf "\n" . g_(
59'This is free software; see the GNU General Public License version 2 or
60later for copying conditions. There is NO warranty.
61');
62}
63
64sub usage {
65
0
0
0
    printf g_(
66"Usage: %s [<option>...] <old> <new-a> <new-b> [<out>]
67
68Options:
69  -m, --merge-prereleases  merge pre-releases together, ignores everything
70                             after the last '~' in the version.
71      --merge-unreleased   merge UNRELEASED entries together, ignoring their
72                             version numbers.
73  -?, --help               show this help message.
74      --version            show the version.
75"), $Dpkg::PROGNAME;
76}
77
78
4
4
my $merge_prereleases;
79my $merge_unreleased;
80
81my @options_spec = (
82
0
0
0
0
0
    'help|?' => sub { usage(); exit(0) },
83
0
0
0
0
0
    'version' => sub { version(); exit(0) },
84
4
14
    'merge-prereleases|m' => \$merge_prereleases,
85    'merge-unreleased' => \$merge_unreleased,
86);
87
88{
89
4
4
0
0
4
12
0
    local $SIG{__WARN__} = sub { usageerr($_[0]) };
90
4
7
    GetOptions(@options_spec);
91}
92
93
4
690
my $backport_version_regex = run_vendor_hook('backport-version-regex');
94
95
4
8
my ($old, $new_a, $new_b, $out_file) = @ARGV;
96
4
50
25
17
unless (defined $old and defined $new_a and defined $new_b)
97{
98
0
0
    usageerr(g_('needs at least three arguments'));
99}
100
4
50
25
41
unless (-e $old and -e $new_a and -e $new_b)
101{
102
0
0
    usageerr(g_('file arguments need to exist'));
103}
104
105
4
4
my ($cho, $cha, $chb);
106
4
18
$cho = Dpkg::Changelog::Debian->new();
107
4
10
$cho->load($old);
108
4
20
$cha = Dpkg::Changelog::Debian->new();
109
4
6
$cha->load($new_a);
110
4
13
$chb = Dpkg::Changelog::Debian->new();
111
4
6
$chb->load($new_b);
112
113
4
12
my @o = reverse @$cho;
114
4
4
my @a = reverse @$cha;
115
4
4
my @b = reverse @$chb;
116
117
4
3
my @result; # Lines to output
118
4
3
my $exitcode = 0; # 1 if conflict encountered
119
120
4
50
12
unless (merge_block($cho, $cha, $chb, sub {
121
12
12
7
                        my $changes = shift;
122
12
16
                        my $tail = $changes->get_unparsed_tail();
123
12
100
11
                        chomp $tail if defined $tail;
124
12
7
                        return $tail;
125                    }))
126{
127
0
0
    merge_conflict($cha->get_unparsed_tail(), $chb->get_unparsed_tail());
128}
129
130
4
8
while (1) {
131
36
24
    my ($o, $a, $b) = get_items_to_merge();
132
36
100
100
55
    last unless defined $o or defined $a or defined $b;
133
32
100
22
    next if merge_block($o, $a, $b);
134    # We only have the usually conflicting cases left
135
10
50
33
18
    if (defined $a and defined $b) {
136        # Same entry, merge sub-items separately for a nicer result
137
10
8
        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
4
50
33
6
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
4
100
28
    print ((blessed $_) ? "$_" : "$_\n") foreach @result;
151}
152
153
4
33
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
36
36
26
    my @items = (shift @o, shift @a, shift @b);
160
36
23
    my @arrays = (\@o, \@a, \@b);
161
36
15
    my $minitem;
162
36
27
    foreach my $i (0 .. 2) {
163
108
100
100
110
        if (defined $minitem and defined $items[$i]) {
164
54
39
            my $cmp = compare_versions($minitem, $items[$i]);
165
54
100
100
63
            if ($cmp > 0) {
166
5
4
                $minitem = $items[$i];
167
5
4
                foreach my $j (0 .. $i - 1) {
168
8
8
4
5
                    unshift @{$arrays[$j]}, $items[$j];
169
8
6
                    $items[$j] = undef;
170                }
171            } elsif ($cmp < 0) {
172
12
12
4
11
                unshift @{$arrays[$i]}, $items[$i];
173
12
9
                $items[$i] = undef;
174            }
175        } else {
176
54
100
48
            $minitem = $items[$i] if defined $items[$i];
177        }
178    }
179
36
34
    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
54
54
27
    my ($a, $b) = @_;
187
188
54
0
33
39
    return 0 if not defined $a and not defined $b;
189
54
50
38
    return 1 if not defined $b;
190
54
50
34
    return -1 if not defined $a;
191
192
54
29
    my ($av, $bv) = ($a, $b);
193
194
54
50
33
118
    $av = $a->get_version() if ref $a and $a->isa('Dpkg::Changelog::Entry');
195
54
50
33
99
    $bv = $b->get_version() if ref $b and $b->isa('Dpkg::Changelog::Entry');
196
197
54
100
42
    if ($merge_unreleased) {
198
4
100
67
3
        return 0 if $a->get_distributions() eq 'UNRELEASED' and
199                    $b->get_distributions() eq 'UNRELEASED';
200    }
201    # Backports are not real prereleases.
202
53
50
32
    if (defined $backport_version_regex) {
203
53
60
        $a =~ s/$backport_version_regex/+$1/;
204
53
59
        $b =~ s/$backport_version_regex/+$1/;
205    }
206
53
100
47
    if ($merge_prereleases) {
207
24
19
        $av =~ s/~[^~]*$//;
208
24
13
        $bv =~ s/~[^~]*$//;
209    }
210
53
56
    $av = Dpkg::Version->new($av);
211
53
41
    $bv = Dpkg::Version->new($bv);
212
53
42
    return $av <=> $bv;
213}
214
215# Merge changelog entries smartly by merging individually the different
216# parts constituting an entry
217sub merge_entries($$$) {
218
10
10
7
    my ($o, $a, $b) = @_;
219    # NOTE: Only $o can be undef
220
221    # Merge the trailer line
222
10
50
9
    unless (merge_entry_item('blank_after_trailer', $o, $a, $b)) {
223
0
0
        unshift @result, '';
224    }
225
10
100
9
    unless (merge_entry_item('trailer', $o, $a, $b)) {
226
3
3
        merge_conflict($a->get_part('trailer'), $b->get_part('trailer'));
227    }
228
229    # Merge the changes
230
10
50
21
    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
3
3
986
                                my ($ca, $cb) = @_;
238
3
1
                                $exitcode = 1;
239
3
3
                                return get_conflict_block($ca, $cb);
240                           }
241
10
100
12
                       });
242
10
4921
    unshift @result, @merged;
243
244    # Merge the header line
245
10
50
6
    unless (merge_entry_item('blank_after_header', $o, $a, $b)) {
246
0
0
        unshift @result, '';
247    }
248
10
100
8
    unless (merge_entry_item('header', $o, $a, $b)) {
249
4
6
        merge_conflict($a->get_part('header'), $b->get_part('header'));
250    }
251}
252
253sub join_lines($) {
254
209
209
97
    my $array = shift;
255
209
100
155
    return join("\n", @$array) if ref($array) eq 'ARRAY';
256
125
58
    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
86
86
55
    my ($o, $a, $b, $preprocess) = @_;
268
86
100
132
    $preprocess //= \&join_lines;
269
86
100
57
    $o = $preprocess->($o) if defined $o;
270
86
100
55
    $a = $preprocess->($a) if defined $a;
271
86
100
64
    $b = $preprocess->($b) if defined $b;
272
86
100
100
70
    return 1 if not defined($a) and not defined($b);
273
82
100
100
100
100
100
100
67
100
100
100
245
    if (defined($a) and defined($b) and ($a eq $b)) {
274
48
33
        unshift @result, $a;
275    } elsif ((defined($a) and defined($o) and ($a eq $o)) or
276             (not defined($a) and not defined($o))) {
277
6
100
9
        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
11
100
13
        unshift @result, $a if defined $a;
281    } else {
282
17
22
        return 0;
283    }
284
65
65
    return 1;
285}
286
287sub merge_entry_item($$$$) {
288
50
50
37
    my ($item, $o, $a, $b) = @_;
289
50
100
50
67
98
    if (blessed($o) and $o->isa('Dpkg::Changelog::Entry')) {
290
40
32
        $o = $o->get_part($item);
291    } elsif (ref $o) {
292
0
0
        $o = $o->{$item};
293    }
294
50
50
0
33
95
    if (blessed($a) and $a->isa('Dpkg::Changelog::Entry')) {
295
50
33
        $a = $a->get_part($item);
296    } elsif (ref $a) {
297
0
0
        $a = $a->{$item};
298    }
299
50
50
0
33
90
    if (blessed($b) and $b->isa('Dpkg::Changelog::Entry')) {
300
50
31
        $b = $b->get_part($item);
301    } elsif (ref $b) {
302
0
0
        $b = $b->{$item};
303    }
304
50
37
    return merge_block($o, $a, $b);
305}
306
307sub merge_conflict($$) {
308
7
7
6
    my ($a, $b) = @_;
309
7
6
    unshift @result, get_conflict_block($a, $b);
310
7
6
    $exitcode = 1;
311}
312
313sub get_conflict_block($$) {
314
10
10
7
    my ($a, $b) = @_;
315
10
4
    my (@a, @b);
316
10
50
9
    push @a, $a if defined $a;
317
10
50
8
    push @b, $b if defined $b;
318
10
3
100
8
3
    @a = @{$a} if ref($a) eq 'ARRAY';
319
10
3
100
9
1
    @b = @{$b} if ref($b) eq 'ARRAY';
320
10
21
    return ('<<<<<<<', @a, '=======', @b, '>>>>>>>');
321}