X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2FCPANPLUS%2FDist%2FGentoo%2FVersion.pm;h=752fe97f7349c5c4eff71ed48d8e97cfc2772660;hb=d77142c8216a27e216565391d32d2cf3f321f63c;hp=bdfd755ad13a8a64945a66b3084a56600e66ab3a;hpb=00e09b5e966914ebedb5c08927cf5a66af177171;p=perl%2Fmodules%2FCPANPLUS-Dist-Gentoo.git

diff --git a/lib/CPANPLUS/Dist/Gentoo/Version.pm b/lib/CPANPLUS/Dist/Gentoo/Version.pm
index bdfd755..752fe97 100644
--- a/lib/CPANPLUS/Dist/Gentoo/Version.pm
+++ b/lib/CPANPLUS/Dist/Gentoo/Version.pm
@@ -3,19 +3,59 @@ package CPANPLUS::Dist::Gentoo::Version;
 use strict;
 use warnings;
 
+=head1 NAME
+
+CPANPLUS::Dist::Gentoo::Version - Gentoo version object.
+
+=head1 VERSION
+
+Version 0.10
+
+=cut
+
+our $VERSION = '0.10';
+
+=head1 DESCRIPTION
+
+This class models Gentoo versions as described in L<http://devmanual.gentoo.org/ebuild-writing/file-format/index.html>.
+
+=cut
+
 use Scalar::Util ();
 
 use overload (
- '<=>' => \&cmp,
- '""'  => \&as_string,
+ '<=>' => \&_spaceship,
+ '""'  => \&_stringify,
 );
 
-our $VERSION = '0.08';
+my $int_rx          = qr/[0-9]+/;
+my $positive_int_rx = qr/0*[1-9][0-9]*/;
+my $letter_rx       = qr/[a-zA-Z]/;
+my $dotted_num_rx   = qr/$int_rx(?:\.$int_rx)*/o;
+
+my @suffixes  = qw<alpha beta pre rc normal p>;
+my $suffix_rx = join '|', grep !/^normal$/, @suffixes;
+$suffix_rx    = qr/(?:$suffix_rx)/o;
+
+our $version_rx = qr{
+ $dotted_num_rx $letter_rx?
+ (?:_$suffix_rx$positive_int_rx?)*
+ (?:-r$positive_int_rx)?
+}xo;
+
+my $capturing_version_rx = qr{
+ ($dotted_num_rx) ($letter_rx)?
+ ((?:_$suffix_rx$positive_int_rx?)*)
+ (?:-r($positive_int_rx))?
+}xo;
 
-my $int_rx        = qr/\d+/;
-my $dotted_num_rx = qr/$int_rx(?:\.$int_rx)*/;
+=head1 METHODS
 
