And move the version comparison logic from C::D::G::Maps to C::D::G::Version.
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
'File::Spec' => 0,
'IPC::Cmd' => 0,
'Parse::CPAN::Meta' => 0,
+ 'Scalar::Util' => 0,
'base' => 0,
);
use base qw/CPANPLUS::Dist::Base/;
+use CPANPLUS::Dist::Gentoo::Atom;
use CPANPLUS::Dist::Gentoo::Maps;
=head1 NAME
"$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";
--- /dev/null
+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;
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>.
--- /dev/null
+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;
use strict;
use warnings;
-use Test::More tests => 10 + 24;
+use Test::More tests => 10;
use CPANPLUS::Dist::Gentoo::Maps;
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')";
--- /dev/null
+#!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'";
+}
projects / perl / modules / CPANPLUS-Dist-Gentoo.git / commitdiff