diff options
| -rwxr-xr-x | bin/metas/perl | 38 | ||||
| -rwxr-xr-x | bin/metas/perl.d/cpandists | 22 | ||||
| -rwxr-xr-x | bin/metas/perl.d/perl-dist | 77 |
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"); |