From: Vincent Pit <vince@profvince.com>
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";