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   185164 use strict;
  2         8  
  2         55  
4 2     2   10 use warnings;
  2         5  
  2         39  
5 2     2   41 use 5.008004;
  2         6  
6 2     2   11 use Carp ();
  2         13  
  2         53  
7 2     2   10 use Exporter qw( import );
  2         2  
  2         227  
8             use overload
9 37     37   4898 '<=>' => sub { shift->cmp(@_) },
10 7     7   333 'cmp' => sub { shift->cmp(@_) },
11 2     2   6 '""' => sub { shift->as_string },
12 0     0   0 bool => sub { 1 },
13 2     2   14 fallback => 1;
  2         3  
  2         27  
14              
15             our @EXPORT_OK = qw( version );
16              
17             # ABSTRACT: Very basic version object for Alien::Build
18             our $VERSION = '2.45'; # VERSION
19              
20              
21             sub new
22             {
23 56     56 1 5439 my($class, $value) = @_;
24 56         97 $value =~ s/\.$//; # trim trailing dot
25 56 100       1941 Carp::croak("invalud version: $value")
26             unless $value =~ /^[0-9]+(\.[0-9]+)*$/;
27 52         171 bless \$value, $class;
28             }
29              
30              
31             sub version ($)
32             {
33 55     55 1 17346 my($value) = @_;
34 55         109 __PACKAGE__->new($value);
35             }
36              
37              
38             sub as_string
39             {
40 4     4 1 852 my($self) = @_;
41 4         6 "@{[ $$self ]}";
  4         42  
42             }
43              
44              
45             sub cmp
46             {
47 51     51 1 59 my @x = split /\./, ${$_[0]};
  51         140  
48 51 100       73 my @y = split /\./, ${ref($_[1]) ? $_[1] : version($_[1])};
  51         127  
49              
50 48   100     121 while(@x or @y)
51             {
52 165   100     278 my $x = (shift @x) || 0;
53 165   100     248 my $y = (shift @y) || 0;
54 165 100       459 return $x <=> $y if $x <=> $y;
55             }
56              
57 24         85 0;
58             }
59              
60              
61             1;
62              
63             __END__