r16022 - in /scripts/qa: DebianQA/BTS.pm DebianQA/Config.pm debianqa.conf-sample

tincho-guest at users.alioth.debian.org tincho-guest at users.alioth.debian.org
Sat Mar 1 08:36:38 UTC 2008


Author: tincho-guest
Date: Sat Mar  1 08:36:37 2008
New Revision: 16022

URL: http://svn.debian.org/wsvn/?sc=1&rev=16022
Log:
New functionality and config option: tracking user tags (usertag_users under
[bts]), default to tracking debian-qa at lists.debian.org usertags.

BTS.pm had to be heavily modified, hopefully now is cleaner. In the way: fixed
correct handling of old version caches and separated cache consolidation from
main code.

Modified:
    scripts/qa/DebianQA/BTS.pm
    scripts/qa/DebianQA/Config.pm
    scripts/qa/debianqa.conf-sample

Modified: scripts/qa/DebianQA/BTS.pm
URL: http://svn.debian.org/wsvn/scripts/qa/DebianQA/BTS.pm?rev=16022&op=diff
==============================================================================
--- scripts/qa/DebianQA/BTS.pm (original)
+++ scripts/qa/DebianQA/BTS.pm Sat Mar  1 08:36:37 2008
@@ -28,15 +28,32 @@
     $force ||= 0;
     debug("bts_download($force, (@pkglist))");
 
-    my @list;
-    my $cdata = {};
     my $replace = 0;
 
     my $soap = SOAP::Lite->uri($CFG{bts}{soap_uri})->proxy(
         $CFG{bts}{soap_proxy});
-    unless($force) {
-        $cdata = read_cache("bts", "", 0);
+
+    my $cdata = read_cache("bts", "", 0);
+    if(find_stamp($cdata, "") == 0) {
+        warn("Forcing complete update -- bts cache has old version");
+        $force = 1;
+        @pkglist = ();
     }
+
+    my @users = split(/\s*,\s*/, $CFG{bts}{usertag_users});
+    my %usertags;
+    if(@users) {
+        if($force
+                or $CFG{bts}{ttl} * 60 < time - find_stamp($cdata, "usertags")
+                or grep({ ! $cdata->{usertags}{$_}} @users)) {
+            info("Scanning usertags");
+            foreach(@users) {
+                $usertags{$_} = $soap->get_usertag($_)->result();
+            }
+        }
+    }
+
+    my @list = ();
     my $pkginfo = get_pkglist_hashref();
     if(@pkglist) {
         # A list of packages to update has been received
@@ -44,12 +61,11 @@
             @pkglist = grep( {
                     $CFG{bts}{ttl} * 60 < time - find_stamp($cdata, $_)
                 } @pkglist);
-            return $cdata unless(@pkglist); # Cache is up-to-date
-            info("BTS info for @pkglist is stale") if(@pkglist);
         }
-        info("Downloading list of bugs of (", join(", ", @pkglist),
-            ")");
-        @list = @{$soap->get_bugs( src => [ @pkglist ] )->result()};
+        if(@pkglist) {
+            info("Downloading list of bugs for (", join(", ", @pkglist), ")");
+            @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);
@@ -63,14 +79,11 @@
         } else {
             # Doesn't make sense to search bugs if we don't have the list
             # of packages.
+            warn("No packages to look bugs for yet");
+            update_cache("bts", \%usertags, "usertags", 1, 0) if(%usertags);
             return {};
-#            info("Downloading list of bugs assigned to $maint");
-#            @list = @{$soap->get_bugs( maint => $maint )->result()};
         }
-    } else {
-        # Cache is up to date
-        return $cdata;
-    }
+    } # If cache is up-to-date, @list will be empty
     my $bugs_st = {};
     if(@list) {
         info("Downloading status for ", scalar @list, " bugs");
@@ -99,17 +112,33 @@
             next;
         }
     }
+    $bugs{usertags} = \%usertags if(%usertags);
     # retain lock, we need consistency
     $cdata = update_cache("bts", \%bugs, "", $replace, 1);
