From: Vincent Pit <vince@profvince.com>
Date: Thu, 26 Nov 2009 15:57:19 +0000 (+0100)
Subject: Introduce C::D::G::{Atom,Version}
X-Git-Tag: v0.09~20
X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FCPANPLUS-Dist-Gentoo.git;a=commitdiff_plain;h=00e09b5e966914ebedb5c08927cf5a66af177171

Introduce C::D::G::{Atom,Version}

And move the version comparison logic from C::D::G::Maps to C::D::G::Version.
---

diff --git a/MANIFEST b/MANIFEST
index 64b73d6..b34c59d 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -4,13 +4,16 @@ META.yml
 Makefile.PL
 README
 lib/CPANPLUS/Dist/Gentoo.pm
+lib/CPANPLUS/Dist/Gentoo/Atom.pm
 lib/CPANPLUS/Dist/Gentoo/Maps.pm
+lib/CPANPLUS/Dist/Gentoo/Version.pm
 samples/g-cpanp
 samples/gengentooisms
 t/00-load.t
 t/11-maps-name.t
 t/12-maps-version.t
 t/13-maps-license.t
+t/20-version.t
 t/91-pod.t
 t/92-pod-coverage.t
 t/95-portability-files.t
diff --git a/Makefile.PL b/Makefile.PL
index ebf53b2..2aa77dd 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -21,6 +21,7 @@ my %PREREQ_PM = (
  'File::Spec'        => 0,
  'IPC::Cmd'          => 0,
  'Parse::CPAN::Meta' => 0,
+ 'Scalar::Util'      => 0,
  'base'              => 0,
 );
 
diff --git a/lib/CPANPLUS/Dist/Gentoo.pm b/lib/CPANPLUS/Dist/Gentoo.pm
index a6b7734..a753ab4 100644
--- a/lib/CPANPLUS/Dist/Gentoo.pm
+++ b/lib/CPANPLUS/Dist/Gentoo.pm
@@ -16,6 +16,7 @@ use CPANPLUS::Error ();
 
 use base qw/CPANPLUS::Dist::Base/;
 
+use CPANPLUS::Dist::Gentoo::Atom;
 use CPANPLUS::Dist::Gentoo::Maps;
 
 =head1 NAME
@@ -562,14 +563,13 @@ sub _cpan2portage {
     "$atom-*.ebuild",
    ) or next;
 
