use Dpkg::Index, field_list_src_dep, deps_parse and deps_iterate
This commit is contained in:
parent
f89dba4b4d
commit
fad7803bde
1 changed files with 21 additions and 18 deletions
|
@ -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"};
|
||||||
|
|
Loading…
Reference in a new issue