r8560 - /scripts/qa/versioncheck2.pl
dmn at users.alioth.debian.org
dmn at users.alioth.debian.org
Wed Oct 24 19:32:31 UTC 2007
Author: dmn
Date: Wed Oct 24 19:32:31 2007
New Revision: 8560
URL: http://svn.debian.org/wsvn/?sc=1&rev=8560
Log:
Also support /dist/-based watch files via direct CPAN ls-lR.gz matching; Saves uscan-s
Modified:
scripts/qa/versioncheck2.pl
Modified: scripts/qa/versioncheck2.pl
URL: http://svn.debian.org/wsvn/scripts/qa/versioncheck2.pl?rev=8560&op=diff
==============================================================================
--- scripts/qa/versioncheck2.pl (original)
+++ scripts/qa/versioncheck2.pl Wed Oct 24 19:32:31 2007
@@ -201,15 +201,18 @@
or from_cache(\%new, 'new', 999) or die;
}
-my( %cpan_authors, %cpan_modules, $cpan_updated );
-unless(not $force_cpan and from_cache(\%cpan_authors, 'cpan_authors', 12)
- and from_cache(\%cpan_modules, 'cpan_modules', 12))
-{
- if(scan_cpan(\%cpan_authors, \%cpan_modules)) {
+my( %cpan_authors, %cpan_modules, %cpan_dists, $cpan_updated );
+unless(not $force_cpan
+ and from_cache(\%cpan_authors, 'cpan_authors', 12)
+ and from_cache(\%cpan_modules, 'cpan_modules', 12)
+ and from_cache(\%cpan_dists, 'cpan_dists', 12))
+{
+ if(scan_cpan(\%cpan_authors, \%cpan_modules, \%cpan_dists)) {
$cpan_updated = 1;
} else {
from_cache(\%cpan_authors, 'cpan_authors', 999) or die;
from_cache(\%cpan_modules, 'cpan_modules', 999) or die;
+ from_cache(\%cpan_dists, 'cpan_dists', 999) or die;
}
}
@@ -257,7 +260,7 @@
}
sub scan_cpan {
- my( $cpauth, $cpmod ) = @_;
+ my( $cpauth, $cpmod, $cpdist ) = @_;
open(TMP, '+>', undef) or die "Unable to open anonymous temporary file";
my $old = select(TMP);
my $lslr = LWP::Simple::getprint("$CPAN_MIRROR/ls-lR.gz");
@@ -276,6 +279,29 @@
chomp;
next unless $_;
+ # catch dist
+ if( m{
+ \s # blank
+ ( # $1 will capture the whole file name
+ (\S+?) # dist name - in $2
+ - # separator - dash
+ v? # optional 'v' before the version
+ (?: # version
+ \d # starts with a digit
+ [\d._]+ # followed by digits, periods and underscores
+ )
+ (?: # file extension
+ \.tar # .tar
+ (?:\.gz)? # most probably followed with .gz
+ | \.zip # yeah, that ugly OS is not wiped yet
+ )
+ )$}x # and this finishes the line
+ )
+ {
+ $cpdist->{$2} ||= [];
+ push @{ $cpdist->{$2} }, $1;
+ }
+
if( m{^\./authors/id/(.+):} )
{
$storage = $cpauth->{$1} ||= [];
@@ -303,7 +329,8 @@
}
close(TMP);
to_cache($cpauth, 'cpan_authors');
- to_cache($cpmod, 'cpan_modules');
+ to_cache($cpmod, 'cpan_modules');
+ to_cache($cpdist, 'cpan_dists' );
1;
}
@@ -450,14 +477,46 @@
{
my($where, $wline, $opts) = @_;
- $wline =~ m{
- ^(\S*?) # 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, no slashes - captured
- (?!.*\() # not followed by search pattern
- }ix;
- my( $key, $filter) = ($1, $2);
+ my( $key, $filter );
+ # watch line is either:
+ # path/pattern
+ # or
+ # path pattern
+ my @elements = split(/\s+/, $wline);
+ # ignore version and script for version=2 watchlines
+ # (consider the first element only unless the second contains a capture)
+ @elements = $elements[0] if $elements[1] and $elements[1] !~ m{\(};
+ if( @elements == 1 )
+ { # "path/pattern"
+ $wline =~ m{
+ ^(\S*?) # some/path - captured
+ # non-greedy to not eat up the pattern
+ / # delimiter - '/'
+ ([^\s/]+) # the search pattern - no spaces, no slashes - captured
+ (?!.*\() # not followed by search pattern
+ }ix
+ and
+ ( $key, $filter ) = ($1, $2)
+ or
+ die "Strange one-element watchline '$wline'";
+ }
+ else
+ { # "path" "pattern" "other things" (ignored)
+ ( $key, $filter ) = @elements[0..1];
+
+ # could this be a dist search?
+ if ( $key =~ m{^http://search.cpan.org/dist/([^/]+)/$} )
+ {
+ $key = $1;
+ $filter =~ s{^.*/}{}; # remove prepended paths
+ }
+ else
+ {
+ # remove trailing slash (if present)
+ $key =~ s{/$}{};
+ }
+ }
+
debugmsg( sprintf( " module search %s %s\n", $key, $filter ) );
my $list = $where->{$key};
@@ -482,9 +541,9 @@
}
# returns (version, URL)
-sub latest_upstream_from_cpan($$$)
-{
- my ($watch, $cpauth, $cpmod) = @_;
+sub latest_upstream_from_cpan($$$$)
+{
+ my ($watch, $cpauth, $cpmod, $cpdist) = @_;
my @cpan = grep( $_->[0] =~ m{(?:^|\s)(?:http|ftp)://\S*cpan}i, @$watch );
@@ -512,6 +571,15 @@
push @vers, map(
[ $_->[0], "http://www.cpan.org/authors/id/".$_->[1] ],
cpan_versions($cpauth, $wline, $opts),
+ );
+ }
+ elsif( $wline =~ m{(?:http|ftp)://search.cpan.org/dist/([^/]+)/?\s} )
+ {
+ # lookup by dist
+ my $dist = $1;
+ push @vers, map(
+ [ $_->[0], "http://search.cpan.org/dist/$dist/" ],
+ cpan_versions($cpdist, $wline, $opts),
);
}
else
@@ -837,7 +905,7 @@
$pkg->{watch} = \@data;
my($upstream_ver, $upstream_url) = latest_upstream_from_cpan(\@data,
- \%cpan_authors, \%cpan_modules);
+ \%cpan_authors, \%cpan_modules, \%cpan_dists);
if( $upstream_ver ) {
$pkg->{watch_cpan} = 1;
} else {
@@ -882,9 +950,9 @@
{
$total++;
- debugmsg("Examining $_\n" );
my $pkgd = $maindata{$_};
- my $spkg = $maindata{$_}{chl_pkg};
+ my $spkg = $maindata{$_}{chl_pkg} or die "No source package for $_?";
+ debugmsg("Examining $_ (src:$spkg)\n" );
debugmsg(sprintf(" - Archive has %s\n", $packages{$spkg} || 'none'));
debugmsg(sprintf(" - experimental has %s\n",
More information about the Pkg-perl-cvs-commits
mailing list