File Coverage

blib/lib/Versioning/Scheme/Dotted.pm

Criterion	Covered	Total	%
statement	60	60	100.0
branch	31	32	96.8
condition	22	27	81.4
subroutine	10	10	100.0
pod	5	5	100.0
total	128	134	95.5

package Versioning::Scheme::Dotted;

our $DATE = '2019-04-14'; # DATE
our $VERSION = '0.010'; # VERSION

use 5.010001;
use strict;
use warnings;

use Role::Tiny;
use Role::Tiny::With;
with 'Role::Versioning::Scheme';

our $re = qr/\A[0-9]+(?:\.[0-9]+)*\z/;

sub is_valid_version {
    my ($self, $v) = @_;
    $v =~ $re ? 1:0;
}

sub parse_version {
    my ($self, $v) = @_;
    $v =~ $re or return undef;
    {parts => [split /\./, $v]};
}

sub normalize_version {
    my ($self, $v, $opts) = @_;
    $opts //= {};

    die "Invalid version '$v'" unless $self->is_valid_version($v);

    my @parts = split /\./, $v;
    if (defined $opts->{parts}) {
        die "parts must at least be 1" unless $opts->{parts} >= 1;
        if ($opts->{parts} < @parts) {
            splice @parts, $opts->{parts};
        } else {
            $parts[$opts->{parts}-1] //= 0;
        }
    }
    join(".", map { $_ // "0" } @parts);
}

sub cmp_version {
    my ($self, $v1, $v2) = @_;

    die "Invalid version '$v1'" unless $self->is_valid_version($v1);
    die "Invalid version '$v2'" unless $self->is_valid_version($v2);

    my @parts1 = split /\./, $v1;
    my @parts2 = split /\./, $v2;
    my $n = @parts1 < @parts2 ? @parts2 : @parts1;
    for my $i (0..$n-1) {
        my $cmp = ($parts1[$i] // 0) <=> ($parts2[$i] // 0);
        return $cmp if $cmp;
    }
    0;
}

sub bump_version {
    my ($self, $v, $opts) = @_;
    $opts //= {};
    $opts->{num} //= 1;
    $opts->{part} //= -1;
    $opts->{reset_smaller} //= 1;

    die "Invalid version '$v'" unless $self->is_valid_version($v);
    die "Invalid 'num', must be non-zero" unless $opts->{num} != 0;
    my @parts = split /\./, $v;
    die "Invalid 'part', must not be smaller than -".@parts
        if $opts->{part} < -@parts;

    my $idx = $opts->{part};
    $parts[$idx] //= 0;
    die "Cannot decrease version, would result in a negative part"
        if $parts[$idx] + $opts->{num} < 0;
    $parts[$idx] = sprintf("%0".length($parts[$idx])."d",
                           $parts[$idx]+$opts->{num});
    if ($opts->{reset_smaller} && $opts->{num} > 0) {
        $idx = @parts + $idx if $idx < 0;
        for my $i ($idx+1 .. $#parts) {
            $parts[$i] //= 0;
            $parts[$i] = sprintf("%0".length($parts[$i])."d", 0);
        }
    }
    join(".", map {$_//0} @parts);
}

1;
# ABSTRACT: Version as dotted numbers

__END__