File Coverage

lib/SemVer.pm

Criterion	Covered	Total	%
statement	112	118	94.9
branch	45	50	90.0
condition	17	21	80.9
subroutine	17	17	100.0
pod	8	8	100.0
total	199	214	92.9

package SemVer;

use 5.008001;
use strict;
use version 0.82;
use Scalar::Util ();

use overload (
    '""'   => 'stringify',
    '<=>'  => 'vcmp',
    'cmp'  => 'vcmp',
);

our @ISA = qw(version);
our $VERSION = '0.7.0'; # For Module::Build

sub _die { require Carp; Carp::croak(@_) }

# Prevent version.pm from mucking with our internals.
sub import {}

# Adapted from version.pm.
my $STRICT_INTEGER_PART = qr/0|[1-9][0-9]*/;
my $DOT_SEPARATOR = qr/\./;
my $PLUS_SEPARATOR = qr/\+/;
my $DASH_SEPARATOR = qr/-/;
my $STRICT_DOTTED_INTEGER_PART = qr/$DOT_SEPARATOR$STRICT_INTEGER_PART/;
my $STRICT_DOTTED_INTEGER_VERSION = qr/ $STRICT_INTEGER_PART $STRICT_DOTTED_INTEGER_PART{2,} /x;
my $IDENTIFIER = qr/[-0-9A-Za-z]+/;
my $DOTTED_IDENTIFIER = qr/(?:$DOT_SEPARATOR$IDENTIFIER)*/;
my $PRERELEASE = qr/$IDENTIFIER$DOTTED_IDENTIFIER/;
my $METADATA = qr/$IDENTIFIER$DOTTED_IDENTIFIER/;

my $OPTIONAL_EXTRA_PART = qr/$PRERELEASE($PLUS_SEPARATOR$METADATA)?/;

sub new {
    my ($class, $ival) = @_;

    # Handle vstring.
    return $class->SUPER::new($ival) if Scalar::Util::isvstring($ival);

    # Let version handle cloning.
    if (eval { $ival->isa('version') }) {
        my $self = $class->SUPER::new($ival);
        $self->{extra} = $ival->{extra};
        $self->{dash}  = $ival->{dash};
        $self->_evalPreRelease($self->{extra});
        return $self;
    }

    my ($val, $dash, $extra) = (
        $ival =~ /^v?($STRICT_DOTTED_INTEGER_VERSION)(?:($DASH_SEPARATOR)($OPTIONAL_EXTRA_PART))?$/
    );
    _die qq{Invalid semantic version string format: "$ival"}
        unless defined $val;

    my $self = $class->SUPER::new($val);
    $self->{dash}  = $dash;
    $self->{extra} = $extra;
    $self->_evalPreRelease($self->{extra});

    return $self;
}

# Internal function to split up given string into prerelease- and patch-components
sub _evalPreRelease {
    no warnings 'uninitialized';
    my $self = shift;
    my $v = shift;
    my ($preRelease, $plus, $patch) = (
       $v =~ /^($PRERELEASE)(?:($PLUS_SEPARATOR)($METADATA))?$/
    );
    @{$self->{prerelease}} = split $DOT_SEPARATOR,$preRelease;
    $self->{plus} = $plus;
    @{$self->{patch}} = (split $DOT_SEPARATOR, $patch || undef);
    return;
}

$VERSION = __PACKAGE__->new($VERSION); # For ourselves.

sub declare {
    my ($class, $ival) = @_;
    return $class->new($ival) if Scalar::Util::isvstring($ival)
        or eval { $ival->isa('version') };

    (my $v = $ival) =~ s/^v?$STRICT_DOTTED_INTEGER_VERSION(?:($DASH_SEPARATOR)($OPTIONAL_EXTRA_PART))[[:space:]]*$//;
    my $dash  = $1;
    my $extra = $2;
    $v += 0 if $v =~ s/_//g; # ignore underscores.
    my $self = $class->SUPER::declare($v);
    $self->{dash}  = $dash;
    $self->{extra} = $extra;
    $self->_evalPreRelease($self->{extra});
    return $self;
}

sub parse {
    my ($class, $ival) = @_;
    return $class->new($ival) if Scalar::Util::isvstring($ival)
        or eval { $ival->isa('version') };

    (my $v = $ival) =~ s/^v?$STRICT_DOTTED_INTEGER_VERSION(?:($DASH_SEPARATOR)($OPTIONAL_EXTRA_PART))[[:space:]]*$//;
    my $dash  = $1;
    my $extra = $2;
    $v += 0 if $v =~ s/_//g; # ignore underscores.
    my $self = $class->SUPER::parse($v);
    $self->{dash}  = $dash;
    $self->{extra} = $extra;
    $self->_evalPreRelease($self->{extra});
    return $self;
}

sub stringify {
    my $self = shift;
    my $str = $self->SUPER::stringify;
    # This is purely for SemVers constructed from version objects.
    $str += 0 if $str =~ s/_//g; # ignore underscores.
    return $str . ($self->{dash} || '') . ($self->{extra} || '');
}

sub normal   {
    my $self = shift;
    (my $norm = $self->SUPER::normal) =~ s/^v//;
    $norm =~ s/_/./g;
    return $norm . ($self->{extra} ? "-$self->{extra}" : '');
}

