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