File Coverage

blib/lib/Versioning/Scheme/Perl.pm
Criterion Covered Total %
statement 76 76 100.0
branch 23 26 88.4
condition 15 16 93.7
subroutine 11 11 100.0
pod 5 5 100.0
total 130 134 97.0


line stmt bran cond sub pod time code
1             package Versioning::Scheme::Perl;
2              
3             our $DATE = '2020-10-01'; # DATE
4             our $VERSION = '0.011'; # VERSION
5              
6 1     1   70725 use 5.010001;
  1         15  
7 1     1   5 use strict;
  1         2  
  1         40  
8 1     1   6 use warnings;
  1         1  
  1         28  
9              
10 1     1   562 use Role::Tiny;
  1         4324  
  1         5  
11 1     1   582 use Role::Tiny::With;
  1         261  
  1         57  
12             with 'Role::Versioning::Scheme';
13 1     1   430 use version;
  1         1936  
  1         5  
14              
15             sub is_valid_version {
16 7     7 1 1178 my ($self, $v) = @_;
17 7         11 eval { version->parse($v) };
  7         51  
18 7 100       41 $@ ? 0:1;
19             }
20              
21             sub parse_version {
22 2     2 1 2395 my ($self, $v) = @_;
23              
24 2         5 my $vp;
25 2         4 eval { $vp = version->parse($v) };
  2         16  
26 2 100       11 return undef if $@;
27 1         6 $vp =~ s/\Av//;
28 1         12 {parts => [split /\./, $vp]};
29             }
30              
31             sub normalize_version {
32 3     3 1 3125 my ($self, $v) = @_;
33 3         41 version->parse($v)->normal;
34             }
35              
36             sub cmp_version {
37 7     7 1 3212 my ($self, $v1, $v2) = @_;
38              
39 7         104 version->parse($v1) <=> version->parse($v2);
40             }
41              
42             sub bump_version {
43 19     19 1 2924 my ($self, $v, $opts) = @_;
44 19   100     56 $opts //= {};
45 19   100     81 $opts->{num} //= 1;
46 19   100     62 $opts->{part} //= -1;
47 19   100     74 $opts->{reset_smaller} //= 1;
48              
49 19 100       56 die "Invalid 'num', must be non-zero" unless $opts->{num} != 0;
50              
51 18 100       51 if ($opts->{part} eq 'dev') {
52 3         22 version->parse($v);
53 3         7 my $dev1;
54 3 100       20 if ($v =~ /_([0-9]+)\z/) { $dev1 = $1 } else { $v .= "_000"; $dev1 = "000" }
  2         5  
  1         3  
  1         2  
55 3         10 my $dev2 = $dev1 + $opts->{num};
56 3 50       8 die "Cannot decrease version, would result in a negative dev part"
57             if $dev2 < 0;
58 3         18 $v =~ s/_([0-9]+)\z/sprintf("_%0".length($dev1)."d", $dev2)/e;
  3         19  
59 3         19 return $v;
60             }
61              
62 15         168 my $vn = version->parse($v)->normal; $vn =~ s/\Av//;
  14         87  
63 14         48 my @parts = split /\./, $vn;
64             die "Invalid 'part', must not be smaller than -".@parts
65 14 100       51 if $opts->{part} < -@parts;
66             die "Invalid 'part', must not be larger than ".$#parts
67 13 50       34 if $opts->{part} > $#parts;
68              
69 13 100       24 my $idx = $opts->{part}; $idx = @parts + $idx if $idx < 0;
  13         31  
70             # for now, we do not allow decreasing that overflow to the next more
71             # significant part
72             die "Cannot decrease version, would result in a negative part"
73 13 100       45 if $parts[$idx] + $opts->{num} < 0;
74 12         24 my $i = $idx;
75 12         15 my $left = $opts->{num};
76 12         22 while (1) {
77 17 100 100     66 if ($i == 0 || $parts[$i]+$left < 1000) {
78 12         18 $parts[$i] += $left;
79 12         20 $left = 0;
80 12         18 last;
81             } else {
82 5         9 my $tmp = $parts[$i] + $left;
83 5         13 $parts[$i] = $tmp % 1000;
84 5         12 $left = int($tmp / 1000);
85 5         6 $i--;
86 5         10 next;
87             }
88             }
89 12 100 100     46 if ($opts->{reset_smaller} && $opts->{num} > 0) {
90 8 50       18 $idx = @parts + $idx if $idx < 0;
91 8         25 for my $i ($idx+1 .. $#parts) {
92 3   50     8 $parts[$i] //= 0;
93 3         14 $parts[$i] = sprintf("%0".length($parts[$i])."d", 0);
94             }
95             }
96 12         158 version->parse(join(".", @parts))->normal;
97             }
98              
99             1;
100             # ABSTRACT: Perl (version.pm) version numbering
101              
102             __END__