-my $cwd = cwd();
-
-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);
- $on_cpan = $where{$name} if exists $where{$name};
- 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;
+my %gentooism;
+
+my %is_on_cpan = map { $_ => 1 } qw/
+ Business-FedEx-DirectConnect
+ CDDB_get
+ CursesWidgets
+ SpeedyCGI
+ WattsUp-Daemon
+ frontier-rpc
+ gnome2-perl
+ gnome2-wnck
+/;
+
+sub p {
+ my ($indent, $fmt, @args) = @_;
+ $fmt = (' ' x ($indent * 3)) . $fmt;
+ printf $fmt, @args;
+}
+
+my (@not_on_cpan, %name_mismatch, %version);
+
+sub parse_portage_tree {
+ my $pcp = Parse::CPAN::Packages::Fast->new(PACKAGES);
+
+ my $ua = LWP::UserAgent->new;
+ $ua->agent('CPANPLUS::Dist::Gentoo gentooisms generator/1.0');
+
+ for my $category (qw/perl-core dev-perl/) {
+ p(0, "Browsing the $category category.\n");
+
+ my $cat_dir = File::Spec->catdir(PORTAGE, $category);
+
+ for my $pkg_dir (glob File::Spec->catdir($cat_dir, '*')) {
+ next unless -d $pkg_dir;
+
+ my $pkg_name = (File::Spec->splitdir($pkg_dir))[-1];
+
+ my $last = reduce { $a->[1] > $b->[1] ? $a : $b }
+ map [ $_, CPANPLUS::Dist::Gentoo::Atom->new_from_ebuild($_) ],
+ glob File::Spec->catfile($pkg_dir, "$pkg_name-*");
+ my ($ebuild, $atom) = @$last;
+ p(1, "%s/%s-%s\n", map $atom->$_, qw/category name version/);
+
+ my @cmd = ('ebuild', $ebuild, 'help', '--debug');
+ my ($ret, $code);
+ (undef, my $err) = capture {
+ $ret = system { $cmd[0] } @cmd;
+ $code = $?;
+ };
+ if ($ret != 0 or $code == -1 or $code & 127 or $code >> 8) {
+ die "system(\"@cmd\") returned $ret and/or failed with status $code";
+ }
+
+ my ($uri, $fqn_dist, $path);
+ while ($err =~ /SRC_URI=((['"]).*?\2|\S+)/gs) {
+ $uri = $1;
+ $uri =~ s{^(['"])(.*?)\1$}{$2}s;
+ }
+ if (defined $uri) {
+ if ($uri =~ m{cpan.*?/id/(\S+)}) {
+ $fqn_dist = $1;
+ $path = "authors/id/$fqn_dist";
+ } elsif ($uri =~ m{mirror://cpan/(\S+)}) {
+ $path = $1;
+ } elsif ($is_on_cpan{$pkg_name} and $uri =~ m{/([^/\s]+)(?:\s|$)}) {
+ my $archive = $1;
+ my ($top_level) = $archive =~ /^([^-]+)/;
+ $path = "modules/by-module/$top_level/$archive";