r6420 - /scripts/qa/versioncheck.pl

[dmn at users.alioth.debian.org]

Author: dmn
Date: Fri Aug 10 10:47:32 2007
New Revision: 6420

URL: http://svn.debian.org/wsvn/?sc=1&rev=6420
Log:
Fix parsing watch options (multiple spaces after them); FTP directories have no <a href="..."> things

Modified:
    scripts/qa/versioncheck.pl

Modified: scripts/qa/versioncheck.pl
URL: http://svn.debian.org/wsvn/scripts/qa/versioncheck.pl?rev=6420&op=diff
==============================================================================
--- scripts/qa/versioncheck.pl (original)
+++ scripts/qa/versioncheck.pl Fri Aug 10 10:47:32 2007
@@ -289,7 +289,11 @@
                                         #  non-greedy to not eat up the pattern
                 (?:/\s*|\s+)            # delimiter - '/' for ver3 or space for ver2
                 ([^\s/]+)               # the search pattern - no spaces, no slashes - captured
-                (?!.*\()                # not followed by search pattern
+                (?:
+                    (?!.*\()            # followed by non-(search pattern)
+                    |
+                    \s*$                # or EOL
+                )
             }ix )
         {
             my( $dir, $filter ) = ($1, $2);
@@ -299,11 +303,23 @@
             my $page_io = IO::Scalar->new(\$page);
             while( <$page_io> )
             {
-                #warn $_ if $_ =~ $filter;
-                while( s/<a [^>]*href="([^"]+)"[^>]*>// )
+                warn $_ if 0;
+
+                if( $dir =~ /^http/ )
                 {
-                    my $href = $1;
-                    push @vers, [$1,$url] if $href =~ $filter;
+                    while( s/<a [^>]*href="([^"]+)"[^>]*>// )
+                    {
+                        my $href = $1;
+                        warn $href;
+                        push @vers, [$1,$url] if $href =~ $filter;
+                    }
+                }
+                else
+                {
+                    while( s/(?:^|\s+)$filter(?:\s+|$)// )
+                    {
+                        push @vers, [$1,$url];
+                    }
                 }
             }
         }
@@ -575,7 +591,7 @@
         {
             debugmsg( "   watch line $_\n" ) if 0;
             # opts either contain no spaces, or is enclosed in double-quotes
-            my $opts = $1 if s!^\s*opts="([^"]*)"\s+!! or s!^\s*opts=(\S*)\s!!;
+            my $opts = $1 if s!^\s*opts="([^"]*)"\s+!! or s!^\s*opts=(\S*)\s+!!;
             debugmsg( "     watch options = $opts\n" ) if $opts;
             # several options are separated by comma and commas are not allowed within
             my @opts = split(/\s*,\s*/, $opts) if $opts;