File Coverage

blib/lib/DJabberd/StreamVersion.pm
Criterion Covered Total %
statement 34 39 87.1
branch 6 8 75.0
condition 6 10 60.0
subroutine 11 13 84.6
pod 0 9 0.0
total 57 79 72.1


line stmt bran cond sub pod time code
1             # class to represent the version number in a stream attribute
2              
3             package DJabberd::StreamVersion;
4              
5 1     1   13738 use constant MAJOR => 0;
  1         2  
  1         102  
6 1     1   4 use constant MINOR => 1;
  1         1  
  1         37  
7 1     1   4 use constant VALID => 2;
  1         1  
  1         36  
8 1     1   3 use constant PRESENT => 3;
  1         1  
  1         508  
9              
10             # returns undef on invalid version
11             sub new {
12 7     7 0 21 my ($class, $ver) = @_;
13              
14             # {=version-format}
15 7         7 my ($valid, $major, $minor) = (0, 0, 0);
16 7 100       26 if ($ver =~ /^(\d+)\.(\d+)$/) {
17 6         6 $valid = 1;
18 6         12 ($major, $minor) = ($1, $2);
19             # {=leading-zeros-ignored}
20 6         6 $major =~ s/^0+//;
21 6         10 $minor =~ s/^0+//;
22             }
23              
24 7 100 100     51 return bless [
      100        
25             int($major || 0),
26             int($minor || 0),
27             $valid,
28             ($ver ne "" ? 1 : 0),
29             ], $class;
30             }
31              
32             sub none {
33 0     0 0 0 my $class = shift;
34 0         0 return bless [ 0, 0, 1, 0 ], $class;
35             }
36              
37             # returns min of two given objects
38             sub min {
39 1     1 0 10 return (sort { $a->cmp($b) } @_)[0];
  1         3  
40             }
41              
42             sub valid {
43 2     2 0 322 my $self = shift;
44 2         6 return $self->[VALID];
45             }
46              
47             sub supports_features {
48 2     2 0 5 my $self = shift;
49 2         6 return $self->at_least("1.0");
50             }
51              
52             sub at_least {
53 2     2 0 4 my ($self, $other) = @_;
54 2         6 my $cmp = $self->cmp($other);
55 2         9 return $cmp >= 0;
56             }
57              
58             # {=numeric-version-compare}
59             sub cmp {
60 7     7 0 10 my ($self, $other) = @_;
61 7 100       16 $other = DJabberd::StreamVersion->new($other) unless ref $other;
62             return
63 7   66     44 ($self->[MAJOR] <=> $other->[MAJOR]) ||
64             ($self->[MINOR] <=> $other->[MINOR]);
65             }
66              
67             sub as_string {
68 1     1 0 2 my $self = shift;
69 1         6 return "$self->[MAJOR].$self->[MINOR]";
70             }
71              
72             # returns "version='1.0'" or empty string when version is 0.0;
73             # {=no-response-version-on-zero-ver}
74             sub as_attr_string {
75 0     0 0   my $self = shift;
76 0 0 0       return "" unless $self->[MAJOR] || $self->[MINOR];
77 0           return "version='" . $self->as_string . "'";
78             }
79              
80             1;