r15908 - in /scripts/qa/DebianQA: Cache.pm DebVersions.pm Watch.pm
tincho-guest at users.alioth.debian.org
tincho-guest at users.alioth.debian.org
Thu Feb 28 20:28:50 UTC 2008
Author: tincho-guest
Date: Thu Feb 28 20:28:49 2008
New Revision: 15908
URL: http://svn.debian.org/wsvn/?sc=1&rev=15908
Log:
Watch.pm: Fixed a dumb error which fucked up everything. Better report errors.
Cache.pm: This time is for real: process the damn version data correctly!
DebVersions.pm: Export deb_valid instead of deb_parse, and use it to better
handle errors.
Modified:
scripts/qa/DebianQA/Cache.pm
scripts/qa/DebianQA/DebVersions.pm
scripts/qa/DebianQA/Watch.pm
Modified: scripts/qa/DebianQA/Cache.pm
URL: http://svn.debian.org/wsvn/scripts/qa/DebianQA/Cache.pm?rev=15908&op=diff
==============================================================================
--- scripts/qa/DebianQA/Cache.pm (original)
+++ scripts/qa/DebianQA/Cache.pm Thu Feb 28 20:28:49 2008
@@ -213,13 +213,17 @@
die "Invalid hashref" unless($hash and ref $hash and ref $hash eq "HASH");
if(not $path and (not $hash->{"/version"} or
$hash->{"/version"} < $VERSION)) {
- debug("find_stamp: returning 0 as cache has old version");
+ info("find_stamp: returning 0 as cache has old version");
return 0;
}
+ return find_stamp_recurse($hash, $path);
+}
+sub find_stamp_recurse {
+ my($hash, $path) = @_;
my $ctsmp = 0;
if($path =~ s{^/*([^/]+)}{}) {
my $root = $1;
- $ctsmp = find_stamp($hash->{$root}, $path) if($hash->{$root});
+ $ctsmp = find_stamp_recurse($hash->{$root}, $path) if($hash->{$root});
}
if(not $ctsmp and exists($hash->{"/stamp"})) {
$ctsmp = $hash->{"/stamp"};
Modified: scripts/qa/DebianQA/DebVersions.pm
URL: http://svn.debian.org/wsvn/scripts/qa/DebianQA/DebVersions.pm?rev=15908&op=diff
==============================================================================
--- scripts/qa/DebianQA/DebVersions.pm (original)
+++ scripts/qa/DebianQA/DebVersions.pm Thu Feb 28 20:28:49 2008
@@ -14,8 +14,13 @@
use Carp;
our @ISA = "Exporter";
-our @EXPORT = qw( deb_compare deb_compare_nofail deb_parse );
+our @EXPORT = qw( deb_compare deb_compare_nofail deb_valid );
+sub deb_valid($) {
+ my $v = shift;
+ return (defined $v and
+ $v =~ /^(?:(\d+):)?([A-Za-z0-9+.:~_-]*?)(?:-([+.~_A-Za-z0-9]+))?$/);
+}
sub deb_parse($) {
my $v = shift;
unless(defined $v) {
@@ -59,8 +64,9 @@
return 0;
}
sub deb_compare($$) {
- my @va = deb_parse($_[0]) or return undef;
- my @vb = deb_parse($_[1]) or return undef;
+ return undef unless(deb_valid($_[0]) and deb_valid($_[1]));
+ my @va = deb_parse($_[0]);
+ my @vb = deb_parse($_[1]);
# Epoch
return $va[0] <=> $vb[0] unless($va[0] == $vb[0]);
@@ -71,8 +77,10 @@
return deb_verrevcmp($va[2], $vb[2]);
}
sub deb_compare_nofail($$) {
- my @va = deb_parse($_[0]) or return 1;
- my @vb = deb_parse($_[1]) or return -1;
+ return 1 unless(deb_valid($_[0]));
+ return -1 unless(deb_valid($_[1]));
+ my @va = deb_parse($_[0]);
+ my @vb = deb_parse($_[1]);
# Epoch
return $va[0] <=> $vb[0] unless($va[0] == $vb[0]);
Modified: scripts/qa/DebianQA/Watch.pm
URL: http://svn.debian.org/wsvn/scripts/qa/DebianQA/Watch.pm?rev=15908&op=diff
==============================================================================
--- scripts/qa/DebianQA/Watch.pm (original)
+++ scripts/qa/DebianQA/Watch.pm Thu Feb 28 20:28:49 2008
@@ -74,9 +74,7 @@
next;
}
my ($watcherr, %uscand) = uscan($wline->{line}, %{$wline->{opts}});
- if($watcherr) {
- warn("Error while processing $pkg watch file: $watcherr");
- } else {
+ unless($watcherr) {
info("Found: version $uscand{upstream_version} ",
"from $uscand{upstream_url} ",
"(mangled: $uscand{upstream_mangled})");
@@ -86,12 +84,14 @@
if(not $watch{$md5}{upstream_mangled}) {
$watch{$md5}{error} ||= "Error";
- } elsif(not scalar (deb_parse($watch{$md5}{upstream_mangled}))) {
+ } elsif(not deb_valid($watch{$md5}{upstream_mangled})) {
$watch{$md5}{error} ||= "InvalidUpstreamVersion";
} elsif($wline->{mangled_ver}
- and not scalar (deb_parse($watch{$md5}{mangled_ver}))) {
+ and not deb_valid($wline->{mangled_ver})) {
$watch{$md5}{error} ||= "InvalidDebianVersion";
}
+ warn("Error while processing $pkg watch file: ",
+ $watch{$md5}{error}) if($watch{$md5}{error});
}
}
info("watch: ", scalar @pkglist, " packages scanned");
More information about the Pkg-perl-cvs-commits
mailing list