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.
12 use List::Util qw/max/;
13 use File::Copy qw/copy/;
15 use constant PORTAGE => '/usr/portage';
16 use constant TARGET => 'lib/CPANPLUS/Dist/Gentoo/Maps.pm';
17 use constant BACKUP => TARGET . '.bak';
22 'Audio-CD-disc-cover' => 1,
34 for my $category (qw/perl-core dev-perl/) {
35 my $dir = PORTAGE . '/' . $category;
39 my $eb = (sort glob "$dir/$name/$name-*")[-1];
40 open my $fh, '<', $eb;
42 $on_cpan = $where{$name} if exists $where{$name};
44 $on_cpan = 1 if not defined $on_cpan
45 and /(?:MODULE_AUTHOR|SRC_URI=.*?(?i:cpan))/;
46 if (not defined $pn and /_PN?=(.*)/) {
48 if ($pn =~ /^\s*["']?\s*\$\{PN?\}/) {
52 $pn =~ s!\$[{(][^/]*?[})]!!g;
53 $pn =~ s!\$\{P?V.*?\}!!g;
54 $pn =~ s/^\s*["']?\s*-*\s*//;
55 $pn =~ s/\s*-*\s*["']?\s*$//;
57 if ($pn =~ m!\$\{PN?(/.*?/(?:.*/?)?)\}!) {
59 $s .= '/' if $s =~ tr!/!! <= 2;
60 eval "(\$pn = \$name) =~ s$s";
64 if ($pn and $pn ne $name) {
66 $gentooism{$pn} = $name;
67 } elsif (not defined $on_cpan) {
68 print STDERR "'$pn' => '$name' may not be on CPAN\n";
76 copy TARGET, BACKUP or die "copy failed: $!";
78 open my $src, '<', BACKUP;
79 open my $dst, '>', TARGET;
81 my $max = max map length, keys %gentooism;
86 printf $dst "%s%s %s\n", $_, (' ' x ($max - length)), $gentooism{$_}
87 for sort keys %gentooism;
92 print STDERR +(keys %gentooism) . " gentooisms found\n";