1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
|
package CheckVer;
use warnings;
use strict;
use integer;
# Since no objects are instantiated here, this file provides just a
# module, not a class. The subroutines given here compare and check
# vname (virtual package) versions.
# Private subroutines: compare version substrings. (Some of these
# private subroutines, unlike the public ones below, assume defined
# input.)
sub cmp_ver_char ($$) {
my( $a , $b ) = @_;
my( $a0, $b0 );
for (
[ \$a, \$a0 ],
[ \$b, \$b0 ],
) {
my( $ab, $ab0 ) = @$_;
$$ab0 = $$ab =~ /^[A-Za-z]$/ ? 0 : 1;
}
my $cmp1 = $a0 <=> $b0;
$cmp1 and return $cmp1;
$a cmp $b;
}
sub cmp_ver_substr_nondig ($$) {
my( $a, $b ) = @_;
my $a_len = length $a;
my $b_len = length $b;
for ( my $i = 0; $i < $a_len && $i < $b_len; ++$i ) {
my $cmp1 = cmp_ver_char substr($a,$i,1), substr($b,$i,1);
return $cmp1 if $cmp1;
}
$a_len <=> $b_len;
}
sub cmp_ver_substr_dig ($$) {
my( $a, $b ) = @_;
defined($a) && length($a) or $a = 0;
defined($b) && length($b) or $b = 0;
$a <=> $b;
}
sub cmp_ver_substr ($$) {
my( $a, $b ) = @_;
defined $a or $a = '';
defined $b or $b = '';
while ( length($a) || length($b) ) {
my( $a_nondig, $a_dig );
my( $b_nondig, $b_dig );
for (
[ \$a, \$a_nondig, \$a_dig ],
[ \$b, \$b_nondig, \$b_dig ],
) {
my( $ab, $nondig, $dig ) = @$_;
my $right;
( $$nondig, $$dig, $right ) = $$ab =~ /^([^0-9]*)([0-9]*)(.*)/;
$$ab = $right;
}
my $cmp_nondig = cmp_ver_substr_nondig $a_nondig, $b_nondig;
return $cmp_nondig if $cmp_nondig;
my $cmp_dig = cmp_ver_substr_dig $a_dig , $b_dig ;
return $cmp_dig if $cmp_dig ;
}
return 0;
}
# Public subroutine: compare version strings.
sub cmp_ver_string ($$) {
my( $a, $b ) = @_;
defined($a) && defined($b) && length($a) && length($b)
or return undef;
my( $a_epoch, $a_upstream, $a_debian );
my( $b_epoch, $b_upstream, $b_debian );
for (
[ \$a, \$a_epoch, \$a_upstream, \$a_debian ],
[ \$b, \$b_epoch, \$b_upstream, \$b_debian ],
) {
# Separate the version string into its principal parts.
# (See Policy 5.6.11, v 3.6.1.1.)
my( $ab, $epoch, $upstream, $debian ) = @$_;
( $$epoch, $$upstream, $$debian ) =
$$ab =~
/^(?:([0-9]*):)?([A-Za-z0-9+.:-]*?)(?:-([A-Za-z0-9+.]*))?$/
or die "$0: bad version number $$ab";
}
my $cmp_epoch = cmp_ver_substr_dig $a_epoch , $b_epoch ;
return $cmp_epoch if $cmp_epoch ;
my $cmp_upstream = cmp_ver_substr $a_upstream, $b_upstream;
return $cmp_upstream if $cmp_upstream;
return cmp_ver_substr $a_debian , $b_debian ;
}
# Public subroutine: compare or check a vname's version against a given
# $ver requirement. Note that when no $ver is given to check against,
# the check is always passed. (But, when a $ver is given and the vname
# has no version, the check is failed. A vname with no version can pass
# no check, except when no standard is given to check against.)
sub check_ver ($$$) {
my( $ver0, $rel, $ver ) = @_;
defined($ver ) && length($ver ) or return '1';
defined($ver0) && length($ver0) or return '' ;
my $cmp1 = cmp_ver_string $ver0, $ver;
!defined( $cmp1 ) || (
$rel eq '<<' && $cmp1 < 0 ||
$rel eq '<=' && $cmp1 <= 0 ||
$rel eq '=' && $cmp1 == 0 ||
$rel eq '>=' && $cmp1 >= 0 ||
$rel eq '>>' && $cmp1 > 0
);
}
1;
|
