r9586 - in /scripts/qa: DebianQA/Classification.pm qareport
tincho-guest at users.alioth.debian.org
tincho-guest at users.alioth.debian.org
Mon Nov 19 06:05:51 UTC 2007
Author: tincho-guest
Date: Mon Nov 19 06:05:51 2007
New Revision: 9586
URL: http://svn.debian.org/wsvn/?sc=1&rev=9586
Log:
Classification now functional. The non-CGI qareport now uses it, and seems to be working OK.
Modified:
scripts/qa/DebianQA/Classification.pm
scripts/qa/qareport
Modified: scripts/qa/DebianQA/Classification.pm
URL: http://svn.debian.org/wsvn/scripts/qa/DebianQA/Classification.pm?rev=9586&op=diff
==============================================================================
--- scripts/qa/DebianQA/Classification.pm (original)
+++ scripts/qa/DebianQA/Classification.pm Mon Nov 19 06:05:51 2007
@@ -32,9 +32,9 @@
# ...
# },
# notes => [ ... ],
-# hilight => {
-# archive => 1,
-# bugs => 1, ...
+# hilight => { # Problems indexed by highlighted item
+# archive => { needs_upload => 1, ... },
+# bts => { has_bugs => 1 }, ...
# },
# svn_path => "...",
# upstream_url => "...", # Already extracted data for ease of use
@@ -49,7 +49,7 @@
archive_waiting => "archive",
needs_upload => "archive",
never_uploaded => "archive",
- has_bugs => "bugs",
+ has_bugs => "bts",
not_finished => "svn",
repo_ancient => "svn",
needs_upgrade => "upstream",
@@ -61,7 +61,7 @@
sub classify(@) {
my @pkglist = @_;
my $data = read_cache(consolidated => "");
- my %res;
+ my %res = ();
foreach my $pkg (@pkglist) {
next if($pkg =~ /^\//);
@@ -118,7 +118,7 @@
foreach(keys %status) {
die "Internal error: $_ is not a valid status" unless(
$error_hilight{$_});
- $hilight{$error_hilight{$_}} = 1;
+ $hilight{$error_hilight{$_}}{$_} = 1;
}
$res{$pkg} = {
watch => $data->{watch}{$pkg},
@@ -138,4 +138,3 @@
}
1;
-
Modified: scripts/qa/qareport
URL: http://svn.debian.org/wsvn/scripts/qa/qareport?rev=9586&op=diff
==============================================================================
--- scripts/qa/qareport (original)
+++ scripts/qa/qareport Mon Nov 19 06:05:51 2007
@@ -9,10 +9,11 @@
use strict;
use warnings;
-use DebianQA::Cache;
-use DebianQA::Common;
+#use DebianQA::Cache;
+use DebianQA::Classification;
+#use DebianQA::Common;
use DebianQA::Config;
-use DebianQA::DebVersions;
+#use DebianQA::DebVersions;
use DebianQA::Svn;
use Getopt::Long;
@@ -21,69 +22,88 @@
my $p = new Getopt::Long::Parser;
$p->configure(qw(no_ignore_case bundling));
-my $list_is_packages = 0;
-$p->getoptions('help|h|?' => \&help, 'packages!' => \$list_is_packages,
+my $list_is_dirs = 0;
+my $show_all = 0;
+$p->getoptions('help|h|?' => \&help, 'directories!' => \$list_is_dirs,
+ 'showall|a!' => $show_all
) or die "Error parsing command-line arguments!\n";
my @dirs = @ARGV;
-if($list_is_packages) {
+if($list_is_dirs) {
foreach my $dir (@dirs) {
$dir = svndir2pkgname($dir) || $dir; # Fallback
}
}
-my $data = read_cache(consolidated => "");
my @pkglist = @dirs;
@pkglist = get_pkglist() unless(@pkglist);
-
-foreach my $pkg (sort @pkglist) {
- next if($pkg =~ /^\//);
- my $svnpath = $data->{svn}{$pkg}{dir};
- my $werr = $data->{watch}{$pkg}{error};
- my $dver = $data->{svn}{$pkg}{version} || 0;
- my $dwerr = $data->{svn}{$pkg}{watch_error};
- my $m_dver = $data->{svn}{$pkg}{mangled_ver} || 0;
- my $undver = $data->{svn}{$pkg}{un_version};
- my $archver = $data->{archive}{$pkg}{most_recent} || 0;
- my $archsuit = $data->{archive}{$pkg}{most_recent_src} || 0;
- my $uver = $data->{watch}{$pkg}{upstream_version};
- my $u_uver = $data->{watch}{$pkg}{upstream_mangled};
- my $uurl = $data->{watch}{$pkg}{upstream_url};
- my @bugs = map({ "#$_" } keys %{$data->{bts}{$pkg}});
-
- my $status;
- if(! $dver) {
- $status = 'Needs to be finished';
- } elsif(! $archver) {
- $status = 'Never uploaded';
- } elsif(deb_compare($archver, $dver) > 0) {
- $status = "Ancient version in SVN";
- } elsif(deb_compare($archver, $dver) != 0) {
- $status = "Needs uploading";
- } elsif($dwerr or not $m_dver or not $u_uver or not $uver) {
- $status = "Watchfile problem";
- } elsif(deb_compare($m_dver, $u_uver) > 0) {
- $status = "Ancient version in upstream?";
- } elsif(deb_compare($m_dver, $u_uver) != 0) {
- $status = "Needs upgrading to newer upstream";
- } elsif($werr) {
- $status = "Watchfile problem";
+my $csfy = classify(@pkglist);
+unless($show_all) {
+ foreach(keys %$csfy) {
+ delete $csfy->{$_} unless(%{$csfy->{$_}{hilight}});
}
- next unless($status or @bugs);
- print "$pkg:", ( $pkg ne $svnpath ? " (SVN: $svnpath)" : '' ), "\n";
- if($status) {
- print " - Version status: $status\n";
- print " + Watch status: ", $werr || "OK", "\n";
- print " + SVN: ", $dver || "none";
- print " (mangled: ", $m_dver || "none", ")";
- print " (unreleased: $undver)" if($undver);
- print " Archive: ", $archver || "Not uploaded";
- print " ($archsuit)" if($archsuit);
- print " Upstream: ", $uver || "Unknown";
- print " (mangled: ", $u_uver || "Unknown", ")\n";
+}
+print("Showing ", scalar keys %$csfy, " out of ", scalar @pkglist,
+ " packages\n");
+foreach my $pkg (sort keys %$csfy) {
+ my %data = %{$csfy->{$pkg}};
+ print "$pkg:";
+ if($pkg ne $data{svn_path}) {
+ print " (SVN: $data{svn_path})";
}
- print " + Bugs: ", join(", ", @bugs), "\n" if(@bugs);
+ print "\n";
+ if(%{$data{status}}) {
+ print " - Problems: ", join(", ", keys %{$data{status}}), "\n";
+ }
+ if(@{$data{notes}}) {
+ print " - Notes: ", join(", ", @{$data{notes}}), "\n";
+ }
+ print " - Repository status: ";
+ if($data{hilight}{svn}) {
+ print join(", ", keys %{$data{hilight}{svn}}), "\n";
+ } else {
+ print "OK\n";
+ }
+ if($data{svn}{version}) {
+ print " + Latest released: $data{svn}{version} ";
+ print "($data{svn}{changer})\n";
+ }
+ if($data{svn}{un_version}) {
+ print " + Latest unreleased: $data{svn}{un_version}\n";
+ }
+ #
+ print " - Debian archive status: ";
+ if($data{hilight}{archive}) {
+ print join(", ", keys %{$data{hilight}{archive}}), "\n";
+ } else {
+ print "OK\n";
+ }
+ if($data{archive}{most_recent}) {
+ print " + Latest version: $data{archive}{most_recent} ";
+ print "(from $data{archive}{most_recent_src})\n";
+ }
+ #
+ print " - BTS status: ";
+ if($data{hilight}{bts}) {
+ print join(", ", keys %{$data{hilight}{bts}}), "\n";
+ } else {
+ print "OK\n";
+ }
+ foreach(keys %{$data{bts}}) {
+ print " + Bug #$_ - $data{bts}{$_}{subject}\n";
+ }
+ #
+ print " - Upstream status: ";
+ if($data{hilight}{upstream}) {
+ print join(", ", keys %{$data{hilight}{upstream}}), "\n";
+ } else {
+ print "OK\n";
+ }
+ print " + URL: $data{upstream_url}\n" if($data{upstream_url});
+ if($data{watch}{upstream_version}) {
+ print " + Latest version: $data{watch}{upstream_version}\n";
+ }
}
#use Data::Dumper; print Dumper $data;
@@ -99,8 +119,9 @@
--help, -h This help.
--conf, -c FILE Specifies a configuration file, uses defaults if not
present.
- --packages Treat the parameters as source package names, instead of
- directories.
+ --directories Treat the parameters as repository directory names, instead
+ of source package names.
+ --showall Show status of all packages, including OK packages.
END
exit 0;
More information about the Pkg-perl-cvs-commits
mailing list