lib/CPANPLUS/Dist/Gentoo/Version.pm

   1 package CPANPLUS::Dist::Gentoo::Version;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Scalar::Util ();
   7
   8 use overload (
   9  '<=>' => \&cmp,
  10  '""'  => \&as_string,
  11 );
  12
  13 our $VERSION = '0.08';
  14
  15 my $int_rx        = qr/\d+/;
  16 my $dotted_num_rx = qr/$int_rx(?:\.$int_rx)*/;
  17
  18 our $version_rx = qr/$dotted_num_rx(?:_p$dotted_num_rx)?(?:-r$int_rx)?/;
  19
  20 sub new {
  21  my $class = shift;
  22  $class = ref($class) || $class;
  23
  24  my $vstring = shift;
  25  if (defined $vstring) {
  26   $vstring =~ s/^[._]+//g;
  27   $vstring =~ s/[._]+$//g;
  28   if ($vstring =~ /^($dotted_num_rx)(?:_p($dotted_num_rx))?(?:-r($int_rx))?$/) {
  29    return bless {
  30     string   => $vstring,
  31     version  => [ split /\.+/, $1 ],
  32     patch    => [ defined $2 ? (split /\.+/, $2) : () ],
  33     revision => [ defined $3 ? $3                : () ],
  34    }, $class;
  35   }
  36  }
  37
  38  require Carp;
  39  Carp::croak("Couldn't parse version string '$vstring'");
  40 }
  41
  42 my @parts;
  43 BEGIN {
  44  @parts = qw/version patch revision/;
  45  eval "sub $_ { \$_[0]->{$_} }" for @parts;
  46 }
  47
  48 sub cmp {
  49  my ($v1, $v2, $r) = @_;
  50
  51  unless (Scalar::Util::blessed($v2) and $v2->isa(__PACKAGE__)) {
  52   $v2 = $v1->new($v2);
  53  }
  54
  55  ($v1, $v2) = ($v2, $v1) if $r;
  56
  57  for (@parts) {
  58   my @a = @{ $v1->$_ };
  59   my @b = @{ $v2->$_ };
  60   while (@a or @b) {
  61    my $x = shift(@a) || 0;
  62    my $y = shift(@b) || 0;
  63    my $c = $x <=> $y;
  64    return $c if $c;
  65   }
  66  }
  67
  68  return 0;
  69 }
  70
  71 sub as_string {
  72  my ($v) = @_;
  73
  74  my ($version, $patch, $revision) = map $v->$_, @parts;
  75
  76  $version  = join '.', @$version;
  77  $version .= '_p' . join('.', @$patch)    if @$patch;
  78  $version .= '-r' . join('.', @$revision) if @$revision;
  79
  80  $version;
  81 }
  82
  83 1;