1 # Copyright © 2008-2012 Raphaël Hertzog <hertzog@debian.org>
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.
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.
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/>.
16 package Dpkg
::Source
::Package
::V3
::Quilt
;
21 our $VERSION = '0.01';
27 use Dpkg
::ErrorHandling
;
28 use Dpkg
::Util
qw(:list
);
30 use Dpkg
::Source
::Patch
;
31 use Dpkg
::Source
::Functions
qw(erasedir fs_time
);
32 use Dpkg
::Source
::Quilt
;
35 # Based on wig&pen implementation
36 use parent
qw(Dpkg
::Source
::Package
::V2
);
38 our $CURRENT_MINOR_VERSION = '0';
42 $self->{options
}{single_debian_patch
} //= 0;
43 $self->{options
}{allow_version_of_quilt_db
} //= [];
45 $self->SUPER::init_options
();
48 my @module_cmdline = (
50 name
=> '--single-debian-patch',
51 help
=> N_
('use a single debianization patch'),
54 name
=> '--allow-version-of-quilt-db=<version>',
55 help
=> N_
('accept quilt metadata <version> even if unknown'),
60 sub describe_cmdline_options
{
63 my @cmdline = ( $self->SUPER::describe_cmdline_options
(), @module_cmdline );
68 sub parse_cmdline_option
{
69 my ($self, $opt) = @_;
70 return 1 if $self->SUPER::parse_cmdline_option
($opt);
71 if ($opt eq '--single-debian-patch') {
72 $self->{options
}{single_debian_patch
} = 1;
73 # For backwards compatibility.
74 $self->{options
}{auto_commit
} = 1;
76 } elsif ($opt =~ /^--allow-version-of-quilt-db=(.*)$/) {
77 push @
{$self->{options
}{allow_version_of_quilt_db
}}, $1;
83 sub _build_quilt_object
{
84 my ($self, $dir) = @_;
85 return $self->{quilt
}{$dir} if exists $self->{quilt
}{$dir};
86 $self->{quilt
}{$dir} = Dpkg
::Source
::Quilt
->new($dir);
87 return $self->{quilt
}{$dir};
91 my ($self, $dir) = @_;
92 my ($code, $msg) = $self->SUPER::can_build
($dir);
93 return ($code, $msg) if $code == 0;
95 my $v = Dpkg
::Version
->new($self->{fields
}->{'Version'});
96 return (0, g_
('non-native package version does not contain a revision'))
99 my $quilt = $self->_build_quilt_object($dir);
100 $msg = $quilt->find_problems();
101 return (0, $msg) if $msg;
105 sub get_autopatch_name
{
107 if ($self->{options
}{single_debian_patch
}) {
108 return 'debian-changes';
110 return 'debian-changes-' . $self->{fields
}{'Version'};
115 my ($self, $dir, %opts) = @_;
117 if ($opts{usage
} eq 'unpack') {
119 } elsif ($opts{usage
} eq 'build') {
120 $opts{warn_options
} = 1;
124 my $quilt = $self->_build_quilt_object($dir);
125 $quilt->load_series(%opts) if $opts{warn_options
}; # Trigger warnings
127 # Always create the quilt db so that if the maintainer calls quilt to
128 # create a patch, it's stored in the right directory
131 # Update debian/patches/series symlink if needed to allow quilt usage
132 my $series = $quilt->get_series_file();
133 my $basename = (File
::Spec
->splitpath($series))[2];
134 if ($basename ne 'series') {
135 my $dest = $quilt->get_patch_file('series');
136 unlink($dest) if -l
$dest;
137 unless (-f _
) { # Don't overwrite real files
138 symlink($basename, $dest)
139 or syserr
(g_
("can't create symlink %s"), $dest);
143 return unless scalar($quilt->series());
145 if ($opts{usage
} eq 'preparation' and
146 $self->{options
}{unapply_patches
} eq 'auto') {
147 # We're applying the patches in --before-build, remember to unapply
148 # them afterwards in --after-build
149 my $pc_unapply = $quilt->get_db_file('.dpkg-source-unapply');
150 open(my $unapply_fh, '>', $pc_unapply)
151 or syserr
(g_
('cannot write %s'), $pc_unapply);
156 my $pc_applied = $quilt->get_db_file('applied-patches');
157 $opts{timestamp
} = fs_time
($pc_applied);
158 if ($opts{skip_auto
}) {
159 my $auto_patch = $self->get_autopatch_name();
160 $quilt->push(%opts) while ($quilt->next() and $quilt->next() ne $auto_patch);
162 $quilt->push(%opts) while $quilt->next();
166 sub unapply_patches
{
167 my ($self, $dir, %opts) = @_;
169 my $quilt = $self->_build_quilt_object($dir);
171 $opts{verbose
} //= 1;
173 my $pc_applied = $quilt->get_db_file('applied-patches');
174 my @applied = $quilt->applied();
175 $opts{timestamp
} = fs_time
($pc_applied) if @applied;
177 $quilt->pop(%opts) while $quilt->top();
179 erasedir
($quilt->get_db_dir());
183 my ($self, $dir) = @_;
184 $self->SUPER::prepare_build
($dir);
185 # Skip .pc directories of quilt by default and ignore difference
186 # on debian/patches/series symlinks and d/p/.dpkg-source-applied
187 # stamp file created by ourselves
189 my $pathname = shift;
191 return 1 if $pathname eq 'debian/patches/series' and -l
$pathname;
192 return 1 if $pathname =~ /^\.pc(\/|$)/;
193 return 1 if $pathname =~ /$self->{options}{diff_ignore_regex}/;
196 $self->{diff_options
}{diff_ignore_func
} = $func;
200 my ($self, $dir) = @_;
202 my $quilt = $self->_build_quilt_object($dir);
203 my $version = $quilt->get_db_version();
205 if (defined($version) and $version != 2) {
206 if (any
{ $version eq $_ }
207 @
{$self->{options
}{allow_version_of_quilt_db
}})
209 warning
(g_
('unsupported version of the quilt metadata: %s'), $version);
211 error
(g_
('unsupported version of the quilt metadata: %s'), $version);
215 $self->SUPER::do_build
($dir);
219 my ($self, $dir) = @_;
220 my $quilt = $self->_build_quilt_object($dir);
221 my $pc_unapply = $quilt->get_db_file('.dpkg-source-unapply');
222 my $opt_unapply = $self->{options
}{unapply_patches
};
223 if (($opt_unapply eq 'auto' and -e
$pc_unapply) or $opt_unapply eq 'yes') {
225 $self->unapply_patches($dir);
229 sub check_patches_applied
{
230 my ($self, $dir) = @_;
232 my $quilt = $self->_build_quilt_object($dir);
233 my $next = $quilt->next();
234 return if not defined $next;
236 my $first_patch = File
::Spec
->catfile($dir, 'debian', 'patches', $next);
237 my $patch_obj = Dpkg
::Source
::Patch
->new(filename
=> $first_patch);
238 return unless $patch_obj->check_apply($dir, fatal_dupes
=> 1);
240 $self->apply_patches($dir, usage
=> 'preparation', verbose
=> 1);
244 my ($self, $dir, $tmpdiff, $patch_name) = @_;
246 my $quilt = $self->_build_quilt_object($dir);
247 my $patch = $quilt->get_patch_file($patch_name);
250 copy
($tmpdiff, $patch)
251 or syserr
(g_
('failed to copy %s to %s'), $tmpdiff, $patch);
252 chmod(0666 & ~ umask(), $patch)
253 or syserr
(g_
("unable to change permission of '%s'"), $patch);
254 } elsif (-e
$patch) {
255 unlink($patch) or syserr
(g_
('cannot remove %s'), $patch);
259 # Add patch to series file
260 $quilt->register($patch_name);
262 # Remove auto_patch from series
263 $quilt->unregister($patch_name);