r11938 - in /scripts/qa/DebianQA: BTS.pm Svn.pm
tincho-guest at users.alioth.debian.org
tincho-guest at users.alioth.debian.org
Thu Jan 3 05:32:43 UTC 2008
Author: tincho-guest
Date: Thu Jan 3 05:32:42 2008
New Revision: 11938
URL: http://svn.debian.org/wsvn/?sc=1&rev=11938
Log:
* Svn.pm:
- Added discardCase to Parse::DebControl options, because we can miss some
uncommon case usage.
- Now saving all binary packages' info in a subhash (key: bindata). Not
exported to consolidated hash.
- Other new field (exported): binaries, containing an array of binaries created
by this source package (ignoring arches).
- Now pkglist stores info about binaries and svn dirs, to easily do lookups.
(backwards compatible).
- Added a check to ensure that source package is the same in changelog and
control.
* BTS.pm:
- When passed a list of packages to update, it was incorrectly querying the
BTS, asking for binaries instead of sources.
- Using the new data from Svn.pm, not it's able to correctly assign bugs to
source packages. The BTS can't provide that info without doing hundreds of
queries (wishlist bug filed).
- Also detected a new bug: bugs can be assigned to more than one package (I
didn't even knew that was possible!), fixed here.
- Removed cheking for package names starting with a slash in pkglist, that was
already solved in Svn.pm.
Modified:
scripts/qa/DebianQA/BTS.pm
scripts/qa/DebianQA/Svn.pm
Modified: scripts/qa/DebianQA/BTS.pm
URL: http://svn.debian.org/wsvn/scripts/qa/DebianQA/BTS.pm?rev=11938&op=diff
==============================================================================
--- scripts/qa/DebianQA/BTS.pm (original)
+++ scripts/qa/DebianQA/BTS.pm Thu Jan 3 05:32:42 2008
@@ -37,6 +37,7 @@
unless($force) {
$cdata = read_cache("bts", "", 0);
}
+ my $pkginfo = get_pkglist_hashref();
if(@pkglist) {
# A list of packages to update has been received
unless($force) {
@@ -48,12 +49,12 @@
}
info("Downloading list of bugs of (", join(", ", @pkglist),
")");
- @list = @{$soap->get_bugs( package => [ @pkglist ] )->result()};
+ @list = @{$soap->get_bugs( src => [ @pkglist ] )->result()};
} elsif($force or $CFG{bts}{ttl} * 60 < time - find_stamp($cdata, "")) {
# No list of packages; forced operation or stale cache
info("BTS info is stale") unless($force);
$replace = 1;
- @pkglist = get_pkglist();
+ @pkglist = keys %$pkginfo;
# TODO: could verificate that pkglist and maint = $maint are the same
# packages
if(@pkglist) {
@@ -72,27 +73,42 @@
}
my $bugs_st = {};
if(@list) {
- info("Downloading bugs' status");
+ info("Downloading status for ", scalar @list, " bugs");
$bugs_st = $soap->get_status(@list)->result();
}
+ my %binmap;
+ foreach my $src (keys %$pkginfo) {
+ $binmap{$_} = $src foreach(@{$pkginfo->{$src}{binaries} || []});
+ }
my %bugs = ();
foreach my $bug (keys %$bugs_st) {
- my $pkgname = $bugs_st->{$bug}->{package};
- $bugs{$pkgname}{$bug} = $bugs_st->{$bug};
+ # Until #458822 is solved, we need to use our own bin -> src mapping
+ my $binname = $bugs_st->{$bug}->{package};
+ # There could be more than one package!
+ $binname =~ s/\s+//g;
+ my @binnames = split(/,/, $binname);
+ my $found = 0;
+ foreach(@binnames) {
+ my $srcname = $binmap{$_} or next;
+ $bugs{$srcname}{$bug} = $bugs_st->{$bug};
+ $found++;
+ }
+ unless($found) {
+ warn("Can't find source package for $binname in bug #$bug");
+ next;
+ }
}
# retain lock, we need consistency
$cdata = update_cache("bts", \%bugs, "", $replace, 1);
info("Re-generating consolidated hash");
- @pkglist = get_pkglist();
- @pkglist = keys(%$cdata) unless(@pkglist);
+ @pkglist = keys %$pkginfo;
# TODO: Interesting fields:
# keywords/tags, severity, subject, forwarded, date
my %cbugs;
foreach my $pkgname (@pkglist) {
- next if($pkgname =~ /^\//);
$bugs{$pkgname} ||= {};
my @blist = keys %{ $bugs{$pkgname} };
# Remove done bugs
Modified: scripts/qa/DebianQA/Svn.pm
URL: http://svn.debian.org/wsvn/scripts/qa/DebianQA/Svn.pm?rev=11938&op=diff
==============================================================================
--- scripts/qa/DebianQA/Svn.pm (original)
+++ scripts/qa/DebianQA/Svn.pm Thu Jan 3 05:32:42 2008
@@ -129,17 +129,30 @@
# they to exist, [2] and on for the other binary packages - which
# we will wisely ignore)
my ($ctrl_data, $short, $long);
- $ctrl_data = Parse::DebControl->new->parse_mem($control);
- ($short, $long) = split_description($ctrl_data->[1]{Description});
-
- $svn{$dir}{uploaders} = $ctrl_data->[0]{Uploaders};
- $svn{$dir}{maintainer} = $ctrl_data->[0]{Maintainer};
- $svn{$dir}{std_version} = $ctrl_data->[0]{'Standards-Version'};
- $svn{$dir}{b_d} = $ctrl_data->[0]{'Build-Depends'};
- $svn{$dir}{b_d_i} = $ctrl_data->[0]{'Build-Depends-Indep'};
+ $ctrl_data = Parse::DebControl->new->parse_mem($control, {
+ discardCase => 1 # unreliable if don't
+ });
+ ($short, $long) = split_description($ctrl_data->[1]{description});
+
+ $svn{$dir}{pkgname} = $ctrl_data->[0]{source};
+ $svn{$dir}{uploaders} = $ctrl_data->[0]{uploaders};
+ $svn{$dir}{maintainer} = $ctrl_data->[0]{maintainer};
+ $svn{$dir}{std_version} = $ctrl_data->[0]{'standards-version'};
+ $svn{$dir}{b_d} = $ctrl_data->[0]{'build-depends'};
+ $svn{$dir}{b_d_i} = $ctrl_data->[0]{'build-depends-indep'};
$svn{$dir}{short_descr} = $short;
$svn{$dir}{long_descr} = $long;
-
+ foreach(1..$#$ctrl_data) {
+ my $bin = $ctrl_data->[$_];
+ my ($shd, $lnd) = split_description($bin->{description});
+ push @{$svn{$dir}{binaries}}, $bin->{package};
+ $svn{$dir}{bindata}[$_-1] = {
+ %$bin,
+ short_descr => $shd,
+ long_descr => $lnd,
+ };
+ delete $svn{$dir}{bindata}[$_-1]{description};
+ }
my $parser = Parse::DebianChangelog->init({
instring => $changelog });
my $error = $parser->get_error() or $parser->get_parse_errors();
@@ -181,7 +194,10 @@
map( $unfinishedchl->$_, qw(Header Changes Trailer) ),
);
}
- $svn{$dir}{pkgname} = $parser->dpkg()->{Source};
+ if($svn{$dir}{pkgname} ne $parser->dpkg()->{Source}) {
+ $svn{$dir}{error} = "SourceNameMismatch";
+ next;
+ }
info("Retrieving watchfile for $dir");
my $watchdata = get_svn_file($svn, "$debdir/watch");
@@ -220,9 +236,14 @@
my @pkglist = grep({ ref $cdata->{$_} and $cdata->{$_}{pkgname} }
keys(%$cdata));
- my %pkglist = map({ $cdata->{$_}{pkgname} => 1 } @pkglist);
+ my %pkglist;
+ foreach(@pkglist) {
+ $pkglist{$cdata->{$_}{pkgname}} = {
+ svndir => $_,
+ binaries => $cdata->{$_}{binaries}
+ };
+ }
update_cache("consolidated", \%pkglist, "pkglist", 1, 1);
-
my %svn2;
foreach(keys(%$cdata)) {
next unless ref($cdata->{$_});
@@ -231,7 +252,7 @@
$svn2{$pkgname} = { %{$cdata->{$_}} };
$svn2{$pkgname}{dir} = $_;
delete $svn2{$pkgname}{$_} foreach(
- qw(watch pkgname text un_text long_descr)
+ qw(watch pkgname text un_text long_descr bindata)
);
}
update_cache("consolidated", \%svn2, "svn", 1, 0);
More information about the Pkg-perl-cvs-commits
mailing list