sub numify   { _die 'Semantic versions cannot be numified'; }
sub is_alpha { !!shift->{extra} }


# Sort Ordering:
# Precedence refers to how versions are compared to each other when ordered. Precedence MUST be calculated by
# separating the version into major, minor, patch and pre-release identifiers in that order (Build metadata does not figure into precedence).
# Precedence is determined by the first difference when comparing each of these identifiers from left to right as follows:
# 1. Major, minor, and patch versions are always compared numerically. Example: 1.0.0 < 2.0.0 < 2.1.0 < 2.1.1.
# 2. When major, minor, and patch are equal, a pre-release version has lower precedence than a normal version.
#    Example: 1.0.0-alpha < 1.0.0.
# 3. Precedence for two pre-release versions with the same major, minor, and patch version MUST be determined by
#    comparing each dot separated identifier from left to right until a difference is found as follows:
#    3.a. identifiers consisting of only digits are compared numerically and identifiers with letters or hyphens are
#         compared lexically in ASCII sort order.
#    3.b. Numeric identifiers always have lower precedence than non-numeric identifiers.
#    3.c. A larger set of pre-release fields has a higher precedence than a smaller set, if all of the preceding identifiers are equal.
#    Example: 1.0.0-alpha < 1.0.0-alpha.1 < 1.0.0-alpha.beta < 1.0.0-beta < 1.0.0-beta.2 < 1.0.0-beta.11 < 1.0.0-rc.1 < 1.0.0.
sub vcmp {
    my $left  = shift;
    my $right = ref($left)->declare(shift);

    # Reverse?
    ($left, $right) = shift() ? ($right, $left): ($left, $right);

    # Major and minor win. - case 1.
    if (my $ret = $left->SUPER::vcmp($right, 0)) {
        return $ret;
    } else { #cases 2, 3
    	my $lenLeft = 0;
    	my $lenRight = 0;
    	if (defined $left->{prerelease}) {
        	$lenLeft = scalar(@{$left->{prerelease}});
        }
        if (defined $right->{prerelease}) {
        	$lenRight = scalar(@{$right->{prerelease}});
        }
        my $lenMin =  ($lenLeft, $lenRight)[$lenLeft > $lenRight];
        if ( $lenLeft == 0) {
            if ($lenRight == 0) {
                return 0; # Neither LEFT nor RIGHT have prerelease identifiers - versions are equal
            } else {
                # Case 2: When major, minor, and patch are equal, a pre-release version has lower precedence than a normal version.
                return 1; # Only RIGHT has prelease - not LEFT -> LEFT wins
            }
        } else {
            if ($lenRight == 0) {
                # Case 2: When major, minor, and patch are equal, a pre-release version has lower precedence than a normal version.
                return -1; # Only LEFT has prelease identifiers - not RIGHT -> RIGHT wins
            } else {
                # LEFT and RIGHT have prelease identifiers - compare each part separately
                for (my $i = 0; $i < $lenMin; $i++) {
                    my $isNumLeft = Scalar::Util::looks_like_number($left->{prerelease}->[$i]);
                    my $isNumRight = Scalar::Util::looks_like_number($right->{prerelease}->[$i]);
                    # Case 3.b: Numeric identifiers always have lower precedence than non-numeric identifiers
                    if (!$isNumLeft && $isNumRight) {
                        return 1; # LEFT identifier is Non-numeric - RIGHT identifier is numeric -> LEFT wins
										} elsif ($isNumLeft && !$isNumRight) {
                        return -1; # LEFT identifier is numeric - RIGHT identifier is non-numeric -> RIGHT wins
                    } elsif ($isNumLeft && $isNumRight) {
                        # Case 3.a.1: identifiers consisting of only digits are compared numerically
                        if ($left->{prerelease}->[$i] == $right->{prerelease}->[$i] ) {
                            next;  # LEFT identifier and RIGHT identifier are equal - step to next part
												} elsif ($left->{prerelease}->[$i] > $right->{prerelease}->[$i] ) {
                            return 1; # LEFT identifier is bigger than RIGHT identifier -> LEFT wins
                        } else {
                            return -1; return 1; # LEFT identifier is smaller than RIGHT identifier -> RIGHT wins
                        }
                    } else {
                        # Case 3.a.2: identifiers with letters or hyphens are compared lexically in ASCII sort order.
                        if (lc $left->{prerelease}->[$i] eq lc $right->{prerelease}->[$i] ) {
                            next;  # LEFT identifier and RIGHT identifier are equal - step to next part
												} elsif (lc $left->{prerelease}->[$i] gt  lc $right->{prerelease}->[$i] ) {
                            return 1; # LEFT identifier is bigger than RIGHT identifier -> LEFT wins
                        } else {
                            return -1; return 1; # LEFT identifier is smaller than RIGHT identifier -> RIGHT wins
                        }
                    }
                }
                # Case 3.c: A larger set of pre-release fields has a higher precedence than a smaller set, if all of the preceding identifiers are equal
                if ($lenLeft > $lenRight) {
                    return 1; # All existing identifiers are equal, but LEFT has more identifiers -> LEFT wins
								} elsif ($lenLeft < $lenRight) {
                    return -1; # All existing identifiers are equal, but RIGHT has more identifiers -> RIGHT wins
                }
                # All identifiers are equal
                return 0;
            }
        }
    }
}

1;
__END__