lib/CPANPLUS/Dist/Gentoo/Version.pm

   1 package CPANPLUS::Dist::Gentoo::Version;
   2
   3 use strict;
   4 use warnings;
   5
   6 =head1 NAME
   7
   8 CPANPLUS::Dist::Gentoo::Version - Gentoo version object.
   9
  10 =head1 VERSION
  11
  12 Version 0.10
  13
  14 =cut
  15
  16 our $VERSION = '0.10';
  17
  18 =head1 DESCRIPTION
  19
  20 This class models Gentoo versions.
  21
  22 =cut
  23
  24 use Scalar::Util ();
  25
  26 use overload (
  27  '<=>' => \&_spaceship,
  28  '""'  => \&_stringify,
  29 );
  30
  31 my $int_rx        = qr/\d+/;
  32 my $dotted_num_rx = qr/$int_rx(?:\.$int_rx)*/;
  33
  34 our $version_rx = qr/$dotted_num_rx(?:_p$dotted_num_rx)?(?:-r$int_rx)?/;
  35
  36 =head1 METHODS
  37
  38 =head2 C<new $vstring>
  39
  40 Creates a new L<CPANPLUS::Dist::Gentoo::Version> object from the version string C<$vstring>.
  41
  42 =cut
  43
  44 sub new {
  45  my $class = shift;
  46  $class = ref($class) || $class;
  47
  48  my $vstring = shift;
  49  if (defined $vstring) {
  50   $vstring =~ s/^[._]+//g;
  51   $vstring =~ s/[._]+$//g;
  52   if ($vstring =~ /^($dotted_num_rx)(?:_p($dotted_num_rx))?(?:-r($int_rx))?$/) {
  53    return bless {
  54     string   => $vstring,
  55     version  => [ split /\.+/, $1 ],
  56     patch    => [ defined $2 ? (split /\.+/, $2) : () ],
  57     revision => [ defined $3 ? $3                : () ],
  58    }, $class;
  59   }
  60  }
  61
  62  require Carp;
  63  Carp::croak("Couldn't parse version string '$vstring'");
  64 }
  65
  66 my @parts;
  67 BEGIN {
  68  @parts = qw/version patch revision/;
  69  eval "sub $_ { \$_[0]->{$_} }" for @parts;
  70 }
  71
  72 =head2 C<version>
  73
  74 Read-only accessor for the C<version> part of the version object.
  75
  76 =head2 C<patch>
  77
  78 Read-only accessor for the C<patch> part of the version object.
  79
  80 =head2 C<revision>
  81
  82 Read-only accessor for the C<revision> part of the version object.
  83
  84 =cut
  85
  86 sub _spaceship {
  87  my ($v1, $v2, $r) = @_;
  88
  89  unless (Scalar::Util::blessed($v2) and $v2->isa(__PACKAGE__)) {
  90   $v2 = $v1->new($v2);
  91  }
  92
  93  ($v1, $v2) = ($v2, $v1) if $r;
  94
  95  for (@parts) {
  96   my @a = @{ $v1->$_ };
  97   my @b = @{ $v2->$_ };
  98   while (@a or @b) {
  99    my $x = shift(@a) || 0;
 100    my $y = shift(@b) || 0;
 101    my $c = $x <=> $y;
 102    return $c if $c;
 103   }
 104  }
 105
 106  return 0;
 107 }
 108
 109 sub _stringify {
 110  my ($v) = @_;
 111
 112  my ($version, $patch, $revision) = map $v->$_, @parts;
 113
 114  $version  = join '.', @$version;
 115  $version .= '_p' . join('.', @$patch)    if @$patch;
 116  $version .= '-r' . join('.', @$revision) if @$revision;
 117
 118  $version;
 119 }
 120
 121 =pod
 122
 123 This class provides overloaded methods for numerical comparison and strigification.
 124
 125 =head1 SEE ALSO
 126
 127 L<CPANPLUS::Dist::Gentoo>.
 128
 129 =head1 AUTHOR
 130
 131 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
 132
 133 You can contact me by mail or on C<irc.perl.org> (vincent).
 134
 135 =head1 BUGS
 136
 137 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>.
 138 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
 139
 140 =head1 SUPPORT
 141
 142 You can find documentation for this module with the perldoc command.
 143
 144     perldoc CPANPLUS::Dist::Gentoo
 145
 146 =head1 COPYRIGHT & LICENSE
 147
 148 Copyright 2009,2010 Vincent Pit, all rights reserved.
 149
 150 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
 151
 152 =cut
 153
 154 1; # End of CPANPLUS::Dist::Gentoo::Version