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

[dmn at users.alioth.debian.org]

Author: dmn
Date: Tue Nov  6 13:29:50 2007
New Revision: 8921

URL: http://svn.debian.org/wsvn/?sc=1&rev=8921
Log:
Add support for watch files using search.cpan.org/dist/$dist_name/-like URLs

Modified:
    scripts/qa/DebianQA/Watch.pm

Modified: scripts/qa/DebianQA/Watch.pm
URL: http://svn.debian.org/wsvn/scripts/qa/DebianQA/Watch.pm?rev=8921&op=diff
==============================================================================
--- scripts/qa/DebianQA/Watch.pm (original)
+++ scripts/qa/DebianQA/Watch.pm Tue Nov  6 13:29:50 2007
@@ -26,6 +26,8 @@
 
 my $cpanregex =
 qr#^(?:http|ftp)://\S*(?:cpan|backpan)\S*/(modules/by-module|(?:by-)?authors/id)\b#i;
+my $cpan_dist_re = qr#^https?://search\.cpan\.org/dist/([^/]+)/?\s+\S*/(\S+)#i;
+                                                 # dist-^^^^^     regex-^^^
 
 my $ua = new LWP::UserAgent;
 $ua->timeout(10);
@@ -169,6 +171,10 @@
         @vers = cpan_lookup($dir, $filter);
         warn("CPAN lookup failed for $dir + $filter") unless(@vers);
     }
+    if($CFG{watch}{use_cpan} and $wline =~ $cpan_dist_re) {
+        @vers = cpan_lookup($wline, undef);
+        warn("CPAN lookup failed for $wline") unless(@vers);
+    }
     unless(@vers) {
         debug("Downloading $dir");
         my $res = $ua->get($dir);
@@ -207,20 +213,30 @@
 sub cpan_lookup($$) {
     my($dir, $filter) = @_;
 
-    return () unless($dir =~ $cpanregex);
-    my $base = $1;
-    unless($base =~ s/.*(modules|authors).*//) {
+    if($dir =~ $cpanregex) {
+        my $base = $1;
+        unless($base =~ s/.*(modules|authors).*//) {
+            return ();
+        }
+        $base = $1;
+        my $cpan = cpan_download()->{$base};
+        my $olddir = $dir;
+        $dir =~ s/$cpanregex//i;
+        $dir =~ s{/+$}{};
+        $dir =~ s{^/+}{};
+        debug("Looking for $dir + $filter into CPAN $base cache");
+        return () unless(exists($cpan->{$dir}));
+        return grep(defined, map({ $_ =~ $filter ? $1 : undef } @{$cpan->{$dir}}));
+    } elsif($dir =~ $cpan_dist_re) {
+        my $dist = $1;
+        $filter = $2;
+        debug("Looking for $dist + $filter into CPAN dist cache");
+        my $cpan = cpan_download()->{dist};
+        return () unless exists($cpan->{$dist});
+        return grep(defined, map({ $_ =~ $filter ? $1 : undef } @{$cpan->{$dist}}));
+    } else {
         return ();
     }
-    $base = $1;
-    my $cpan = cpan_download()->{$base};
-    my $olddir = $dir;
-    $dir =~ s/$cpanregex//i;
-    $dir =~ s{/+$}{};
-    $dir =~ s{^/+}{};
-    debug("Looking for $dir + $filter into CPAN $base cache");
-    return () unless(exists($cpan->{$dir}));
-    return grep(defined, map({ $_ =~ $filter ? $1 : undef } @{$cpan->{$dir}}));
 }
 sub cpan_download(;$) {
     my $force = shift;
@@ -283,6 +299,25 @@
         my @fields = split;
         if(@fields >= 9 and $fields[8] ne "CHECKSUMS") {
             push @{$cpan->{$type}{$dir}}, $fields[8];
+
+            if($fields[8] =~ m{
+                    (\S+?)      # dist name, non-greedy
+                    -           # separator - dash (between dist name and the version
+                    v?          # optional v before the version string
+                    (?:         # version
+                        \d          # starts with a digit
+                        [\d._]+     # followed by digits, periods and underscores
+                    )
+                    (?:         # file extension
+                        \.tar       # .tar
+                        (?:\.gz)?   # probably followed by .gz
+                        | \.zip     # or zip
+                    )
+                    $           # and this is at the end
+                }x
+            ) {
+                push @{$cpan->{dist}{$1}}, $fields[8];
+            }
         }
     }
     close $data;