]> git.vpit.fr Git - perl/modules/CPANPLUS-Dist-Gentoo.git/blob - lib/CPANPLUS/Dist/Gentoo/Atom.pm
Strip duplicated entries in the RDEPEND list
[perl/modules/CPANPLUS-Dist-Gentoo.git] / 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 ($name, $category, $version);
27  if (defined $args{name}) {
28   ($name, $category, $version) = @args{qw/name category 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   ($name, $category, $version) = ($1, $2, $3);
36  } elsif (defined $args{ebuild}) {
37   my $ebuild = $args{ebuild};
38   $ebuild =~ m{/([\w-]+)/([\w-]+)-v?($version_rx)\.ebuild$}
39                                              or Carp::confess('Invalid ebuild');
40   ($name, $category, $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  => $name,
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->minmium) {
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;