Rework perl.d/cpandists to list modules as well.

Restyle metas/perl slightly. Use the new files generated by cpandists.
Rewrite metas/perl.d/perl-dist to try to read through the cpanmods file as little
as possible.

3 files changed, 94 insertions, 43 deletions

diff --git a/bin/metas/perl b/bin/metas/perl
index 7b7acd1..89e63aa 100755
--- a/bin/metas/perl
+++ b/bin/metas/perl
@@ -5,38 +5,40 @@ use strict;
 
 use File::Fetch;
 use IO::Handle; # for autoflush
+use Cwd;
 
 my $PROG = 'perl';
 
 sub err
 {
-	print STDERR @_;
+	print STDERR @_, "\n";
 	exit 2;	
 }
 
-sub distsearch
+sub matchdist
 {
 	my ($dist) = @_;
 
 	# Refresh our local list of distributions if needed.
 	my $var = $ENV{'PKGVAR'}
-		or die "$PROG: PKGVAR env variable is unset\n";
+		or err("$PROG: PKGVAR env variable is unset\n");
 
-	if (! -f "$var/cpan" || -M "$var/cpan" > 1) {
+	my $cwd = getcwd();
+	if(! -f "$var/cpandists" || -M "$var/cpandists" > 1) {
 		print STDERR "Refreshing local CPAN distribution list...";
-		system qq{cpandists >'$var/cpan' 2>/dev/null};
-		err("FAILED\n") unless $? == 0;
+		system('cpandists');
+		err("FAILED") unless $? == 0;
 		print STDERR "OK\n";
 	}
 
-	open DISTS, '<', "$var/cpan" or err("$PROG: open: $!");
-	while (<DISTS>) {
+	open(DISTS, '<', "$var/cpandists") or err("$PROG: open: $!");
+	while(<DISTS>) {
 		my @f = split;
-		next unless lc $f[0] eq lc $dist;
-		close DISTS;
+		next unless(lc $f[0] eq lc $dist);
+		close(DISTS);
 		return ($f[0], $f[2]);
 	}
-	close DISTS;
+	close(DISTS);
 	return ();
 }
 
@@ -44,7 +46,7 @@ sub fetchdist
 {
 	my ($cpath) = @_;
 	my $file = $cpath; $file =~ s{^.*/}{};
-	if (-f $file) {
+	if(-f $file) {
 		print STDERR "$file already downloaded.\n";
 		return;
 	}
@@ -54,7 +56,7 @@ sub fetchdist
 
 	print STDERR "Downloading $file... ";
 	my $ff = File::Fetch->new('uri' => $url);
-	err("FAILED\n") unless $ff->fetch();
+	err("FAILED") unless($ff->fetch());
 	print STDERR "OK\n";
 }
 
@@ -66,9 +68,11 @@ sub main
 	$dist = "app-$dist" if $dist =~ s/^perl-// == 0;
 	
 	STDERR->autoflush(1);
-	my ($realname, $cpath) = distsearch($dist);
-	die "$PROG: failed to find perl dist similar to $dist\n"
-		unless $realname;
+	my ($realname, $cpath) = matchdist($dist);
+	unless($realname) {
+		print STDERR "$PROG: failed to find perl dist similar to $dist\n";
+		exit 1;
+	}
 	fetchdist($cpath);
 
 	my $srch = 'http://search.cpan.org';
@@ -82,7 +86,7 @@ $srch/CPAN/authors/id/$cpath
 END_META
 
 	my $file = $cpath; $file =~ s{^.*/}{};
-	system 'perl-dist', $file;
+	system('perl-dist', $file);
 	return $?;
 }
 
diff --git a/bin/metas/perl.d/cpandists b/bin/metas/perl.d/cpandists
index 9273bd4..339a75c 100755
--- a/bin/metas/perl.d/cpandists
+++ b/bin/metas/perl.d/cpandists
@@ -3,14 +3,14 @@
 mirror=${CPANMIRROR:-ftp://cpan.pair.com}
 path=/modules/02packages.details.txt.gz
 
-curl --silent $mirror$path | gzip -dc | awk '
+curl --silent "$mirror$path" | gzip -dc | awk '
 NR < 10 { next }
 {
     file = a[split($3, a, "/")]
     len = split(file, a, ".")
 
     if (!match(a[1], /[-_][vV]?[0-9]+$/)) {
-        print "error: failed to grok " $3 | "cat 1>&2"
+        #print "error: failed to grok " $3 | "cat 1>&2"
         next
     }
     ver  = substr(file, RSTART+1, RLENGTH-1)
@@ -21,6 +21,13 @@ NR < 10 { next }
     }
     sub(/^[vV]/, "", ver)
 
+    # For some reason the newest version of perl had no modules in 02packages
+    # so I can't just use modules from the newest version of perl.
+    if(dist == "perl")
+        coremods = coremods $1 " " $2 "\n"
+    else
+        mods[dist,ver] = mods[dist,ver] $1 " " $2 "\n"
+
     if (lessthan(dists[dist], ver)) {
         dists[dist] = ver
         paths[dist] = $3
@@ -28,7 +35,16 @@ NR < 10 { next }
 }
 
 END {
-    for (dist in dists) print dist, dists[dist], paths[dist] | "sort"
+    for (dist in dists) {
+        ver = dists[dist]
+        print dist, ver, paths[dist] | "sort >cpandists"
+    }
+    close("sort >cpandists")
+
+    # Prints modules out in sorted order, too!
+    while(getline<"cpandists" > 0) {
+        print $1 "\n" ($1 == "perl" ? coremods : mods[$1,$2]) >"cpanmods"
+    }
 }
 
 function lessthan (l, r)
diff --git a/bin/metas/perl.d/perl-dist b/bin/metas/perl.d/perl-dist
index c6ae35b..32b2414 100755
--- a/bin/metas/perl.d/perl-dist
+++ b/bin/metas/perl.d/perl-dist
@@ -3,6 +3,8 @@
 use warnings 'FATAL' => 'all';
 use strict;
 
+my $PROG = 'perl-dist';
+
 package Convert;
 
 use Module::CoreList;
@@ -165,9 +167,8 @@ sub _perldepver
 sub _reqs2deps
 {
 	my ($prereqs) = @_;
+	my (@mods, %pkgdeps);	
 
-	my %pkgdeps;
-	
 	CPAN_DEP_LOOP:
 	while(my ($name, $ver) = each(%$prereqs)) {
 		# Sometimes a perl version is given as a prerequisite
@@ -175,13 +176,17 @@ sub _reqs2deps
 			$pkgdeps{'perl'} = _perldepver($ver);
 			next CPAN_DEP_LOOP;
 		}
+		push @mods, $name;
+	}
 
-		my $dist = _distofmod($name);
+	my %dists = _distsofmods(@mods);
+	while(my ($mod, $dist) = each %dists) {
 		my $pkgname = dist_pkgname($dist);
+		my $ver = $prereqs->{$mod};
 
 		# If the module is not named after the distribution, ignore its
 		# version which might not match the distribution.
-		undef $ver unless(_ismainmod($name, $dist));
+		undef $ver unless(_ismainmod($mod, $dist));
 
 		# If two module prereqs are in the same CPAN distribution then
 		# the version required for the main module will override.
@@ -189,6 +194,7 @@ sub _reqs2deps
 		# are 0)
 		$pkgdeps{$pkgname} ||= ($ver ? dist_pkgver($ver) : 0);
 	}
+
 	
 	return \%pkgdeps;
 }
@@ -254,23 +260,48 @@ sub _stringify
 	return \@depstrs;
 }
 
-my $UA;
-sub _distofmod
+sub _distsofmods
 {
-	my ($mod) = @_;
-
-	my $UA ||= LWP::UserAgent->new();
-	my $url = "http://cpanmetadb.appspot.com/v1.0/package/$mod";
-	my $resp = $UA->get($url);
-	die "failed to lookup dist for $mod: " . $resp->status_line
-		unless($resp->is_success);
+	my (@mods) = @_;
+
+	return () if(@mods == 0);
+
+	use Time::HiRes qw(time);
+	my $beg = time;
+
+	my $var = $ENV{'PKGVAR'}
+		or die "$PROG: PKGVAR env variable is unset\n";
+	open(my $fh, '<', "$var/cpanmods")
+		or die "$PROG: failed to open $var/cpanmods: $!";
+
+	my (@hunted, %dists) = @mods;
+	local $/ = '';
+
+	RECLOOP:
+	while(my $rec = <$fh>) {
+		my ($dist, @modvers) = split(/\n/, $rec);
+		for (@modvers) {
+			my ($m) = split;
+
+			CMPLOOP:
+			for my $i (0 .. $#hunted) {
+				next CMPLOOP unless($hunted[$i] eq $m);
+				$dists{$m} = $dist;
+				splice @hunted, $i, 1;
+				last RECLOOP if(@hunted == 0);
+				last CMPLOOP;
+			}
+		}
+	}
 
-	$resp = YAML::XS::Load($resp->content);
-	my $file = $resp->{'distfile'};
-	$file =~ s{.*/}{};
-	$file =~ s{-[^-]+\z}{};
+	if (@hunted) {
+		for my $lost (@hunted) {
+			print STDERR "$PROG: failed to find module $lost\n";
+		}
+		exit 2;
+	}
 
-	return $file;
+	return %dists;
 }
 
 #-----------------------------------------------------------------------------
@@ -290,7 +321,7 @@ use Digest::SHA ();
 
 sub main
 {
-	my $distpath = shift() or die "Usage: perl-dist [path to cpan dist file]\n";
+	my $distpath = shift() or die "Usage: $PROG [path to cpan dist file]\n";
 	my $dir  = dirname($distpath);
 	my $file = basename($distpath);
 	my $info = distinfo($file);
@@ -360,15 +391,15 @@ sub extractdist
 	my ($file) = @_;
 
 	system("bsdtar -xf $file");
-	die "perl-dist: bsdtar failed to extract $file\n" unless($? == 0);
+	die "$PROG: bsdtar failed to extract $file\n" unless($? == 0);
 
 	opendir(my $srcdir, '.') or die "opendir: $!";
 	my @dirs = grep { -d $_ && !/\A[.]/ } readdir($srcdir);
 	closedir($srcdir);
 
-	die("perl-dist: many dirs (@dirs) inside the tarball $file\n")
+	die("$PROG: many dirs (@dirs) inside the tarball $file\n")
 		if(@dirs > 1);
-	die("perl-dist: no dirs found in tarball $file\n") if(@dirs == 0);
+	die("$PROG: no dirs found in tarball $file\n") if(@dirs == 0);
 	return $dirs[0];
 }
 
@@ -377,7 +408,7 @@ sub printmeta
 	my ($pbvars) = @_;
 	while(my ($name, $val) = each(%$pbvars)) {
 		if(!defined($val) || $val eq q{}) {
-			warn("perl-dist: warning: $name is undefined\n");
+			warn("$PROG: warning: $name is undefined\n");
 			$val = q{};
 		}
 		print($name, "\n");