From a36fce5c41553ae705d265813560a0823b9b6249 Mon Sep 17 00:00:00 2001 From: Justin Davis Date: Sun, 20 Nov 2011 10:08:21 -0500 Subject: Add special logic to avoid deps on core-only modules to perl-dist. --- lib/metas/perl.d/perl-dist | 57 +++++++++++++++++++++++++++++++-------------- lib/metas/perl.d/scrapecore | 2 +- 2 files changed, 40 insertions(+), 19 deletions(-) diff --git a/lib/metas/perl.d/perl-dist b/lib/metas/perl.d/perl-dist index 5f6bd4c..ee3f5ee 100755 --- a/lib/metas/perl.d/perl-dist +++ b/lib/metas/perl.d/perl-dist @@ -268,35 +268,33 @@ sub _distsofmods my (@mods) = @_; return () if(@mods == 0); + @mods = _nocore(@mods); - my $var = $ENV{'PKGVAR'} - or die "$PROG: PKGVAR env variable is unset\n"; + my $var = _vardir(); open(my $fh, '<', "$var/cpanmods") or die "$PROG: failed to open $var/cpanmods: $!"; - my (@hunted, %dists) = @mods; + my %mods = map { ($_ => 1) } @mods; + my %dists; 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; - } + last RECLOOP unless(keys %mods > 0); + + my($dist, @mvs) = split(/\n/, $rec); + MODLOOP: + for(@mvs){ + my($m) = split; + my $fnd = delete($mods{$m}) or next; + $dists{$m} = $dist; } } - if (@hunted) { - for my $lost (@hunted) { - print STDERR "$PROG: failed to find module $lost\n"; + my @lost = keys %mods; + if(@lost){ + for my $m (@lost){ + print STDERR "$PROG: failed to find module $m\n"; } exit 2; } @@ -304,6 +302,29 @@ sub _distsofmods return %dists; } +sub _nocore +{ + my (@mods) = @_; + + my $path = _vardir() . '/coremods'; + open(my $if, '<', $path) or die "$PROG: open $path: $!"; + + my %mods = map { ($_ => 1) } @mods; + while(<$if>){ + my ($m) = split; + delete $mods{$m}; + } + + close($if); + return keys %mods; +} + +sub _vardir +{ + return $ENV{'PKGVAR'} + or die "$PROG: PKGVAR env variable is unset\n"; +} + #----------------------------------------------------------------------------- package main; diff --git a/lib/metas/perl.d/scrapecore b/lib/metas/perl.d/scrapecore index eae1b21..19cce80 100644 --- a/lib/metas/perl.d/scrapecore +++ b/lib/metas/perl.d/scrapecore @@ -205,7 +205,7 @@ sub _delmatch sub coreonly { - my (%mods) = map { @$_ } @_; + my %mods = map { @$_ } @_; my $path = "$ENV{'PKGVAR'}/cpanmods"; open(my $if, '<', $path) or die("open $path: $!"); -- cgit v1.2.3-24-g4f1b