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
|
package SlackBuild::Registry::Version;
use strict;
use warnings;
use Carp;
use SlackBuild::Base qw(major minor patch tail string:ro);
sub new {
my $class = shift;
my $self = bless {}, $class;
if (my $s = shift) {
croak "too many arguments" if @_;
$self->parse($s);
}
return $self;
}
sub major_number { shift->major || 0 };
sub minor_number { shift->minor || 0 };
sub patch_number { shift->patch || 0 };
sub tail_string { shift->tail || '' };
sub parse {
my ($self, $str) = @_;
$self->{string} = $str;
delete $self->{major};
delete $self->{minor};
delete $self->{patch};
delete $self->{tail};
if ($str =~ s/^(\d+)(.*)/$2/) {
$self->major($1);
if ($str =~ s/^\.(\d+)(.*)/$2/) {
$self->minor($1);
if ($str =~ s/^\.(\d+)(.*)/$2/) {
$self->patch($1);
}
}
}
$self->tail($str);
}
sub cmp {
my ($self, $other) = @_;
$other = __PACKAGE__->new($other) unless ref($other);
foreach my $part (map { "${_}_number" } qw(major minor patch)) {
if (my $d = $self->${\$part} <=> $other->${\$part}) {
return $d;
}
}
return $self->tail_string cmp $other->tail_string;
}
use overload
'""' => sub { shift->string },
'cmp' => sub {
my ($self, $other, $swap) = @_;
my $res = $self->cmp($other);
return $swap ? -$res : $res;
},
'<=>' => sub {
my ($self, $other, $swap) = @_;
my $res = $self->cmp($other);
return $swap ? -$res : $res;
},
'==' => sub {
my ($self, $other) = @_;
my $res = $self->cmp($other) == 0;
},
'!=' => sub {
my ($self, $other) = @_;
my $res = $self->cmp($other) != 0;
},
'<' => sub {
my ($self, $other, $swap) = @_;
my $res = $self->cmp($other) < 0;
return $swap ? !$res : $res;
},
'<=' => sub {
my ($self, $other, $swap) = @_;
my $res = $self->cmp($other) <= 0;
return $swap ? !$res : $res;
},
'>' => sub {
my ($self, $other, $swap) = @_;
my $res = $self->cmp($other) > 0;
return $swap ? !$res : $res;
},
'>=' => sub {
my ($self, $other, $swap) = @_;
my $res = $self->cmp($other) >= 0;
return $swap ? !$res : $res;
};
1;
|