| OLD | NEW |
|---|
| (Empty) |
| 1 # Copyright © 2008-2011 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; | |
| 17 | |
| 18 =encoding utf8 | |
| 19 | |
| 20 =head1 NAME | |
| 21 | |
| 22 Dpkg::Source::Package - manipulate Debian source packages | |
| 23 | |
| 24 =head1 DESCRIPTION | |
| 25 | |
| 26 This module provides an object that can manipulate Debian source | |
| 27 packages. While it supports both the extraction and the creation | |
| 28 of source packages, the only API that is officially supported | |
| 29 is the one that supports the extraction of the source package. | |
| 30 | |
| 31 =head1 FUNCTIONS | |
| 32 | |
| 33 =cut | |
| 34 | |
| 35 use strict; | |
| 36 use warnings; | |
| 37 | |
| 38 our $VERSION = '1.01'; | |
| 39 | |
| 40 use Dpkg::Gettext; | |
| 41 use Dpkg::ErrorHandling; | |
| 42 use Dpkg::Control; | |
| 43 use Dpkg::Checksums; | |
| 44 use Dpkg::Version; | |
| 45 use Dpkg::Compression; | |
| 46 use Dpkg::Exit qw(run_exit_handlers); | |
| 47 use Dpkg::Path qw(check_files_are_the_same find_command); | |
| 48 use Dpkg::IPC; | |
| 49 use Dpkg::Vendor qw(run_vendor_hook); | |
| 50 | |
| 51 use Carp; | |
| 52 use POSIX qw(:errno_h :sys_wait_h); | |
| 53 use File::Basename; | |
| 54 | |
| 55 use Exporter qw(import); | |
| 56 our @EXPORT_OK = qw(get_default_diff_ignore_regex | |
| 57 set_default_diff_ignore_regex | |
| 58 get_default_tar_ignore_pattern); | |
| 59 | |
| 60 my $diff_ignore_default_regex = ' | |
| 61 # Ignore general backup files | |
| 62 (?:^|/).*~$| | |
| 63 # Ignore emacs recovery files | |
| 64 (?:^|/)\.#.*$| | |
| 65 # Ignore vi swap files | |
| 66 (?:^|/)\..*\.sw.$| | |
| 67 # Ignore baz-style junk files or directories | |
| 68 (?:^|/),,.*(?:$|/.*$)| | |
| 69 # File-names that should be ignored (never directories) | |
| 70 (?:^|/)(?:DEADJOE|\.arch-inventory|\.(?:bzr|cvs|hg|git)ignore)$| | |
| 71 # File or directory names that should be ignored | |
| 72 (?:^|/)(?:CVS|RCS|\.deps|\{arch\}|\.arch-ids|\.svn| | |
| 73 \.hg(?:tags|sigs)?|_darcs|\.git(?:attributes|modules)?| | |
| 74 \.shelf|_MTN|\.be|\.bzr(?:\.backup|tags)?)(?:$|/.*$) | |
| 75 '; | |
| 76 # Take out comments and newlines | |
| 77 $diff_ignore_default_regex =~ s/^#.*$//mg; | |
| 78 $diff_ignore_default_regex =~ s/\n//sg; | |
| 79 | |
| 80 # Public variables | |
| 81 # XXX: Backwards compatibility, stop exporting on VERSION 2.00. | |
| 82 ## no critic (Variables::ProhibitPackageVars) | |
| 83 our $diff_ignore_default_regexp; | |
| 84 *diff_ignore_default_regexp = \$diff_ignore_default_regex; | |
| 85 | |
| 86 no warnings 'qw'; ## no critic (TestingAndDebugging::ProhibitNoWarnings) | |
| 87 our @tar_ignore_default_pattern = qw( | |
| 88 *.a | |
| 89 *.la | |
| 90 *.o | |
| 91 *.so | |
| 92 .*.sw? | |
| 93 */*~ | |
| 94 ,,* | |
| 95 .[#~]* | |
| 96 .arch-ids | |
| 97 .arch-inventory | |
| 98 .be | |
| 99 .bzr | |
| 100 .bzr.backup | |
| 101 .bzr.tags | |
| 102 .bzrignore | |
| 103 .cvsignore | |
| 104 .deps | |
| 105 .git | |
| 106 .gitattributes | |
| 107 .gitignore | |
| 108 .gitmodules | |
| 109 .hg | |
| 110 .hgignore | |
| 111 .hgsigs | |
| 112 .hgtags | |
| 113 .shelf | |
| 114 .svn | |
| 115 CVS | |
| 116 DEADJOE | |
| 117 RCS | |
| 118 _MTN | |
| 119 _darcs | |
| 120 {arch} | |
| 121 ); | |
| 122 ## use critic | |
| 123 | |
| 124 =over 4 | |
| 125 | |
| 126 =item my $string = get_default_diff_ignore_regex() | |
| 127 | |
| 128 Returns the default diff ignore regex. | |
| 129 | |
| 130 =cut | |
| 131 | |
| 132 sub get_default_diff_ignore_regex { | |
| 133 return $diff_ignore_default_regex; | |
| 134 } | |
| 135 | |
| 136 =item set_default_diff_ignore_regex($string) | |
| 137 | |
| 138 Set a regex as the new default diff ignore regex. | |
| 139 | |
| 140 =cut | |
| 141 | |
| 142 sub set_default_diff_ignore_regex { | |
| 143 my ($regex) = @_; | |
| 144 | |
| 145 $diff_ignore_default_regex = $regex; | |
| 146 } | |
| 147 | |
| 148 =item my @array = get_default_tar_ignore_pattern() | |
| 149 | |
| 150 Returns the default tar ignore pattern, as an array. | |
| 151 | |
| 152 =cut | |
| 153 | |
| 154 sub get_default_tar_ignore_pattern { | |
| 155 return @tar_ignore_default_pattern; | |
| 156 } | |
| 157 | |
| 158 =item $p = Dpkg::Source::Package->new(filename => $dscfile, options => {}) | |
| 159 | |
| 160 Creates a new object corresponding to the source package described | |
| 161 by the file $dscfile. | |
| 162 | |
| 163 The options hash supports the following options: | |
| 164 | |
| 165 =over 8 | |
| 166 | |
| 167 =item skip_debianization | |
| 168 | |
| 169 If set to 1, do not apply Debian changes on the extracted source package. | |
| 170 | |
| 171 =item skip_patches | |
| 172 | |
| 173 If set to 1, do not apply Debian-specific patches. This options is | |
| 174 specific for source packages using format "2.0" and "3.0 (quilt)". | |
| 175 | |
| 176 =item require_valid_signature | |
| 177 | |
| 178 If set to 1, the check_signature() method will be stricter and will error | |
| 179 out if the signature can't be verified. | |
| 180 | |
| 181 =item copy_orig_tarballs | |
| 182 | |
| 183 If set to 1, the extraction will copy the upstream tarballs next the | |
| 184 target directory. This is useful if you want to be able to rebuild the | |
| 185 source package after its extraction. | |
| 186 | |
| 187 =back | |
| 188 | |
| 189 =cut | |
| 190 | |
| 191 # Object methods | |
| 192 sub new { | |
| 193 my ($this, %args) = @_; | |
| 194 my $class = ref($this) || $this; | |
| 195 my $self = { | |
| 196 fields => Dpkg::Control->new(type => CTRL_PKG_SRC), | |
| 197 options => {}, | |
| 198 checksums => Dpkg::Checksums->new(), | |
| 199 }; | |
| 200 bless $self, $class; | |
| 201 if (exists $args{options}) { | |
| 202 $self->{options} = $args{options}; | |
| 203 } | |
| 204 if (exists $args{filename}) { | |
| 205 $self->initialize($args{filename}); | |
| 206 $self->init_options(); | |
| 207 } | |
| 208 return $self; | |
| 209 } | |
| 210 | |
| 211 sub init_options { | |
| 212 my ($self) = @_; | |
| 213 # Use full ignore list by default | |
| 214 # note: this function is not called by V1 packages | |
| 215 $self->{options}{diff_ignore_regex} ||= $diff_ignore_default_regex; | |
| 216 $self->{options}{diff_ignore_regex} .= '|(?:^|/)debian/source/local-.*$'; | |
| 217 if (defined $self->{options}{tar_ignore}) { | |
| 218 $self->{options}{tar_ignore} = [ @tar_ignore_default_pattern ] | |
| 219 unless @{$self->{options}{tar_ignore}}; | |
| 220 } else { | |
| 221 $self->{options}{tar_ignore} = [ @tar_ignore_default_pattern ]; | |
| 222 } | |
| 223 push @{$self->{options}{tar_ignore}}, 'debian/source/local-options', | |
| 224 'debian/source/local-patch-header'; | |
| 225 # Skip debianization while specific to some formats has an impact | |
| 226 # on code common to all formats | |
| 227 $self->{options}{skip_debianization} ||= 0; | |
| 228 } | |
| 229 | |
| 230 sub initialize { | |
| 231 my ($self, $filename) = @_; | |
| 232 my ($fn, $dir) = fileparse($filename); | |
| 233 error(_g('%s is not the name of a file'), $filename) unless $fn; | |
| 234 $self->{basedir} = $dir || './'; | |
| 235 $self->{filename} = $fn; | |
| 236 | |
| 237 # Read the fields | |
| 238 my $fields = Dpkg::Control->new(type => CTRL_PKG_SRC); | |
| 239 $fields->load($filename); | |
| 240 $self->{fields} = $fields; | |
| 241 $self->{is_signed} = $fields->get_option('is_pgp_signed'); | |
| 242 | |
| 243 foreach my $f (qw(Source Version Files)) { | |
| 244 unless (defined($fields->{$f})) { | |
| 245 error(_g('missing critical source control field %s'), $f); | |
| 246 } | |
| 247 } | |
| 248 | |
| 249 $self->{checksums}->add_from_control($fields, use_files_for_md5 => 1); | |
| 250 | |
| 251 $self->upgrade_object_type(0); | |
| 252 } | |
| 253 | |
| 254 sub upgrade_object_type { | |
| 255 my ($self, $update_format) = @_; | |
| 256 $update_format //= 1; | |
| 257 $self->{fields}{'Format'} = '1.0' | |
| 258 unless exists $self->{fields}{'Format'}; | |
| 259 my $format = $self->{fields}{'Format'}; | |
| 260 | |
| 261 if ($format =~ /^([\d\.]+)(?:\s+\((.*)\))?$/) { | |
| 262 my ($version, $variant, $major, $minor) = ($1, $2, $1, undef); | |
| 263 | |
| 264 if (defined $variant and $variant ne lc $variant) { | |
| 265 error(_g("source package format '%s' is not supported: %s"), | |
| 266 $format, _g('format variant must be in lowercase')); | |
| 267 } | |
| 268 | |
| 269 $major =~ s/\.[\d\.]+$//; | |
| 270 my $module = "Dpkg::Source::Package::V$major"; | |
| 271 $module .= '::' . ucfirst $variant if defined $variant; | |
| 272 eval "require $module; \$minor = \$${module}::CURRENT_MINOR_VERSION;"; | |
| 273 $minor //= 0; | |
| 274 if ($update_format) { | |
| 275 $self->{fields}{'Format'} = "$major.$minor"; | |
| 276 $self->{fields}{'Format'} .= " ($variant)" if defined $variant; | |
| 277 } | |
| 278 if ($@) { | |
| 279 error(_g("source package format '%s' is not supported: %s"), | |
| 280 $format, $@); | |
| 281 } | |
| 282 bless $self, $module; | |
| 283 } else { | |
| 284 error(_g("invalid Format field `%s'"), $format); | |
| 285 } | |
| 286 } | |
| 287 | |
| 288 =item $p->get_filename() | |
| 289 | |
| 290 Returns the filename of the DSC file. | |
| 291 | |
| 292 =cut | |
| 293 | |
| 294 sub get_filename { | |
| 295 my ($self) = @_; | |
| 296 return $self->{basedir} . $self->{filename}; | |
| 297 } | |
| 298 | |
| 299 =item $p->get_files() | |
| 300 | |
| 301 Returns the list of files referenced by the source package. The filenames | |
| 302 usually do not have any path information. | |
| 303 | |
| 304 =cut | |
| 305 | |
| 306 sub get_files { | |
| 307 my ($self) = @_; | |
| 308 return $self->{checksums}->get_files(); | |
| 309 } | |
| 310 | |
| 311 =item $p->check_checksums() | |
| 312 | |
| 313 Verify the checksums embedded in the DSC file. It requires the presence of | |
| 314 the other files constituting the source package. If any inconsistency is | |
| 315 discovered, it immediately errors out. | |
| 316 | |
| 317 =cut | |
| 318 | |
| 319 sub check_checksums { | |
| 320 my ($self) = @_; | |
| 321 my $checksums = $self->{checksums}; | |
| 322 # add_from_file verify the checksums if they are already existing | |
| 323 foreach my $file ($checksums->get_files()) { | |
| 324 $checksums->add_from_file($self->{basedir} . $file, key => $file); | |
| 325 } | |
| 326 } | |
| 327 | |
| 328 sub get_basename { | |
| 329 my ($self, $with_revision) = @_; | |
| 330 my $f = $self->{fields}; | |
| 331 unless (exists $f->{'Source'} and exists $f->{'Version'}) { | |
| 332 error(_g('source and version are required to compute the source basename
')); | |
| 333 } | |
| 334 my $v = Dpkg::Version->new($f->{'Version'}); | |
| 335 my $vs = $v->as_string(omit_epoch => 1, omit_revision => !$with_revision); | |
| 336 return $f->{'Source'} . '_' . $vs; | |
| 337 } | |
| 338 | |
| 339 sub find_original_tarballs { | |
| 340 my ($self, %opts) = @_; | |
| 341 $opts{extension} = compression_get_file_extension_regex() | |
| 342 unless exists $opts{extension}; | |
| 343 $opts{include_main} = 1 unless exists $opts{include_main}; | |
| 344 $opts{include_supplementary} = 1 unless exists $opts{include_supplementary}; | |
| 345 my $basename = $self->get_basename(); | |
| 346 my @tar; | |
| 347 foreach my $dir ('.', $self->{basedir}, $self->{options}{origtardir}) { | |
| 348 next unless defined($dir) and -d $dir; | |
| 349 opendir(my $dir_dh, $dir) or syserr(_g('cannot opendir %s'), $dir); | |
| 350 push @tar, map { "$dir/$_" } grep { | |
| 351 ($opts{include_main} and | |
| 352 /^\Q$basename\E\.orig\.tar\.$opts{extension}$/) or | |
| 353 ($opts{include_supplementary} and | |
| 354 /^\Q$basename\E\.orig-[[:alnum:]-]+\.tar\.$opts{extension}$/) | |
| 355 } readdir($dir_dh); | |
| 356 closedir($dir_dh); | |
| 357 } | |
| 358 return @tar; | |
| 359 } | |
| 360 | |
| 361 =item $bool = $p->is_signed() | |
| 362 | |
| 363 Returns 1 if the DSC files contains an embedded OpenPGP signature. | |
| 364 Otherwise returns 0. | |
| 365 | |
| 366 =cut | |
| 367 | |
| 368 sub is_signed { | |
| 369 my $self = shift; | |
| 370 return $self->{is_signed}; | |
| 371 } | |
| 372 | |
| 373 =item $p->check_signature() | |
| 374 | |
| 375 Implement the same OpenPGP signature check that dpkg-source does. | |
| 376 In case of problems, it prints a warning or errors out. | |
| 377 | |
| 378 If the object has been created with the "require_valid_signature" option, | |
| 379 then any problem will result in a fatal error. | |
| 380 | |
| 381 =cut | |
| 382 | |
| 383 sub check_signature { | |
| 384 my ($self) = @_; | |
| 385 my $dsc = $self->get_filename(); | |
| 386 my @exec; | |
| 387 | |
| 388 if (find_command('gpgv2')) { | |
| 389 push @exec, 'gpgv2'; | |
| 390 } elsif (find_command('gpgv')) { | |
| 391 push @exec, 'gpgv'; | |
| 392 } elsif (find_command('gpg2')) { | |
| 393 push @exec, 'gpg2', '--no-default-keyring', '-q', '--verify'; | |
| 394 } elsif (find_command('gpg')) { | |
| 395 push @exec, 'gpg', '--no-default-keyring', '-q', '--verify'; | |
| 396 } | |
| 397 if (scalar(@exec)) { | |
| 398 if (defined $ENV{HOME} and -r "$ENV{HOME}/.gnupg/trustedkeys.gpg") { | |
| 399 push @exec, '--keyring', "$ENV{HOME}/.gnupg/trustedkeys.gpg"; | |
| 400 } | |
| 401 foreach my $vendor_keyring (run_vendor_hook('keyrings')) { | |
| 402 if (-r $vendor_keyring) { | |
| 403 push @exec, '--keyring', $vendor_keyring; | |
| 404 } | |
| 405 } | |
| 406 push @exec, $dsc; | |
| 407 | |
| 408 my ($stdout, $stderr); | |
| 409 spawn(exec => \@exec, wait_child => 1, nocheck => 1, | |
| 410 to_string => \$stdout, error_to_string => \$stderr, | |
| 411 timeout => 10); | |
| 412 if (WIFEXITED($?)) { | |
| 413 my $gpg_status = WEXITSTATUS($?); | |
| 414 print { *STDERR } "$stdout$stderr" if $gpg_status; | |
| 415 if ($gpg_status == 1 or ($gpg_status && | |
| 416 $self->{options}{require_valid_signature})) | |
| 417 { | |
| 418 error(_g('failed to verify signature on %s'), $dsc); | |
| 419 } elsif ($gpg_status) { | |
| 420 warning(_g('failed to verify signature on %s'), $dsc); | |
| 421 } | |
| 422 } else { | |
| 423 subprocerr("@exec"); | |
| 424 } | |
| 425 } else { | |
| 426 if ($self->{options}{require_valid_signature}) { | |
| 427 error(_g("could not verify signature on %s since gpg isn't installed
"), $dsc); | |
| 428 } else { | |
| 429 warning(_g("could not verify signature on %s since gpg isn't install
ed"), $dsc); | |
| 430 } | |
| 431 } | |
| 432 } | |
| 433 | |
| 434 sub parse_cmdline_options { | |
| 435 my ($self, @opts) = @_; | |
| 436 foreach (@opts) { | |
| 437 if (not $self->parse_cmdline_option($_)) { | |
| 438 warning(_g('%s is not a valid option for %s'), $_, ref($self)); | |
| 439 } | |
| 440 } | |
| 441 } | |
| 442 | |
| 443 sub parse_cmdline_option { | |
| 444 return 0; | |
| 445 } | |
| 446 | |
| 447 =item $p->extract($targetdir) | |
| 448 | |
| 449 Extracts the source package in the target directory $targetdir. Beware | |
| 450 that if $targetdir already exists, it will be erased. | |
| 451 | |
| 452 =cut | |
| 453 | |
| 454 sub extract { | |
| 455 my $self = shift; | |
| 456 my $newdirectory = $_[0]; | |
| 457 | |
| 458 my ($ok, $error) = version_check($self->{fields}{'Version'}); | |
| 459 error($error) unless $ok; | |
| 460 | |
| 461 # Copy orig tarballs | |
| 462 if ($self->{options}{copy_orig_tarballs}) { | |
| 463 my $basename = $self->get_basename(); | |
| 464 my ($dirname, $destdir) = fileparse($newdirectory); | |
| 465 $destdir ||= './'; | |
| 466 my $ext = compression_get_file_extension_regex(); | |
| 467 foreach my $orig (grep { /^\Q$basename\E\.orig(-[[:alnum:]-]+)?\.tar\.$e
xt$/ } | |
| 468 $self->get_files()) | |
| 469 { | |
| 470 my $src = File::Spec->catfile($self->{basedir}, $orig); | |
| 471 my $dst = File::Spec->catfile($destdir, $orig); | |
| 472 if (not check_files_are_the_same($src, $dst, 1)) { | |
| 473 system('cp', '--', $src, $dst); | |
| 474 subprocerr("cp $src to $dst") if $?; | |
| 475 } | |
| 476 } | |
| 477 } | |
| 478 | |
| 479 # Try extract | |
| 480 eval { $self->do_extract(@_) }; | |
| 481 if ($@) { | |
| 482 run_exit_handlers(); | |
| 483 die $@; | |
| 484 } | |
| 485 | |
| 486 # Store format if non-standard so that next build keeps the same format | |
| 487 if ($self->{fields}{'Format'} ne '1.0' and | |
| 488 not $self->{options}{skip_debianization}) | |
| 489 { | |
| 490 my $srcdir = File::Spec->catdir($newdirectory, 'debian', 'source'); | |
| 491 my $format_file = File::Spec->catfile($srcdir, 'format'); | |
| 492 unless (-e $format_file) { | |
| 493 mkdir($srcdir) unless -e $srcdir; | |
| 494 open(my $format_fh, '>', $format_file) | |
| 495 or syserr(_g('cannot write %s'), $format_file); | |
| 496 print { $format_fh } $self->{fields}{'Format'} . "\n"; | |
| 497 close($format_fh); | |
| 498 } | |
| 499 } | |
| 500 | |
| 501 # Make sure debian/rules is executable | |
| 502 my $rules = File::Spec->catfile($newdirectory, 'debian', 'rules'); | |
| 503 my @s = lstat($rules); | |
| 504 if (not scalar(@s)) { | |
| 505 unless ($! == ENOENT) { | |
| 506 syserr(_g('cannot stat %s'), $rules); | |
| 507 } | |
| 508 warning(_g('%s does not exist'), $rules) | |
| 509 unless $self->{options}{skip_debianization}; | |
| 510 } elsif (-f _) { | |
| 511 chmod($s[2] | 0111, $rules) | |
| 512 or syserr(_g('cannot make %s executable'), $rules); | |
| 513 } else { | |
| 514 warning(_g('%s is not a plain file'), $rules); | |
| 515 } | |
| 516 } | |
| 517 | |
| 518 sub do_extract { | |
| 519 croak 'Dpkg::Source::Package does not know how to unpack a ' . | |
| 520 'source package; use one of the subclasses'; | |
| 521 } | |
| 522 | |
| 523 # Function used specifically during creation of a source package | |
| 524 | |
| 525 sub before_build { | |
| 526 my ($self, $dir) = @_; | |
| 527 } | |
| 528 | |
| 529 sub build { | |
| 530 my $self = shift; | |
| 531 eval { $self->do_build(@_) }; | |
| 532 if ($@) { | |
| 533 run_exit_handlers(); | |
| 534 die $@; | |
| 535 } | |
| 536 } | |
| 537 | |
| 538 sub after_build { | |
| 539 my ($self, $dir) = @_; | |
| 540 } | |
| 541 | |
| 542 sub do_build { | |
| 543 croak 'Dpkg::Source::Package does not know how to build a ' . | |
| 544 'source package; use one of the subclasses'; | |
| 545 } | |
| 546 | |
| 547 sub can_build { | |
| 548 my ($self, $dir) = @_; | |
| 549 return (0, 'can_build() has not been overriden'); | |
| 550 } | |
| 551 | |
| 552 sub add_file { | |
| 553 my ($self, $filename) = @_; | |
| 554 my ($fn, $dir) = fileparse($filename); | |
| 555 if ($self->{checksums}->has_file($fn)) { | |
| 556 croak "tried to add file '$fn' twice"; | |
| 557 } | |
| 558 $self->{checksums}->add_from_file($filename, key => $fn); | |
| 559 $self->{checksums}->export_to_control($self->{fields}, | |
| 560 use_files_for_md5 => 1); | |
| 561 } | |
| 562 | |
| 563 sub commit { | |
| 564 my $self = shift; | |
| 565 eval { $self->do_commit(@_) }; | |
| 566 if ($@) { | |
| 567 run_exit_handlers(); | |
| 568 die $@; | |
| 569 } | |
| 570 } | |
| 571 | |
| 572 sub do_commit { | |
| 573 my ($self, $dir) = @_; | |
| 574 info(_g("'%s' is not supported by the source format '%s'"), | |
| 575 'dpkg-source --commit', $self->{fields}{'Format'}); | |
| 576 } | |
| 577 | |
| 578 sub write_dsc { | |
| 579 my ($self, %opts) = @_; | |
| 580 my $fields = $self->{fields}; | |
| 581 | |
| 582 foreach my $f (keys %{$opts{override}}) { | |
| 583 $fields->{$f} = $opts{override}{$f}; | |
| 584 } | |
| 585 | |
| 586 unless($opts{nocheck}) { | |
| 587 foreach my $f (qw(Source Version)) { | |
| 588 unless (defined($fields->{$f})) { | |
| 589 error(_g('missing information for critical output field %s'), $f
); | |
| 590 } | |
| 591 } | |
| 592 foreach my $f (qw(Maintainer Architecture Standards-Version)) { | |
| 593 unless (defined($fields->{$f})) { | |
| 594 warning(_g('missing information for output field %s'), $f); | |
| 595 } | |
| 596 } | |
| 597 } | |
| 598 | |
| 599 foreach my $f (keys %{$opts{remove}}) { | |
| 600 delete $fields->{$f}; | |
| 601 } | |
| 602 | |
| 603 my $filename = $opts{filename}; | |
| 604 unless (defined $filename) { | |
| 605 $filename = $self->get_basename(1) . '.dsc'; | |
| 606 } | |
| 607 open(my $dsc_fh, '>', $filename) | |
| 608 or syserr(_g('cannot write %s'), $filename); | |
| 609 $fields->apply_substvars($opts{substvars}); | |
| 610 $fields->output($dsc_fh); | |
| 611 close($dsc_fh); | |
| 612 } | |
| 613 | |
| 614 =back | |
| 615 | |
| 616 =head1 CHANGES | |
| 617 | |
| 618 =head2 Version 1.01 | |
| 619 | |
| 620 New functions: get_default_diff_ignore_regex(), set_default_diff_ignore_regex(), | |
| 621 get_default_tar_ignore_pattern() | |
| 622 | |
| 623 Deprecated variables: $diff_ignore_default_regexp, @tar_ignore_default_pattern | |
| 624 | |
| 625 =head1 AUTHOR | |
| 626 | |
| 627 Raphaël Hertzog, E<lt>hertzog@debian.orgE<gt> | |
| 628 | |
| 629 =cut | |
| 630 | |
| 631 1; | |
| OLD | NEW |
|---|
Chromium Code Reviews
Issue 2425693003:
Revert of Linux build: Use sysroot when calculating dependencies (Closed)
