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

tincho-guest at users.alioth.debian.org tincho-guest at users.alioth.debian.org
Thu Nov 8 04:34:06 UTC 2007


Author: tincho-guest
Date: Thu Nov  8 04:34:05 2007
New Revision: 9008

URL: http://svn.debian.org/wsvn/?sc=1&rev=9008
Log:
Simplified a little the cpan stuff: don't handle dist as a different thing

Modified:
    scripts/qa/DebianQA/Watch.pm

Modified: scripts/qa/DebianQA/Watch.pm
URL: http://svn.debian.org/wsvn/scripts/qa/DebianQA/Watch.pm?rev=9008&op=diff
==============================================================================
--- scripts/qa/DebianQA/Watch.pm (original)
+++ scripts/qa/DebianQA/Watch.pm Thu Nov  8 04:34:05 2007
@@ -24,10 +24,7 @@
 use Fcntl qw(:seek);
 use LWP::UserAgent;
 
-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 $cpanregex = qr#^(?:http|ftp)://\S*(?:cpan|backpan)\S*/(dist|modules/by-module|(?:by-)?authors/id)\b#i;
 
 my $ua = new LWP::UserAgent;
 $ua->timeout(10);
@@ -171,10 +168,6 @@
         @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);
@@ -214,30 +207,21 @@
 sub cpan_lookup($$) {
     my($dir, $filter) = @_;
 
-    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 ();
-    }
+    $dir =~ $cpanregex or return ();
+    my $base = $1;
+    $base =~ s/.*(dist|modules|authors).*// or return ();
+    $base = $1;
+    if($base eq "dist") {
+        $filter =~ s/.*\///;
+    }
+    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;
@@ -317,6 +301,7 @@
                         )?
                         | \.tgz     # or .tgz
                         | \.zip     # or .zip
+                        | \.rar     # or .rar
                     )
                     $           # and this is at the end
                 }x




More information about the Pkg-perl-cvs-commits mailing list