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 unless (merge_block($cho, $cha, $chb, sub {
 120                         my $changes = shift;
 121                         my $tail = $changes->get_unparsed_tail();
 122                         chomp $tail if defined $tail;
 123                         return $tail;
 124                     }))
 125 {
 126     merge_conflict($cha->get_unparsed_tail(), $chb->get_unparsed_tail());
 127 }
 128
 129 while (1) {
 130     my ($o, $a, $b) = get_items_to_merge();
 131     last unless defined $o or defined $a or defined $b;
 132     next if merge_block($o, $a, $b);
 133     # We only have the usually conflicting cases left
 134     if (defined $a and defined $b) {
 135         # Same entry, merge sub-items separately for a nicer result
 136         merge_entries($o, $a, $b);
 137     } else {
 138         # Non-existing on one side, changed on the other side
 139         merge_conflict($a, $b);
 140     }
 141 }
 142
 143 if (defined($out_file) and $out_file ne '-') {
 144     open(my $out_fh, '>', $out_file)
 145         or syserr(g_('cannot write %s'), $out_file);
 146     print { $out_fh } ((blessed $_) ? "$_" : "$_\n") foreach @result;
 147     close($out_fh) or syserr(g_('cannot write %s'), $out_file);
 148 } else {
 149     print ((blessed $_) ? "$_" : "$_\n") foreach @result;
 150 }
 151
 152 exit $exitcode;
 153
 154 # Returns the next items to merge, all items returned correspond to the
 155 # same minimal version among the 3 possible next items (undef is returned
 156 # if the next item on the given changelog is skipped)
 157 sub get_items_to_merge {
 158     my @items = (shift @o, shift @a, shift @b);
 159     my @arrays = (\@o, \@a, \@b);
 160     my $minitem;
 161     foreach my $i (0 .. 2) {
 162         if (defined $minitem and defined $items[$i]) {
 163             my $cmp = compare_versions($minitem, $items[$i]);
 164             if ($cmp > 0) {
 165                 $minitem = $items[$i];
 166                 foreach my $j (0 .. $i - 1) {
 167                     unshift @{$arrays[$j]}, $items[$j];
 168                     $items[$j] = undef;
 169                 }
 170             } elsif ($cmp < 0) {
 171                 unshift @{$arrays[$i]}, $items[$i];
 172                 $items[$i] = undef;
 173             }
 174         } else {
 175             $minitem = $items[$i] if defined $items[$i];
 176         }
 177     }
 178     return @items;
 179 }
 180
 181 # Compares the versions taking into account some oddities like the fact
 182 # that we want backport versions to sort higher than the version
 183 # on which they are based.
 184 sub compare_versions {
 185     my ($a, $b) = @_;
 186
 187     return 0 if not defined $a and not defined $b;
 188     return 1 if not defined $b;
 189     return -1 if not defined $a;
 190
 191     my ($av, $bv) = ($a, $b);
 192
 193     $av = $a->get_version() if ref $a and $a->isa('Dpkg::Changelog::Entry');
 194     $bv = $b->get_version() if ref $b and $b->isa('Dpkg::Changelog::Entry');
 195
 196     if ($merge_unreleased) {
 197         return 0 if $a->get_distributions() eq 'UNRELEASED' and
 198                     $b->get_distributions() eq 'UNRELEASED';
 199     }
 200     # Backports are not real prereleases.
 201     if (defined $backport_version_regex) {
 202         $a =~ s/$backport_version_regex/+$1/;
 203         $b =~ s/$backport_version_regex/+$1/;
 204     }
 205     if ($merge_prereleases) {
 206         $av =~ s/~[^~]*$//;
 207         $bv =~ s/~[^~]*$//;
 208     }
 209     $av = Dpkg::Version->new($av);
 210     $bv = Dpkg::Version->new($bv);
 211     return $av <=> $bv;
 212 }
 213
 214 # Merge changelog entries smartly by merging individually the different
 215 # parts constituting an entry
 216 sub merge_entries($$$) {
 217     my ($o, $a, $b) = @_;
 218     # NOTE: Only $o can be undef
 219
 220     # Merge the trailer line
 221     unless (merge_entry_item('blank_after_trailer', $o, $a, $b)) {
 222         unshift @result, '';
 223     }
 224     unless (merge_entry_item('trailer', $o, $a, $b)) {
 225         merge_conflict($a->get_part('trailer'), $b->get_part('trailer'));
 226     }
 227
 228     # Merge the changes
 229     unless (merge_entry_item('blank_after_changes', $o, $a, $b)) {
 230         unshift @result, '';
 231     }
 232     my @merged = merge(defined $o ? $o->get_part('changes') : [],
 233                        $a->get_part('changes'), $b->get_part('changes'),
 234                        {
 235                            CONFLICT => sub {
 236                                 my ($ca, $cb) = @_;
 237                                 $exitcode = 1;
 238                                 return get_conflict_block($ca, $cb);
 239                            }
 240                        });
 241     unshift @result, @merged;
 242
 243     # Merge the header line
 244     unless (merge_entry_item('blank_after_header', $o, $a, $b)) {
 245         unshift @result, '';
 246     }
 247     unless (merge_entry_item('header', $o, $a, $b)) {
 248         merge_conflict($a->get_part('header'), $b->get_part('header'));
 249     }
 250 }
 251
 252 sub join_lines($) {
 253     my $array = shift;
 254     return join("\n", @$array) if ref($array) eq 'ARRAY';
 255     return $array;
 256 }
 257
 258 # Try to merge the obvious cases, return 1 on success and 0 on failure
 259 # O A B
 260 # - x x => x
 261 # o o b => b
 262 # - - b => b
 263 # o a o => a
 264 # - a - => a
 265 sub merge_block($$$;&) {
 266     my ($o, $a, $b, $preprocess) = @_;
 267     $preprocess //= \&join_lines;
 268     $o = $preprocess->($o) if defined $o;
 269     $a = $preprocess->($a) if defined $a;
 270     $b = $preprocess->($b) if defined $b;
 271     return 1 if not defined($a) and not defined($b);
 272     if (defined($a) and defined($b) and ($a eq $b)) {
 273         unshift @result, $a;
 274     } elsif ((defined($a) and defined($o) and ($a eq $o)) or
 275              (not defined($a) and not defined($o))) {
 276         unshift @result, $b if defined $b;
 277     } elsif ((defined($b) and defined($o) and ($b eq $o)) or
 278              (not defined($b) and not defined($o))) {
 279         unshift @result, $a if defined $a;
 280     } else {
 281         return 0;
 282     }
 283     return 1;
 284 }
 285
 286 sub merge_entry_item($$$$) {
 287     my ($item, $o, $a, $b) = @_;
 288     if (blessed($o) and $o->isa('Dpkg::Changelog::Entry')) {
 289         $o = $o->get_part($item);
 290     } elsif (ref $o) {
 291         $o = $o->{$item};
 292     }
 293     if (blessed($a) and $a->isa('Dpkg::Changelog::Entry')) {
 294         $a = $a->get_part($item);
 295     } elsif (ref $a) {
 296         $a = $a->{$item};
 297     }
 298     if (blessed($b) and $b->isa('Dpkg::Changelog::Entry')) {
 299         $b = $b->get_part($item);
 300     } elsif (ref $b) {
 301         $b = $b->{$item};
 302     }
 303     return merge_block($o, $a, $b);
 304 }
 305
 306 sub merge_conflict($$) {
 307     my ($a, $b) = @_;
 308     unshift @result, get_conflict_block($a, $b);
 309     $exitcode = 1;
 310 }
 311
 312 sub get_conflict_block($$) {
 313     my ($a, $b) = @_;
 314     my (@a, @b);
 315     push @a, $a if defined $a;
 316     push @b, $b if defined $b;
 317     @a = @{$a} if ref($a) eq 'ARRAY';
 318     @b = @{$b} if ref($b) eq 'ARRAY';
 319     return ('<<<<<<<', @a, '=======', @b, '>>>>>>>');
 320 }