r6181 - /scripts/qa/versioncheck.pl

dmn at users.alioth.debian.org dmn at users.alioth.debian.org
Tue Jul 31 11:23:11 UTC 2007


Author: dmn
Date: Tue Jul 31 11:23:11 2007
New Revision: 6181

URL: http://svn.debian.org/wsvn/?sc=1&rev=6181
Log:
make upstream version link to the upstream page

Modified:
    scripts/qa/versioncheck.pl

Modified: scripts/qa/versioncheck.pl
URL: http://svn.debian.org/wsvn/scripts/qa/versioncheck.pl?rev=6181&op=diff
==============================================================================
--- scripts/qa/versioncheck.pl (original)
+++ scripts/qa/versioncheck.pl Tue Jul 31 11:23:11 2007
@@ -5,8 +5,7 @@
 
 ### TODO ###
 #
-# Make "CPAN: x.xx" link to the upstream site (the path component of the watch
-# file)
+# Empty :)
 
 our $THIS_REVISION = '$Id$';
 
@@ -273,7 +272,12 @@
     foreach(@$watch)
     {
         my( $wline, $opts ) = @$_;
-        $wline =~ s{^http://sf\.net/}{http://qa.debian.org/watch/sf.php/};
+
+        $wline =~ m{^(http://\S+)/};
+        my $url = $1;
+        $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
@@ -284,6 +288,7 @@
         {
             my( $dir, $filter ) = ($1, $2);
             debugmsg( "   uscan $dir $filter\n" );
+            $url ||= $dir;
             my $page = LWP::Simple::get($dir) or return "Unable to get $dir (".__LINE__.")";
             my $page_io = IO::Scalar->new(\$page);
             while( <$page_io> )
@@ -292,7 +297,7 @@
                 while( s/<a [^>]*href="([^"]+)"[^>]*>// )
                 {
                     my $href = $1;
-                    push @vers, $1 if $href =~ $filter;
+                    push @vers, [$1,$url] if $href =~ $filter;
                 }
             }
         }
@@ -302,11 +307,17 @@
         }
     }
 
-    @vers = sort { cmp_ver($a,$b) } @vers;
-
-    return $vers[-1] || '';
-}
-
+    @vers = sort { cmp_ver($a->[0],$b->[0]) } @vers;
+
+    my $ver = $vers[-1];
+    my $url;
+
+    ($ver, $url) = $ver ? @$ver : (undef, undef);
+
+    return wantarray ? ($ver, $url) : $ver;
+}
+
+# returns array of [ver, path]
 sub cpan_versions($$$)
 {
     my($where, $wline, $opts) = @_;
@@ -342,12 +353,13 @@
                 die "<<\$_ =~ $uvm>> $@" if $@;
             }
         }
-        push @vers, $1 if $_ =~ $filter;
+        push @vers, [$1, $key] if $_ =~ $filter;
     }
 
     return @vers;
 }
 
+# returns (version, URL)
 sub latest_upstream_from_cpan($$)
 {
     my ($watch, $pkg) = @_;
@@ -364,7 +376,10 @@
         if( $wline =~ s{^(?:http|ftp)://\S*cpan\S*/modules/by-module/}{}i )
         {
             # lookup by module
-            push @vers, cpan_versions(\%cpan_modules, $wline, $opts);
+            push @vers, map(
+                [ $_->[0], "http://www.cpan.org/modules/by-module/".$_->[1] ],
+                cpan_versions(\%cpan_modules, $wline, $opts),
+            );
         }
         elsif( $wline =~ s{^(?:http|ftp)://\S*cpan\S*/authors/(?:by-)?id/}{}i
                 or
@@ -372,7 +387,10 @@
         )
         {
             # lookup by author
-            push @vers, cpan_versions(\%cpan_authors, $wline, $opts);
+            push @vers, map(
+                [ $_->[0], "http://www.cpan.org/authors/id/".$_->[1] ],
+                cpan_versions(\%cpan_authors, $wline, $opts),
+            );
         }
         else
         {
@@ -381,9 +399,20 @@
         }
     }
 
-    @vers = sort { cmp_ver($a,$b) } @vers;
-
-    return $vers[-1] || '';
+    @vers = sort { cmp_ver($a->[0],$b->[0]) } @vers;
+
+    my $ver = $vers[-1];
+    my $url;
+    if( $ver )
+    {
+        ($ver, $url) = @$ver;
+    }
+    else
+    {
+        undef($ver); undef($url);
+    }
+
+    return wantarray ? ($ver, $url) : $ver;
 }
 
 sub unmangle_debian_version($$)
@@ -512,6 +541,7 @@
     my $upstream = '';
     my $upstream_is_cpan;
     my $in_cpan = '';
+    my $upstream_url;
     my @watch;
     eval {
         my $watch;
@@ -587,8 +617,8 @@
 
     if( @watch )
     {
-        $in_cpan = latest_upstream_from_cpan(\@watch, $pkg);
-        debugmsg( sprintf( " - CPAN has %s\n", $in_cpan||'none' ) );
+        ($in_cpan,  $upstream_url) = latest_upstream_from_cpan(\@watch, $pkg);
+        debugmsg( sprintf( " - CPAN has %s (%s)\n", $in_cpan||'none', $upstream_url||'no url' ) );
         if( $in_cpan )
         {
             $upstream_is_cpan = 1;
@@ -596,9 +626,9 @@
         }
         else
         {
-            $upstream = latest_upstream_from_watch(\@watch);
-        }
-        debugmsg( sprintf( " - upstream has %s\n", $upstream||'none' ) );
+            ($upstream, $upstream_url) = latest_upstream_from_watch(\@watch);
+        }
+        debugmsg( sprintf( " - upstream has %s (%s)\n", $upstream||'none', $upstream_url||'no url' ) );
     }
     else
     {




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