X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2FCPANPLUS%2FDist%2FGentoo%2FAtom.pm;h=543ece4f61f0dd3aa35aa4afb5ccd62c2d29678c;hb=d77142c8216a27e216565391d32d2cf3f321f63c;hp=76af6fe787c27053c129932c461f6347417db175;hpb=eec0ec3915edc56c40c9ab85e50f22d2aee29beb;p=perl%2Fmodules%2FCPANPLUS-Dist-Gentoo.git diff --git a/lib/CPANPLUS/Dist/Gentoo/Atom.pm b/lib/CPANPLUS/Dist/Gentoo/Atom.pm index 76af6fe..543ece4 100644 --- a/lib/CPANPLUS/Dist/Gentoo/Atom.pm +++ b/lib/CPANPLUS/Dist/Gentoo/Atom.pm @@ -5,15 +5,15 @@ use warnings; =head1 NAME -CPANPLUS::Dist::Gentoo::Version - Gentoo atom object. +CPANPLUS::Dist::Gentoo::Atom - Gentoo atom object. =head1 VERSION -Version 0.08 +Version 0.10 =cut -our $VERSION = '0.08'; +our $VERSION = '0.10'; =head1 DESCRIPTION @@ -32,7 +32,10 @@ use overload ( use CPANPLUS::Dist::Gentoo::Version; -my $version_rx = $CPANPLUS::Dist::Gentoo::Version::version_rx; +my $range_rx = qr/(?:<|<=|=|>=|>)/; +my $name_rx = qr/[a-zA-Z0-9_+-]+/; +my $category_rx = $name_rx; +my $version_rx = $CPANPLUS::Dist::Gentoo::Version::version_rx; =head1 METHODS @@ -50,12 +53,13 @@ sub new { my ($range, $category, $name, $version); if (defined $args{name}) { - ($range, $category, $name, $version) = @args{qw/range category name version/}; + ($range, $category, $name, $version) = @args{qw}; Carp::confess('Category unspecified') unless defined $category; - /[^\w-]/ and Carp::confess('Invalid argument') for $name, $category; + Carp::confess('Invalid category') unless $category =~ /^$category_rx$/o; + Carp::confess('Invalid name') unless $name =~ /^$name_rx$/o; } elsif (defined $args{atom}) { my $atom = $args{atom}; - $atom =~ m{^(<|<=|=|>=|>)?([\w-]+)/([\w-]+)(?-v?($version_rx))?$} + $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 { @@ -64,17 +68,16 @@ 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); } } if (defined $version) { if (defined $range) { - Carp::confess("Invalid range $range") - unless grep $range eq $_, qw|< <= = >= >|; + Carp::confess("Invalid range $range") unless $range =~ /^$range_rx$/o; } else { - $range = '='; + $range = '>='; } } else { Carp::confess('Range atoms require a valid version') @@ -103,7 +106,7 @@ sub new_from_ebuild { my $ebuild = shift; $ebuild = '' unless defined $ebuild; - $ebuild =~ m{/([\w-]+)/([\w-]+)/\2-v?($version_rx)\.ebuild$} + $ebuild =~ m{/($category_rx)/($name_rx)/\2-($version_rx)\.ebuild$}o or Carp::confess('Invalid ebuild'); my ($category, $name, $version) = ($1, $2, $3); @@ -116,7 +119,7 @@ sub new_from_ebuild { } BEGIN { - eval "sub $_ { \$_[0]->{$_} }" for qw/category name version range ebuild/; + eval "sub $_ { \$_[0]->{$_} }" for qw; } =head2 C @@ -153,36 +156,57 @@ sub _spaceship { 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; + my $blessed = Scalar::Util::blessed($a2); + unless ($blessed and $a2->isa(__PACKAGE__)) { + if ($blessed and $a2->isa('CPANPLUS::Dist::Gentoo::Version')) { + $v2 = $a2; + $a2 = undef; + } else { + my $maybe_atom = eval { __PACKAGE__->new(atom => $a2) }; + if (my $err = $@) { + $v2 = eval { CPANPLUS::Dist::Gentoo::Version->new($a2) }; + Carp::confess("Can't compare an atom against something that's not an atom, an atom string ($err), a version or a version string ($@)") if $@; + $a2 = undef; + } else { + $a2 = $maybe_atom; + } + } + } + + if (defined $a2) { $v2 = $a2->version; - } else { - $v2 = $a2; + + my $p1 = $a1->qualified_name; + my $p2 = $a2->qualified_name; + Carp::confess("Atoms for different packages $p1 and $p2") unless $p1 eq $p2; } ($v1, $v2) = ($v2, $v1) if $r; + return (defined $v1 or 0) <=> (defined $v2 or 0) unless defined $v1 + and defined $v2; + return $v1 <=> $v2; } 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 { @@ -271,7 +295,7 @@ sub fold { $seen{$key} = defined $cur ? $cur->and($atom) : $atom; } - return values %seen; + return map $seen{$_}, sort keys %seen; } =pod @@ -290,7 +314,8 @@ You can contact me by mail or on C (vincent). =head1 BUGS -Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. +Please report any bugs or feature requests to C, or through the web interface at L. +I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 SUPPORT @@ -300,7 +325,7 @@ You can find documentation for this module with the perldoc command. =head1 COPYRIGHT & LICENSE -Copyright 2009 Vincent Pit, all rights reserved. +Copyright 2009,2010 Vincent Pit, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.