r8892 - /scripts/qa/DebianQA/Watch.pm

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

Author: tincho-guest
Date: Tue Nov  6 07:24:53 2007
New Revision: 8892

URL: http://svn.debian.org/wsvn/?sc=1&rev=8892
Log:
Fixed various problems wrt cpan

Modified:
    scripts/qa/DebianQA/Watch.pm

Modified: scripts/qa/DebianQA/Watch.pm
URL: http://svn.debian.org/wsvn/scripts/qa/DebianQA/Watch.pm?rev=8892&op=diff
==============================================================================
--- scripts/qa/DebianQA/Watch.pm (original)
+++ scripts/qa/DebianQA/Watch.pm Tue Nov  6 07:24:53 2007
@@ -34,6 +34,9 @@
     $force ||= 0;
     debug("watch_download($force, (@pkglist))");
 
+    if($CFG{watch}{use_cpan}) {
+        cpan_download($force);
+    }
     my $complete;
     if(not @pkglist) {
         $complete = 1;
@@ -101,7 +104,7 @@
         } elsif(@result = grep( { not $_->[0] } @noerror)) {
             $watch2{$pkg} = { upstream_ver => $result[0][2] }; # OK
         } else {
-            $watch2{$pkg} = { error => "MissingUpstream",
+            $watch2{$pkg} = { error => "NewerThanUpstream",
                 upstream_ver => $noerror[0][2] };
         }
     }
@@ -147,8 +150,11 @@
     }
     debug("uscan $dir $filter");
     my @vers;
-    unless($CFG{watch}{use_cpan} and $dir =~ $cpanregex
-            and @vers = cpan_lookup($dir, $filter)) {
+    if($CFG{watch}{use_cpan} and $dir =~ $cpanregex) {
+        @vers = cpan_lookup($dir, $filter);
+        warn("CPAN lookup failed for $dir + $filter") unless(@vers);
+    }
+    unless(@vers) {
         debug("Downloading $dir");
         my $res = $ua->get($dir);
         unless($res->is_success) {
@@ -172,7 +178,7 @@
             eval "\$mangled[-1] =~ $_";
             if($@) {
                 error("Invalid watchfile: $@");
-                return "Invalid";
+                return("Invalid");
             }
         }
     }
@@ -183,26 +189,29 @@
 sub cpan_lookup($$) {
     my($dir, $filter) = @_;
 
-    return undef unless($dir =~ $cpanregex);
+    return () unless($dir =~ $cpanregex);
     my $base = $1;
     unless($base =~ s/.*(modules|authors).*//) {
-        return undef;
+        return ();
     }
     $base = $1;
-    my $cpan = cpan_download($base);
+    my $cpan = cpan_download()->{$base};
     my $olddir = $dir;
     $dir =~ s/$cpanregex//;
     $dir =~ s{/+$}{};
     $dir =~ s{^/+}{};
     debug("Looking for $dir + $filter into CPAN $base cache");
-    return undef unless(exists($cpan->{$dir}));
+    return () unless(exists($cpan->{$dir}));
     return grep(defined, map({ $_ =~ $filter ? $1 : undef } @{$cpan->{$dir}}));
 }
-sub cpan_download($) {
-    my $base = shift;
-    my $cpan = read_cache("cpan", "", 0);
-    if($CFG{watch}{cpan_ttl} * 60 > time - find_stamp($cpan, $base)) {
-        return $cpan->{$base};
+sub cpan_download(;$) {
+    my $force = shift;
+    my $cpan;
+    unless($force) {
+        $cpan = read_cache("cpan", "", 0);
+        if($CFG{watch}{cpan_ttl} * 60 > time - find_stamp($cpan, "")) {
+            return $cpan;
+        }
     }
     $cpan = {};
 
@@ -245,6 +254,6 @@
     }
     close $data;
     update_cache("cpan", $cpan, "", 1);
-    return $cpan->{$base};
+    return $cpan;
 }
 1;