r5928 - /scripts/qa/versioncheck.pl

[dmn at users.alioth.debian.org]

Author: dmn
Date: Fri Jul 20 14:18:50 2007
New Revision: 5928

URL: http://svn.debian.org/wsvn/?sc=1&rev=5928
Log:
uscan checking still does not work, but CPAN one actually does

Modified:
    scripts/qa/versioncheck.pl

Modified: scripts/qa/versioncheck.pl
URL: http://svn.debian.org/wsvn/scripts/qa/versioncheck.pl?rev=5928&op=diff
==============================================================================
--- scripts/qa/versioncheck.pl (original)
+++ scripts/qa/versioncheck.pl Fri Jul 20 14:18:50 2007
@@ -126,11 +126,79 @@
     $cpan = 'CPAN::Shell';
 };
 
-sub latest_upstream_from_watch(@)
-{
-    my @watch = @_;
+# RETURNS
+#  1 if first version is bigger
+#  0 if both versions are equal
+# -1 if second version is bigger
+sub cmp_ver($$)
+{
+    my($a,$b) = @_;
+
+    while( $a and $b )
+    {
+        $a =~ s/^(\w*)//; my $a_w = $1||'';
+        $b =~ s/^(\w*)//; my $b_w = $1||'';
+
+        my $r = $a_w cmp $b_w;
+
+        return $r if $r;
+
+        $a =~ s/^(\d*)//; my $a_d = defined($1) ? $1 : -1;
+        $b =~ s/^(\d*)//; my $b_d = defined($1) ? $1 : -1;
+
+        $r = $a_d <=> $b_d;
+
+        return $r if $r;
+
+        $a =~ s/^(\D*)//; my $a_nd = $1||'';
+        $b =~ s/^(\D*)//; my $b_nd = $1||'';
+
+        $r = $a_nd cmp $b_nd;
+
+        return $r if $r;
+    }
+    return 1 if $a;
+    return -1 if $b;
+    return 0;
+}
+
+# RETURNS undef if all watch files point to CPAN
+sub latest_upstream_from_watch($;$)
+{
+    my ($watch, $cpan_ver) = @_;
+
+    my @non_cpan = grep( !/cpan/i, @$watch );
+
+    return $cpan_ver unless @non_cpan;
 
     return 'EUNIMPL';
+}
+
+sub latest_upstream_from_cpan($)
+{
+    my ($watch) = @_;
+
+    my @cpan = grep( m{^(?:http|ftp)://.*cpan}i, @$watch );
+
+    return undef unless @cpan;
+
+    my @vers;
+
+    foreach(@cpan)
+    {
+        s{^(?:http|ftp)://.+/\s*}{};
+        s{-?\(.+$}{};
+        s/-/::/g;
+
+        debugmsg( sprintf( "    cpan search %s\n", $_ ) );
+        my $cpan_mod = $cpan->expand('Module', $_);
+
+        push @vers, $cpan_mod->cpan_version if $cpan_mod;
+    }
+
+    @vers = sort { cmp_ver($a,$b) } @vers;
+
+    return $vers[-1];
 }
 
 print <<_EOF;
@@ -246,22 +314,13 @@
         );
 
 
-        my $in_incoming = $incoming{$pkg};
+        my $in_incoming = $incoming{$pkg}||'';
         debugmsg( sprintf( " - incoming has %s\n", $in_incoming||'none' ) );
-        my $in_new = $new{$pkg};
+        my $in_new = $new{$pkg}||'';
         debugmsg( sprintf( " - NEW has %s\n", $in_new||'none' ) );
 
-        my $mod_name = $pkg;
-        $mod_name =~ s/-perl$//;
-        $mod_name =~ s/^lib(.)/\U$1/;
-        $mod_name =~ s/-(.)/::\U$1/g;
-        debugmsg( sprintf( " + module name is %s\n", $mod_name ) );
-
-        my $mod_cpan = $cpan->expand('Module', $mod_name);
-        my $in_cpan = $mod_cpan->cpan_version if $mod_cpan;
-        debugmsg( sprintf( " - CPAN has %s\n", $in_cpan||'none' ) );
-
         my $upstream = '';
+        my $in_cpan = '';
 
         eval {
             my $watch;
@@ -287,7 +346,10 @@
 
             if( @watch )
             {
-                $upstream = latest_upstream_from_watch(@watch);
+                $in_cpan = latest_upstream_from_cpan(\@watch);
+                debugmsg( sprintf( " - CPAN has %s\n", $in_cpan||'none' ) );
+                $upstream = latest_upstream_from_watch(\@watch, $in_cpan);
+                debugmsg( sprintf( " - upstream has %s\n", $upstream||'none' ) );
             }
             else
             {
@@ -309,7 +371,6 @@
                 die $@;
             }
         }
-        debugmsg( sprintf( " - upstream has %s\n", $upstream||'none' ) );
 
 
         if( $up_svn ne $upstream
@@ -344,7 +405,11 @@
             )."</td>\n";
             print(
                 ($up_svn ne $upstream)
-                ? "<td class=\"upgrade\">$upstream</td>\n"
+                ? "<td class=\"upgrade\">".join(
+                    "\n",
+                    $upstream,
+                    ( $in_cpan ? "CPAN:&nbsp;$in_cpan" : () )
+                )."</td>\n"
                 : "<td>&nbsp</td>\n"
             );
             print "<tr>\n";