-   my $last = reduce {
-    CPANPLUS::Dist::Gentoo::Maps::version_gcmp($b->[1], $a->[1]) >= 0 ? $b : $a
-   } map [ $_, /\Q$atom\E-v?([\d._pr-]+).*?\.ebuild$/ ? $1 : 0 ], @ebuilds;
+   my $last = reduce { $a->[1] < $b->[1] ? $b : $a }
+               map [ $_, CPANPLUS::Dist::Gentoo::Atom->new(ebuild => $_) ],
+                @ebuilds;
 
    my $dep;
    if (defined $ver) { # implies that $version is defined
-    next unless
-              CPANPLUS::Dist::Gentoo::Maps::version_gcmp($last->[1], $ver) >= 0;
+    next if $last < $ver;
     $dep = ">=$category/$atom-$ver";
    } else {
     $dep = "$category/$atom";
diff --git a/lib/CPANPLUS/Dist/Gentoo/Atom.pm b/lib/CPANPLUS/Dist/Gentoo/Atom.pm
new file mode 100644
index 0000000..b017e6b
--- /dev/null
+++ b/lib/CPANPLUS/Dist/Gentoo/Atom.pm
@@ -0,0 +1,88 @@
+package CPANPLUS::Dist::Gentoo::Atom;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.08';
+
+use Carp         ();
+use Scalar::Util ();
+
+use overload (
+ '<=>' => \&cmp,
+ '""'  => \&as_string,
+);
+
+use CPANPLUS::Dist::Gentoo::Version;
+
+my $version_rx = $CPANPLUS::Dist::Gentoo::Version::version_rx;
+
+sub new {
+ my $class = shift;
+ $class = ref($class) || $class;
+
+ my %args = @_;
+
+ my ($name, $category, $version);
+ if (defined $args{name}) {
+  ($name, $category, $version) = @args{qw/name category version/};
+  Carp::confess('Category unspecified') unless defined $category;
+  /[^\w-]/ and Carp::confess('Invalid argument') for $name, $category;
+ } elsif (defined $args{atom}) {
+  my $atom = $args{atom};
+  $atom =~ m{^([\w-]+)/([\w-]+)-v?($version_rx)$}
+                                               or Carp::confess('Invalid atom');
+  ($name, $category, $version) = ($1, $2, $3);
+ } elsif (defined $args{ebuild}) {
+  my $ebuild = $args{ebuild};
+  $ebuild =~ m{/([\w-]+)/([\w-]+)-v?($version_rx)\.ebuild$}
+                                             or Carp::confess('Invalid ebuild');
+  ($name, $category, $version) = ($1, $2, $3);
+ } else {
+  Carp::confess('Not enough information for building an atom object');
+ }
+
+ if (defined $version) {
+  unless (Scalar::Util::blessed($version)
+                              and $_->isa('CPANPLUS::Dist::Gentoo::Version')) {
+   $version = CPANPLUS::Dist::Gentoo::Version->new($version);
+  }
+ }
+
+ bless {
+  category => $category,
+  name     => $name,
+  version  => $name,
+ }, $class;
+}
+
+BEGIN {
+ eval "sub $_ { \$_[0]->{$_} }" for qw/category name version/;
+}
+
+sub cmp {
+ my ($a1, $a2, $r) = @_;
+
+ my $v1 = $a1->version;
+
+ my $v2;
+ if (Scalar::Util::blessed($a2) and $a2->isa(__PACKAGE__)) {
+  Carp::confess('Can\'t compare atoms of different packages')
+                    if $a1->category ne $a2->category or $a1->name ne $a2->name;
+  $v2 = $a2->version;
+ } else {
+  $v2 = $a2;
+ }
+
+ ($v1, $v2) = ($v2, $v1) if $r;
+
+ return $v1 <=> $v2;
+}
+
+sub as_string {
+ my ($a) = @_;
+
+ $a->category . '/' . $a->name . '-' . $a->version;
+}
+
+1;
diff --git a/lib/CPANPLUS/Dist/Gentoo/Maps.pm b/lib/CPANPLUS/Dist/Gentoo/Maps.pm
index 5323307..d4a3fe6 100644
--- a/lib/CPANPLUS/Dist/Gentoo/Maps.pm
+++ b/lib/CPANPLUS/Dist/Gentoo/Maps.pm
@@ -93,44 +93,6 @@ sub version_c2g {
  return $v;
 }
 
-=head2 C<version_gcmp $va, $vb>
-
-Compares two Gentoo versions.
-
-=cut
-
-sub version_gcmp {
- my ($a, $b) = map { defined() ? $_ : 0 } @_;
-
- for ($a, $b) {
-  s/^[._]+//g;
-  s/[._]+$//g;
-  if (/^([\d.]*\d)\.*(?:_p\.*(\d[\d.]*))?\.*(?:-r(\d+))?$/) {
-   $_ = {
-    v => [ split /\.+/, $1 ],
-    p => [ split /\.+/, $2 || 0 ],
-    r => [ $3 || 0 ],
-   };
-  } else {
-   require Carp;
-   Carp::croak("Couldn't parse version string '$_'");
-  }
- }
-
- for my $k (qw/v p r/) {
-  my $xa = $a->{$k};
-  my $xb = $b->{$k};
-  while (@$xa or @$xb) {
-   my $na = shift(@$xa) || 0;
-   my $nb = shift(@$xb) || 0;
-   my $c  = $na <=> $nb;
-   return $c if $c;
-  }
- }
-
- return 0;
-}
-
 =head1 SEE ALSO
 
 L<CPANPLUS::Dist::Gentoo>.
diff --git a/lib/CPANPLUS/Dist/Gentoo/Version.pm b/lib/CPANPLUS/Dist/Gentoo/Version.pm
new file mode 100644
index 0000000..bdfd755
--- /dev/null
+++ b/lib/CPANPLUS/Dist/Gentoo/Version.pm
@@ -0,0 +1,83 @@
+package CPANPLUS::Dist::Gentoo::Version;
+
+use strict;
+use warnings;
+
+use Scalar::Util ();
+
+use overload (
+ '<=>' => \&cmp,
+ '""'  => \&as_string,
+);
+
+our $VERSION = '0.08';
+
+my $int_rx        = qr/\d+/;
+my $dotted_num_rx = qr/$int_rx(?:\.$int_rx)*/;
+
+our $version_rx = qr/$dotted_num_rx(?:_p$dotted_num_rx)?(?:-r$int_rx)?/;
+
+sub new {
+ my $class = shift;
+ $class = ref($class) || $class;
+
+ my $vstring = shift;
+ if (defined $vstring) {
+  $vstring =~ s/^[._]+//g;
+  $vstring =~ s/[._]+$//g;
+  if ($vstring =~ /^($dotted_num_rx)(?:_p($dotted_num_rx))?(?:-r($int_rx))?$/) {
+   return bless {
+    string   => $vstring,
+    version  => [ split /\.+/, $1 ],
+    patch    => [ defined $2 ? (split /\.+/, $2) : () ],
+    revision => [ defined $3 ? $3                : () ],
+   }, $class;
+  }
+ }
+
+ require Carp;
+ Carp::croak("Couldn't parse version string '$vstring'");
+}
+
+my @parts;
+BEGIN {
+ @parts = qw/version patch revision/;
+ eval "sub $_ { \$_[0]->{$_} }" for @parts;
+}
+
+sub cmp {
+ my ($v1, $v2, $r) = @_;
+
+ unless (Scalar::Util::blessed($v2) and $v2->isa(__PACKAGE__)) {
+  $v2 = $v1->new($v2);
+ }
+
+ ($v1, $v2) = ($v2, $v1) if $r;
+
+ for (@parts) {
+  my @a = @{ $v1->$_ };
+  my @b = @{ $v2->$_ };
+  while (@a or @b) {
+   my $x = shift(@a) || 0;
+   my $y = shift(@b) || 0;
+   my $c = $x <=> $y;
+   return $c if $c;
+  }
+ }
+
+ return 0;
+}
+
+sub as_string {
+ my ($v) = @_;
+
+ my ($version, $patch, $revision) = map $v->$_, @parts;
+
+ $version  = join '.', @$version;
+ $version .= '_p' . join('.', @$patch)    if @$patch;
+ $version .= '-r' . join('.', @$revision) if @$revision;
+
+ $version;
+}
+
+1;
diff --git a/t/12-maps-version.t b/t/12-maps-version.t
index 80a4baa..ea53f9b 100644
--- a/t/12-maps-version.t
+++ b/t/12-maps-version.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 10 + 24;
+use Test::More tests => 10;
 
 use CPANPLUS::Dist::Gentoo::Maps;
 
@@ -19,37 +19,3 @@ 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')";
-
-*vgcmp = \&CPANPLUS::Dist::Gentoo::Maps::version_gcmp;
-
-eval { vgcmp('dongs', 1) };
-like $@, qr/Couldn't\s+parse\s+version\s+string/, "version_gcmp('dongs', 1)";
-
-eval { vgcmp(1, 'dongs') };
-like $@, qr/Couldn't\s+parse\s+version\s+string/, "version_gcmp(1, 'dongs')";
-
-is vgcmp(undef, 0), 0,  'version_gcmp(undef, 0)';
-is vgcmp(0, 0),     0,  'version_gcmp(0, 0)';
-is vgcmp(1, 0),     1,  'version_gcmp(1, 0)';
-is vgcmp(0, 1),     -1, 'version_gcmp(0, 1)';
-is vgcmp(1, 1),     0,  'version_gcmp(1, 1)';
-
-is vgcmp('1.0', 1),     0,  "version_gcmp('1.0', 1)";
-is vgcmp('1.1', 1),     1,  "version_gcmp('1.1', 1)";
-is vgcmp('1.1', '1.0'), 1,  "version_gcmp('1.1', '1.0')";
-is vgcmp(1, '1.0'),     0,  "version_gcmp(1, '1.0')";
-is vgcmp(1, '1.1'),     -1, "version_gcmp(1, '1.1')";
-is vgcmp('1.0', '1.1'), -1, "version_gcmp('1.0', '1.1')";
-
-is vgcmp('1.0_p0', '1.0_p0'),     0,  "version_gcmp('1.0_p0', '1.0_p0')";
-is vgcmp('1.0_p0', '1.0_p1'),     -1, "version_gcmp('1.0_p0', '1.0_p1')";
-is vgcmp('1.1_p0', '1.0_p1'),     1,  "version_gcmp('1.1_p0', '1.0_p1')";
-is vgcmp('1.1_p0', '1.1_p0.1'),   -1, "version_gcmp('1.1_p0', '1.1_p0.1')";
-is vgcmp('1.1_p0.1', '1.1_p0.1'), 0,  "version_gcmp('1.1_p0.1', '1.1_p0.1')";
-
-is vgcmp('1.2_p0-r0', '1.2_p0'),  0,  "version_gcmp('1.2_p0-r0', '1.2_p0')";
-is vgcmp('1.2_p0-r1', '1.2_p0'),  1,  "version_gcmp('1.2_p0-r1', '1.2_p0')";
-is vgcmp('1.2-r0',    '1.2_p0'),  0,  "version_gcmp('1.2-r0', '1.2_p0')";
-is vgcmp('1.2-r1',    '1.2_p0'),  1,  "version_gcmp('1.2-r1', '1.2_p0')";
-is vgcmp('1.2-r1',    '1.2_p1'),  -1, "version_gcmp('1.2-r1', '1.2_p1')";
-is vgcmp('1.2-r2',    '1.2_p1'),  -1, "version_gcmp('1.2-r2', '1.2_p1')";
diff --git a/t/20-version.t b/t/20-version.t
new file mode 100644
index 0000000..16294ae
--- /dev/null
+++ b/t/20-version.t
@@ -0,0 +1,57 @@
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More tests => 2 + 21 * (3 + 2);
+
+use CPANPLUS::Dist::Gentoo::Version;
+
+sub V () { 'CPANPLUS::Dist::Gentoo::Version' }
+
+eval { V->new('dongs') };
+like $@, qr/Couldn't\s+parse\s+version\s+string/, "V->('dongs')";
+
+eval { my $res = 'dongs' < V->new(1) };
+like $@, qr/Couldn't\s+parse\s+version\s+string/, "'dongs' < V->new(1)";
+
+my @tests = (
+ [ 0, 0,  0 ],
+ [ 1, 0,  1 ],
+ [ 0, 1, -1 ],
+ [ 1, 1,  0 ],
+
+ [ '1.0', 1,      0 ],
+ [ '1.1', 1,      1 ],
+ [ '1.1', '1.0',  1 ],
+ [ 1,     '1.0',  0 ],
+ [ 1,     '1.1', -1 ],
+ [ '1.0', '1.1', -1 ],
+
+ [ '1.0_p0',   '1.0_p0',    0 ],
+ [ '1.0_p0',   '1.0_p1',   -1 ],
+ [ '1.1_p0',   '1.0_p1',    1 ],
+ [ '1.1_p0',   '1.1_p0.1', -1 ],
+ [ '1.1_p0.1', '1.1_p0.1',  0 ],
+
+ [ '1.2_p0-r0', '1.2_p0',  0 ],
+ [ '1.2_p0-r1', '1.2_p0',  1 ],
+ [ '1.2-r0',    '1.2_p0',  0 ],
+ [ '1.2-r1',    '1.2_p0',  1 ],
+ [ '1.2-r1',    '1.2_p1', -1 ],
+ [ '1.2-r2',    '1.2_p1', -1 ],
+);
+
+for (@tests) {
+ my ($s1, $s2, $res) = @$_;
+
+ my $v1 = V->new($s1);
+ my $v2 = V->new($s2);
+
+ is $s1 <=> $v2, $res, "'$s1' <=> V->new('$s2')";
+ is $v1 <=> $s2, $res, "V->new('$s1') <=> '$s2'";
+ is $v1 <=> $v2, $res, "V->new('$s1') <=> V->new('$s2')";
+
+ cmp_ok "$v1", 'eq', $s1, "V->new('$s1') eq '$s1'";
+ cmp_ok "$v2", 'eq', $s2, "V->new('$s2') eq '$s2'";
+}