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

tincho-guest at users.alioth.debian.org tincho-guest at users.alioth.debian.org
Fri Feb 1 09:08:00 UTC 2008


Author: tincho-guest
Date: Fri Feb  1 09:08:00 2008
New Revision: 13948

URL: http://svn.debian.org/wsvn/?sc=1&rev=13948
Log:
uscan code almost rewritten to correctly cope with recursive matching. Also
fixed a bug when scanning broken html code (unquoted 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=13948&op=diff
==============================================================================
--- scripts/qa/DebianQA/Watch.pm (original)
+++ scripts/qa/DebianQA/Watch.pm Fri Feb  1 09:08:00 2008
@@ -172,7 +172,7 @@
         }
     }
     unless(@vers) {
-        @vers = recurse_dirs($filter, $dir, "");
+        @vers = recurse_dirs($filter, $dir);
         my $status = shift @vers;
         return $status || "NotFound" unless(@vers);
     }
@@ -198,25 +198,25 @@
         %{$vers[$order[-1]]},
         upstream_mangled => $mangled[$order[-1]]);
 }
-sub recurse_dirs($$$);
-sub recurse_dirs($$$) {
-    my($filter, $base, $remaining) = @_;
-    debug("recurse_dirs($filter, $base, $remaining)");
-
-    if($base =~ s{/([^/]*?\(.*)}{}) {
-        $remaining = "$1/$remaining";
-    }
-    my @rparts;
-    @rparts = split(/\/+/, $remaining) if($remaining);
-    while(@rparts and $rparts[0] !~ /\(/) {
-        $base .= "/" . shift @rparts;
-    }
-    if(@rparts) {
-        my ($status, @data) = recurse_dirs($rparts[0]."/?", $base, "");
+sub recurse_dirs($$);
+sub recurse_dirs($$) {
+    my($filter, $base) = @_;
+    debug("recurse_dirs($filter, $base)");
+
+    if($base =~ /\(/) {
+        my($newfilt, $staticpart) = ("", "");
+        while($base =~ s#/[^/(]*$##) {
+            $staticpart = "$&$staticpart";
+        }
+        $base =~ s#([^/]*\([^/]*)$## or die "Can't happen!!";
+        $newfilt = "$1/?";
+        debug("After stripping (): $newfilt, $base, remains: $staticpart");
+        my ($status, @data) = recurse_dirs($newfilt, $base);
         return $status unless(@data);
         @data = sort({ deb_compare_nofail($a->{upstream_version},
                     $b->{upstream_version}) } @data);
-        $base = $data[-1]{upstream_url};
+        $base = $data[-1]{upstream_url} . $staticpart;
+        debug("Return from recursion: $base");
     }
     unless($base =~ m{(^\w+://[^/]+)(/.*?)/*$}) {
         error("Invalid base: $base");
@@ -249,19 +249,21 @@
         @candidates = split(/\s+/, $page);
     } else {
         @candidates = grep(defined, ($page =~
-                m{<a\s[^>]*href\s*=\s*(?:"([^"]+)"|'([^']+)'|([^"]\S+))}gi));
+                m{<a\s[^>]*href\s*=\s*(?:"([^"]+)"|'([^']+)'|([^"][^\s>]+))}gi));
     }
     my @vers;
     foreach my $url (grep(m{^$pattern$}, @candidates)) {
-        $url =~ m{^$pattern$};
-        my @ver = map({substr($url, $-[$_], $+[$_] - $-[$_])} (1..$#+));
+        my $ver = join(".", ($url =~ m{^$pattern$}));
+        if($ver =~ s#/+$##) { # Can't find a better way
+            $url =~ s#\Q$&\E$##; # Remove the same
+        }
         if($url =~ m{^/}) {
             $url = $site . $url;
         } elsif($url !~ m{^\w+://}) {
             $url = $site . $path . "/" . $url;
         }
         push @vers, {
-            upstream_version => join(".", @ver),
+            upstream_version => $ver,
             upstream_url => $url };
     }
     debug("Versions found: ", join(", ", map({ $_->{upstream_version} }




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