File Coverage

blib/lib/Python/Version.pm
Criterion Covered Total %
statement 112 113 99.1
branch 42 46 91.3
condition 16 23 69.5
subroutine 19 19 100.0
pod 9 10 90.0
total 198 211 93.8


line stmt bran cond sub pod time code
1             package Python::Version;
2              
3             #ABSTRACT: Python PEP440 compatible version string parser in Perl
4              
5 1     1   149640 use 5.010;
  1         7  
6 1     1   4 use strict;
  1         1  
  1         14  
7 1     1   3 use warnings;
  1         2  
  1         25  
8              
9             our $VERSION = '0.0001'; #VERSION
10              
11 1     1   361 use Sort::Versions;
  1         485  
  1         107  
12              
13             use overload (
14 1         10 'cmp' => \&vcmp,
15             '<=>' => \&vcmp,
16             fallback => 1,
17 1     1   5 );
  1         2  
18              
19             # obtained from https://www.python.org/dev/peps/pep-0440
20 1         100 use constant RE_python_version => qr/^
21             v?
22             (?:
23             (?:(?P[0-9]+)!)? # epoch
24             (?P[0-9]+(?:\.[0-9]+)*) # release segment
25             (?P
                                          # pre-release 
26             [-_\.]?
27             (?P(a|b|c|rc|alpha|beta|pre|preview))
28             [-_\.]?
29             (?P[0-9]+)?
30             )?
31             (?P # post release
32             (?:-(?P[0-9]+))
33             |
34             (?:
35             [-_\.]?
36             (?Ppost|rev|r)
37             [-_\.]?
38             (?P[0-9]+)?
39             )
40             )?
41             (?P # dev release
42             [-_\.]?
43             (?Pdev)
44             [-_\.]?
45             (?P[0-9]+)?
46             )?
47             )
48             (?:\+(?P[a-z0-9]+(?:[-_\.][a-z0-9]+)*))? # local version
49 1     1   228 $/x;
  1         2  
