| OLD | NEW |
| (Empty) |
| 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 package Dpkg::Source::Package::V3::Quilt; | |
| 17 | |
| 18 use strict; | |
| 19 use warnings; | |
| 20 | |
| 21 our $VERSION = '0.01'; | |
| 22 | |
| 23 # Based on wig&pen implementation | |
| 24 use parent qw(Dpkg::Source::Package::V2); | |
| 25 | |
| 26 use Dpkg; | |
| 27 use Dpkg::Gettext; | |
| 28 use Dpkg::ErrorHandling; | |
| 29 use Dpkg::Util qw(:list); | |
| 30 use Dpkg::Version; | |
| 31 use Dpkg::Source::Patch; | |
| 32 use Dpkg::Source::Functions qw(erasedir fs_time); | |
| 33 use Dpkg::Source::Quilt; | |
| 34 use Dpkg::Exit; | |
| 35 | |
| 36 use File::Spec; | |
| 37 use File::Copy; | |
| 38 | |
| 39 our $CURRENT_MINOR_VERSION = '0'; | |
| 40 | |
| 41 sub init_options { | |
| 42 my ($self) = @_; | |
| 43 $self->{options}{single_debian_patch} = 0 | |
| 44 unless exists $self->{options}{single_debian_patch}; | |
| 45 $self->{options}{allow_version_of_quilt_db} = [] | |
| 46 unless exists $self->{options}{allow_version_of_quilt_db}; | |
| 47 | |
| 48 $self->SUPER::init_options(); | |
| 49 } | |
| 50 | |
| 51 sub parse_cmdline_option { | |
| 52 my ($self, $opt) = @_; | |
| 53 return 1 if $self->SUPER::parse_cmdline_option($opt); | |
| 54 if ($opt =~ /^--single-debian-patch$/) { | |
| 55 $self->{options}{single_debian_patch} = 1; | |
| 56 # For backwards compatibility. | |
| 57 $self->{options}{auto_commit} = 1; | |
| 58 return 1; | |
| 59 } elsif ($opt =~ /^--allow-version-of-quilt-db=(.*)$/) { | |
| 60 push @{$self->{options}{allow_version_of_quilt_db}}, $1; | |
| 61 return 1; | |
| 62 } | |
| 63 return 0; | |
| 64 } | |
| 65 | |
| 66 sub build_quilt_object { | |
| 67 my ($self, $dir) = @_; | |
| 68 return $self->{quilt}{$dir} if exists $self->{quilt}{$dir}; | |
| 69 $self->{quilt}{$dir} = Dpkg::Source::Quilt->new($dir); | |
| 70 return $self->{quilt}{$dir}; | |
| 71 } | |
| 72 | |
| 73 sub can_build { | |
| 74 my ($self, $dir) = @_; | |
| 75 my ($code, $msg) = $self->SUPER::can_build($dir); | |
| 76 return ($code, $msg) if $code == 0; | |
| 77 | |
| 78 my $v = Dpkg::Version->new($self->{fields}->{'Version'}); | |
| 79 warning (_g('version does not contain a revision')) if $v->is_native(); | |
| 80 | |
| 81 my $quilt = $self->build_quilt_object($dir); | |
| 82 $msg = $quilt->find_problems(); | |
| 83 return (0, $msg) if $msg; | |
| 84 return 1; | |
| 85 } | |
| 86 | |
| 87 sub get_autopatch_name { | |
| 88 my ($self) = @_; | |
| 89 if ($self->{options}{single_debian_patch}) { | |
| 90 return 'debian-changes'; | |
| 91 } else { | |
| 92 return 'debian-changes-' . $self->{fields}{'Version'}; | |
| 93 } | |
| 94 } | |
| 95 | |
| 96 sub apply_patches { | |
| 97 my ($self, $dir, %opts) = @_; | |
| 98 | |
| 99 if ($opts{usage} eq 'unpack') { | |
| 100 $opts{verbose} = 1; | |
| 101 } elsif ($opts{usage} eq 'build') { | |
| 102 $opts{warn_options} = 1; | |
| 103 $opts{verbose} = 0; | |
| 104 } | |
| 105 | |
| 106 my $quilt = $self->build_quilt_object($dir); | |
| 107 $quilt->load_series(%opts) if $opts{warn_options}; # Trigger warnings | |
| 108 | |
| 109 # Always create the quilt db so that if the maintainer calls quilt to | |
| 110 # create a patch, it's stored in the right directory | |
| 111 $quilt->write_db(); | |
| 112 | |
| 113 # Update debian/patches/series symlink if needed to allow quilt usage | |
| 114 my $series = $quilt->get_series_file(); | |
| 115 my $basename = (File::Spec->splitpath($series))[2]; | |
| 116 if ($basename ne 'series') { | |
| 117 my $dest = $quilt->get_patch_file('series'); | |
| 118 unlink($dest) if -l $dest; | |
| 119 unless (-f _) { # Don't overwrite real files | |
| 120 symlink($basename, $dest) | |
| 121 or syserr(_g("can't create symlink %s"), $dest); | |
| 122 } | |
| 123 } | |
| 124 | |
| 125 return unless scalar($quilt->series()); | |
| 126 | |
| 127 if ($opts{usage} eq 'preparation' and | |
| 128 $self->{options}{unapply_patches} eq 'auto') { | |
| 129 # We're applying the patches in --before-build, remember to unapply | |
| 130 # them afterwards in --after-build | |
| 131 my $pc_unapply = $quilt->get_db_file('.dpkg-source-unapply'); | |
| 132 open(my $unapply_fh, '>', $pc_unapply) | |
| 133 or syserr(_g('cannot write %s'), $pc_unapply); | |
| 134 close($unapply_fh); | |
| 135 } | |
| 136 | |
| 137 # Apply patches | |
| 138 my $pc_applied = $quilt->get_db_file('applied-patches'); | |
| 139 $opts{timestamp} = fs_time($pc_applied); | |
| 140 if ($opts{skip_auto}) { | |
| 141 my $auto_patch = $self->get_autopatch_name(); | |
| 142 $quilt->push(%opts) while ($quilt->next() and $quilt->next() ne $auto_pa
tch); | |
| 143 } else { | |
| 144 $quilt->push(%opts) while $quilt->next(); | |
| 145 } | |
| 146 } | |
| 147 | |
| 148 sub unapply_patches { | |
| 149 my ($self, $dir, %opts) = @_; | |
| 150 | |
| 151 my $quilt = $self->build_quilt_object($dir); | |
| 152 | |
| 153 $opts{verbose} //= 1; | |
| 154 | |
| 155 my $pc_applied = $quilt->get_db_file('applied-patches'); | |
| 156 my @applied = $quilt->applied(); | |
| 157 $opts{timestamp} = fs_time($pc_applied) if @applied; | |
| 158 | |
| 159 $quilt->pop(%opts) while $quilt->top(); | |
| 160 | |
| 161 erasedir($quilt->get_db_dir()); | |
| 162 } | |
| 163 | |
| 164 sub prepare_build { | |
| 165 my ($self, $dir) = @_; | |
| 166 $self->SUPER::prepare_build($dir); | |
| 167 # Skip .pc directories of quilt by default and ignore difference | |
| 168 # on debian/patches/series symlinks and d/p/.dpkg-source-applied | |
| 169 # stamp file created by ourselves | |
| 170 my $func = sub { | |
| 171 return 1 if $_[0] =~ m{^debian/patches/series$} and -l $_[0]; | |
| 172 return 1 if $_[0] =~ /^\.pc(\/|$)/; | |
| 173 return 1 if $_[0] =~ /$self->{options}{diff_ignore_regex}/; | |
| 174 return 0; | |
| 175 }; | |
| 176 $self->{diff_options}{diff_ignore_func} = $func; | |
| 177 } | |
| 178 | |
| 179 sub do_build { | |
| 180 my ($self, $dir) = @_; | |
| 181 | |
| 182 my $quilt = $self->build_quilt_object($dir); | |
| 183 my $version = $quilt->get_db_version(); | |
| 184 | |
| 185 if (defined($version) and $version != 2) { | |
| 186 if (any { $version eq $_ } | |
| 187 @{$self->{options}{allow_version_of_quilt_db}}) | |
| 188 { | |
| 189 warning(_g('unsupported version of the quilt metadata: %s'), $versio
n); | |
| 190 } else { | |
| 191 error(_g('unsupported version of the quilt metadata: %s'), $version)
; | |
| 192 } | |
| 193 } | |
| 194 | |
| 195 $self->SUPER::do_build($dir); | |
| 196 } | |
| 197 | |
| 198 sub after_build { | |
| 199 my ($self, $dir) = @_; | |
| 200 my $quilt = $self->build_quilt_object($dir); | |
| 201 my $pc_unapply = $quilt->get_db_file('.dpkg-source-unapply'); | |
| 202 my $opt_unapply = $self->{options}{unapply_patches}; | |
| 203 if (($opt_unapply eq 'auto' and -e $pc_unapply) or $opt_unapply eq 'yes') { | |
| 204 unlink($pc_unapply); | |
| 205 $self->unapply_patches($dir); | |
| 206 } | |
| 207 } | |
| 208 | |
| 209 sub check_patches_applied { | |
| 210 my ($self, $dir) = @_; | |
| 211 | |
| 212 my $quilt = $self->build_quilt_object($dir); | |
| 213 my $next = $quilt->next(); | |
| 214 return if not defined $next; | |
| 215 | |
| 216 my $first_patch = File::Spec->catfile($dir, 'debian', 'patches', $next); | |
| 217 my $patch_obj = Dpkg::Source::Patch->new(filename => $first_patch); | |
| 218 return unless $patch_obj->check_apply($dir); | |
| 219 | |
| 220 $self->apply_patches($dir, usage => 'preparation', verbose => 1); | |
| 221 } | |
| 222 | |
| 223 sub _add_line { | |
| 224 my ($file, $line) = @_; | |
| 225 | |
| 226 open(my $file_fh, '>>', $file) or syserr(_g('cannot write %s'), $file); | |
| 227 print { $file_fh } "$line\n"; | |
| 228 close($file_fh); | |
| 229 } | |
| 230 | |
| 231 sub _drop_line { | |
| 232 my ($file, $re) = @_; | |
| 233 | |
| 234 open(my $file_fh, '<', $file) or syserr(_g('cannot read %s'), $file); | |
| 235 my @lines = <$file_fh>; | |
| 236 close($file_fh); | |
| 237 open($file_fh, '>', $file) or syserr(_g('cannot write %s'), $file); | |
| 238 print { $file_fh } $_ foreach grep { not /^\Q$re\E\s*$/ } @lines; | |
| 239 close($file_fh); | |
| 240 } | |
| 241 | |
| 242 sub register_patch { | |
| 243 my ($self, $dir, $tmpdiff, $patch_name) = @_; | |
| 244 | |
| 245 my $quilt = $self->build_quilt_object($dir); | |
| 246 | |
| 247 my @patches = $quilt->series(); | |
| 248 my $has_patch = (grep { $_ eq $patch_name } @patches) ? 1 : 0; | |
| 249 my $series = $quilt->get_series_file(); | |
| 250 my $applied = $quilt->get_db_file('applied-patches'); | |
| 251 my $patch = $quilt->get_patch_file($patch_name); | |
| 252 | |
| 253 if (-s $tmpdiff) { | |
| 254 copy($tmpdiff, $patch) | |
| 255 or syserr(_g('failed to copy %s to %s'), $tmpdiff, $patch); | |
| 256 chmod(0666 & ~ umask(), $patch) | |
| 257 or syserr(_g("unable to change permission of `%s'"), $patch); | |
| 258 } elsif (-e $patch) { | |
| 259 unlink($patch) or syserr(_g('cannot remove %s'), $patch); | |
| 260 } | |
| 261 | |
| 262 if (-e $patch) { | |
| 263 $quilt->setup_db(); | |
| 264 # Add patch to series file | |
| 265 if (not $has_patch) { | |
| 266 _add_line($series, $patch_name); | |
| 267 _add_line($applied, $patch_name); | |
| 268 $quilt->load_series(); | |
| 269 $quilt->load_db(); | |
| 270 } | |
| 271 # Ensure quilt meta-data are created and in sync with some trickery: | |
| 272 # reverse-apply the patch, drop .pc/$patch, re-apply it | |
| 273 # with the correct options to recreate the backup files | |
| 274 $quilt->pop(reverse_apply => 1); | |
| 275 $quilt->push(); | |
| 276 } else { | |
| 277 # Remove auto_patch from series | |
| 278 if ($has_patch) { | |
| 279 _drop_line($series, $patch_name); | |
| 280 _drop_line($applied, $patch_name); | |
| 281 erasedir($quilt->get_db_file($patch_name)); | |
| 282 $quilt->load_db(); | |
| 283 $quilt->load_series(); | |
| 284 } | |
| 285 # Clean up empty series | |
| 286 unlink($series) if -z $series; | |
| 287 } | |
| 288 return $patch; | |
| 289 } | |
| 290 | |
| 291 1; | |
| OLD | NEW |