=head1 VERSION
-Version 0.09
+Version 0.11
=cut
-our $VERSION = '0.09';
+our $VERSION = '0.11';
=head1 DESCRIPTION
-This class models Gentoo versions.
+This class models Gentoo versions as described in L<http://devmanual.gentoo.org/ebuild-writing/file-format/index.html>.
=cut
'""' => \&_stringify,
);
-my $int_rx = qr/\d+/;
-my $dotted_num_rx = qr/$int_rx(?:\.$int_rx)*/;
+my $int_rx = qr/[0-9]+/;
+my $letter_rx = qr/[a-zA-Z]/;
+my $dotted_num_rx = qr/$int_rx(?:\.$int_rx)*/o;
-our $version_rx = qr/$dotted_num_rx(?:_p$dotted_num_rx)?(?:-r$int_rx)?/;
+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$int_rx?)*
+ (?:-r$int_rx)?
+}xo;
+
+my $capturing_version_rx = qr{
+ ($dotted_num_rx) ($letter_rx)?
+ ((?:_$suffix_rx$int_rx?)*)
+ (?:-r($int_rx))?
+}xo;
=head1 METHODS
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)($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;
}
Read-only accessor for the C<version> part of the version object.
-=head2 C<patch>
+=head2 C<letter>
-Read-only accessor for the C<patch> part of the version object.
+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>
=cut
+my %suffix_grade = do {
+ my $i = 0;
+ map { $_ => ++$i } @suffixes;
+};
+
sub _spaceship {
my ($v1, $v2, $r) = @_;
($v1, $v2) = ($v2, $v1) if $r;
- for (@parts) {
- my @a = @{ $v1->$_ };
- my @b = @{ $v2->$_ };
+ {
+ my @a = @{ $v1->version };
+ my @b = @{ $v2->version };
+
+ {
+ my $x = shift @a;
+ my $y = shift @b;
+ my $c = $x <=> $y;
+ return $c if $c;
+ }
+
+ while (@a and @b) {
+ my $x = shift @a;
+ my $y = shift @b;
+ my $c;
+ if ($x =~ /^0/ or $y =~ /^0/) {
+ s/0+\z// for $x, $y;
+ $c = $x cmp $y;
+ } else {
+ $c = $x <=> $y;
+ }
+ return $c if $c;
+ }
+
+ return 1 if @a;
+ return -1 if @b;
+ }
+
+ {
+ 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 = shift(@a) || 0;
- my $y = shift(@b) || 0;
+ 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 _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;
}
=pod
-This class provides overloaded methods for numerical comparison and strigification.
+This class provides overloaded methods for numerical comparison and stringification.
=head1 SEE ALSO
=head1 COPYRIGHT & LICENSE
-Copyright 2009 Vincent Pit, all rights reserved.
+Copyright 2009,2010,2011 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.