r11493 - /scripts/qa/DebianQA/Watch.pm
tincho-guest at users.alioth.debian.org
tincho-guest at users.alioth.debian.org
Sun Dec 23 08:54:05 UTC 2007
Author: tincho-guest
Date: Sun Dec 23 08:54:05 2007
New Revision: 11493
URL: http://svn.debian.org/wsvn/?sc=1&rev=11493
Log:
CPAN backend rewritten to use 02packages.details.txt.gz and CPAN::DistnameInfo
to have more reliable data.
Modified:
scripts/qa/DebianQA/Watch.pm
Modified: scripts/qa/DebianQA/Watch.pm
URL: http://svn.debian.org/wsvn/scripts/qa/DebianQA/Watch.pm?rev=11493&op=diff
==============================================================================
--- scripts/qa/DebianQA/Watch.pm (original)
+++ scripts/qa/DebianQA/Watch.pm Sun Dec 23 08:54:05 2007
@@ -16,6 +16,7 @@
our @EXPORT = qw(watch_download watch_get watch_get_consolidated);
use Compress::Zlib ();
+use CPAN::DistnameInfo;
use DebianQA::Cache;
use DebianQA::Common;
use DebianQA::Config '%CFG';
@@ -24,7 +25,7 @@
use Fcntl qw(:seek);
use LWP::UserAgent;
-my $cpanregex = qr#^(?:http|ftp)://\S*(?:cpan|backpan)\S*/(dist|modules/by-module|(?:by-)?authors/id)\b#i;
+my $cpanregex = qr#^((?:http|ftp)://\S*(?:cpan|backpan)\S*)/(dist|modules/by-module|(?:by-)?authors/id)\b#i;
my $ua = new LWP::UserAgent;
$ua->timeout(10);
@@ -158,7 +159,13 @@
my @vers;
if($CFG{watch}{use_cpan} and $dir =~ $cpanregex) {
@vers = cpan_lookup($dir, $filter);
- warn("CPAN lookup failed for $dir + $filter") unless(@vers);
+ my $status = shift @vers;
+ if($status) {
+ warn("CPAN lookup failed for $dir + $filter: $status");
+ return $status;
+ } elsif(not @vers) {
+ warn("CPAN lookup failed for $dir + $filter");
+ }
}
unless(@vers) {
@vers = recurse_dirs($filter, $dir, "");
@@ -263,38 +270,46 @@
$dir =~ $cpanregex or return ();
my $base = $1;
- $base =~ s/.*(dist|modules|authors).*// or return ();
- $base = $1;
- if($base eq "dist") {
+ my $type = $2;
+ $dir =~ s{/+$}{};
+ my $origdir = $dir;
+
+ $type =~ s/.*(dist|modules|authors).*/$1/ or return ();
+ if($type eq "dist") {
$filter =~ s/.*\///;
}
- my $cpan = cpan_download()->{$base};
- my $olddir = $dir;
- $olddir =~ s{/+$}{};
+ my $cpan = cpan_download()->{$type};
$dir =~ s/$cpanregex//i;
- $dir =~ s{/+$}{};
$dir =~ s{^/+}{};
- debug("Looking for $dir + $filter into CPAN $base cache");
- return () unless(exists($cpan->{$dir}));
- return map({
- $_ =~ $filter ? {
- upstream_version => $1,
- upstream_url => "$olddir/" . ($base eq "dist" ? "" : $_)
- } : ()
- } @{$cpan->{$dir}});
+ debug("Looking for $dir + $filter into CPAN $type cache");
+ return ("NotFound") unless(exists($cpan->{$dir}));
+ my @res;
+ foreach(keys %{$cpan->{$dir}}) {
+ next unless ($_ =~ $filter);
+ my $filt_ver = $1;
+ my $cpan_ver = $cpan->{$dir}{$_}{version};
+ if($filt_ver ne $cpan_ver) {
+ warn("Version mismatch: uscan says $filt_ver, cpan says $cpan_ver");
+ return ("VersionMismatch");
+ }
+ push @res, {
+ upstream_version => $cpan_ver,
+ upstream_url => ($type eq "dist" ? $base : $origdir) . "/$_"
+ };
+ }
+ return ("NotFound") unless(@res);
+ return (undef, @res);
}
sub cpan_download(;$) {
my $force = shift;
- my $cpan;
unless($force) {
- $cpan = read_cache("cpan", "", 0);
+ my $cpan = read_cache("cpan", "", 0);
if($CFG{watch}{cpan_ttl} * 60 > time - find_stamp($cpan, "")) {
return $cpan;
}
}
- $cpan = {};
-
- my $url = $CFG{watch}{cpan_mirror} . "/indices/ls-lR.gz";
+
+ my $url = $CFG{watch}{cpan_mirror} . "/modules/02packages.details.txt.gz";
info("Rebuilding CPAN cache from $url");
open(TMP, "+>", undef) or die $!;
my $res = $ua->get($url, ":content_cb" => sub {
@@ -321,53 +336,37 @@
seek($data, 0, SEEK_SET) or die "Can't seek: $!\n";
- my($dir, $type);
+ # Skip header
while(<$data>) {
chomp;
- if(/^(.+):$/) {
- $dir = $1;
- if($dir =~ m{/.*(?:authors/id|modules/by-module)/+(.*?)/*$}) {
- my $subdir = $1;
- $dir =~ /(authors|modules)/;
- $type = $1;
- $dir = $subdir;
- #$cpan->{$type} ||= {};
- #$cpan->{$type}{$dir} ||= [];
- } else {
- $type = undef;
- }
- next;
- }
- next unless($type
- and /^[-l]r.....r.*\.(?:bz2|gz|zip|pl|pm|tar|tgz)$/i);
- s/ -> .*//;
- my @fields = split;
- if(@fields >= 9 and $fields[8] ne "CHECKSUMS") {
- push @{$cpan->{$type}{$dir}}, $fields[8];
-
- if($type eq "modules" and $fields[8] =~ m{
- (\S+?) # dist name, non-greedy
- - # separator - dash (between dist name and the version
- v? # optional v before the version string
- (?: # version
- \d # starts with a digit
- [\d._-]+ # followed by digits, periods and underscores
- )
- (?: # file extension
- \.tar # .tar
- (?: # probably compressed
- \.gz # with gzip
- |\.bz2 # or bzip2
- )?
- | \.tgz # or .tgz
- | \.zip # or .zip
- )
- $ # and this is at the end
- }x
- ) {
- push @{$cpan->{dist}{$1}}, $fields[8];
- }
- }
+ last if(/^$/);
+ }
+ my $cpan = {};
+ while(<$data>) {
+ chomp;
+ my $tarball = (split)[2];
+ my $distinfo = new CPAN::DistnameInfo($tarball);
+# next if($distinfo->maturity() eq "developer");
+ my $distname = $distinfo->dist();
+ unless($distname) {
+ info("Invalid CPAN distribution: $tarball");
+ next;
+ }
+ my $version = $distinfo->version();
+ my $filename = $distinfo->filename();
+
+ my $author_path = $1 if($tarball =~ m#(.*)/#);
+ (my $module_path = $distname) =~ s#-.*##g;
+
+ $cpan->{modules}{$module_path}{$filename} =
+ $cpan->{authors}{$author_path}{$filename} =
+ $cpan->{dist}{$distname}{$filename} = {
+ author_path => $author_path,
+ module_path => $module_path,
+ filename => $filename,
+ distname => $distname,
+ version => $version
+ };
}
close $data;
update_cache("cpan", $cpan, "", 1);
More information about the Pkg-perl-cvs-commits
mailing list