+    bts_consolidate($cdata, keys %$pkginfo);
+    unlock_cache("bts");
+    return $cdata;
+}
+sub bts_consolidate {
+    my($bugs, @pkglist) = @_;
+    info("Re-generating consolidated hash");
 
-    info("Re-generating consolidated hash");
-    @pkglist = keys %$pkginfo;
+    # Inverted index of usertags
+    my %usertags;
+    foreach my $user (keys %{$bugs->{usertags} || {}}) {
+        foreach my $tag (keys %{$bugs->{usertags}{$user} || {}}) {
+            foreach(@{$bugs->{usertags}{$user}{$tag}}) {
+                $usertags{$_} ||= [];
+                push @{$usertags{$_}}, { user => $user, tag => $tag };
+            }
+        }
+    }
 
     # TODO: Interesting fields:
     # keywords/tags, severity, subject, forwarded, date
     my %cbugs;
     foreach my $pkgname (@pkglist) {
-        $bugs{$pkgname} ||= {};
+        $bugs->{$pkgname} ||= {};
 
         # bugs to ignore if keyword present
         my %ign_keywords = map({ $_ => 1 }
@@ -119,28 +148,34 @@
             split(/\s*,\s*/, $CFG{bts}{ignore_severities}));
 
         $cbugs{$pkgname} = {};
-        foreach my $bug (keys %{ $bugs{$pkgname} }) {
-            next unless(ref $bugs{$pkgname}{$bug});
+        foreach my $bug (keys %{ $bugs->{$pkgname} }) {
+            next unless(ref $bugs->{$pkgname}{$bug});
             # Remove done bugs
-            next if($bugs{$pkgname}{$bug}{done});
+            next if($bugs->{$pkgname}{$bug}{done});
             # Remove if severity match
-            next if($ign_severities{$bugs{$pkgname}{$bug}{severity}});
+            next if($ign_severities{$bugs->{$pkgname}{$bug}{severity}});
             # Remove if keyword match
-            my @keywords = split(/\s+/, $bugs{$pkgname}{$bug}{keywords});
+            my @keywords = split(/\s+/, $bugs->{$pkgname}{$bug}{keywords});
             next if(grep({ $ign_keywords{$_} } @keywords));
             $cbugs{$pkgname}{$bug} = {
-                keywords => $bugs{$pkgname}{$bug}{keywords},
+                keywords => $bugs->{$pkgname}{$bug}{keywords},
                 # need to use a new key for compatibility
                 keywordsA => \@keywords,
-                severity => $bugs{$pkgname}{$bug}{severity},
-                subject  => $bugs{$pkgname}{$bug}{subject},
-                forwarded=> $bugs{$pkgname}{$bug}{forwarded},
+                severity => $bugs->{$pkgname}{$bug}{severity},
+                subject  => $bugs->{$pkgname}{$bug}{subject},
+                forwarded=> $bugs->{$pkgname}{$bug}{forwarded},
             };
+            if($usertags{$bug}) {
+                $cbugs{$pkgname}{$bug}{usertags} = $usertags{$bug};
+                foreach(@{$usertags{$bug}}) {
+                    $cbugs{$pkgname}{$bug}{keywords} .= " usertag:$_->{tag}";
+                    push(@{$cbugs{$pkgname}{$bug}{keywordsA}},
+                        "usertag:$_->{tag}");
+                }
+            }
         }
     }
     update_cache("consolidated", \%cbugs, "bts", 1, 0);
-    unlock_cache("bts");
-    return $cdata;
 }
 # Returns the hash of bugs. Doesn't download anything.
 sub bts_get {

Modified: scripts/qa/DebianQA/Config.pm
URL: http://svn.debian.org/wsvn/scripts/qa/DebianQA/Config.pm?rev=16022&op=diff
==============================================================================
--- scripts/qa/DebianQA/Config.pm (original)
+++ scripts/qa/DebianQA/Config.pm Sat Mar  1 08:36:37 2008
@@ -54,6 +54,7 @@
         ttl => 60, # 1 hour
         soap_proxy => 'http://bugs.debian.org/cgi-bin/soap.cgi',
         soap_uri => 'Debbugs/SOAP',
+        usertag_users => 'debian-qa at lists.debian.org',
         ignore_keywords => "",
         ignore_severities => ""
     },

Modified: scripts/qa/debianqa.conf-sample
URL: http://svn.debian.org/wsvn/scripts/qa/debianqa.conf-sample?rev=16022&op=diff
==============================================================================
--- scripts/qa/debianqa.conf-sample (original)
+++ scripts/qa/debianqa.conf-sample Sat Mar  1 08:36:37 2008
@@ -44,6 +44,8 @@
 ttl = 60 # 1 hour
 soap_proxy = http://bugs.debian.org/cgi-bin/soap.cgi
 soap_uri = Debbugs/SOAP
+; usertags to follow (usernames/emails): foo at bar.com, bar at foo.com
+usertag_users = debian-qa at lists.debian.org
 ; wontfix, pending, etch, sarge, etc
 ignore_keywords =
 ; wishlist, minor




More information about the Pkg-perl-cvs-commits mailing list