chiark - git - mdw - dpkg/blob - 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 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 }