]> git.vpit.fr Git - perl/modules/CPANPLUS-Dist-Gentoo.git/commitdiff
Correctly map exotic Gentoo versions from CPAN versions
authorVincent Pit <vince@profvince.com>
Sun, 19 Sep 2010 22:40:27 +0000 (00:40 +0200)
committerVincent Pit <vince@profvince.com>
Sun, 19 Sep 2010 23:04:05 +0000 (01:04 +0200)
Also improve greatly the gentooisms discovery.

.gitignore
Makefile.PL
lib/CPANPLUS/Dist/Gentoo.pm
lib/CPANPLUS/Dist/Gentoo/Maps.pm
samples/gengentooisms
t/11-maps-name.t
t/12-maps-version.t

index 6be9f283a734f73df62382a76038670c04848403..4b44dd653ba54ff9b3eea3269e27c1e908abd788 100644 (file)
@@ -24,4 +24,5 @@ cover_db
 
 Debian_CPANTS.txt
 
+gentooisms.sto
 lib/CPANPLUS/Dist/Gentoo/Maps.pm.bak
index 2aa77dd41bf51deb5660f7dd0f3cd9cc4c2c5f4f..e5a8c9660b3c0aa1e3ab2ac8159d3f2f4eef2904 100644 (file)
@@ -61,3 +61,12 @@ WriteMakefile(
   FILES => "$dist-* *.gcov *.gcda *.gcno cover_db Debian_CPANTS.txt"
  },
 );
