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