chiark - git - mdw - dpkg/blob - scripts/Dpkg/Control/FieldsCore.pm

   1 # Copyright © 2007-2009 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::Control::FieldsCore;
  17
  18 use strict;
  19 use warnings;
  20
  21 our $VERSION = '1.00';
  22 our @EXPORT = qw(
  23     field_capitalize
  24     field_is_official
  25     field_is_allowed_in
  26     field_transfer_single
  27     field_transfer_all
  28     field_list_src_dep
  29     field_list_pkg_dep
  30     field_get_dep_type
  31     field_get_sep_type
  32     field_ordered_list
  33     field_register
  34     field_insert_after
  35     field_insert_before
  36     FIELD_SEP_UNKNOWN
  37     FIELD_SEP_SPACE
  38     FIELD_SEP_COMMA
  39     FIELD_SEP_LINE
  40 );
  41
  42 use Exporter qw(import);
  43
  44 use Dpkg::Gettext;
  45 use Dpkg::ErrorHandling;
  46 use Dpkg::Control::Types;
  47 use Dpkg::Checksums;
  48
  49 use constant {
  50     ALL_PKG => CTRL_INFO_PKG | CTRL_INDEX_PKG | CTRL_PKG_DEB | CTRL_FILE_STATUS,
  51     ALL_SRC => CTRL_INFO_SRC | CTRL_INDEX_SRC | CTRL_PKG_SRC,
  52     ALL_CHANGES => CTRL_FILE_CHANGES | CTRL_CHANGELOG,
  53     ALL_COPYRIGHT => CTRL_COPYRIGHT_HEADER | CTRL_COPYRIGHT_FILES | CTRL_COPYRIGHT_LICENSE,
  54 };
  55
  56 use constant {
  57     FIELD_SEP_UNKNOWN => 0,
  58     FIELD_SEP_SPACE => 1,
  59     FIELD_SEP_COMMA => 2,
  60     FIELD_SEP_LINE => 4,
  61 };
  62
  63 # The canonical list of fields
  64
  65 # Note that fields used only in dpkg's available file are not listed
  66 # Deprecated fields of dpkg's status file are also not listed
  67 our %FIELDS = (
  68     'Architecture' => {
  69         allowed => (ALL_PKG | ALL_SRC | CTRL_FILE_BUILDINFO | CTRL_FILE_CHANGES) & (~CTRL_INFO_SRC),
  70         separator => FIELD_SEP_SPACE,
  71     },
  72     'Architectures' => {
  73         allowed => CTRL_REPO_RELEASE,
  74         separator => FIELD_SEP_SPACE,
  75     },
  76     'Auto-Built-Package' => {
  77         allowed => ALL_PKG & ~CTRL_INFO_PKG,
  78         separator => FIELD_SEP_SPACE,
  79     },
  80     'Binary' => {
  81         allowed => CTRL_PKG_SRC | CTRL_FILE_BUILDINFO | CTRL_FILE_CHANGES,
  82         # XXX: This field values are separated either by space or comma
  83         # depending on the context.
  84         separator => FIELD_SEP_SPACE | FIELD_SEP_COMMA,
  85     },
  86     'Binary-Only' => {
  87         allowed => ALL_CHANGES,
  88     },
  89     'Binary-Only-Changes' => {
  90         allowed => CTRL_FILE_BUILDINFO,
  91     },
  92     'Breaks' => {
  93         allowed => ALL_PKG,
  94         separator => FIELD_SEP_COMMA,
  95         dependency => 'union',
  96         dep_order => 7,
  97     },
  98     'Bugs' => {
  99         allowed => (ALL_PKG | CTRL_INFO_SRC | CTRL_FILE_VENDOR) & (~CTRL_INFO_PKG),
 100     },
 101     'Build-Architecture' => {
 102         allowed => CTRL_FILE_BUILDINFO,
 103     },
 104     'Build-Conflicts' => {
 105         allowed => ALL_SRC,
 106         separator => FIELD_SEP_COMMA,
 107         dependency => 'union',
 108         dep_order => 4,
 109     },
 110     'Build-Conflicts-Arch' => {
 111         allowed => ALL_SRC,
 112         separator => FIELD_SEP_COMMA,
 113         dependency => 'union',
 114         dep_order => 5,
 115     },
 116     'Build-Conflicts-Indep' => {
 117         allowed => ALL_SRC,
 118         separator => FIELD_SEP_COMMA,
 119         dependency => 'union',
 120         dep_order => 6,
 121     },
 122     'Build-Date' => {
 123         allowed => CTRL_FILE_BUILDINFO,
 124     },
 125     'Build-Depends' => {
 126         allowed => ALL_SRC,
 127         separator => FIELD_SEP_COMMA,
 128         dependency => 'normal',
 129         dep_order => 1,
 130     },
 131     'Build-Depends-Arch' => {
 132         allowed => ALL_SRC,
 133         separator => FIELD_SEP_COMMA,
 134         dependency => 'normal',
 135         dep_order => 2,
 136     },
 137     'Build-Depends-Indep' => {
 138         allowed => ALL_SRC,
 139         separator => FIELD_SEP_COMMA,
 140         dependency => 'normal',
 141         dep_order => 3,
 142     },
 143     'Build-Essential' => {
 144         allowed => ALL_PKG,
 145     },
 146     'Build-Origin' => {
 147         allowed => CTRL_FILE_BUILDINFO,
 148     },
 149     'Build-Path' => {
 150         allowed => CTRL_FILE_BUILDINFO,
 151     },
 152     'Build-Profiles' => {
 153         allowed => CTRL_INFO_PKG,
 154         separator => FIELD_SEP_SPACE,
 155     },
 156     'Built-For-Profiles' => {
 157         allowed => ALL_PKG | CTRL_FILE_CHANGES,
 158         separator => FIELD_SEP_SPACE,
 159     },
 160     'Built-Using' => {
 161         allowed => ALL_PKG,
 162         separator => FIELD_SEP_COMMA,
 163         dependency => 'union',
 164         dep_order => 10,
 165     },
 166     'Changed-By' => {
 167         allowed => CTRL_FILE_CHANGES,
 168     },
 169     'Changelogs' => {
 170         allowed => CTRL_REPO_RELEASE,
 171     },
 172     'Changes' => {
 173         allowed => ALL_CHANGES,
 174     },
 175     'Classes' => {
 176         allowed => CTRL_TESTS,
 177         separator => FIELD_SEP_COMMA,
 178     },
 179     'Closes' => {
 180         allowed => ALL_CHANGES,
 181         separator => FIELD_SEP_SPACE,
 182     },
 183     'Codename' => {
 184         allowed => CTRL_REPO_RELEASE,
 185     },
 186     'Comment' => {
 187         allowed => ALL_COPYRIGHT,
 188     },
 189     'Components' => {
 190         allowed => CTRL_REPO_RELEASE,
 191         separator => FIELD_SEP_SPACE,
 192     },
 193     'Conffiles' => {
 194         allowed => CTRL_FILE_STATUS,
 195         separator => FIELD_SEP_LINE | FIELD_SEP_SPACE,
 196     },
 197     'Config-Version' => {
 198         allowed => CTRL_FILE_STATUS,
 199     },
 200     'Conflicts' => {
 201         allowed => ALL_PKG,
 202         separator => FIELD_SEP_COMMA,
 203         dependency => 'union',
 204         dep_order => 6,
 205     },
 206     'Copyright' => {
 207         allowed => CTRL_COPYRIGHT_HEADER | CTRL_COPYRIGHT_FILES,
 208     },
 209     'Date' => {
 210         allowed => ALL_CHANGES | CTRL_REPO_RELEASE,
 211     },
 212     'Depends' => {
 213         allowed => ALL_PKG | CTRL_TESTS,
 214         separator => FIELD_SEP_COMMA,
 215         dependency => 'normal',
 216         dep_order => 2,
 217     },
 218     'Description' => {
 219         allowed => ALL_PKG | CTRL_FILE_CHANGES | CTRL_REPO_RELEASE,
 220     },
 221     'Disclaimer' => {
 222         allowed => CTRL_COPYRIGHT_HEADER,
 223     },
 224     'Directory' => {
 225         allowed => CTRL_INDEX_SRC,
 226     },
 227     'Distribution' => {
 228         allowed => ALL_CHANGES,
 229     },
 230     'Enhances' => {
 231         allowed => ALL_PKG,
 232         separator => FIELD_SEP_COMMA,
 233         dependency => 'union',
 234         dep_order => 5,
 235     },
 236     'Environment' => {
 237         allowed => CTRL_FILE_BUILDINFO,
 238         separator => FIELD_SEP_LINE,
 239     },
 240     'Essential' => {
 241         allowed => ALL_PKG,
 242     },
 243     'Features' => {
 244         allowed => CTRL_TESTS,
 245         separator => FIELD_SEP_SPACE,
 246     },
 247     'Filename' => {
 248         allowed => CTRL_INDEX_PKG,
 249         separator => FIELD_SEP_LINE | FIELD_SEP_SPACE,
 250     },
 251     'Files' => {
 252         allowed => CTRL_PKG_SRC | CTRL_FILE_CHANGES | CTRL_COPYRIGHT_FILES,
 253         separator => FIELD_SEP_LINE | FIELD_SEP_SPACE,
 254     },
 255     'Format' => {
 256         allowed => CTRL_PKG_SRC | CTRL_FILE_CHANGES | CTRL_COPYRIGHT_HEADER | CTRL_FILE_BUILDINFO,
 257     },
 258     'Homepage' => {
 259         allowed => ALL_SRC | ALL_PKG,
 260     },
 261     'Installed-Build-Depends' => {
 262         allowed => CTRL_FILE_BUILDINFO,
 263         separator => FIELD_SEP_COMMA,
 264         dependency => 'union',
 265         dep_order => 11,
 266     },
 267     'Installed-Size' => {
 268         allowed => ALL_PKG & ~CTRL_INFO_PKG,
 269     },
 270     'Installer-Menu-Item' => {
 271         allowed => ALL_PKG,
 272     },
 273     'Kernel-Version' => {
 274         allowed => ALL_PKG,
 275     },
 276     'Label' => {
 277         allowed => CTRL_REPO_RELEASE,
 278     },
 279     'License' => {
 280         allowed => ALL_COPYRIGHT,
 281     },
 282     'Origin' => {
 283         allowed => (ALL_PKG | ALL_SRC | CTRL_REPO_RELEASE) & (~CTRL_INFO_PKG),
 284     },
 285     'Maintainer' => {
 286         allowed => CTRL_PKG_DEB| CTRL_FILE_STATUS | ALL_SRC  | ALL_CHANGES,
 287     },
 288     'Multi-Arch' => {
 289         allowed => ALL_PKG,
 290     },
 291     'Package' => {
 292         allowed => ALL_PKG,
 293     },
 294     'Package-List' => {
 295         allowed => ALL_SRC & ~CTRL_INFO_SRC,
 296         separator => FIELD_SEP_LINE | FIELD_SEP_SPACE,
 297     },
 298     'Package-Type' => {
 299         allowed => ALL_PKG,
 300     },
 301     'Parent' => {
 302         allowed => CTRL_FILE_VENDOR,
 303     },
 304     'Pre-Depends' => {
 305         allowed => ALL_PKG,
 306         separator => FIELD_SEP_COMMA,
 307         dependency => 'normal',
 308         dep_order => 1,
 309     },
 310     'Priority' => {
 311         allowed => CTRL_INFO_SRC | CTRL_INDEX_SRC | ALL_PKG,
 312     },
 313     'Provides' => {
 314         allowed => ALL_PKG,
 315         separator => FIELD_SEP_COMMA,
 316         dependency => 'union',
 317         dep_order => 9,
 318     },
 319     'Recommends' => {
 320         allowed => ALL_PKG,
 321         separator => FIELD_SEP_COMMA,
 322         dependency => 'normal',
 323         dep_order => 3,
 324     },
 325     'Replaces' => {
 326         allowed => ALL_PKG,
 327         separator => FIELD_SEP_COMMA,
 328         dependency => 'union',
 329         dep_order => 8,
 330     },
 331     'Restrictions' => {
 332         allowed => CTRL_TESTS,
 333         separator => FIELD_SEP_SPACE,
 334     },
 335     'Section' => {
 336         allowed => CTRL_INFO_SRC | CTRL_INDEX_SRC | ALL_PKG,
 337     },
 338     'Size' => {
 339         allowed => CTRL_INDEX_PKG,
 340         separator => FIELD_SEP_LINE | FIELD_SEP_SPACE,
 341     },
 342     'Source' => {
 343         allowed => (ALL_PKG | ALL_SRC | ALL_CHANGES | CTRL_COPYRIGHT_HEADER | CTRL_FILE_BUILDINFO) &
 344                    (~(CTRL_INDEX_SRC | CTRL_INFO_PKG)),
 345     },
 346     'Standards-Version' => {
 347         allowed => ALL_SRC,
 348     },
 349     'Status' => {
 350         allowed => CTRL_FILE_STATUS,
 351         separator => FIELD_SEP_SPACE,
 352     },
 353     'Subarchitecture' => {
 354         allowed => ALL_PKG,
 355     },
 356     'Suite' => {
 357         allowed => CTRL_REPO_RELEASE,
 358     },
 359     'Suggests' => {
 360         allowed => ALL_PKG,
 361         separator => FIELD_SEP_COMMA,
 362         dependency => 'normal',
 363         dep_order => 4,
 364     },
 365     'Tag' => {
 366         allowed => ALL_PKG,
 367         separator => FIELD_SEP_COMMA,
 368     },
 369     'Task' => {
 370         allowed => ALL_PKG,
 371     },
 372     'Test-Command' => {
 373         allowed => CTRL_TESTS,
 374     },
 375     'Tests' => {
 376         allowed => CTRL_TESTS,
 377         separator => FIELD_SEP_SPACE,
 378     },
 379     'Tests-Directory' => {
 380         allowed => CTRL_TESTS,
 381     },
 382     'Testsuite' => {
 383         allowed => ALL_SRC,
 384         separator => FIELD_SEP_COMMA,
 385     },
 386     'Testsuite-Triggers' => {
 387         allowed => ALL_SRC,
 388         separator => FIELD_SEP_COMMA,
 389     },
 390     'Timestamp' => {
 391         allowed => CTRL_CHANGELOG,
 392     },
 393     'Triggers-Awaited' => {
 394         allowed => CTRL_FILE_STATUS,
 395         separator => FIELD_SEP_SPACE,
 396     },
 397     'Triggers-Pending' => {
 398         allowed => CTRL_FILE_STATUS,
 399         separator => FIELD_SEP_SPACE,
 400     },
 401     'Uploaders' => {
 402         allowed => ALL_SRC,
 403         separator => FIELD_SEP_COMMA,
 404     },
 405     'Upstream-Name' => {
 406         allowed => CTRL_COPYRIGHT_HEADER,
 407     },
 408     'Upstream-Contact' => {
 409         allowed => CTRL_COPYRIGHT_HEADER,
 410     },
 411     'Urgency' => {
 412         allowed => ALL_CHANGES,
 413     },
 414     'Valid-Until' => {
 415         allowed => CTRL_REPO_RELEASE,
 416     },
 417     'Vcs-Browser' => {
 418         allowed => ALL_SRC,
 419     },
 420     'Vcs-Arch' => {
 421         allowed => ALL_SRC,
 422     },
 423     'Vcs-Bzr' => {
 424         allowed => ALL_SRC,
 425     },
 426     'Vcs-Cvs' => {
 427         allowed => ALL_SRC,
 428     },
 429     'Vcs-Darcs' => {
 430         allowed => ALL_SRC,
 431     },
 432     'Vcs-Git' => {
 433         allowed => ALL_SRC,
 434     },
 435     'Vcs-Hg' => {
 436         allowed => ALL_SRC,
 437     },
 438     'Vcs-Mtn' => {
 439         allowed => ALL_SRC,
 440     },
 441     'Vcs-Svn' => {
 442         allowed => ALL_SRC,
 443     },
 444     'Vendor' => {
 445         allowed => CTRL_FILE_VENDOR,
 446     },
 447     'Vendor-Url' => {
 448         allowed => CTRL_FILE_VENDOR,
 449     },
 450     'Version' => {
 451         allowed => (ALL_PKG | ALL_SRC | CTRL_FILE_BUILDINFO | ALL_CHANGES) &
 452                     (~(CTRL_INFO_SRC | CTRL_INFO_PKG)),
 453     },
 454 );
 455
 456 my @checksum_fields = map { &field_capitalize("Checksums-$_") } checksums_get_list();
 457 my @sum_fields = map { $_ eq 'md5' ? 'MD5sum' : &field_capitalize($_) }
 458                  checksums_get_list();
 459 &field_register($_, CTRL_PKG_SRC | CTRL_FILE_CHANGES | CTRL_FILE_BUILDINFO) foreach @checksum_fields;
 460 &field_register($_, CTRL_INDEX_PKG | CTRL_REPO_RELEASE,
 461                 separator => FIELD_SEP_LINE | FIELD_SEP_SPACE) foreach @sum_fields;
 462
 463 our %FIELD_ORDER = (
 464     CTRL_PKG_DEB() => [
 465         qw(Package Package-Type Source Version Built-Using Kernel-Version
 466         Built-For-Profiles Auto-Built-Package Architecture Subarchitecture
 467         Installer-Menu-Item Essential Origin Bugs
 468         Maintainer Installed-Size), &field_list_pkg_dep(),
 469         qw(Section Priority Multi-Arch Homepage Description Tag Task)
 470     ],
 471     CTRL_PKG_SRC() => [
 472         qw(Format Source Binary Architecture Version Origin Maintainer
 473         Uploaders Homepage Standards-Version Vcs-Browser
 474         Vcs-Arch Vcs-Bzr Vcs-Cvs Vcs-Darcs Vcs-Git Vcs-Hg Vcs-Mtn
 475         Vcs-Svn Testsuite Testsuite-Triggers), &field_list_src_dep(),
 476         qw(Package-List), @checksum_fields, qw(Files)
 477     ],
 478     CTRL_FILE_BUILDINFO() => [
 479         qw(Format Source Binary Architecture Version
 480         Binary-Only-Changes),
 481         @checksum_fields,
 482         qw(Build-Origin Build-Architecture Build-Date Build-Path
 483            Installed-Build-Depends Environment),
 484     ],
 485     CTRL_FILE_CHANGES() => [
 486         qw(Format Date Source Binary Binary-Only Built-For-Profiles Architecture
 487         Version Distribution Urgency Maintainer Changed-By Description
 488         Closes Changes),
 489         @checksum_fields, qw(Files)
 490     ],
 491     CTRL_CHANGELOG() => [
 492         qw(Source Binary-Only Version Distribution Urgency Maintainer
 493         Timestamp Date Closes Changes)
 494     ],
 495     CTRL_FILE_STATUS() => [ # Same as fieldinfos in lib/dpkg/parse.c
 496         qw(Package Essential Status Priority Section Installed-Size Origin
 497         Maintainer Bugs Architecture Multi-Arch Source Version Config-Version
 498         Replaces Provides Depends Pre-Depends Recommends Suggests Breaks
 499         Conflicts Enhances Conffiles Description Triggers-Pending
 500         Triggers-Awaited)
 501     ],
 502     CTRL_REPO_RELEASE() => [
 503         qw(Origin Label Suite Codename Changelogs Date Valid-Until
 504         Architectures Components Description), @sum_fields
 505     ],
 506     CTRL_COPYRIGHT_HEADER() => [
 507         qw(Format Upstream-Name Upstream-Contact Source Disclaimer Comment
 508         License Copyright)
 509     ],
 510     CTRL_COPYRIGHT_FILES() => [
 511         qw(Files Copyright License Comment)
 512     ],
 513     CTRL_COPYRIGHT_LICENSE() => [
 514         qw(License Comment)
 515     ],
 516 );
 517 # Order for CTRL_INDEX_PKG is derived from CTRL_PKG_DEB
 518 $FIELD_ORDER{CTRL_INDEX_PKG()} = [ @{$FIELD_ORDER{CTRL_PKG_DEB()}} ];
 519 &field_insert_before(CTRL_INDEX_PKG, 'Section', 'Filename', 'Size', @sum_fields);
 520 # Order for CTRL_INDEX_SRC is derived from CTRL_PKG_SRC
 521 $FIELD_ORDER{CTRL_INDEX_SRC()} = [ @{$FIELD_ORDER{CTRL_PKG_SRC()}} ];
 522 @{$FIELD_ORDER{CTRL_INDEX_SRC()}} = map { $_ eq 'Source' ? 'Package' : $_ }
 523                                   @{$FIELD_ORDER{CTRL_PKG_SRC()}};
 524 &field_insert_after(CTRL_INDEX_SRC, 'Version', 'Priority', 'Section');
 525 &field_insert_before(CTRL_INDEX_SRC, 'Checksums-Md5', 'Directory');
 526
 527 =encoding utf8
 528
 529 =head1 NAME
 530
 531 Dpkg::Control::FieldsCore - manage (list of official) control fields
 532
 533 =head1 DESCRIPTION
 534
 535 The modules contains a list of fieldnames with associated meta-data explaining
 536 in which type of control information they are allowed. The types are the
 537 CTRL_* constants exported by Dpkg::Control.
 538
 539 =head1 FUNCTIONS
 540
 541 =over 4
 542
 543 =item $f = field_capitalize($field_name)
 544
 545 Returns the field name properly capitalized. All characters are lowercase,
 546 except the first of each word (words are separated by a hyphen in field names).
 547
 548 =cut
 549
 550 sub field_capitalize($) {
 551     my $field = lc(shift);
 552     # Some special cases due to history
 553     return 'MD5sum' if $field eq 'md5sum';
 554     return uc($field) if checksums_is_supported($field);
 555     # Generic case
 556     return join '-', map { ucfirst } split /-/, $field;
 557 }
 558
 559 =item field_is_official($fname)
 560
 561 Returns true if the field is official and known.
 562
 563 =cut
 564
 565 sub field_is_official($) {
 566     my $field = field_capitalize(shift);
 567
 568     return exists $FIELDS{$field};
 569 }
 570
 571 =item field_is_allowed_in($fname, @types)
 572
 573 Returns true (1) if the field $fname is allowed in all the types listed in
 574 the list. Note that you can use type sets instead of individual types (ex:
 575 CTRL_FILE_CHANGES | CTRL_CHANGELOG).
 576
 577 field_allowed_in(A|B, C) returns true only if the field is allowed in C
 578 and either A or B.
 579
 580 Undef is returned for non-official fields.
 581
 582 =cut
 583
 584 sub field_is_allowed_in($@) {
 585     my ($field, @types) = @_;
 586     $field = field_capitalize($field);
 587     return unless field_is_official($field);
 588
 589     return 0 if not scalar(@types);
 590     foreach my $type (@types) {
 591         next if $type == CTRL_UNKNOWN; # Always allowed
 592         return 0 unless $FIELDS{$field}{allowed} & $type;
 593     }
 594     return 1;
 595 }
 596
 597 =item field_transfer_single($from, $to, $field)
 598
 599 If appropriate, copy the value of the field named $field taken from the
 600 $from Dpkg::Control object to the $to Dpkg::Control object.
 601
 602 Official fields are copied only if the field is allowed in both types of
 603 objects. Custom fields are treated in a specific manner. When the target
 604 is not among CTRL_PKG_SRC, CTRL_PKG_DEB or CTRL_FILE_CHANGES, then they
 605 are always copied as is (the X- prefix is kept). Otherwise they are not
 606 copied except if the target object matches the target destination encoded
 607 in the field name. The initial X denoting custom fields can be followed by
 608 one or more letters among "S" (Source: corresponds to CTRL_PKG_SRC), "B"
 609 (Binary: corresponds to CTRL_PKG_DEB) or "C" (Changes: corresponds to
 610 CTRL_FILE_CHANGES).
 611
 612 Returns undef if nothing has been copied or the name of the new field
 613 added to $to otherwise.
 614
 615 =cut
 616
 617 sub field_transfer_single($$;$) {
 618     my ($from, $to, $field) = @_;
 619     $field //= $_;
 620     my ($from_type, $to_type) = ($from->get_type(), $to->get_type());
 621     $field = field_capitalize($field);
 622
 623     if (field_is_allowed_in($field, $from_type, $to_type)) {
 624         $to->{$field} = $from->{$field};
 625         return $field;
 626     } elsif ($field =~ /^X([SBC]*)-/i) {
 627         my $dest = $1;
 628         if (($dest =~ /B/i and $to_type == CTRL_PKG_DEB) or
 629             ($dest =~ /S/i and $to_type == CTRL_PKG_SRC) or
 630             ($dest =~ /C/i and $to_type == CTRL_FILE_CHANGES))
 631         {
 632             my $new = $field;
 633             $new =~ s/^X([SBC]*)-//i;
 634             $to->{$new} = $from->{$field};
 635             return $new;
 636         } elsif ($to_type != CTRL_PKG_DEB and
 637                  $to_type != CTRL_PKG_SRC and
 638                  $to_type != CTRL_FILE_CHANGES)
 639         {
 640             $to->{$field} = $from->{$field};
 641             return $field;
 642         }
 643     } elsif (not field_is_allowed_in($field, $from_type)) {
 644         warning(g_("unknown information field '%s' in input data in %s"),
 645                 $field, $from->get_option('name') || g_('control information'));
 646     }
 647     return;
 648 }
 649
 650 =item field_transfer_all($from, $to)
 651
 652 Transfer all appropriate fields from $from to $to. Calls
 653 field_transfer_single() on all fields available in $from.
 654
 655 Returns the list of fields that have been added to $to.
 656
 657 =cut
 658
 659 sub field_transfer_all($$) {
 660     my ($from, $to) = @_;
 661     my (@res, $res);
 662     foreach my $k (keys %$from) {
 663         $res = field_transfer_single($from, $to, $k);
 664         push @res, $res if $res and defined wantarray;
 665     }
 666     return @res;
 667 }
 668
 669 =item field_ordered_list($type)
 670
 671 Returns an ordered list of fields for a given type of control information.
 672 This list can be used to output the fields in a predictable order.
 673 The list might be empty for types where the order does not matter much.
 674
 675 =cut
 676
 677 sub field_ordered_list($) {
 678     my $type = shift;
 679     return @{$FIELD_ORDER{$type}} if exists $FIELD_ORDER{$type};
 680     return ();
 681 }
 682
 683 =item field_list_src_dep()
 684
 685 List of fields that contains dependencies-like information in a source
 686 Debian package.
 687
 688 =cut
 689
 690 sub field_list_src_dep() {
 691     my @list = sort {
 692         $FIELDS{$a}{dep_order} <=> $FIELDS{$b}{dep_order}
 693     } grep {
 694         field_is_allowed_in($_, CTRL_PKG_SRC) and
 695         exists $FIELDS{$_}{dependency}
 696     } keys %FIELDS;
 697     return @list;
 698 }
 699
 700 =item field_list_pkg_dep()
 701
 702 List of fields that contains dependencies-like information in a binary
 703 Debian package. The fields that express real dependencies are sorted from
 704 the stronger to the weaker.
 705
 706 =cut
 707
 708 sub field_list_pkg_dep() {
 709     my @keys = keys %FIELDS;
 710     my @list = sort {
 711         $FIELDS{$a}{dep_order} <=> $FIELDS{$b}{dep_order}
 712     } grep {
 713         field_is_allowed_in($_, CTRL_PKG_DEB) and
 714         exists $FIELDS{$_}{dependency}
 715     } @keys;
 716     return @list;
 717 }
 718
 719 =item field_get_dep_type($field)
 720
 721 Return the type of the dependency expressed by the given field. Can
 722 either be "normal" for a real dependency field (Pre-Depends, Depends, ...)
 723 or "union" for other relation fields sharing the same syntax (Conflicts,
 724 Breaks, ...). Returns undef for fields which are not dependencies.
 725
 726 =cut
 727
 728 sub field_get_dep_type($) {
 729     my $field = field_capitalize(shift);
 730
 731     return unless field_is_official($field);
 732     return $FIELDS{$field}{dependency} if exists $FIELDS{$field}{dependency};
 733     return;
 734 }
 735
 736 =item field_get_sep_type($field)
 737
 738 Return the type of the field value separator. Can be one of FIELD_SEP_UNKNOWN,
 739 FIELD_SEP_SPACE, FIELD_SEP_COMMA or FIELD_SEP_LINE.
 740
 741 =cut
 742
 743 sub field_get_sep_type($) {
 744     my $field = field_capitalize(shift);
 745
 746     return $FIELDS{$field}{separator} if exists $FIELDS{$field}{separator};
 747     return FIELD_SEP_UNKNOWN;
 748 }
 749
 750 =item field_register($field, $allowed_types, %opts)
 751
 752 Register a new field as being allowed in control information of specified
 753 types. %opts is optional
 754
 755 =cut
 756
 757 sub field_register($$;@) {
 758     my ($field, $types, %opts) = @_;
 759     $field = field_capitalize($field);
 760     $FIELDS{$field} = {
 761         allowed => $types,
 762         %opts
 763     };
 764 }
 765
 766 =item field_insert_after($type, $ref, @fields)
 767
 768 Place field after another one ($ref) in output of control information of
 769 type $type.
 770
 771 =cut
 772 sub field_insert_after($$@) {
 773     my ($type, $field, @fields) = @_;
 774     return 0 if not exists $FIELD_ORDER{$type};
 775     ($field, @fields) = map { field_capitalize($_) } ($field, @fields);
 776     @{$FIELD_ORDER{$type}} = map {
 777         ($_ eq $field) ? ($_, @fields) : $_
 778     } @{$FIELD_ORDER{$type}};
 779     return 1;
 780 }
 781
 782 =item field_insert_before($type, $ref, @fields)
 783
 784 Place field before another one ($ref) in output of control information of
 785 type $type.
 786
 787 =cut
 788 sub field_insert_before($$@) {
 789     my ($type, $field, @fields) = @_;
 790     return 0 if not exists $FIELD_ORDER{$type};
 791     ($field, @fields) = map { field_capitalize($_) } ($field, @fields);
 792     @{$FIELD_ORDER{$type}} = map {
 793         ($_ eq $field) ? (@fields, $_) : $_
 794     } @{$FIELD_ORDER{$type}};
 795     return 1;
 796 }
 797
 798 =back
 799
 800 =head1 CHANGES
 801
 802 =head2 Version 1.00 (dpkg 1.17.0)
 803
 804 Mark the module as public.
 805
 806 =cut
 807
 808 1;