scripts/dpkg-mergechangelogs.pl

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