r8818 - /scripts/qa/QA/DebBugs.pm

[tincho-guest at users.alioth.debian.org]

Author: tincho-guest
Date: Sun Nov  4 10:27:51 2007
New Revision: 8818

URL: http://svn.debian.org/wsvn/?sc=1&rev=8818
Log:
Working Debbugs/SOAP interface

Added:
    scripts/qa/QA/DebBugs.pm

Added: scripts/qa/QA/DebBugs.pm
URL: http://svn.debian.org/wsvn/scripts/qa/QA/DebBugs.pm?rev=8818&op=file
==============================================================================
--- scripts/qa/QA/DebBugs.pm (added)
+++ scripts/qa/QA/DebBugs.pm Sun Nov  4 10:27:51 2007
@@ -1,0 +1,107 @@
+# vim:ts=4:sw=4:et:ai:sts=4
+# $Id: Common.pm 6650 2007-08-15 10:17:36Z tincho-guest $
+#
+# Routines for comparing package versions, based on policy + dpkg code
+# I'm not using AptPkg::Version since it depends on having a working apt and
+# dpkg, it's overly complicated and underdocumented.
+#
+# Copyright gregor herrmann <gregor+debian at comodo.priv.at>, 2007
+# Copyright Damyan Ivanov <dmn at debian.org>, 2007
+# Copyright Martín Ferrari <martin.ferrari at gmail.com>, 2007
+# Released under the terms of the GNU GPL 2
+
+package QA::DebBugs;
+use strict;
+use warnings;
+
+our @ISA = "Exporter";
+our @EXPORT = qw(bts_download bts_get);
+
+use QA::Common;
+use QA::Cache;
+use SOAP::Lite;
+
+my $ttl = 360;	# 6 hours
+my $btsproxy = 'http://bugs.debian.org/cgi-bin/soap.cgi';
+my $maint = 'pkg-perl-maintainers at lists.alioth.debian.org';
+
+sub bts_download {
+    my($force, @pkglist) = @_;
+    $force ||= 0;
+    debug("bts_download($force, (@pkglist))");
+
+    my @list;
+    my $cdata = {};
+    my $replace = 0;
+
+    my $soap = SOAP::Lite->uri('Debbugs/SOAP')->proxy($btsproxy);
+    unless($force) {
+        $cdata = read_cache("bts", "", 0);
+    }
+    if(@pkglist) {
+        # A list of packages to update has been received
+        unless($force) {
+            @pkglist = grep( {
+                    $ttl * 60 < time - find_timestamp($cdata, $_)
+                } @pkglist);
+            info("BTS info for @pkglist is stale");
+        }
+        info("Downloading list of bugs of (", join(", ", @pkglist),
+            ")");
+        @list = @{$soap->get_bugs( package => [ @pkglist ] )->result()};
+    } elsif($force or $ttl * 60 < time - find_timestamp($cdata, "")) {
+        # No list of packages; forced operation or stale cache
+        info("BTS info is stale") unless($force);
+        $replace = 1;
+        @pkglist = keys(%{ read_cache("consolidated", "pkglist", 0) });
+        # TODO: could verificate that pkglist and maint = $maint are the same
+        # packages
+        if(@pkglist) {
+            info("Downloading list of bugs of packages in the repo");
+            @list = @{$soap->get_bugs( src => [ @pkglist ] )->result()};
+        } else {
+            info("Downloading list of bugs assigned to $maint");
+            @list = @{$soap->get_bugs( maint => $maint )->result()};
+        }
+    } else {
+        # Cache is up to date
+        return $cdata;
+    }
+    my $bugs_st = {};
+    if(@list) {
+        info("Downloading bugs' status");
+        $bugs_st = $soap->get_status(@list)->result();
+    }
+
+    my %bugs = ();
+    foreach my $bug (keys %$bugs_st) {
+        my $pkgname = $bugs_st->{$bug}->{package};
+        $bugs{$pkgname}{$bug} = $bugs_st->{$bug};
+    }
+    # retain lock, we need consistency
+    $cdata = update_cache("bts", \%bugs, "", $replace, 1);
+
+    info("Re-generating consolidated hash");
+    @pkglist = keys(%{ read_cache("consolidated", "pkglist", 0) });
+    @pkglist = keys(%bugs) unless(@pkglist);
+
+    # TODO: Interesting fields:
+    # keywords/tags, severity, subject, forwarded, date
+    my %cbugs;
+    foreach my $pkgname (@pkglist) {
+        next if($pkgname eq "/timestamp");
+        $bugs{$pkgname} ||= {};
+        my @blist = keys %{ $bugs{$pkgname} };
+        # Remove done bugs
+        @blist = grep( { ! $bugs{$pkgname}{$_}{done} } @blist );
+        $cbugs{$pkgname} = \@blist;
+    }
+    update_cache("consolidated", \%cbugs, "bts", 1, 0);
+    unlock_cache("bts");
+    return $cdata;
+}
+# Returns the consolidated hash of bugs. Doesn't download anything.
+sub bts_get {
+    return read_cache("consolidated", "bts", 0);
+}
+1;