lib/CPANPLUS/Dist/Gentoo/Atom.pm

   1 package CPANPLUS::Dist::Gentoo::Atom;
   2
   3 use strict;
   4 use warnings;
   5
   6 our $VERSION = '0.08';
   7
   8 use Carp         ();
   9 use Scalar::Util ();
  10
  11 use overload (
  12  '<=>' => \&_spaceship,
  13  '""'  => \&_stringify,
  14 );
  15
  16 use CPANPLUS::Dist::Gentoo::Version;
  17
  18 my $version_rx = $CPANPLUS::Dist::Gentoo::Version::version_rx;
  19
  20 sub new {
  21  my $class = shift;
  22  $class = ref($class) || $class;
  23
  24  my %args = @_;
  25
  26  my ($category, $name, $version);
  27  if (defined $args{name}) {
  28   ($category, $name, $version) = @args{qw/category name version/};
  29   Carp::confess('Category unspecified') unless defined $category;
  30   /[^\w-]/ and Carp::confess('Invalid argument') for $name, $category;
  31  } elsif (defined $args{atom}) {
  32   my $atom = $args{atom};
  33   $atom =~ m{^([\w-]+)/([\w-]+)-v?($version_rx)$}
  34                                                or Carp::confess('Invalid atom');
  35   ($category, $name, $version) = ($1, $2, $3);
  36  } elsif (defined $args{ebuild}) {
  37   my $ebuild = $args{ebuild};
  38   $ebuild =~ m{/([\w-]+)/([\w-]+)/\2-v?($version_rx)\.ebuild$}
  39                                              or Carp::confess('Invalid ebuild');
  40   ($category, $name, $version) = ($1, $2, $3);
  41  } else {
  42   Carp::confess('Not enough information for building an atom object');
  43  }
  44
  45  if (defined $version) {
  46   unless (Scalar::Util::blessed($version)
  47                               and $_->isa('CPANPLUS::Dist::Gentoo::Version')) {
  48    $version = CPANPLUS::Dist::Gentoo::Version->new($version);
  49   }
  50  }
  51
  52  my $range = $args{range};
  53  if (defined $version) {
  54   if (defined $range) {
  55    Carp::confess("Invalid range $range")
  56                                       unless grep $range eq $_, qw|< <= = >= >|;
  57   } else {
  58    $range = '=';
  59   }
  60  } else {
  61   Carp::confess('Range atoms require a valid version')
  62                                             if defined $range and length $range;
  63  }
  64
  65  bless {
  66   category => $category,
  67   name     => $name,
  68   version  => $version,
  69   range    => $range,
  70   ebuild   => $args{ebuild},
  71  }, $class;
  72 }
  73
  74 BEGIN {
  75  eval "sub $_ { \$_[0]->{$_} }" for qw/category name version range ebuild/;
  76 }
  77
  78 sub qualified_name { join '/', $_[0]->category, $_[0]->name }
  79
  80 sub _spaceship {
  81  my ($a1, $a2, $r) = @_;
  82
  83  my $v1 = $a1->version;
  84
  85  my $v2;
  86  if (Scalar::Util::blessed($a2) and $a2->isa(__PACKAGE__)) {
  87   Carp::confess('Can\'t compare atoms of different packages')
  88                     if $a1->category ne $a2->category or $a1->name ne $a2->name;
  89   $v2 = $a2->version;
  90  } else {
  91   $v2 = $a2;
  92  }
  93
  94  ($v1, $v2) = ($v2, $v1) if $r;
  95
  96  return $v1 <=> $v2;
  97 }
  98
  99 sub _stringify {
 100  my ($a) = @_;
 101
 102  my $atom = $a->qualified_name;
 103
 104  my $version = $a->version;
 105  $atom = $a->range . $atom . '-' . $version if defined $version;
 106
 107  return $atom;
 108 }
 109
 110 my %order = (
 111  '<'  => -2,
 112  '<=' => -1,
 113   '=' =>  0,
 114  '>=' =>  1,
 115  '>'  =>  2,
 116 );
 117
 118 sub and {
 119  shift unless length ref $_[0];
 120
 121  my $a1 = shift;
 122  my $a2 = shift;
 123  $a2 = $a2->and(@_) if @_;
 124
 125  my $p1 = $a1->qualified_name;
 126  my $p2 = $a2->qualified_name;
 127  Carp::confess("Atoms for different packages $p1 and $p2") unless $p1 eq $p2;
 128
 129  my $v1 = $a1->version;
 130  return $a2 unless defined $v1;
 131  my $r1 = $a1->range; # Defined if $v1 is defined
 132
 133  my $v2 = $a2->version;
 134  return $a1 unless defined $v2;
 135  my $r2 = $a2->range; # defined if $v2 is defined
 136
 137  my $o1 = $order{$r1};
 138  my $o2 = $order{$r2};
 139
 140  Carp::confess("Incompatible ranges $r1$p1 and $r2$p2") if $o1 * $o2 < 0;
 141
 142  if ($r2 eq '=') {
 143   ($a1, $a2) = ($a2, $a1);
 144   ($v1, $v2) = ($v2, $v1);
 145   ($r1, $r2) = ($r2, $r1);
 146   ($o1, $o2) = ($o2, $o1);
 147  }
 148
 149  if ($r1 eq '=') {
 150   my $r = $r2 eq '=' ? '==' : $r2;
 151   Carp::confess("Version mismatch $v1 $r $v2") unless eval "\$a1 $r \$a2";
 152   return $a1;
 153  } elsif ($o1 > 0) {
 154   return $a1 < $a2 ? $a2 : $a1;
 155  } else {
 156   return $a1 < $a2 ? $a1 : $a2;
 157  }
 158 }
 159
 160 sub fold {
 161  shift unless length ref $_[0];
 162
 163  my %seen;
 164  for my $atom (@_) {
 165   my $key = $atom->qualified_name;
 166
 167   my $cur = $seen{$key};
 168   $seen{$key} = defined $cur ? $cur->and($atom) : $atom;
 169  }
 170
 171  return values %seen;
 172 }
 173
 174 1;