File Coverage

blib/lib/Alien/Build/Version/Basic.pm
Criterion Covered Total %
statement 38 39 97.4
branch 6 6 100.0
condition 7 7 100.0
subroutine 13 14 92.8
pod 4 4 100.0
total 68 70 97.1


line stmt bran cond sub pod time code
1             package Alien::Build::Version::Basic;
2              
3 2     2   272682 use strict;
  2         16  
  2         64  
4 2     2   11 use warnings;
  2         4  
  2         57  
5 2     2   44 use 5.008004;
  2         8  
6 2     2   12 use Carp ();
  2         14  
  2         55  
7 2     2   13 use Exporter qw( import );
  2         5  
  2         264  
8             use overload
9 37     37   6348 '<=>' => sub { shift->cmp(@_) },
10 7     7   428 'cmp' => sub { shift->cmp(@_) },
11 2     2   9 '""' => sub { shift->as_string },
12 0     0   0 bool => sub { 1 },
13 2     2   14 fallback => 1;
  2         4  
  2         33  
14              
15             our @EXPORT_OK = qw( version );
16              
17             # ABSTRACT: Very basic version object for Alien::Build
18             our $VERSION = '2.46'; # VERSION
19              
20              
21             sub new
22             {
23 56     56 1 7185 my($class, $value) = @_;
24 56         127 $value =~ s/\.$//; # trim trailing dot
25 56 100       1028 Carp::croak("invalud version: $value")
26             unless $value =~ /^[0-9]+(\.[0-9]+)*$/;
27 52         203 bless \$value, $class;
28             }
29              
30              
31             sub version ($)
32             {
33 55     55 1 18347 my($value) = @_;
34 55         136 __PACKAGE__->new($value);
35             }
36              
37              
38             sub as_string
39             {
40 4     4 1 1261 my($self) = @_;
41 4         10 "@{[ $$self ]}";
  4         67  
42             }
43              
44              
45             sub cmp
46             {
47 51     51 1 85 my @x = split /\./, ${$_[0]};
  51         174  
48 51 100       108 my @y = split /\./, ${ref($_[1]) ? $_[1] : version($_[1])};
  51         158  
49              
50 48   100     152 while(@x or @y)
51             {
52 165   100     335 my $x = (shift @x) || 0;
53 165   100     302 my $y = (shift @y) || 0;
54 165 100       550 return $x <=> $y if $x <=> $y;
55             }
56              
57 24         118 0;
58             }
59              
60              
61             1;
62              
63             __END__