X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2FCPANPLUS%2FDist%2FGentoo%2FAtom.pm;h=b58ebc3a9e28f7a8912e6a288cff0c683d91be5f;hb=f7846983c923e0aac6f815d8c494fbd958cb3fbe;hp=33c622c1622e54b3f3641ebe24cbee44d2b63154;hpb=c915539acae3c42715a7587868c8165f9bb7137f;p=perl%2Fmodules%2FCPANPLUS-Dist-Gentoo.git diff --git a/lib/CPANPLUS/Dist/Gentoo/Atom.pm b/lib/CPANPLUS/Dist/Gentoo/Atom.pm index 33c622c..b58ebc3 100644 --- a/lib/CPANPLUS/Dist/Gentoo/Atom.pm +++ b/lib/CPANPLUS/Dist/Gentoo/Atom.pm @@ -59,7 +59,7 @@ sub new { Carp::confess('Invalid name') unless $name =~ /^$name_rx$/o; } elsif (defined $args{atom}) { my $atom = $args{atom}; - $atom =~ m{^($range_rx)?($category_rx)/($name_rx)(?:-v?($version_rx))?$}o + $atom =~ m{^($range_rx)?($category_rx)/($name_rx)(?:-($version_rx))?$}o or Carp::confess('Invalid atom'); ($range, $category, $name, $version) = ($1, $2, $3, $4); } else { @@ -68,7 +68,7 @@ sub new { if (defined $version) { unless (Scalar::Util::blessed($version) - and $_->isa('CPANPLUS::Dist::Gentoo::Version')) { + and $version->isa('CPANPLUS::Dist::Gentoo::Version')) { $version = CPANPLUS::Dist::Gentoo::Version->new($version); } } @@ -106,7 +106,7 @@ sub new_from_ebuild { my $ebuild = shift; $ebuild = '' unless defined $ebuild; - $ebuild =~ m{/($category_rx)/($name_rx)/\2-v?($version_rx)\.ebuild$}o + $ebuild =~ m{/($category_rx)/($name_rx)/\2-($version_rx)\.ebuild$}o or Carp::confess('Invalid ebuild'); my ($category, $name, $version) = ($1, $2, $3); @@ -192,20 +192,21 @@ sub _spaceship { sub _cmp { my ($a1, $a2, $r) = @_; - my $s1 = $a1->qualified_name; - my $v1 = $a1->version; - $s1 .= "-$v1" if defined $v1; + if (defined $a2) { + my $p1 = $a1->qualified_name; - my $s2; - if (Scalar::Util::blessed($a2) and $a2->isa(__PACKAGE__)) { - $s2 = $a2->qualified_name; - my $v2 = $a2->version; - $s2 .= "-$v2" if defined $v2; - } else { - $s2 = $a2; + unless (Scalar::Util::blessed($a2) && $a2->isa(__PACKAGE__)) { + $a2 = eval { __PACKAGE__->new(atom => $a2) }; + Carp::confess("Can't compare an atom against something that's not an atom or an atom string ($@)") if $@; + } + my $p2 = $a2->qualified_name; + + if (my $c = $p1 cmp $p2) { + return $r ? -$c : $c; + } } - $s1 cmp $s2; + $a1 <=> $a2; } sub _stringify {