3 # This scrit is meant to guess gentooisms by looking into the portage tree.
4 # A really good one would use the CPANPLUS API to check if the dist name
5 # candidates are really on CPAN.
11 use List::Util qw/max/;
13 use constant PORTAGE => '/usr/portage';
17 for my $category (qw/perl-core dev-perl/) {
18 my $dir = PORTAGE . '/' . $category;
22 my $eb = (sort glob "$dir/$name/$name-*")[-1];
23 open my $fh, '<', $eb;
26 $on_cpan = 1 if not defined $on_cpan
27 and /(?:MODULE_AUTHOR|SRC_URI=.*?(?i:cpan))/;
28 if (not defined $pn and /_PN?=(.*)/) {
30 if ($pn =~ /^\s*["']?\s*\$\{PN?\}/) {
34 $pn =~ s!\$[{(][^/]*?[})]!!g;
35 $pn =~ s!\$\{P?V.*?\}!!g;
36 $pn =~ s/^\s*["']?\s*-*\s*//;
37 $pn =~ s/\s*-*\s*["']?\s*$//;
39 if ($pn =~ m!\$\{PN?(/.*?/(?:.*/?)?)\}!) {
41 $s .= '/' if $s =~ tr!/!! <= 2;
42 eval "(\$pn = \$name) =~ s$s";
46 if ($pn and $pn ne $name) {
48 $gentooism{$pn} = $name;
50 print STDERR "'$pn' => '$name' may not be on CPAN\n";
56 my $max = max map length, keys %gentooism;
58 print STDERR +(keys %gentooism) . " gentooisms found\n";
60 print "my %gentooism = (\n";
61 printf " '%s'%s => '%s',\n", $_, (' ' x ($max - length)), $gentooism{$_}
62 for sort keys %gentooism;