r6175 - /scripts/qa/versioncheck.pl

dmn at users.alioth.debian.org dmn at users.alioth.debian.org
Tue Jul 31 10:33:00 UTC 2007


Author: dmn
Date: Tue Jul 31 10:33:00 2007
New Revision: 6175

URL: http://svn.debian.org/wsvn/?sc=1&rev=6175
Log:
Really support both ver2 and ver3 watch files

Modified:
    scripts/qa/versioncheck.pl

Modified: scripts/qa/versioncheck.pl
URL: http://svn.debian.org/wsvn/scripts/qa/versioncheck.pl?rev=6175&op=diff
==============================================================================
--- scripts/qa/versioncheck.pl (original)
+++ scripts/qa/versioncheck.pl Tue Jul 31 10:33:00 2007
@@ -273,11 +273,17 @@
     foreach(@$watch)
     {
         my( $wline, $opts ) = @$_;
-        if( $wline =~ m{^((?:http|ftp)://\S*)(?:/|\s+)([^\s/]+)}i )
+        if( $wline =~ m{
+                ^((?:http|ftp)://\S*?)  # http://server/some/path - captured
+                                        #  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
+            }ix )
         {
             my( $dir, $filter ) = ($1, $2);
-            debugmsg( "   uscan search $dir $filter\n" );
-            my $page = LWP::Simple::get($dir) or return "Unable to get $dir";
+            debugmsg( "   uscan $dir $filter\n" );
+            my $page = LWP::Simple::get($dir) or return "Unable to get $dir (".__LINE__.")";
             my $page_io = IO::Scalar->new(\$page);
             while( <$page_io> )
             {
@@ -299,14 +305,20 @@
 {
     my($where, $wline, $opts) = @_;
 
-    $wline =~ s{(.+)(?:/|\s)([^/\s]+)(?:\s|$)}{};
+    $wline =~ m{
+                ^(\S*?)                 # some/path - captured
+                                        #  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
+            }ix;
     my( $key, $filter) = ($1, $2);
     debugmsg( sprintf( "   module search %s %s\n", $key, $filter ) );
 
     my $list = $where->{$key};
     unless($list)
     {
-        debugmsg("directory $key not found\n");
+        debugmsg("directory $key not found (from $wline) [".__LINE__."]\n");
         return();
     }
 




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