-our $version_rx = qr/$dotted_num_rx(?:_p$dotted_num_rx)?(?:-r$int_rx)?/;
+=head2 C<new $vstring>
+
+Creates a new L<CPANPLUS::Dist::Gentoo::Version> object from the version string C<$vstring>.
+
+=cut
 
 sub new {
  my $class = shift;
@@ -25,27 +65,55 @@ sub new {
  if (defined $vstring) {
   $vstring =~ s/^[._]+//g;
   $vstring =~ s/[._]+$//g;
-  if ($vstring =~ /^($dotted_num_rx)(?:_p($dotted_num_rx))?(?:-r($int_rx))?$/) {
+
+  if ($vstring =~ /^$capturing_version_rx$/o) {
    return bless {
     string   => $vstring,
     version  => [ split /\.+/, $1 ],
-    patch    => [ defined $2 ? (split /\.+/, $2) : () ],
-    revision => [ defined $3 ? $3                : () ],
+    letter   => $2,
+    suffixes => [ map /_($suffix_rx)($positive_int_rx)?/go, $3 ],
+    revision => $4,
    }, $class;
   }
+
+  require Carp;
+  Carp::croak("Couldn't parse version string '$vstring'");
  }
 
  require Carp;
- Carp::croak("Couldn't parse version string '$vstring'");
+ Carp::croak('You must specify a version string');
 }
 
 my @parts;
 BEGIN {
- @parts = qw/version patch revision/;
+ @parts = qw<version letter suffixes revision>;
  eval "sub $_ { \$_[0]->{$_} }" for @parts;
 }
 
-sub cmp {
+=head2 C<version>
+
+Read-only accessor for the C<version> part of the version object.
+
+=head2 C<letter>
+
+Read-only accessor for the C<letter> part of the version object.
+
+=head2 C<suffixes>
+
+Read-only accessor for the C<suffixes> part of the version object.
+
+=head2 C<revision>
+
+Read-only accessor for the C<revision> part of the version object.
+
+=cut
+
+my %suffix_grade = do {
+ my $i = 0;
+ map { $_ => ++$i } @suffixes;
+};
+
+sub _spaceship {
  my ($v1, $v2, $r) = @_;
 
  unless (Scalar::Util::blessed($v2) and $v2->isa(__PACKAGE__)) {
@@ -54,9 +122,10 @@ sub cmp {
 
  ($v1, $v2) = ($v2, $v1) if $r;
 
- for (@parts) {
-  my @a = @{ $v1->$_ };
-  my @b = @{ $v2->$_ };
+ {
+  my @a = @{ $v1->version };
+  my @b = @{ $v2->version };
+
   while (@a or @b) {
    my $x = shift(@a) || 0;
    my $y = shift(@b) || 0;
@@ -65,19 +134,89 @@ sub cmp {
   }
  }
 
+ {
+  my ($l1, $l2) = map { defined() ? ord : 0 } map $_->letter, $v1, $v2;
+
+  my $c = $l1 <=> $l2;
+  return $c if $c;
+ }
+
+ {
+  my @a = @{ $v1->suffixes };
+  my @b = @{ $v2->suffixes };
+
+  while (@a or @b) {
+   my $x = $suffix_grade{ shift(@a) || 'normal' };
+   my $y = $suffix_grade{ shift(@b) || 'normal' };
+   my $c = $x <=> $y;
+   return $c if $c;
+
+   $x = shift(@a) || 0;
+   $y = shift(@b) || 0;
+   $c = $x <=> $y;
+   return $c if $c;
+  }
+ }
+
+ {
+  my ($r1, $r2) = map { defined() ? $_ : 0 } map $_->revision, $v1, $v2;
+
+  my $c = $r1 <=> $r2;
+  return $c if $c;
+ }
+
  return 0;
 }
 
-sub as_string {
+sub _stringify {
  my ($v) = @_;
 
- my ($version, $patch, $revision) = map $v->$_, @parts;
+ my ($version, $letter, $suffixes, $revision) = map $v->$_, @parts;
+ my @suffixes = @$suffixes;
 
- $version  = join '.', @$version;
- $version .= '_p' . join('.', @$patch)    if @$patch;
- $version .= '-r' . join('.', @$revision) if @$revision;
+ $version   = join '.', @$version;
+ $version  .= $letter if defined $letter;
+ while (my @suffix = splice @suffixes, 0, 2) {
+  my $s = $suffix[0];
+  my $n = $suffix[1];
+  $version .= "_$s" . (defined $n ? $n : '');
+ }
+ $version .= "-r$revision" if defined $revision;
 
  $version;
 }
 
-1;
+=pod
+
+This class provides overloaded methods for numerical comparison and strigification.
+
+=head1 SEE ALSO
+
+L<CPANPLUS::Dist::Gentoo>.
+
+=head1 AUTHOR
+
+Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
+
+You can contact me by mail or on C<irc.perl.org> (vincent).
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-cpanplus-dist-gentoo at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=CPANPLUS-Dist-Gentoo>.
+I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+    perldoc CPANPLUS::Dist::Gentoo
+
+=head1 COPYRIGHT & LICENSE
+
+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.
+
+=cut
+
+1; # End of CPANPLUS::Dist::Gentoo::Version