r15903 - in /scripts/qa/DebianQA: Common.pm Watch.pm
tincho-guest at users.alioth.debian.org
tincho-guest at users.alioth.debian.org
Thu Feb 28 19:21:37 UTC 2008
Author: tincho-guest
Date: Thu Feb 28 19:21:37 2008
New Revision: 15903
URL: http://svn.debian.org/wsvn/?sc=1&rev=15903
Log:
Watch.pm: Big changes, separate watch scanning from consolidated cache generation, correctly upgrade cache when version changes and handle new packages correctly too.
Common.pm: cache version bumped.
Modified:
scripts/qa/DebianQA/Common.pm
scripts/qa/DebianQA/Watch.pm
Modified: scripts/qa/DebianQA/Common.pm
URL: http://svn.debian.org/wsvn/scripts/qa/DebianQA/Common.pm?rev=15903&op=diff
==============================================================================
--- scripts/qa/DebianQA/Common.pm (original)
+++ scripts/qa/DebianQA/Common.pm Thu Feb 28 19:21:37 2008
@@ -19,7 +19,7 @@
#our $VERSION = qv("1.000");
# Bump this version in case of data file change
-our $VERSION = 1.003;
+our $VERSION = 1.004;
use DebianQA::Config '%CFG';
use POSIX;
Modified: scripts/qa/DebianQA/Watch.pm
URL: http://svn.debian.org/wsvn/scripts/qa/DebianQA/Watch.pm?rev=15903&op=diff
==============================================================================
--- scripts/qa/DebianQA/Watch.pm (original)
+++ scripts/qa/DebianQA/Watch.pm Thu Feb 28 19:21:37 2008
@@ -40,88 +40,127 @@
cpan_dist_download($force);
cpan_index_download($force);
}
+ if(find_stamp(watch_get(), "") == 0) {
+ warn("Forcing complete update -- watch cache has old version");
+ @pkglist = ();
+ $force = 1;
+ }
my $complete;
if(not @pkglist) {
$complete = 1;
- @pkglist = grep(! /^\//, get_pkglist());
- }
- my $cdata = watch_get() unless($force);
- my(%watch, %watch2, @not_updated);
+ @pkglist = get_pkglist();
+ }
+ my $cdata;
+ $cdata = watch_get() unless($force);
+ my(%watch, $some_uptodate, @updated);
foreach my $pkg (@pkglist) {
debug("Retrieving watchfile from svn for $pkg");
my $svndata = svn_get(pkgname2svndir($pkg));
- if($svndata->{watch_error}) {
- info("Error from svn: " . $svndata->{watch_error});
- $watch2{$pkg} = { error => $svndata->{watch_error} };
- next;
- }
- unless($svndata->{watch} and ref $svndata->{watch}
- and ref $svndata->{watch} eq "ARRAY") {
- info("Missing watch file");
- $watch2{$pkg} = { error => "Missing" };
- next;
- }
- my @wlines = @{$svndata->{watch}};
- unless(@wlines) {
- info("Empty watch file");
- $watch2{$pkg} = { error => "Empty" };
- next;
- }
- my @wresult;
- foreach my $wline (@wlines) {
+ unless(not $svndata->{watch_error}
+ and $svndata->{watch} and ref $svndata->{watch}
+ and ref $svndata->{watch} eq "ARRAY"
+ and @{$svndata->{watch}}) {
+ push @updated, $pkg; # Those have no stamp, so force rescan
+ next; # Errors will be set in consolidated
+ }
+
+ my(@wresult);
+ foreach my $wline (@{$svndata->{watch}}) {
my $md5 = $wline->{md5};
next unless($md5);
if(not $force and $cdata->{$md5} and
$CFG{watch}{ttl} * 60 > time - find_stamp($cdata, $md5)) {
- $watch{$md5} = $cdata->{$md5};
- push @not_updated, $md5;
+ $some_uptodate = 1;
+ next;
+ }
+ my ($watcherr, %uscand) = uscan($wline->{line}, %{$wline->{opts}});
+ if($watcherr) {
+ warn("Error while processing $pkg watch file: $watcherr");
} else {
- my ($watcherr, %uscand) = uscan($wline->{line},
- %{$wline->{opts}});
- if($watcherr) {
- warn("Error while processing $pkg watch file: $watcherr");
- } else {
- info("Found: version $uscand{upstream_version} ",
- "from $uscand{upstream_url} ",
- "(mangled: $uscand{upstream_mangled})");
- }
- $watch{$md5} = { watch_error => $watcherr, %uscand };
- }
- my $diff = 0;
+ info("Found: version $uscand{upstream_version} ",
+ "from $uscand{upstream_url} ",
+ "(mangled: $uscand{upstream_mangled})");
+ }
+ $watch{$md5} = { error => $watcherr, %uscand };
+ push @updated, $pkg;
+
if(not $watch{$md5}{upstream_mangled}) {
- $watch{$md5}{watch_error} ||= "Error";
- } elsif($wline->{mangled_ver}) {
- $diff = deb_compare($wline->{mangled_ver},
- $watch{$md5}{upstream_mangled});
- $watch{$md5}{watch_error} = "InvalidVersion" unless(
- defined $diff);
- }
- push @wresult, { diff => $diff, %{$watch{$md5}} };
- }
- my @noerror = grep({ not $_->{watch_error} } @wresult);
- @noerror = sort({
+ $watch{$md5}{error} ||= "Error";
+ } elsif(not scalar (deb_parse($watch{$md5}{upstream_mangled}))) {
+ $watch{$md5}{error} ||= "InvalidUpstreamVersion";
+ } elsif($wline->{mangled_ver}
+ and not scalar (deb_parse($watch{$md5}{mangled_ver}))) {
+ $watch{$md5}{error} ||= "InvalidDebianVersion";
+ }
+ }
+ }
+ info("watch: ", scalar @pkglist, " packages scanned");
+ if(not @updated and (
+ find_stamp(read_cache("consolidated", "pkglist", 0)) <=
+ find_stamp(read_cache("consolidated", "watch", 0)))) {
+ info("Watch cache is up-to-date");
+ return;
+ }
+ $cdata = update_cache("watch", \%watch, "",
+ ($complete and not $some_uptodate), 1);
+ # Start consolidated build
+ my %watch2;
+ unless($complete) {
+ # Only re-process updated entries
+ @pkglist = @updated;
+ }
+ foreach my $pkg (@pkglist) {
+ my $svndata = svn_get(pkgname2svndir($pkg));
+ $watch2{$pkg} = {};
+
+ if($svndata->{watch_error}) {
+ $watch2{$pkg}{error} = $svndata->{watch_error};
+ } elsif(not $svndata->{watch} or not ref $svndata->{watch}
+ or not ref $svndata->{watch} eq "ARRAY") {
+ $watch2{$pkg}{error} = "Missing";
+ } elsif(not @{$svndata->{watch}}) {
+ $watch2{$pkg}{error} = "Empty";
+ }
+ next if($watch2{$pkg}{error});
+
+ my(@wresult, $error);
+ foreach my $wline (@{$svndata->{watch}}) {
+ my $md5 = $wline->{md5};
+ next unless($md5);
+ if($cdata->{md5}{error}) {
+ $error = $cdata->{md5}{error};
+ next;
+ }
+ next unless($cdata->{$md5}{upstream_mangled}
+ and $wline->{mangled_ver});
+
+ push @wresult, {
+ diff => deb_compare($wline->{mangled_ver},
+ $cdata->{$md5}{upstream_mangled}),
+ %{$cdata->{$md5}}
+ };
+ }
+ unless(@wresult) {
+ $watch2{$pkg} = { error => $error || "MissingData?" };
+ next;
+ }
+ @wresult = sort({
deb_compare_nofail($a->{upstream_mangled},
- $b->{upstream_mangled}) } @noerror);
- unless(@noerror) {
- $watch2{$pkg} = { error => $wresult[0]{watch_error} };
- next;
- }
+ $b->{upstream_mangled}) } @wresult);
my @result;
- if(@result = grep({ $_->{diff} < 0 } @noerror)) {
+ if(@result = grep({ $_->{diff} < 0 } @wresult)) {
$watch2{$pkg} = $result[-1];
- } elsif(@result = grep( { not $_->{diff} } @noerror)) {
+ } elsif(@result = grep( { not $_->{diff} } @wresult)) {
$watch2{$pkg} = $result[0];
} else {
- $watch2{$pkg} = $noerror[0];
+ $watch2{$pkg} = $wresult[0];
}
delete($watch2{$pkg}{diff}) unless($watch2{$pkg}{diff});
- delete($watch2{$pkg}{watch_error}) unless($watch2{$pkg}{watch_error});
- }
- delete $watch{$_} foreach(@not_updated);
- update_cache("watch", \%watch, "", $complete && @not_updated == 0, 1);
+ delete($watch2{$pkg}{error}) unless($watch2{$pkg}{error});
+ }
+
update_cache("consolidated", \%watch2, "watch", $complete, 0);
unlock_cache("watch");
- info("watch: ", scalar @pkglist, " packages scanned");
}
# Returns the hash of bugs. Doesn't download anything.
sub watch_get {
More information about the Pkg-perl-cvs-commits
mailing list