+
+package MY;
+
+sub postamble {
+ <<POSTAMBLE
+regen:
+       \$(PERL) samples/gengentooisms
+POSTAMBLE
+}
index e3ff15340d0f10f842215bbe0a0630b9a07bc563..6c6ef13715fbca7886ec6a20d63a4c7cf72d745c 100644 (file)
@@ -289,7 +289,7 @@ sub prepare {
 
  $stat->distribution($name . '-' . $version);
 
- $stat->ebuild_version(CPANPLUS::Dist::Gentoo::Maps::version_c2g($version));
+ $stat->ebuild_version(CPANPLUS::Dist::Gentoo::Maps::version_c2g($name, $version));
 
  $stat->ebuild_name(CPANPLUS::Dist::Gentoo::Maps::name_c2g($name));
 
@@ -366,7 +366,7 @@ sub prepare {
 
  my $meta = $self->meta;
  $stat->min_perl(CPANPLUS::Dist::Gentoo::Maps::perl_version_c2g(
-  $meta->{requires}->{perl}
+  $meta->{requires}->{perl},
  ));
 
  return $OK->();
@@ -595,10 +595,10 @@ sub ebuild_source {
 }
 
 sub _cpan2portage {
- my ($self, $name, $version) = @_;
+ my ($self, $dist_name, $dist_version) = @_;
 
$name    = CPANPLUS::Dist::Gentoo::Maps::name_c2g($name);
$version = CPANPLUS::Dist::Gentoo::Maps::version_c2g($version);
my $name    = CPANPLUS::Dist::Gentoo::Maps::name_c2g($dist_name);
my $version = CPANPLUS::Dist::Gentoo::Maps::version_c2g($dist_name, $dist_version);
 
  my @portdirs = ($main_portdir, @{$self->status->portdir_overlay});
 
index 1aa7d85458442f641dcf21d7fa48e466778a853e..0cb1af2809eeb0b15f3c94321af2b4b0df75c9ac 100644 (file)
@@ -21,9 +21,9 @@ This is an helper package to L<CPANPLUS::Dist::Gentoo>.
 
 =cut
 
-our %gentooisms;
+my %name_mismatch;
 
-/^\s*([\w-]+)\s+([\w-]+)\s*$/ and $gentooisms{$1} = $2 while <DATA>;
+/^\s*([\w-]+)\s+([\w-]+)\s*$/ and $name_mismatch{$1} = $2 while <DATA>;
 
 close DATA;
 
@@ -37,7 +37,7 @@ Maps a CPAN distribution name to its Gentoo counterpart.
 
 sub name_c2g {
  my ($name) = @_;
- return $gentooisms{$name} || $name;
+ return $name_mismatch{$name} || $name;
 }
 
 =head2 C<license_c2g @licenses>
@@ -70,29 +70,187 @@ sub license_c2g {
  grep !$seen{$_}++, map @{$licenses{+lc} || []}, @_;
 }
 
-=head2 C<version_c2g $version>
+=head2 C<version_c2g $name, $version>
 
-Converts a CPAN version to a Gentoo version.
+Converts the C<$version> of a CPAN distribution C<$name> to a Gentoo version.
 
 =cut
 
-sub version_c2g {
+my $default_mapping = sub {
  my ($v) = @_;
 
- return unless defined $v;
-
+ $v =~ s/^v//;
  $v =~ y/-/_/;
- $v =~ y/0-9._//cd;
 
  $v =~ s/^[._]*//;
  $v =~ s/[._]*$//;
  $v =~ s/([._])[._]*/$1/g;
 
- ($v, my $patch, my @rest) = split /_/, $v;
- $v .= '_p' . $patch if defined $patch;
- $v .= join('.', '', @rest) if @rest;
+ ($v, my $patch) = split /_/, $v, 2;
+ if (defined $patch) {
+  $patch =~ s/_//g;
+  $v .= "_p$patch";
+ }
 
  return $v;
+};
+
+my $insert_dot_at = sub {
+ my ($v, $pos, $all) = @_;
+
+ my ($int, $frac) = split /\./, $v, 2;
+ return $v unless defined $frac;
+
+ my @p;
+ push @p, $-[0] while $frac =~ /[0-9]/g;
+ my %digit = map { $_ => 1 } @p;
+
+ my $shift = 0;
+ for (my $i = $pos; $i < @p; $i += $pos) {
+  if ($digit{$i}) {
+   substr($frac, $i + $shift, 0) = '.';
+   ++$shift;
+  }
+  last unless $all;
+ }
+
+ "$int.$frac";
+};
+
+my $insert_dot_at_1     = sub { $insert_dot_at->($_[0], 1, 0) },
+my $insert_dot_at_all_1 = sub { $insert_dot_at->($_[0], 1, 1) },
+my $insert_dot_at_2     = sub { $insert_dot_at->($_[0], 2, 0) },
+my $insert_dot_at_all_2 = sub { $insert_dot_at->($_[0], 2, 1) },
+my $insert_dot_at_all_3 = sub { $insert_dot_at->($_[0], 3, 1) },
+
+my $pad_decimals_to = sub {
+ my ($v, $n) = @_;
+
+ my ($int, $frac) = split /\./, $v, 2;
+ return $v unless defined $v;
+
+ my $l = length $frac;
+ if ($l < $n) {
+  $frac .= '0' x ($n - $l);
+ }
+
+ "$int.$frac";
+};
+
+my $pad_decimals_to_2 = sub { $pad_decimals_to->($_[0], 2) };
+my $pad_decimals_to_4 = sub { $pad_decimals_to->($_[0], 4) };
+
+my $correct_suffixes = sub {
+ my ($v) = @_;
+
+ $v = $default_mapping->($v);
+ $v =~ s/(?<!_)((?:alpha|beta|pre|rc|p)\d*)\b/_$1/g;
+
+ return $v;
+};
+
+my $strip_letters = sub {
+ my ($v) = @_;
+
+ $v = $default_mapping->($v);
+ $v =~ s/(?<=\d)[a-z]+//g;
+
+ return $v;
+};
+
+my $letters_as_suffix = sub {
+ my ($v) = @_;
+
+ $v = $default_mapping->($v);
+ $v =~ s/(?<=\d)b(?=\d)/_beta/g;
+
+ return $v;
+};
+
+my %version_mismatch;
+
+$version_mismatch{$_} = $insert_dot_at_1 for qw/
+ CGI-Simple
+/;
+
+$version_mismatch{$_} = $insert_dot_at_all_1 for qw/
+ AnyEvent
+ Archive-Rar
+ IO-AIO
+ Image-Size
+ Linux-Inotify2
+ PadWalker
+ Tie-Array-Sorted
+ Tk-TableMatrix
+ XML-RSS-Feed
+/;
+
+$version_mismatch{$_} = $insert_dot_at_2 for qw/
+ Error
+/;
+
+$version_mismatch{$_} = $insert_dot_at_all_2 for qw/
+ Authen-Htpasswd
+ BSD-Resource
+ CDDB
+ Cairo
+ Curses-UI
+ DBD-mysql
+ Email-MessageID
+ ExtUtils-CBuilder
+ ExtUtils-ParseXS
+ FileHandle-Unget
+ FreezeThaw
+ Lexical-Persistence
+ Lingua-EN-Inflect
+ Mail-Mbox-MessageParser
+ Module-Build
+ SQL-Abstract-Limit
+ Term-ReadLine-Perl
+ Test-Differences
+ Time-HiRes
+ Time-Local
+ perl-ldap
+/;
+
+$version_mismatch{$_} = $insert_dot_at_all_3 for qw/
+ Parse-RecDescent
+ Return-Value
+/;
+
+$version_mismatch{$_} = $pad_decimals_to_2 for qw/
+ Nmap-Parser
+ XML-AutoWriter
+/;
+
+$version_mismatch{$_} = $pad_decimals_to_4 for qw/
+ Convert-BER
+/;
+
+$version_mismatch{$_} = $correct_suffixes for qw/
+ Gimp
+ XML-Grove
+/;
+
+$version_mismatch{$_} = $strip_letters for qw/
+ DelimMatch
+ SGMLSpm
+/;
+
+$version_mismatch{$_} = $letters_as_suffix for qw/
+ Frontier-RPC
+/;
+
+sub version_c2g {
+ my ($n, $v) = @_;
+
+ return unless defined $v;
+
+ my $handler;
+ $handler = $version_mismatch{$n} if defined $n;
+ $handler = $default_mapping  unless defined $handler;
+
+ return $handler->($v);
 }
 
 =head2 C<perl_version_c2g $version>
@@ -154,8 +312,9 @@ This program is free software; you can redistribute it and/or modify it under th
 __DATA__
 ANSIColor               Term-ANSIColor
 AcePerl                 Ace
-Audio-CD                Audio-CD-disc-cover
 CGI-Simple              Cgi-Simple
+CGI-SpeedyCGI           SpeedyCGI
+CPAN-Mini-Phalanx100    CPAN-Mini-Phalanx
 Cache-Mmap              cache-mmap
 Class-Loader            class-loader
 Class-ReturnValue       class-returnvalue
@@ -181,6 +340,7 @@ ExtUtils-PkgConfig      extutils-pkgconfig
 Frontier-RPC            frontier-rpc
 Gimp                    gimp-perl
 Glib                    glib-perl
+Gnome2                  gnome2-perl
 Gnome2-Canvas           gnome2-canvas
 Gnome2-GConf            gnome2-gconf
 Gnome2-Print            gnome2-print
index ca69b2360d42c43c547e6d5014c44bc97e260d80..74a46e9d28bf51491a1e0ad9303725239adc7e4f 100755 (executable)
 #!/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 Cwd qw/cwd/;
-use List::Util qw/max/;
+use File::Spec;
 use File::Copy qw/copy/;
+use List::Util qw/max reduce/;
+use Storable ();
+use Term::ANSIColor;
 
-use constant PORTAGE => '/usr/portage';
-use constant TARGET  => 'lib/CPANPLUS/Dist/Gentoo/Maps.pm';
-use constant BACKUP  => TARGET . '.bak';
+use CPAN::DistnameInfo;
+use Capture::Tiny qw/capture/;
+use LWP::UserAgent;
+use Parse::CPAN::Packages::Fast;
 
-my %gentooism;
+use lib 'lib';
+use CPANPLUS::Dist::Gentoo::Atom;
+use CPANPLUS::Dist::Gentoo::Maps;
 
-my %where = (
- 'Audio-CD-disc-cover' => 1,
- 'aww'                 => 0,
- 'frontier-rpc'        => 1,
- 'gimp-perl'           => 1,
- 'gnome2-wnck'         => 1,
- 'HTML-Object'         => 0,
- 'JKFlow'              => 0,
- 'PDF-Create'          => 0,
+use constant PACKAGES    => File::Spec->catdir(
+ $ENV{HOME}, '.cpanplus', '02packages.details.txt.gz'
 );
+use constant CPAN_MIRROR => 'http://www.cpan.org/';
+use constant PORTAGE     => '/usr/portage';
+use constant TARGET      => 'lib/CPANPLUS/Dist/Gentoo/Maps.pm';
+use constant BACKUP      => TARGET . '.bak';
+use constant STATE_FILE  => 'gentooisms.sto';
 
-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";
     }
-    $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";
+   }
+
+   unless (defined $path) {
+    p(2, "doesn't seem to be fetching its tarball from a CPAN mirror.\n");
+    p(2, colored("$pkg_name is not a CPAN distribution", 'bright_red') . "\n");
+    push @not_on_cpan, "$category/$pkg_name";
+    next;
+   }
+   p(2, "fetches $path\n");
+
+   my $dist;
+   if (defined $fqn_dist) {
+    $dist = eval { $pcp->distribution($fqn_dist) };
+    p(2, defined $dist ? "is indexed on the CPAN\n" : 'is not indexed, but ');
+   } else {
+    p(2, 'is ');
+   }
+   unless (defined $dist) {
+    print 'maybe on a CPAN mirror... ';
+    my $r = $ua->head(CPAN_MIRROR . $path);
+    if ($r and $r->code == 200) {
+     print "yes\n";
+    } else {
+     print "no\n";
+     p(2, colored("$pkg_name is not a CPAN distribution", 'bright_red') . "\n");
+     push @not_on_cpan, "$category/$pkg_name";
+     next;
     }
+    $dist = CPAN::DistnameInfo->new($path);
    }
-  }
-  if ($pn and $pn ne $name) {
-   if ($on_cpan) {
-    $gentooism{$pn} = $name;
-   } elsif (not defined $on_cpan) {
-    print STDERR "'$pn' => '$name' may not be on CPAN\n";
+
+   my $dist_name = $dist->dist;
+   if ($dist_name ne $pkg_name) {
+    p(2, colored("$dist_name => $pkg_name", 'bright_yellow') . "\n");
+    $name_mismatch{$dist_name} = $pkg_name;
+   }
+
+   my $pkg_version = $atom->version . '';
+   $pkg_version =~ s/-r\d+$//;
+   my $dist_version = $dist->version;
+   my $mapped_version = CPANPLUS::Dist::Gentoo::Maps::version_c2g(
+    undef, # default conversion
+    $dist_version,
+   );
+   if ($mapped_version ne $pkg_version) {
+    my $str = "$dist_version => $mapped_version != $pkg_version";
+    p(2, colored($str, 'bright_cyan') . "\n");
    }
+   $version{$dist_name} = [ $dist_version => $pkg_version ];
   }
  }
 }
 
-chdir $cwd;
+sub timestamp {
+ my $tm = File::Spec->catfile(PORTAGE, 'metadata', 'timestamp.chk');
+ return unless -e $tm;
+ open my $fh, '<', $tm;
+ local $/;
+ <$fh>;
+}
+
+my $already_parsed = 0;
+my $timestamp = timestamp();
+
+if (-e STATE_FILE) {
+ my $data = Storable::retrieve(STATE_FILE);
+ if ($data->[0] eq $timestamp) {
+  printf "Data retrieved from %s\n", STATE_FILE;
+  @not_on_cpan    = @{ $data->[1] };
+  %name_mismatch  = %{ $data->[2] };
+  %version        = %{ $data->[3] };
+  $already_parsed = 1;
+ } else {
+  printf "Obsolete data file %s, regenerating data\n", STATE_FILE;
+  1 while unlink STATE_FILE;
+ }
+}
+
+unless ($already_parsed) {
+ parse_portage_tree();
+ print  "\n";
+ Storable::store([
+  $timestamp,
+  \@not_on_cpan,
+  \%name_mismatch,
+  \%version,
+ ] => STATE_FILE);
+ printf "Data stored to %s\n", STATE_FILE;
+}
+
+print "\n";
+p(0, "Summary\n");
+
+p(1, "Not on the CPAN:\n");
+p(2, "$_\n") for @not_on_cpan;
+
+p(1, "Name mismatch:\n");
+for my $dist_name (sort keys %name_mismatch) {
+ my $pkg_name    = $name_mismatch{$dist_name};
+ my $mapped_name = CPANPLUS::Dist::Gentoo::Maps::name_c2g($dist_name);
+
+ my $fixed = $mapped_name eq $pkg_name;
+ my $eq    = $fixed ? '==' : '!=';
+ my $str   = colored(
+  "$dist_name => $mapped_name $eq $pkg_name",
+  $fixed ? 'bright_green' : 'bright_red'
+ );
+ p(2, "$str\n");
+}
+
+p(1, "Version mismatch:\n");
+for (sort keys %version) {
+ my ($dist_version, $pkg_version) = @{$version{$_}};
+ my $default_mapped_version = CPANPLUS::Dist::Gentoo::Maps::version_c2g(
+  undef,
+  $dist_version,
+ );
+ my $mapped_version = CPANPLUS::Dist::Gentoo::Maps::version_c2g(
+  $_,
+  $dist_version,
+ );
+ if ($default_mapped_version ne $pkg_version) {
+  my $fixed = $mapped_version eq $pkg_version;
+  my $eq    = $fixed ? '==' : '!=';
+  my $str   = colored(
+   "$dist_version => $mapped_version $eq $pkg_version",
+   $fixed ? 'bright_green' : 'bright_red'
+  );
+  p(2, "$_: $str\n");
+ }
+}
 
 copy TARGET, BACKUP or die "copy failed: $!";
 
 open my $src, '<', BACKUP;
 open my $dst, '>', TARGET;
 
-my $max = max map length, keys %gentooism;
+my $max = max map length, keys %name_mismatch;
 
 SRC: while (<$src>) {
  print $dst $_;
  if (/^__DATA__$/) {
-  printf $dst "%s%s %s\n", $_, (' ' x ($max - length)), $gentooism{$_}
-                                                       for sort keys %gentooism;
+  printf $dst "%s%s %s\n", $_, (' ' x ($max - length)), $name_mismatch{$_}
+                                                   for sort keys %name_mismatch;
   last SRC;
  }
 }
 
-print STDERR +(keys %gentooism) . " gentooisms found\n";
-
+print "\n" . +(keys %name_mismatch) . " name mismatches found\n";
index 884c61fdc8575829a115f534fc8d089be9c7ccfe..ca48370ee7853b3cdbd90c81bdeaafe9a17adcb6 100644 (file)
@@ -3,17 +3,40 @@
 use strict;
 use warnings;
 
-use Test::More tests => 4;
+use Test::More tests => 1 + 7 + 9;
 
 use CPANPLUS::Dist::Gentoo::Maps;
 
-our %gentooisms;
-*gentooisms = \%CPANPLUS::Dist::Gentoo::Maps::gentooisms;
-
-is scalar(keys %gentooisms), 76, 'gentooisms are all there';
-
-is $gentooisms{PathTools}, 'File-Spec', 'gentooisms were correctly loaded';
-
-is CPANPLUS::Dist::Gentoo::Maps::name_c2g('PathTools'), 'File-Spec', 'name_c2g maps gentooisms correctly';
-
-is CPANPLUS::Dist::Gentoo::Maps::name_c2g('CPANPLUS-Dist-Gentoo'), 'CPANPLUS-Dist-Gentoo', 'name_c2g returns non gentooisms correctly';
+*nc2g = \&CPANPLUS::Dist::Gentoo::Maps::name_c2g;
+
+is nc2g('CPANPLUS-Dist-Gentoo'), 'CPANPLUS-Dist-Gentoo', 'name_c2g returns non gentooisms correctly';
+
+my %core_gentooisms = (
+ 'ANSIColor'       => 'Term-ANSIColor',
+ 'Digest'          => 'digest-base',
+ 'I18N-LangTags'   => 'i18n-langtags',
+ 'Locale-Maketext' => 'locale-maketext',
+ 'Net-Ping'        => 'net-ping',
+ 'Pod-Parser'      => 'PodParser',
+ 'PathTools'       => 'File-Spec',
+);
+
+for my $dist (sort keys %core_gentooisms) {
+ is nc2g($dist), $core_gentooisms{$dist}, "name_c2g('$dist')";
+}
+
+my %cpan_gentooisms = (
+ 'CGI-Simple'    => 'Cgi-Simple',
+ 'Date-Manip'    => 'DateManip',
+ 'Gtk2'          => 'gtk2-perl',
+ 'Log-Dispatch'  => 'log-dispatch',
+ 'Math-Pari'     => 'math-pari',
+ 'Regexp-Common' => 'regexp-common',
+ 'Tk'            => 'perl-tk',
+ 'Wx'            => 'wxperl',
+ 'YAML'          => 'yaml',
+);
+
+for my $dist (sort keys %cpan_gentooisms) {
+ is nc2g($dist), $cpan_gentooisms{$dist}, "name_c2g('$dist')";
+}
index 13586ce54aff64caa570b42d036bab9ee6939492..da28c3286c320440993341d378437e98ebe32878 100644 (file)
@@ -3,22 +3,39 @@
 use strict;
 use warnings;
 
-use Test::More tests => 10 + 7;
+use Test::More tests => 11 + 2 * 5 + 7;
 
 use CPANPLUS::Dist::Gentoo::Maps;
 
-*vc2g  = \&CPANPLUS::Dist::Gentoo::Maps::version_c2g;
+*vc2g = sub {
+ unshift @_, undef if @_ == 1;
+ goto &CPANPLUS::Dist::Gentoo::Maps::version_c2g
+};
 
 is vc2g('1'),       '1',      "version_c2g('1')";
-is vc2g('a1b'),     '1',      "version_c2g('a1b')";
+is vc2g('v1'),      '1',      "version_c2g('v1')";
 is vc2g('..1'),     '1',      "version_c2g('..1')";
 is vc2g('1.0'),     '1.0',    "version_c2g('1.0')";
+is vc2g('v1.0'),    '1.0',    "version_c2g('v1.0')";
 is vc2g('1._0'),    '1.0',    "version_c2g('1._0')";
 is vc2g('1_1'),     '1_p1',   "version_c2g('1_1')";
 is vc2g('1_.1'),    '1_p1',   "version_c2g('1_.1')";
 is vc2g('1_.1._2'), '1_p1.2', "version_c2g('1_.1._2')";
-is vc2g('1_.1_2'),  '1_p1.2', "version_c2g('1_.1_2')";
-is vc2g('1_.1_.2'), '1_p1.2', "version_c2g('1_.1_.2')";
+is vc2g('1_.1_2'),  '1_p12',  "version_c2g('1_.1_2')";
+is vc2g('1_.1_.2'), '1_p12',  "version_c2g('1_.1_.2')";
+
+for my $test ([ '0.12' => '0.12' ], [ '0.1234' => '0.12.34' ]) {
+ my @dists = qw/
+  ExtUtils-CBuilder
+  ExtUtils-ParseXS
+  Module-Build
+  Time-HiRes
+  Time-Local
+ /;
+ for my $dist (@dists) {
+  is vc2g($dist, $test->[0]), $test->[1], "'version_c2g('$dist', '$test->[0]')";
+ }
+}
 
 *pvc2g = \&CPANPLUS::Dist::Gentoo::Maps::perl_version_c2g;