r6174 - /scripts/qa/versioncheck.pl

[dmn at users.alioth.debian.org]

Author: dmn
Date: Tue Jul 31 10:08:44 2007
New Revision: 6174

URL: http://svn.debian.org/wsvn/?sc=1&rev=6174
Log:
Support version=2 watch files; implement direct upstream checking a-la uscan when CPAN search gives nothing

Modified:
    scripts/qa/versioncheck.pl

Modified: scripts/qa/versioncheck.pl
URL: http://svn.debian.org/wsvn/scripts/qa/versioncheck.pl?rev=6174&op=diff
==============================================================================
--- scripts/qa/versioncheck.pl (original)
+++ scripts/qa/versioncheck.pl Tue Jul 31 10:08:44 2007
@@ -4,11 +4,6 @@
 # Released under the terms of the GNU GPL 2
 
 ### TODO ###
-#
-# Fall-back to uscan when there is no other way
-# Perhaps even when there IS other way, but the versions differ
-# Would be best if we could copy the code over to avoid temp file + fork + exec
-# + parsing the output
 #
 # Make "CPAN: x.xx" link to the upstream site (the path component of the watch
 # file)
@@ -269,18 +264,42 @@
 }
 
 # RETURNS undef if all watch files point to CPAN
-sub latest_upstream_from_watch($;$$)
-{
-    my ($watch, $cpan_ver, $svn_ver) = @_;
-
-    return $cpan_ver || 'EUNIMPL';
+sub latest_upstream_from_watch($)
+{
+    my ($watch) = @_;
+
+    my @vers;
+
+    foreach(@$watch)
+    {
+        my( $wline, $opts ) = @$_;
+        if( $wline =~ m{^((?:http|ftp)://\S*)(?:/|\s+)([^\s/]+)}i )
+        {
+            my( $dir, $filter ) = ($1, $2);
+            debugmsg( "   uscan search $dir $filter\n" );
+            my $page = LWP::Simple::get($dir) or return "Unable to get $dir";
+            my $page_io = IO::Scalar->new(\$page);
+            while( <$page_io> )
+            {
+                push @vers, $1 if $_ =~ $filter;
+            }
+        }
+        else
+        {
+            return "bad watch URL $wline";
+        }
+    }
+
+    @vers = sort { cmp_ver($a,$b) } @vers;
+
+    return $vers[-1] || '';
 }
 
 sub cpan_versions($$$)
 {
     my($where, $wline, $opts) = @_;
 
-    $wline =~ s{(.+)/\s?([^/\s]+)(?:\s|$)}{};
+    $wline =~ s{(.+)(?:/|\s)([^/\s]+)(?:\s|$)}{};
     my( $key, $filter) = ($1, $2);
     debugmsg( sprintf( "   module search %s %s\n", $key, $filter ) );
 
@@ -486,7 +505,7 @@
         $watch =~ s/\\\n//gs;
         my @watch_lines = split(/\n/, $watch) if $watch;
 
-        @watch_lines = grep( !/^#/, @watch_lines );
+        @watch_lines = grep( (!/^#/ and !/^version=/), @watch_lines );
 
         foreach(@watch_lines)
         {
@@ -550,7 +569,7 @@
     {
         $in_cpan = latest_upstream_from_cpan(\@watch, $pkg);
         debugmsg( sprintf( " - CPAN has %s\n", $in_cpan||'none' ) );
-        $upstream = latest_upstream_from_watch(\@watch, $in_cpan, $up_svn);
+        $upstream = $in_cpan || latest_upstream_from_watch(\@watch);
         debugmsg( sprintf( " - upstream has %s\n", $upstream||'none' ) );
     }
     else