From: Vincent Pit Date: Fri, 19 Dec 2008 23:24:35 +0000 (+0100) Subject: Add the samples/gengentooisms script X-Git-Tag: v0.05~16 X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=2eb39130ee05208fc41d7c671a4050d64799c00b;p=perl%2Fmodules%2FCPANPLUS-Dist-Gentoo.git Add the samples/gengentooisms script --- diff --git a/MANIFEST b/MANIFEST index bdb387f..a588b58 100644 --- a/MANIFEST +++ b/MANIFEST @@ -4,6 +4,7 @@ Makefile.PL README lib/CPANPLUS/Dist/Gentoo.pm samples/g-cpanp +samples/gengentooisms t/00-load.t t/90-boilerplate.t t/91-pod.t diff --git a/samples/gengentooisms b/samples/gengentooisms new file mode 100755 index 0000000..b554f9b --- /dev/null +++ b/samples/gengentooisms @@ -0,0 +1,63 @@ +#!/usr/bin/env perl + +# This scrit is meant to guess gentooisms by looking into the portage tree. +# A really good one would use the CPANPLUS API to check if the dist name +# candidates are really on CPAN. + +use strict; +use warnings; + +use Fatal; +use List::Util qw/max/; + +use constant PORTAGE => '/usr/portage'; + +my %gentooism; + +for my $category (qw/perl-core dev-perl/) { + my $dir = PORTAGE . '/' . $category; + chdir $dir; + for my $name (<*>) { + next unless -d $name; + my $eb = (sort glob "$dir/$name/$name-*")[-1]; + open my $fh, '<', $eb; + my ($pn, $on_cpan); + while (<$fh>) { + $on_cpan = 1 if not defined $on_cpan + and /(?:MODULE_AUTHOR|SRC_URI=.*?(?i:cpan))/; + if (not defined $pn and /_PN?=(.*)/) { + $pn = $1; + if ($pn =~ /^\s*["']?\s*\$\{PN?\}/) { + undef $pn; + next; + } + $pn =~ s!\$[{(][^/]*?[})]!!g; + $pn =~ s!\$\{P?V.*?\}!!g; + $pn =~ s/^\s*["']?\s*-*\s*//; + $pn =~ s/\s*-*\s*["']?\s*$//; + $pn =~ s/-\d+\..*//; + if ($pn =~ m!\$\{PN?(/.*?/(?:.*/?)?)\}!) { + my $s = $1; + $s .= '/' if $s =~ tr!/!! <= 2; + eval "(\$pn = \$name) =~ s$s"; + } + } + } + if ($pn and $pn ne $name) { + if ($on_cpan) { + $gentooism{$pn} = $name; + } else { + print STDERR "'$pn' => '$name' may not be on CPAN\n"; + } + } + } +} + +my $max = max map length, keys %gentooism; + +print STDERR +(keys %gentooism) . " gentooisms found\n"; + +print "my %gentooism = (\n"; +printf " '%s'%s => '%s',\n", $_, (' ' x ($max - length)), $gentooism{$_} + for sort keys %gentooism; +print ");\n";