X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FCPANPLUS-Dist-Gentoo.git;a=blobdiff_plain;f=lib%2FCPANPLUS%2FDist%2FGentoo%2FAtom.pm;h=bc0e9c027eb57809f817da445e64e92aa2673aeb;hp=ebe6a4e64d8e393c58c5af2ae3c7d6608becf8d0;hb=5a5575483b3f3ae59a3895e1a571edd687becec0;hpb=1c081d8b9a6c65ece91fa1363a4bdd9e49b00a37 diff --git a/lib/CPANPLUS/Dist/Gentoo/Atom.pm b/lib/CPANPLUS/Dist/Gentoo/Atom.pm index ebe6a4e..bc0e9c0 100644 --- a/lib/CPANPLUS/Dist/Gentoo/Atom.pm +++ b/lib/CPANPLUS/Dist/Gentoo/Atom.pm @@ -49,20 +49,30 @@ sub new { } } - Carp::confess('Minimum atoms require a valid version') if not defined $version - and $args{minimum}; + my $range = $args{range}; + if (defined $version) { + if (defined $range) { + Carp::confess("Invalid range $range") + unless grep $range eq $_, qw|< <= = >= >|; + } else { + $range = '='; + } + } else { + Carp::confess('Range atoms require a valid version') + if defined $range and length $range; + } bless { category => $category, name => $name, version => $version, - minimum => $args{minimum}, + range => $range, ebuild => $args{ebuild}, }, $class; } BEGIN { - eval "sub $_ { \$_[0]->{$_} }" for qw/category name version minimum ebuild/; + eval "sub $_ { \$_[0]->{$_} }" for qw/category name version range ebuild/; } sub cmp { @@ -90,44 +100,70 @@ sub as_string { my $atom = $a->category . '/' . $a->name; my $version = $a->version; - if (defined $version) { - $atom = "=$atom-$version"; - $atom = ">$atom" if $a->minimum; - } + $atom = $a->range . $atom . '-' . $version if defined $version; return $atom; } -sub fold { +my %order = ( + '<' => -2, + '<=' => -1, + '=' => 0, + '>=' => 1, + '>' => 2, +); + +sub and { shift unless length ref $_[0]; - my %seen; - for my $atom (@_) { - my ($category, $name, $version) = map $atom->$_, qw/category name version/; - my $key = join '/', $category, $name; - my $cur = $seen{$key}; + my $a1 = shift; + my $a2 = shift; + $a2 = $a2->and(@_) if @_; - unless (defined $cur) { - $seen{$key} = $atom; - next; - } + my $p1 = join '/', $a1->category, $a1->name; + my $p2 = join '/', $a2->category, $a2->name; + Carp::confess("Atoms for different packages $p1 and $p2") unless $p1 eq $p2; - next unless defined $version; + my $v1 = $a1->version; + return $a2 unless defined $v1; + my $r1 = $a1->range; # Defined if $v1 is defined - if (not defined $cur->version) { - $seen{$key} = $atom; - next; - } + my $v2 = $a2->version; + return $a1 unless defined $v2; + my $r2 = $a2->range; # defined if $v2 is defined - if ($atom->minimum) { - if ($cur->minimum) { - $seen{$key} = $atom < $cur ? $cur : $atom; - } else { - Carp::confess('Version mismatch') if $atom > $cur; - } - } elsif ($cur->minimum) { - Carp::confess('Version mismatch') if $cur > $atom; - } + my $o1 = $order{$r1}; + my $o2 = $order{$r2}; + + Carp::confess("Incompatible ranges $r1$p1 and $r2$p2") if $o1 * $o2 < 0; + + if ($r2 eq '=') { + ($a1, $a2) = ($a2, $a1); + ($v1, $v2) = ($v2, $v1); + ($r1, $r2) = ($r2, $r1); + ($o1, $o2) = ($o2, $o1); + } + + if ($r1 eq '=') { + my $r = $r2 eq '=' ? '==' : $r2; + Carp::confess("Version mismatch $v1 $r $v2") unless eval "\$a1 $r \$a2"; + return $a1; + } elsif ($o1 > 0) { + return $a1 < $a2 ? $a2 : $a1; + } else { + return $a1 < $a2 ? $a1 : $a2; + } +} + +sub fold { + shift unless length ref $_[0]; + + my %seen; + for my $atom (@_) { + my $key = join '/', $atom->category, $atom->name; + + my $cur = $seen{$key}; + $seen{$key} = defined $cur ? $cur->and($atom) : $atom; } return values %seen;