File Coverage

blib/lib/Versioning/Scheme/Monotonic.pm
Criterion Covered Total %
statement 37 42 88.1
branch 29 36 80.5
condition 14 15 93.3
subroutine 8 9 88.8
pod 5 5 100.0
total 93 107 86.9


line stmt bran cond sub pod time code
1             package Versioning::Scheme::Monotonic;
2              
3             our $DATE = '2020-10-01'; # DATE
4             our $VERSION = '0.011'; # VERSION
5              
6 1     1   72714 use 5.010001;
  1         13  
7 1     1   14 use strict;
  1         2  
  1         40  
8 1     1   6 use warnings;
  1         2  
  1         28  
9              
10 1     1   470 use Role::Tiny::With;
  1         5246  
  1         638  
11             with 'Role::Versioning::Scheme';
12              
13             our $re = qr/
14             \A
15             ([1-9][0-9]*)\. # 1=compatibility
16             ([1-9][0-9]*) # 2=release
17             (?:\.(0))? # 3=semver_marker
18             (?:\+([0-9A-Za-z-]+(?:\.[0-9A-Za-z-]+)*))? # 4=metadata
19             \z
20             /x;
21              
22             sub is_valid_version {
23 13     13 1 1265 my ($self, $v) = @_;
24 13 100       153 $v =~ $re ? 1:0;
25             }
26              
27             sub parse_version {
28 0     0 1 0 my ($self, $v) = @_;
29 0 0       0 return undef unless my ($c, $r, $mark, $meta) = $v =~ $re;
30             return {
31 0         0 compatibility => $1,
32             release => $2,
33             semver_marker => $3,
34             metadata => $4,
35             };
36             }
37              
38             sub normalize_version {
39 3     3 1 2827 my ($self, $v, $opts) = @_;
40 3   50     18 $opts //= {};
41              
42 3 100       44 die "Invalid version '$v'" unless $v =~ $re;
43              
44 2 50       22 "$1.$2" . (defined $4 ? ".$4" : "");
45             }
46              
47             sub cmp_version {
48 8     8 1 3153 my ($self, $v1, $v2) = @_;
49              
50 8 100       119 die "Invalid version '$v1'" unless my ($c1, $r1, undef, $m1) = $v1 =~ $re;
51 7 100       60 die "Invalid version '$v2'" unless my ($c2, $r2, undef, $m2) = $v2 =~ $re;
52              
53 6 100 100     74 ($c1 <=> $c2) || ($r1 <=> $r2) || (($m1||'') cmp ($m2||''));
      100        
      100        
54             }
55              
56             sub bump_version {
57 15     15 1 3029 my ($self, $v, $opts) = @_;
58 15   100     45 $opts //= {};
59 15   100     55 $opts->{num} //= 1;
60 15   100     47 $opts->{part} //= 1;
61              
62 15 100       173 die "Invalid version '$v'" unless my ($c, $r, $mark, $meta) = $v =~ $re;
63 14 50       45 die "Invalid 'num', must be non-zero" unless $opts->{num} != 0;
64 14 100       72 die "Invalid 'part', must be 0|1" unless $opts->{part} =~ /\A(0|1)\z/;
65              
66 12 100       40 if ($opts->{part} == 0) {
67 2 50       9 if ($c + $opts->{num} < 1) {
68 0         0 die "Cannot decrease compatibility that would result in zero/negative number";
69             }
70 2 100       8 if ($r + ($opts->{num} < 0 ? -1 : 1) < 1) {
    50          
71 0         0 die "Cannot decrease compatibility that would result in zero/negative release number";
72             }
73 2         5 $c = $c + $opts->{num};
74 2 100       5 $r = $r + ($opts->{num} < 0 ? -1 : 1);
75             } else {
76 10 100       30 if ($r + $opts->{num} < 1) {
77 3         29 die "Cannot decrease release that would result in zero/negative number";
78             }
79 7         13 $r = $r + $opts->{num};
80             }
81 9 100       65 join(
    50          
82             "",
83             $c, ".", $r,
84             (defined $mark ? ".$mark" : ""),
85             (defined $meta ? ".$meta" : ""),
86             );
87             }
88              
89             1;
90             # ABSTRACT: Monotonic versioning
91              
92             __END__