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  '<=>' => \&cmp,
  13  '""'  => \&as_string,
  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  Carp::confess('Minimum atoms require a valid version') if  not defined $version
  53                                                         and $args{minimum};
  54
  55  bless {
  56   category => $category,
  57   name     => $name,
  58   version  => $version,
  59   minimum  => $args{minimum},
  60   ebuild   => $args{ebuild},
  61  }, $class;
  62 }
  63
  64 BEGIN {
  65  eval "sub $_ { \$_[0]->{$_} }" for qw/category name version minimum ebuild/;
  66 }
  67
  68 sub cmp {
  69  my ($a1, $a2, $r) = @_;
  70
  71  my $v1 = $a1->version;
  72
  73  my $v2;
  74  if (Scalar::Util::blessed($a2) and $a2->isa(__PACKAGE__)) {
  75   Carp::confess('Can\'t compare atoms of different packages')
  76                     if $a1->category ne $a2->category or $a1->name ne $a2->name;
  77   $v2 = $a2->version;
  78  } else {
  79   $v2 = $a2;
  80  }
  81
  82  ($v1, $v2) = ($v2, $v1) if $r;
  83
  84  return $v1 <=> $v2;
  85 }
  86
  87 sub as_string {
  88  my ($a) = @_;
  89
  90  my $atom = $a->category . '/' . $a->name;
  91
  92  my $version = $a->version;
  93  if (defined $version) {
  94   $atom = "=$atom-$version";
  95   $atom = ">$atom" if $a->minimum;
  96  }
  97
  98  return $atom;
  99 }
 100
 101 sub fold {
 102  shift unless length ref $_[0];
 103
 104  my %seen;
 105  for my $atom (@_) {
 106   my ($category, $name, $version) = map $atom->$_, qw/category name version/;
 107   my $key = join '/', $category, $name;
 108   my $cur = $seen{$key};
 109
 110   unless (defined $cur) {
 111    $seen{$key} = $atom;
 112    next;
 113   }
 114
 115   next unless defined $version;
 116
 117   if (not defined $cur->version) {
 118    $seen{$key} = $atom;
 119    next;
 120   }
 121
 122   if ($atom->minimum) {
 123    if ($cur->minimum) {
 124     $seen{$key} = $atom < $cur ? $cur : $atom;
 125    } else {
 126     Carp::confess('Version mismatch') if $atom > $cur;
 127    }
 128   } elsif ($cur->minimum) {
 129    Carp::confess('Version mismatch') if $cur > $atom;
 130   }
 131  }
 132
 133  return values %seen;
 134 }
 135
 136 1;