File Coverage

blib/lib/SemVer.pm

Criterion	Covered	Total	%
statement	73	73	100.0
branch	27	28	96.4
condition	7	10	70.0
subroutine	15	15	100.0
pod	8	8	100.0
total	130	134	97.0

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.6.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 $STRICT_DOTTED_INTEGER_PART = qr/\.$STRICT_INTEGER_PART/;
my $STRICT_DOTTED_INTEGER_VERSION =
    qr/ $STRICT_INTEGER_PART $STRICT_DOTTED_INTEGER_PART{2,} /x;
my $OPTIONAL_EXTRA_PART = qr/[a-zA-Z][-0-9A-Za-z]*/;

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};
        return $self;
    }

    my ($val, $dash, $extra) = (
        $ival =~ /^v?($STRICT_DOTTED_INTEGER_VERSION)(?:(-)($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;
    return $self;
}

$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/(?:(-?)($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;
    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/(?:(-?)($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;
    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} }

sub vcmp {
    my $left  = shift;
    my $right = ref($left)->declare(shift);

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

    # Major and minor win.
    if (my $ret = $left->SUPER::vcmp($right, 0)) {
        return $ret;
    } else {
        # They're equal. Check the extra text stuff.
        if (my $l = $left->{extra}) {
            my $r = $right->{extra} or return -1;
            return lc $l cmp lc $r;
        } else {
            return $right->{extra} ? 1 : 0;
        }
    }
}

1;
__END__