r9577 - /scripts/qa/DebianQA/Classification.pm

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

Author: tincho-guest
Date: Mon Nov 19 03:37:40 2007
New Revision: 9577

URL: http://svn.debian.org/wsvn/?sc=1&rev=9577
Log:
First attempt to put the classification logic into a module.

Added:
    scripts/qa/DebianQA/Classification.pm

Added: scripts/qa/DebianQA/Classification.pm
URL: http://svn.debian.org/wsvn/scripts/qa/DebianQA/Classification.pm?rev=9577&op=file
==============================================================================
--- scripts/qa/DebianQA/Classification.pm (added)
+++ scripts/qa/DebianQA/Classification.pm Mon Nov 19 03:37:40 2007
@@ -1,0 +1,128 @@
+# vim:ts=4:sw=4:et:ai:sts=4
+# $Id: Watch.pm 9185 2007-11-10 11:06:28Z tincho-guest $
+#
+# Module for classifying packages into problem clases. The idea is to make the
+# reporting scripts absolutely minimal, and to have a common code in different
+# report implementations.
+#
+# 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 DebianQA::Classification;
+use strict;
+use warnings;
+
+our @ISA = "Exporter";
+our @EXPORT = qw(classify);
+
+use DebianQA::Cache;
+#use DebianQA::Common;
+#use DebianQA::Config '%CFG';
+#use DebianQA::DebVersions;
+
+# Takes a list of packages to process.
+# Returns an unique hash ready to use in reporting, keyed by package name.
+# package_name => {
+#   status => {                 # Hash to ease lookup, empty if OK (@notes)
+#       needs_upload => 1,
+#       needs_upgrade => 1,
+#       invalid_svn_version => 1,
+#       ...
+#   },
+#   problem => {                # Hash, ditto (%todo)
+#       repo => 1,
+#       archive => 1,
+#       upstream => 1,
+#       bugs => 1
+#   },
+#   bts => {},
+#   archive => {},
+#   svn => {},
+#   watch => {}                 # Copies from the caches
+# }
+sub classify(@) {
+    my @pkglist = @_;
+    my $data = read_cache(consolidated => "");
+    my %res;
+
+    foreach my $pkg (@pkglist) {
+        next if($pkg =~ /^\//);
+        my(%problem, %status);
+        # SVN versus archive
+        my $archive_ver = $data->{archive}{$pkg}{most_recent};
+        my $svn_ver = $data->{svn}{$pkg}{version};
+        if(not $svn_ver or not $archive_ver) {
+            if(not $svn_ver) {
+                $status{not_finished} = 1;
+                $problem{repo} = "Not finished";
+            }
+            if(not $archive_ver) {
+                $status{never_uploaded} = 1;
+                $problem{archive} = "Never uploaded";
+            }
+        } elsif(deb_compare($archive_ver, $svn_ver) > 0) {
+            $status{repo_ancient} = 1;
+            $problem{repo} = "Ancient version in repository";
+        } elsif(deb_compare($archive_ver, $svn_ver) != 0) {
+            $status{needs_upload} = 1;
+            $problem{archive} = "Needs upload";
+        }
+        # SVN versus upstream
+        my $repo_mangled_ver = $data->{svn}{$pkg}{mangled_ver};
+        my $repo_unrel_mangled_ver = $data->{svn}{$pkg}{mangled_un_ver};
+        my $upstream_mangled_ver = $data->{watch}{$pkg}{upstream_mangled};
+        # watch_error from svn is not needed, as Watch.pm copies it
+        my $watch_error = $data->{watch}{$pkg}{error};
+        if($watch_error and $watch_error eq "Native") {
+            $status{native} = 1;
+        } elsif($watch_error) {
+            $status{watch_error} = 1;
+            $problem{upstream} = $watch_error;
+        } elsif((not $repo_mangled_ver and not $repo_unrel_mangled_ver)
+                or not $upstream_mangled_ver) {
+            $status{watch_error} = 1;
+            $problem{upstream} = "Watchfile problem"; # Should not happen
+        } elsif($repo_mangled_ver) { # Will not check if UNRELEASED (?)
+            if(deb_compare($repo_mangled_ver, $upstream_mangled_ver) > 0) {
+                $problem{repo} = "Ancient version in upstream?";
+                $status{upstream_ancient} = 1;
+            }
+            if(deb_compare($repo_mangled_ver, $upstream_mangled_ver) < 0) {
+                $problem{upstream} = "Newer upstream version";
+                $status{needs_upgrade} = 1;
+            }
+        }
+        # Archive
+        my $archive_latest = $data->{archive}{$pkg}{most_recent_src} || "";
+        if($archive_latest =~ /new|incoming/) {
+            $problem{archive} = "Waiting to hit the archive";
+            $status{archive_waiting} = 1;
+        }
+        my @bugs = sort keys %{$data->{bts}{$pkg}};
+        if(@bugs) {
+            $problem{bts} = "Outstanding bugs";
+            $status{has_bugs} = 1;
+        }
+
+        $res{$pkg} = {
+            watch   => $data->{watch}{$pkg},
+            archive => $data->{archive}{$pkg},
+            svn     => $data->{svn}{$pkg},
+            bts     => $data->{bts}{$pkg},
+            #
+            svnpath => $data->{svn}{$pkg}{dir},
+            upstream_url => $data->{watch}{$pkg}{upstream_url},
+        };
+
+        use Data::Dumper;
+        print "$pkg\n";
+        print Dumper \%problem;
+        print Dumper \%status;
+        print "\n";
+    }
+}
+
+1;
+