use Dpkg::Index, field_list_src_dep, deps_parse and deps_iterate

This commit is contained in:
josch 2015-05-22 08:46:07 +02:00
parent f89dba4b4d
commit fad7803bde

View file

@ -8,41 +8,44 @@ use warnings;
# wildcard) in build dependencies, conflicts, the architecture field and in # wildcard) in build dependencies, conflicts, the architecture field and in
# binary packages listed in the Package-List field # binary packages listed in the Package-List field
use Dpkg::Control; use Dpkg::Deps qw(deps_parse deps_iterate);
use Dpkg::Compression::FileHandle; use Dpkg::Index;
use Dpkg::Deps;
use List::MoreUtils qw{any}; use List::MoreUtils qw{any};
use List::Util qw{first}; use List::Util qw{first};
use Dpkg::Arch qw(debarch_is); use Dpkg::Arch qw(debarch_is);
use Dpkg::Control::FieldsCore qw(field_list_src_dep);
my $desc = $ARGV[0]; # /home/josch/gsoc2012/bootstrap/tests/sid-sources-20140101T000000Z my $desc = $ARGV[0]; # /home/josch/gsoc2012/bootstrap/tests/sid-sources-20140101T000000Z
if (not defined($desc)) { if (not defined($desc)) {
die "need filename"; die "need filename";
} }
my $fh = Dpkg::Compression::FileHandle->new(filename => $desc);
my $key_func = sub {
return $_[0]->{Package} . '_' . $_[0]->{Version};
};
my $index = Dpkg::Index->new(get_key_func=>$key_func);
$index->load($desc);
my @debarches = ("amd64", "armel", "armhf", "hurd-i386", "i386", "kfreebsd-amd64", "kfreebsd-i386", "mips", "mipsel", "powerpc", "s390x", "sparc", my @debarches = ("amd64", "armel", "armhf", "hurd-i386", "i386", "kfreebsd-amd64", "kfreebsd-i386", "mips", "mipsel", "powerpc", "s390x", "sparc",
"alpha", "arm64", "hppa", "m68k", "powerpcspe", "ppc64", "sh4", "sparc64", "x32"); "alpha", "arm64", "hppa", "m68k", "powerpcspe", "ppc64", "sh4", "sparc64", "x32");
while (1) { foreach my $key ($index->get_keys()) {
my $cdata = Dpkg::Control->new(type => CTRL_INDEX_SRC); my $cdata = $index->get_by_key($key);
last if not $cdata->parse($fh, $desc);
my $pkgname = $cdata->{"Package"}; my $pkgname = $cdata->{"Package"};
next if not defined($pkgname); next if not defined($pkgname);
my @depfields = ('Build-Depends', 'Build-Depends-Indep', 'Build-Depends-Arch', my @depfields = field_list_src_dep();
'Build-Conflicts', 'Build-Conflicts-Indep', 'Build-Conflicts-Arch');
# search for invalid arches in the dependency and conflict fields
foreach my $depfield (@depfields) { foreach my $depfield (@depfields) {
my $dep_line = $cdata->{$depfield}; my $dep_line = $cdata->{$depfield};
next if not defined($dep_line); next if not defined($dep_line);
foreach my $dep_and (split(/\s*,\s*/m, $dep_line)) { my $dep_iter = deps_parse($dep_line);
my @or_list = (); deps_iterate($dep_iter, sub {
foreach my $dep_or (split(/\s*\|\s*/m, $dep_and)) { my $dep_simple = shift;
my $dep_simple = Dpkg::Deps::Simple->new($dep_or);
my $depname = $dep_simple->{package}; my $depname = $dep_simple->{package};
next if not defined($depname); return 1 if not defined($depname);
my $arches = $dep_simple->{arches}; my $arches = $dep_simple->{arches};
next if not defined($arches); return 1 if not defined($arches);
# find wildcards that do not match any existing architecture # find wildcards that do not match any existing architecture
foreach my $arch (@{$arches}) { foreach my $arch (@{$arches}) {
$arch =~ s/^!//; $arch =~ s/^!//;
@ -70,8 +73,8 @@ while (1) {
print "DD: $pkgname $arch $depname\n"; print "DD: $pkgname $arch $depname\n";
} }
} }
} return 1;
} });
} }
# search for invalid arches in Architecture field # search for invalid arches in Architecture field
my $architecture = $cdata->{"Architecture"}; my $architecture = $cdata->{"Architecture"};