r7577 - /scripts/qa/versioncheck2.pl

dmn at users.alioth.debian.org dmn at users.alioth.debian.org
Fri Sep 14 18:11:46 UTC 2007


Author: dmn
Date: Fri Sep 14 18:11:46 2007
New Revision: 7577

URL: http://svn.debian.org/wsvn/?sc=1&rev=7577
Log:
Fix latest_upstream_from_watch() to properly work with single-URL and homepage+pattern watch files

Modified:
    scripts/qa/versioncheck2.pl

Modified: scripts/qa/versioncheck2.pl
URL: http://svn.debian.org/wsvn/scripts/qa/versioncheck2.pl?rev=7577&op=diff
==============================================================================
--- scripts/qa/versioncheck2.pl (original)
+++ scripts/qa/versioncheck2.pl Fri Sep 14 18:11:46 2007
@@ -375,19 +375,26 @@
         $url =~ s{^http://sf.net/}{http://sf.net.projects/};
 
         $wline =~ s{^http://sf\.net/(\S+)}{http://qa.debian.org/watch/sf.php/$1};
-        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 - captured
-                (?:
-                    (?!.*\()            # followed by non-(search pattern)
-                    |
-                    \s*$                # or EOL
-                )
-            }ix )
-        {
-            my( $dir, $filter ) = ($1, $2);
+
+        my @items = split(/\s+/, $wline);
+
+        my( $dir, $filter );
+
+        # Either we have single URL/pattern
+        if( @items == 1 )
+        {
+            # Since '+' is greedy, the second capture has no slashes
+            ($dir, $filter) = $items[0] =~ m{^(.+)/(.+)$};
+        }
+        # or, we have a homepage plus pattern
+        # (plus optional other non-interesting stuff)
+        elsif( @items >= 2 and $items[1] =~ /\(/ )
+        {
+            ($dir, $filter) = @items[0,1];
+        }
+
+        if( $dir and $filter )
+        {
             debugmsg( "   uscan $dir $filter\n" );
             $url ||= $dir;
             my $page = LWP::Simple::get($dir) or return "Unable to get $dir (".__LINE__.")";
@@ -462,7 +469,7 @@
     {
         if( $_ =~ $filter )
         {
-            debugmsg("     looking at $_\n") if 1;
+            debugmsg("     looking at $_\n") if 0;
             my $ver = unmangle( $1, $opts->{uversionmangle} );
             push @vers, [$ver, $key];
         }
@@ -668,8 +675,10 @@
 
     if( not @watch )
     {
+        warn "invalid debian/watch" if 0;
         return 'invalid';
     }
+    debugmsg('Found valid debian/watch') if 0;
     return ( 'valid', @watch );
 }
 
@@ -784,6 +793,7 @@
 foreach(keys %tmp) {
     my $pkg = $maindata{$_};
     my($st, @data) = read_watch($_);
+    debugmsg("$_: $st ".scalar(@data)) if 0;
     foreach(keys %{$pkg}) {
         delete $pkg->{$_} if(/^watch_/);
     }




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