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