scripts/Dpkg/Source/Package/V3/Quilt.pm

   1 # Copyright © 2008-2012 Raphaël Hertzog <hertzog@debian.org>
   2 #
   3 # This program is free software; you can redistribute it and/or modify
   4 # it under the terms of the GNU General Public License as published by
   5 # the Free Software Foundation; either version 2 of the License, or
   6 # (at your option) any later version.
   7 #
   8 # This program is distributed in the hope that it will be useful,
   9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 # GNU General Public License for more details.
  12 #
  13 # You should have received a copy of the GNU General Public License
  14 # along with this program.  If not, see <https://www.gnu.org/licenses/>.
  15
  16 =encoding utf8
  17
  18 =head1 NAME
  19
  20 Dpkg::Source::Package::V3::Quilt - class for source format 3.0 (quilt)
  21
  22 =head1 DESCRIPTION
  23
  24 This module provides a class to handle the source package format 3.0 (quilt).
  25
  26 B<Note>: This is a private module, its API can change at any time.
  27
  28 =cut
  29
  30 package Dpkg::Source::Package::V3::Quilt 0.01;
  31
  32 use strict;
  33 use warnings;
  34
  35 use List::Util qw(any);
  36 use File::Spec;
  37 use File::Copy;
  38
  39 use Dpkg::Gettext;
  40 use Dpkg::ErrorHandling;
  41 use Dpkg::File;
  42 use Dpkg::Version;
  43 use Dpkg::Source::Patch;
  44 use Dpkg::Source::Functions qw(erasedir chmod_if_needed fs_time);
  45 use Dpkg::Source::Quilt;
  46 use Dpkg::Exit;
  47
  48 # Based on wig&pen implementation
  49 use parent qw(Dpkg::Source::Package::V2);
  50
  51 our $CURRENT_MINOR_VERSION = '0';
  52
  53 sub init_options {
  54     my $self = shift;
  55     $self->{options}{single_debian_patch} //= 0;
  56     $self->{options}{allow_version_of_quilt_db} //= [];
  57
  58     $self->SUPER::init_options();
  59 }
  60
  61 my @module_cmdline = (
  62     {
  63         name => '--single-debian-patch',
  64         help => N_('use a single debianization patch'),
  65         when => 'build',
  66     }, {
  67         name => '--allow-version-of-quilt-db=<version>',
  68         help => N_('accept quilt metadata <version> even if unknown'),
  69         when => 'build',
  70     }
  71 );
  72
  73 sub describe_cmdline_options {
  74     my $self = shift;
  75
  76     my @cmdline = ( $self->SUPER::describe_cmdline_options(), @module_cmdline );
  77
  78     return @cmdline;
  79 }
  80
  81 sub parse_cmdline_option {
  82     my ($self, $opt) = @_;
  83     return 1 if $self->SUPER::parse_cmdline_option($opt);
  84     if ($opt eq '--single-debian-patch') {
  85         $self->{options}{single_debian_patch} = 1;
  86         # For backwards compatibility.
  87         $self->{options}{auto_commit} = 1;
  88         return 1;
  89     } elsif ($opt =~ /^--allow-version-of-quilt-db=(.*)$/) {
  90         push @{$self->{options}{allow_version_of_quilt_db}}, $1;
  91         return 1;
  92     }
  93     return 0;
  94 }
  95
  96 sub _build_quilt_object {
  97     my ($self, $dir) = @_;
  98     return $self->{quilt}{$dir} if exists $self->{quilt}{$dir};
  99     $self->{quilt}{$dir} = Dpkg::Source::Quilt->new($dir);
 100     return $self->{quilt}{$dir};
 101 }
 102
 103 sub can_build {
 104     my ($self, $dir) = @_;
 105     my ($code, $msg) = $self->SUPER::can_build($dir);
 106     return ($code, $msg) if $code == 0;
 107
 108     my $v = Dpkg::Version->new($self->{fields}->{'Version'});
 109     return (0, g_('non-native package version does not contain a revision'))
 110         if $v->is_native();
 111
 112     my $quilt = $self->_build_quilt_object($dir);
 113     $msg = $quilt->find_problems();
 114     return (0, $msg) if $msg;
 115     return 1;
 116 }
 117
 118 sub get_autopatch_name {
 119     my $self = shift;
 120     if ($self->{options}{single_debian_patch}) {
 121         return 'debian-changes';
 122     } else {
 123         return 'debian-changes-' . $self->{fields}{'Version'};
 124     }
 125 }
 126
 127 sub apply_patches {
 128     my ($self, $dir, %opts) = @_;
 129
 130     if ($opts{usage} eq 'unpack') {
 131         $opts{verbose} = 1;
 132     } elsif ($opts{usage} eq 'build') {
 133         $opts{warn_options} = 1;
 134         $opts{verbose} = 0;
 135     }
 136
 137     my $quilt = $self->_build_quilt_object($dir);
 138     $quilt->load_series(%opts) if $opts{warn_options}; # Trigger warnings
 139
 140     # Always create the quilt db so that if the maintainer calls quilt to
 141     # create a patch, it's stored in the right directory
 142     $quilt->save_db();
 143
 144     # Update debian/patches/series symlink if needed to allow quilt usage
 145     my $series = $quilt->get_series_file();
 146     my $basename = (File::Spec->splitpath($series))[2];
 147     if ($basename ne 'series') {
 148         my $dest = $quilt->get_patch_file('series');
 149         unlink($dest) if -l $dest;
 150         unless (-f _) { # Don't overwrite real files
 151             symlink($basename, $dest)
 152                 or syserr(g_("can't create symlink %s"), $dest);
 153         }
 154     }
 155
 156     return unless scalar($quilt->series());
 157
 158     info(g_('using patch list from %s'), "debian/patches/$basename");
 159
 160     if ($opts{usage} eq 'preparation' and
 161         $self->{options}{unapply_patches} eq 'auto') {
 162         # We're applying the patches in --before-build, remember to unapply
 163         # them afterwards in --after-build
 164         my $pc_unapply = $quilt->get_db_file('.dpkg-source-unapply');
 165         file_touch($pc_unapply);
 166     }
 167
 168     # Apply patches
 169     my $pc_applied = $quilt->get_db_file('applied-patches');
 170     $opts{timestamp} = fs_time($pc_applied);
 171     if ($opts{skip_auto}) {
 172         my $auto_patch = $self->get_autopatch_name();
 173         $quilt->push(%opts) while ($quilt->next() and $quilt->next() ne $auto_patch);
 174     } else {
 175         $quilt->push(%opts) while $quilt->next();
 176     }
 177 }
 178
 179 sub unapply_patches {
 180     my ($self, $dir, %opts) = @_;
 181
 182     my $quilt = $self->_build_quilt_object($dir);
 183
 184     $opts{verbose} //= 1;
 185
 186     my $pc_applied = $quilt->get_db_file('applied-patches');
 187     my @applied = $quilt->applied();
 188     $opts{timestamp} = fs_time($pc_applied) if @applied;
 189
 190     $quilt->pop(%opts) while $quilt->top();
 191
 192     erasedir($quilt->get_db_dir());
 193 }
 194
 195 sub prepare_build {
 196     my ($self, $dir) = @_;
 197     $self->SUPER::prepare_build($dir);
 198     # Skip .pc directories of quilt by default and ignore difference
 199     # on debian/patches/series symlinks and d/p/.dpkg-source-applied
 200     # stamp file created by ourselves
 201     my $func = sub {
 202         my $pathname = shift;
 203
 204         return 1 if $pathname eq 'debian/patches/series' and -l $pathname;
 205         return 1 if $pathname =~ /^\.pc(\/|$)/;
 206         return 1 if $pathname =~ /$self->{options}{diff_ignore_regex}/;
 207         return 0;
 208     };
 209     $self->{diff_options}{diff_ignore_func} = $func;
 210 }
 211
 212 sub do_build {
 213     my ($self, $dir) = @_;
 214
 215     my $quilt = $self->_build_quilt_object($dir);
 216     my $version = $quilt->get_db_version();
 217
 218     if (defined($version) and $version != 2) {
 219         if (any { $version eq $_ }
 220             @{$self->{options}{allow_version_of_quilt_db}})
 221         {
 222             warning(g_('unsupported version of the quilt metadata: %s'), $version);
 223         } else {
 224             error(g_('unsupported version of the quilt metadata: %s'), $version);
 225         }
 226     }
 227
 228     $self->SUPER::do_build($dir);
 229 }
 230
 231 sub after_build {
 232     my ($self, $dir) = @_;
 233     my $quilt = $self->_build_quilt_object($dir);
 234     my $pc_unapply = $quilt->get_db_file('.dpkg-source-unapply');
 235     my $opt_unapply = $self->{options}{unapply_patches};
 236     if (($opt_unapply eq 'auto' and -e $pc_unapply) or $opt_unapply eq 'yes') {
 237         unlink($pc_unapply);
 238         $self->unapply_patches($dir);
 239     }
 240 }
 241
 242 sub check_patches_applied {
 243     my ($self, $dir) = @_;
 244
 245     my $quilt = $self->_build_quilt_object($dir);
 246     my $next = $quilt->next();
 247     return if not defined $next;
 248
 249     my $first_patch = File::Spec->catfile($dir, 'debian', 'patches', $next);
 250     my $patch_obj = Dpkg::Source::Patch->new(filename => $first_patch);
 251     return unless $patch_obj->check_apply($dir, fatal_dupes => 1);
 252
 253     $self->apply_patches($dir, usage => 'preparation', verbose => 1);
 254 }
 255
 256 sub register_patch {
 257     my ($self, $dir, $tmpdiff, $patch_name) = @_;
 258
 259     my $quilt = $self->_build_quilt_object($dir);
 260     my $patch = $quilt->get_patch_file($patch_name);
 261
 262     if (-s $tmpdiff) {
 263         copy($tmpdiff, $patch)
 264             or syserr(g_('failed to copy %s to %s'), $tmpdiff, $patch);
 265         chmod_if_needed(0666 & ~ umask(), $patch)
 266             or syserr(g_("unable to change permission of '%s'"), $patch);
 267     } elsif (-e $patch) {
 268         unlink($patch) or syserr(g_('cannot remove %s'), $patch);
 269     }
 270
 271     if (-e $patch) {
 272         # Add patch to series file
 273         $quilt->register($patch_name);
 274     } else {
 275         # Remove auto_patch from series
 276         $quilt->unregister($patch_name);
 277     }
 278     return $patch;
 279 }
 280
 281 =head1 CHANGES
 282
 283 =head2 Version 0.xx
 284
 285 This is a private module.
 286
 287 =cut
 288
 289 1;