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 = '2019-04-14'; # DATE
4             our $VERSION = '0.010'; # VERSION
5              
6 1     1   57355 use 5.010001;
  1         9  
7 1     1   5 use strict;
  1         1  
  1         31  
8 1     1   4 use warnings;
  1         1  
  1         21  
9              
10 1     1   477 use Role::Tiny;
  1         3392  
  1         4  
11 1     1   465 use Role::Tiny::With;
  1         242  
  1         44  
12             with 'Role::Versioning::Scheme';
13 1     1   346 use version;
  1         1508  
  1         4  
14              
15             sub is_valid_version {
16 7     7 1 949 my ($self, $v) = @_;
17 7         7 eval { version->parse($v) };
  7         42  
18 7 100       31 $@ ? 0:1;
19             }
20              
21             sub parse_version {
22 2     2 1 1965 my ($self, $v) = @_;
23              
24 2         3 my $vp;
25 2         3 eval { $vp = version->parse($v) };
  2         12  
26 2 100       9 return undef if $@;
27 1         6 $vp =~ s/\Av//;
28 1         8 {parts => [split /\./, $vp]};
29             }
30              
31             sub normalize_version {
32 3     3 1 2552 my ($self, $v) = @_;
33 3         33 version->parse($v)->normal;
34             }
35              
36             sub cmp_version {
37 7     7 1 2707 my ($self, $v1, $v2) = @_;
38              
39 7         86 version->parse($v1) <=> version->parse($v2);
40             }
41              
42             sub bump_version {
43 19     19 1 2535 my ($self, $v, $opts) = @_;
44 19   100     48 $opts //= {};
45 19   100     47 $opts->{num} //= 1;
46 19   100     53 $opts->{part} //= -1;
47 19   100     56 $opts->{reset_smaller} //= 1;
48              
49 19 100       38 die "Invalid 'num', must be non-zero" unless $opts->{num} != 0;
50              
51 18 100       47 if ($opts->{part} eq 'dev') {
52 3         44 version->parse($v);
53 3         9 my $dev1;
54 3 100       15 if ($v =~ /_([0-9]+)\z/) { $dev1 = $1 } else { $v .= "_000"; $dev1 = "000" }
  2         6  
  1         3  
  1         1  
55 3         7 my $dev2 = $dev1 + $opts->{num};
56 3 50       20 die "Cannot decrease version, would result in a negative dev part"
57             if $dev2 < 0;
58 3         15 $v =~ s/_([0-9]+)\z/sprintf("_%0".length($dev1)."d", $dev2)/e;
  3         16  
59 3         16 return $v;
60             }
61              
62 15         123 my $vn = version->parse($v)->normal; $vn =~ s/\Av//;
  14         67  
63 14         35 my @parts = split /\./, $vn;
64             die "Invalid 'part', must not be smaller than -".@parts
65 14 100       41 if $opts->{part} < -@parts;
66             die "Invalid 'part', must not be larger than ".$#parts
67 13 50       26 if $opts->{part} > $#parts;
68              
69 13 100       24 my $idx = $opts->{part}; $idx = @parts + $idx if $idx < 0;
  13         24  
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       44 if $parts[$idx] + $opts->{num} < 0;
74 12         15 my $i = $idx;
75 12         16 my $left = $opts->{num};
76 12         15 while (1) {
77 17 100 100     58 if ($i == 0 || $parts[$i]+$left < 1000) {
78 12         19 $parts[$i] += $left;
79 12         14 $left = 0;
80 12         15 last;
81             } else {
82 5         6 my $tmp = $parts[$i] + $left;
83 5         9 $parts[$i] = $tmp % 1000;
84 5         10 $left = int($tmp / 1000);
85 5         5 $i--;
86 5         7 next;
87             }
88             }
89 12 100 100     36 if ($opts->{reset_smaller} && $opts->{num} > 0) {
90 8 50       14 $idx = @parts + $idx if $idx < 0;
91 8         19 for my $i ($idx+1 .. $#parts) {
92 3   50     7 $parts[$i] //= 0;
93 3         11 $parts[$i] = sprintf("%0".length($parts[$i])."d", 0);
94             }
95             }
96 12         140 version->parse(join(".", @parts))->normal;
97             }
98              
99             1;
100             # ABSTRACT: Perl (version.pm) version numbering
101              
102             __END__