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


line stmt bran cond sub pod time code
1             package Versioning::Scheme::Dotted;
2              
3             our $DATE = '2019-04-14'; # DATE
4             our $VERSION = '0.010'; # VERSION
5              
6 1     1   56233 use 5.010001;
  1         11  
7 1     1   5 use strict;
  1         1  
  1         27  
8 1     1   5 use warnings;
  1         2  
  1         27  
9              
10 1     1   437 use Role::Tiny;
  1         3351  
  1         5  
11 1     1   467 use Role::Tiny::With;
  1         208  
  1         665  
12             with 'Role::Versioning::Scheme';
13              
14             our $re = qr/\A[0-9]+(?:\.[0-9]+)*\z/;
15              
16             sub is_valid_version {
17 39     39 1 950 my ($self, $v) = @_;
18 39 100       341 $v =~ $re ? 1:0;
19             }
20              
21             sub parse_version {
22 2     2 1 1924 my ($self, $v) = @_;
23 2 100       19 $v =~ $re or return undef;
24 1         8 {parts => [split /\./, $v]};
25             }
26              
27             sub normalize_version {
28 7     7 1 2499 my ($self, $v, $opts) = @_;
29 7   100     25 $opts //= {};
30              
31 7 100       12 die "Invalid version '$v'" unless $self->is_valid_version($v);
32              
33 6         18 my @parts = split /\./, $v;
34 6 100       14 if (defined $opts->{parts}) {
35 4 100       17 die "parts must at least be 1" unless $opts->{parts} >= 1;
36 3 100       7 if ($opts->{parts} < @parts) {
37 1         2 splice @parts, $opts->{parts};
38             } else {
39 2   50     11 $parts[$opts->{parts}-1] //= 0;
40             }
41             }
42 5   100     10 join(".", map { $_ // "0" } @parts);
  15         48  
43             }
44              
45             sub cmp_version {
46 7     7 1 2413 my ($self, $v1, $v2) = @_;
47              
48 7 100       15 die "Invalid version '$v1'" unless $self->is_valid_version($v1);
49 6 100       12 die "Invalid version '$v2'" unless $self->is_valid_version($v2);
50              
51 5         17 my @parts1 = split /\./, $v1;
52 5         10 my @parts2 = split /\./, $v2;
53 5 50       11 my $n = @parts1 < @parts2 ? @parts2 : @parts1;
54 5         15 for my $i (0..$n-1) {
55 12   50     32 my $cmp = ($parts1[$i] // 0) <=> ($parts2[$i] // 0);
      100        
56 12 100       27 return $cmp if $cmp;
57             }
58 3         12 0;
59             }
60              
61             sub bump_version {
62 12     12 1 2363 my ($self, $v, $opts) = @_;
63 12   100     31 $opts //= {};
64 12   100     35 $opts->{num} //= 1;
65 12   100     31 $opts->{part} //= -1;
66 12   100     37 $opts->{reset_smaller} //= 1;
67              
68 12 100       25 die "Invalid version '$v'" unless $self->is_valid_version($v);
69 11 100       33 die "Invalid 'num', must be non-zero" unless $opts->{num} != 0;
70 10         26 my @parts = split /\./, $v;
71             die "Invalid 'part', must not be smaller than -".@parts
72 10 100       29 if $opts->{part} < -@parts;
73              
74 9         15 my $idx = $opts->{part};
75 9   50     17 $parts[$idx] //= 0;
76             die "Cannot decrease version, would result in a negative part"
77 9 100       30 if $parts[$idx] + $opts->{num} < 0;
78             $parts[$idx] = sprintf("%0".length($parts[$idx])."d",
79 8         34 $parts[$idx]+$opts->{num});
80 8 100 100     27 if ($opts->{reset_smaller} && $opts->{num} > 0) {
81 4 100       8 $idx = @parts + $idx if $idx < 0;
82 4         10 for my $i ($idx+1 .. $#parts) {
83 3   50     8 $parts[$i] //= 0;
84 3         8 $parts[$i] = sprintf("%0".length($parts[$i])."d", 0);
85             }
86             }
87 8   50     13 join(".", map {$_//0} @parts);
  24         89  
88             }
89              
90             1;
91             # ABSTRACT: Version as dotted numbers
92              
93             __END__