Dave Cross: Still Munging Data With Perl: Online event - Mar 27 Learn more

#!/usr/bin/perl
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <https://www.gnu.org/licenses/>.
use strict;
use Test::Dpkg qw(:paths);
BEGIN {
plan tests => 2606;
use_ok('Dpkg::Control::Types');
use_ok('Dpkg::Control::FieldsCore');
use_ok('Dpkg::Control');
}
#my $datadir = test_get_data_path();
my @src_dep_fields = qw(
Build-Depends
Build-Depends-Arch
Build-Depends-Indep
Build-Conflicts
Build-Conflicts-Arch
Build-Conflicts-Indep
);
my @bin_dep_normal_fields = qw(
Pre-Depends
Depends
Recommends
Suggests
Enhances
);
my @bin_dep_union_fields = qw(
Conflicts
Breaks
Replaces
Provides
Built-Using
Static-Built-Using
);
my @bin_dep_fields = (
@bin_dep_normal_fields,
@bin_dep_union_fields,
);
my @src_checksums = qw(
Checksums-Md5
Checksums-Sha1
Checksums-Sha256
);
my @bin_checksums = qw(
MD5sum
SHA1
SHA256
);
my @src_files = (
@src_checksums,
qw(
Files
),
);
my @bin_files = (
qw(
Filename
Size
),
@bin_checksums,
);
my @vcs_fields = qw(
Vcs-Browser
Vcs-Arch
Vcs-Bzr
Vcs-Cvs
Vcs-Darcs
Vcs-Git
Vcs-Hg
Vcs-Mtn
Vcs-Svn
);
my @test_fields = qw(
Testsuite
Testsuite-Triggers
);
my %fields = (
CTRL_TMPL_SRC() => {
name => 'debian/control source stanza',
fields => [
qw(
Source
Section
Priority
Maintainer
Uploaders
Origin
Bugs
),
@vcs_fields,
qw(
Homepage
Standards-Version
Rules-Requires-Root
),
@src_dep_fields,
@test_fields,
qw(
Description
),
],
},
CTRL_TMPL_PKG() => {
name => 'debian/control binary stanza',
fields => [
qw(
Package
Package-Type
Section
Priority
Architecture
Subarchitecture
Multi-Arch
Essential
Protected
Build-Essential
Build-Profiles
Built-For-Profiles
Kernel-Version
),
@bin_dep_fields,
qw(
Homepage
Installer-Menu-Item
Task
Tag
Description
),
],
},
CTRL_DSC() => {
name => '.dsc',
fields => [
qw(
Format
Source
Binary
Architecture
Version
Origin
Maintainer
Uploaders
Homepage
Description
Standards-Version
),
@vcs_fields,
@test_fields,
@src_dep_fields,
qw(
Package-List
),
@src_files,
],
},
CTRL_DEB() => {
name => 'DEBIAN/control',
fields => [
qw(
Package
Package-Type
Source
Version
Kernel-Version
Built-For-Profiles
Auto-Built-Package
Architecture
Subarchitecture
Installer-Menu-Item
Build-Essential
Essential
Protected
Origin
Bugs
Maintainer
Installed-Size
),
@bin_dep_fields,
qw(
Section
Priority
Multi-Arch
Homepage
Description
Tag
Task
),
],
},
CTRL_REPO_SRC() => {
name => 'Sources',
fields => [
qw(
Format
Package
Binary
Architecture
Version
Priority
Section
Origin
Maintainer
Uploaders
Homepage
Description
Standards-Version
),
@vcs_fields,
@test_fields,
@src_dep_fields,
qw(
Package-List
Directory
),
@src_files,
],
},
CTRL_REPO_PKG() => {
name => 'Packages',
fields => [
qw(
Package
Package-Type
Source
Version
Kernel-Version
Built-For-Profiles
Auto-Built-Package
Architecture
Subarchitecture
Installer-Menu-Item
Build-Essential
Essential
Protected
Origin
Bugs
Maintainer
Installed-Size
),
@bin_dep_fields,
@bin_files,
qw(
Section
Priority
Multi-Arch
Homepage
Description
Tag
Task
),
],
},
CTRL_REPO_RELEASE() => {
name => 'Release',
fields => [
qw(
Origin
Label
Suite
Version
Codename
Changelogs
Date
Valid-Until
NotAutomatic
ButAutomaticUpgrades
Acquire-By-Hash
No-Support-for-Architecture-all
Architectures
Components
Description
),
@bin_checksums,
],
},
CTRL_CHANGELOG() => {
name => 'debian/changelog',
fields => [
qw(
Source
Binary-Only
Version
Distribution
Urgency
Maintainer
Timestamp
Date
Closes
Changes
),
],
},
CTRL_COPYRIGHT_HEADER() => {
name => 'debian/copyright Format stanza',
fields => [
qw(
Format
Upstream-Name
Upstream-Contact
Source
Disclaimer
Comment
License
Copyright
),
],
},
CTRL_COPYRIGHT_FILES() => {
name => 'debian/copyright Files stanza',
fields => [
qw(
Files
Copyright
License
Comment
),
],
},
CTRL_COPYRIGHT_LICENSE() => {
name => 'debian/copyright License stanza',
fields => [
qw(
License
Comment
),
],
},
CTRL_TESTS() => {
name => 'debian/tests/control',
fields => [
qw(
Test-Command
Tests
Tests-Directory
Architecture
Restrictions
Features
Classes
Depends
),
],
},
CTRL_FILE_BUILDINFO() => {
name => '.buildinfo',
fields => [
qw(
Format
Source
Binary
Architecture
Version
Binary-Only-Changes
),
@src_checksums,
qw(
Build-Origin
Build-Architecture
Build-Kernel-Version
Build-Date
Build-Path
Build-Tainted-By
Installed-Build-Depends
Environment
),
],
},
CTRL_FILE_CHANGES() => {
name => '.changes',
fields => [
qw(
Format
Date
Source
Binary
Binary-Only
Built-For-Profiles
Architecture
Version
Distribution
Urgency
Maintainer
Changed-By
Description
Closes
Changes
),
@src_files,
],
},
CTRL_FILE_VENDOR() => {
name => 'dpkg origin',
fields => [
qw(
Vendor
Vendor-Url
Bugs
Parent
),
],
},
CTRL_FILE_STATUS() => {
name => 'dpkg status',
fields => [
qw(
Package
Essential
Protected
Status
Priority
Section
Installed-Size
Origin
Maintainer
Bugs
Architecture
Multi-Arch
Source
Version
Config-Version
Replaces
Provides
Depends
Pre-Depends
Recommends
Suggests
Breaks
Conflicts
Enhances
Conffiles
Description
Triggers-Pending
Triggers-Awaited
Auto-Built-Package
Build-Essential
Built-For-Profiles
Built-Using
Static-Built-Using
Homepage
Installer-Menu-Item
Kernel-Version
Package-Type
Subarchitecture
Tag
Task
),
],
},
);
is_deeply([ field_list_src_dep() ],
[ @src_dep_fields ],
'List of build dependencies');
is_deeply([ field_list_pkg_dep() ],
[ @bin_dep_fields ],
'List of build dependencies');
is(field_get_default_value('Source'), undef,
'no default value for Source field');
is(field_get_default_value('Section'), 'unknown',
'default value for Section field');
is(field_get_default_value('Priority'), 'optional',
'default value for Priority field');
is(field_capitalize('invented-field'), 'Invented-Field',
'Field Invented-Field capitalization');
ok(!field_is_official('invented-field'),
'Field Invented-Field is not official');
my %known_fields;
foreach my $type (sort keys %fields) {
if (not $fields{$type}->{unordered}) {
is_deeply([ field_ordered_list($type) ], $fields{$type}->{fields},
"List of $fields{$type}->{name} fields");
}
foreach my $field (@{$fields{$type}->{fields}}) {
$known_fields{$field} = 1;
}
}
foreach my $field (sort keys %known_fields) {
is(field_capitalize($field), $field, "Field $field capitalization");
is(field_capitalize(lc $field), $field, "Field lc($field) capitalization");
is(field_capitalize(uc $field), $field, "Field uc($field) capitalization");
ok(field_is_official($field), "Field $field is official");
ok(field_is_official(lc $field), "Field lc($field) is official");
ok(field_is_official(uc $field), "Field uc($field) is official");
}
foreach my $type (sort keys %fields) {
my %allowed_fields = map { $_ => 1 } @{$fields{$type}->{fields}};
foreach my $field (sort keys %known_fields) {
if ($allowed_fields{$field}) {
ok(field_is_allowed_in($field, $type),
"Field $field allowed for type $fields{$type}->{name}");
} else {
ok(!field_is_allowed_in($field, $type),
"Field $field not allowed for type $fields{$type}->{name}");
}
}
}
# Check deb822 field parsers
my $ctrl = Dpkg::Control->new(type => CTRL_DEB);
my ($source, $version);
$ctrl->{Package} = 'test-binary';
$ctrl->{Version} = '2.0-1';
$ctrl->{Source} = 'test-source (1.0)';
($source, $version) = field_parse_binary_source($ctrl);
is($source, 'test-source', 'Source package from binary w/ Source field');
is($version, '1.0', 'Source version from binary w/ Source field');
$ctrl->{Source} = 'test-source';
($source, $version) = field_parse_binary_source($ctrl);
is($source, 'test-source', 'Source package from binary w/ Source field w/o version');
is($version, '2.0-1', 'Source version from binary w/ Source field w/o version');
delete $ctrl->{Source};
($source, $version) = field_parse_binary_source($ctrl);
is($source, 'test-binary', 'Source package from binary w/o Source field');
is($version, '2.0-1', 'Source version from binary w/o Source field');