50              
51              
52             sub parse {
53 49     49 1 7236 my ( $proto, $version_str ) = @_;
54 49   33     120 my $class = ref($proto) || $proto;
55              
56 49 50       316 if ( $version_str =~ RE_python_version ) {
57             my (
58             $epoch, $release, $pre, $post, $dev, $local,
59             $pre_l, $pre_n, $post_n1, $post_l, $post_n2, $dev_n
60             )
61 1     1   353 = map { $+{$_} }
  1         340  
  1         794  
  49         70  
  588         1469  
62             qw(
63             epoch release pre post dev local
64             pre_l pre_n post_n1 post_l post_n2 dev_n
65             );
66              
67 49         116 my $self = bless { _original => $version_str }, $class;
68             $self->{_base_version} =
69 49         97 [ map { int($_) } split( /\./, $release ) ];
  122         193  
70 49 100       89 if ( defined $epoch ) {
71 6         9 $self->{_epoch} = $epoch;
72             }
73 49 100       71 if ( defined $pre ) {
    100          
74 19   50     29 $self->{_prerelease} = [ $self->_normalize_prerelease_label($pre_l),
75             int( $pre_n // 0 ) ];
76             }
77             elsif ( defined $post ) {
78             $self->{_postrelease} =
79 13   100     40 [ 'post', int( $post_n1 // $post_n2 // 0 ) ];
      100        
80             }
81 49 100       75 if ( defined $dev ) {
82 13   50     25 $self->{_devrelease} = [ 'dev', int( $dev_n // 0 ) ];
83             }
84 49 100       57 if ( defined $local ) {
85             $self->{_local_version} =
86 11         33 [ split( /[-_\.]/, $local ) ];
87             }
88 49         104 return $self;
89             }
90             else {
91 0         0 die "Cannot parse Python version string '$version_str'";
92             }
93             }
94              
95             sub _normalize_prerelease_label {
96 19     19   23 my ( $self, $label ) = @_;
97 19 100       36 return 'a' if $label eq 'alpha';
98 16 50       19 return 'b' if $label eq 'beta';
99 16 100       20 return 'rc' if ( grep { $label eq $_ } qw(c pre preview) );
  48         81  
100 4         12 return $label;
101             }
102              
103              
104             sub base_version {
105 47     47 1 45 my $self = shift;
106 47         43 return join( '.', @{ $self->{_base_version} } );
  47         117  
107             }
108              
109              
110             sub is_prerelease {
111 40     40 1 42 my $self = shift;
112 40         77 return !!( $self->{_prerelease} );
113             }
114              
115             sub is_postrelease {
116 30     30 1 30 my $self = shift;
117 30         41 return !!( $self->{_postrelease} );
118             }
119              
120             sub is_devrelease {
121 41     41 1 43 my $self = shift;
122 41         62 return !!( $self->{_devrelease} );
123             }
124              
125              
126             sub local {
127 21     21 1 21 my $self = shift;
128 21 100       28 if ( defined $self->{_local_version} ) {
129 9         7 return join( '.', @{ $self->{_local_version} } );
  9         20  
130             }
131             else {
132 12         22 return '';
133             }
134             }
135              
136              
137             sub normal {
138 15     15 1 38 my $self = shift;
139              
140 15         24 my $s = $self->public;
141 15 100       19 if ( my $local = $self->local ) {
142 5         9 $s .= "+$local";
143             }
144 15         45 return $s;
145             }
146              
147              
148             sub original {
149 12     12 1 19 my ($self) = @_;
150 12         25 return $self->{_original};
151             }
152              
153              
154             sub public {
155 15     15 1 14 my $self = shift;
156              
157 15         15 my $s = '';
158 15 100       24 if ( $self->{_epoch} ) {
159 5         9 $s .= $self->{_epoch} . '!';
160             }
161 15         21 $s .= $self->base_version;
162 15 100       25 if ( $self->is_prerelease ) {
    50          
163 10         10 $s .= join( '', @{ $self->{_prerelease} } );
  10         19  
164             }
165             elsif ( $self->is_postrelease ) {
166 5         7 $s .= '.' . join( '', @{ $self->{_postrelease} } );
  5         8  
167             }
168 15 100       21 if ( $self->is_devrelease ) {
169 10         10 $s .= '.' . join( '', @{ $self->{_devrelease} } );
  10         18  
170             }
171 15         21 return $s;
172             }
173              
174             sub vcmp {
175 17     17 0 27 my ( $left, $right ) = @_;
176 17         20 my $class = ref($left);
177 17 50       57 unless ( UNIVERSAL::isa( $right, $class ) ) {
178 17         25 $right = $class->parse($right);
179             }
180              
181 17   100     22 my ( $l_epoch, $r_epoch ) = map { $_->{_epoch} // 0 } ( $left, $right );
  34         79  
182 17         36 my $rslt_epoch = versioncmp( $l_epoch, $r_epoch );
183 17 100       324 return $rslt_epoch if ( $rslt_epoch != 0 );
184              
185             my ( $l_base, $r_base ) =
186 16         21 map { $_->base_version } ( $left, $right );
  32         43  
187 16         29 my $rslt_base = versioncmp( $l_base, $r_base );
188 16 100       497 return $rslt_base if ( $rslt_base != 0 );
189              
190             my ( $l_converted, $r_converted ) =
191 12         14 map { $_->_convert_prepostdev; } ( $left, $right );
  24         32  
192 12         42 my $rslt_converted =
193             versioncmp( join( '.', @$l_converted ), join( '.', @$r_converted ) );
194 12 100       382 return $rslt_converted if ( $rslt_converted != 0 );
195              
196 3         5 return versioncmp( $left->local, $right->local );
197             }
198              
199             sub _convert_prepostdev {
200 24     24   25 my $self = shift;
201              
202             # dev < pre < nothing < post
203 24         30 my ( $dev, $pre, $final, $post ) = ( 0, 1, 2, 3 );
204              
205 24         22 my @segments;
206 24         26 my $is_prerelease = $self->is_prerelease;
207 24         29 my $is_postrelease = $self->is_postrelease;
208 24         29 my $is_devrelease = $self->is_devrelease;
209 24 100 100     53 if ( $is_prerelease or $is_postrelease ) {
    100          
210 17 100       20 if ($is_prerelease) {
211 9   50     16 push @segments, $pre, ( $self->{_prerelease}->[1] // 0 );
212             }
213             else {
214 8   50     15 push @segments, $post, ( $self->{_postrelease}->[1] // 0 );
215             }
216 17 100       20 if ($is_devrelease) {
217 2   50     5 push @segments, $dev, ( $self->{_devrelease}->[1] // 0 );
218             }
219             else {
220 15         14 push @segments, $final;
221             }
222             }
223             elsif ($is_devrelease) {
224 1         2 push @segments, $dev;
225             }
226             else {
227 6         7 push @segments, $final;
228             }
229              
230 24         41 return \@segments;
231             }
232              
233             1;
234              
235             __END__