| OLD | NEW |
|---|
| (Empty) |
| 1 # Copyright © Colin Watson <cjwatson@debian.org> | |
| 2 # Copyright © Ian Jackson <iwj@debian.org> | |
| 3 # Copyright © 2007 Don Armstrong <don@donarmstrong.com>. | |
| 4 # Copyright © 2009 Raphaël Hertzog <hertzog@debian.org> | |
| 5 # | |
| 6 # This program is free software; you can redistribute it and/or modify | |
| 7 # it under the terms of the GNU General Public License as published by | |
| 8 # the Free Software Foundation; either version 2 of the License, or | |
| 9 # (at your option) any later version. | |
| 10 # | |
| 11 # This program is distributed in the hope that it will be useful, | |
| 12 # but WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
| 14 # GNU General Public License for more details. | |
| 15 # | |
| 16 # You should have received a copy of the GNU General Public License | |
| 17 # along with this program. If not, see <https://www.gnu.org/licenses/>. | |
| 18 | |
| 19 package Dpkg::Version; | |
| 20 | |
| 21 use strict; | |
| 22 use warnings; | |
| 23 | |
| 24 our $VERSION = '1.01'; | |
| 25 | |
| 26 use Dpkg::ErrorHandling; | |
| 27 use Dpkg::Gettext; | |
| 28 | |
| 29 use Carp; | |
| 30 use Exporter qw(import); | |
| 31 our @EXPORT = qw(version_compare version_compare_relation | |
| 32 version_normalize_relation version_compare_string | |
| 33 version_compare_part version_split_digits version_check | |
| 34 REL_LT REL_LE REL_EQ REL_GE REL_GT); | |
| 35 | |
| 36 use constant { | |
| 37 REL_LT => '<<', | |
| 38 REL_LE => '<=', | |
| 39 REL_EQ => '=', | |
| 40 REL_GE => '>=', | |
| 41 REL_GT => '>>', | |
| 42 }; | |
| 43 | |
| 44 use overload | |
| 45 '<=>' => \&comparison, | |
| 46 'cmp' => \&comparison, | |
| 47 '""' => sub { return $_[0]->as_string(); }, | |
| 48 'bool' => sub { return $_[0]->as_string() if $_[0]->is_valid(); }, | |
| 49 'fallback' => 1; | |
| 50 | |
| 51 =encoding utf8 | |
| 52 | |
| 53 =head1 NAME | |
| 54 | |
| 55 Dpkg::Version - handling and comparing dpkg-style version numbers | |
| 56 | |
| 57 =head1 DESCRIPTION | |
| 58 | |
| 59 The Dpkg::Version module provides pure-Perl routines to compare | |
| 60 dpkg-style version numbers (as used in Debian packages) and also | |
| 61 an object oriented interface overriding perl operators | |
| 62 to do the right thing when you compare Dpkg::Version object between | |
| 63 them. | |
| 64 | |
| 65 =head1 OBJECT INTERFACE | |
| 66 | |
| 67 =over 4 | |
| 68 | |
| 69 =item my $v = Dpkg::Version->new($version, %opts) | |
| 70 | |
| 71 Create a new Dpkg::Version object corresponding to the version indicated in | |
| 72 the string (scalar) $version. By default it will accepts any string | |
| 73 and consider it as a valid version. If you pass the option "check => 1", | |
| 74 it will return undef if the version is invalid (see version_check for | |
| 75 details). | |
| 76 | |
| 77 You can always call $v->is_valid() later on to verify that the version is | |
| 78 valid. | |
| 79 | |
| 80 =cut | |
| 81 | |
| 82 sub new { | |
| 83 my ($this, $ver, %opts) = @_; | |
| 84 my $class = ref($this) || $this; | |
| 85 $ver = "$ver" if ref($ver); # Try to stringify objects | |
| 86 | |
| 87 if ($opts{check}) { | |
| 88 return unless version_check($ver); | |
| 89 } | |
| 90 | |
| 91 my $self = {}; | |
| 92 if ($ver =~ /^([^:]*):(.+)$/) { | |
| 93 $self->{epoch} = $1; | |
| 94 $ver = $2; | |
| 95 } else { | |
| 96 $self->{epoch} = 0; | |
| 97 $self->{no_epoch} = 1; | |
| 98 } | |
| 99 if ($ver =~ /(.*)-(.*)$/) { | |
| 100 $self->{version} = $1; | |
| 101 $self->{revision} = $2; | |
| 102 } else { | |
| 103 $self->{version} = $ver; | |
| 104 $self->{revision} = 0; | |
| 105 $self->{no_revision} = 1; | |
| 106 } | |
| 107 | |
| 108 return bless $self, $class; | |
| 109 } | |
| 110 | |
| 111 =item boolean evaluation | |
| 112 | |
| 113 When the Dpkg::Version object is used in a boolean evaluation (for example | |
| 114 in "if ($v)" or "$v || 'default'") it returns its string representation | |
| 115 if the version stored is valid ($v->is_valid()) and undef otherwise. | |
| 116 | |
| 117 =item $v->is_valid() | |
| 118 | |
| 119 Returns true if the version is valid, false otherwise. | |
| 120 | |
| 121 =cut | |
| 122 | |
| 123 sub is_valid { | |
| 124 my ($self) = @_; | |
| 125 return scalar version_check($self); | |
| 126 } | |
| 127 | |
| 128 =item $v->epoch(), $v->version(), $v->revision() | |
| 129 | |
| 130 Returns the corresponding part of the full version string. | |
| 131 | |
| 132 =cut | |
| 133 | |
| 134 sub epoch { | |
| 135 my $self = shift; | |
| 136 return $self->{epoch}; | |
| 137 } | |
| 138 | |
| 139 sub version { | |
| 140 my $self = shift; | |
| 141 return $self->{version}; | |
| 142 } | |
| 143 | |
| 144 sub revision { | |
| 145 my $self = shift; | |
| 146 return $self->{revision}; | |
| 147 } | |
| 148 | |
| 149 =item $v->is_native() | |
| 150 | |
| 151 Returns true if the version is native, false if it has a revision. | |
| 152 | |
| 153 =cut | |
| 154 | |
| 155 sub is_native { | |
| 156 my $self = shift; | |
| 157 return $self->{no_revision}; | |
| 158 } | |
| 159 | |
| 160 =item $v1 <=> $v2, $v1 < $v2, $v1 <= $v2, $v1 > $v2, $v1 >= $v2 | |
| 161 | |
| 162 Numerical comparison of various versions numbers. One of the two operands | |
| 163 needs to be a Dpkg::Version, the other one can be anything provided that | |
| 164 its string representation is a version number. | |
| 165 | |
| 166 =cut | |
| 167 | |
| 168 sub comparison { | |
| 169 my ($a, $b, $inverted) = @_; | |
| 170 if (not ref($b) or not $b->isa('Dpkg::Version')) { | |
| 171 $b = Dpkg::Version->new($b); | |
| 172 } | |
| 173 ($a, $b) = ($b, $a) if $inverted; | |
| 174 my $r = version_compare_part($a->epoch(), $b->epoch()); | |
| 175 return $r if $r; | |
| 176 $r = version_compare_part($a->version(), $b->version()); | |
| 177 return $r if $r; | |
| 178 return version_compare_part($a->revision(), $b->revision()); | |
| 179 } | |
| 180 | |
| 181 =item "$v", $v->as_string(), $v->as_string(%options) | |
| 182 | |
| 183 Accepts an optional option hash reference, affecting the string conversion. | |
| 184 | |
| 185 Options: | |
| 186 | |
| 187 =over 8 | |
| 188 | |
| 189 =item omit_epoch (defaults to 0) | |
| 190 | |
| 191 Omit the epoch, if present, in the output string. | |
| 192 | |
| 193 =item omit_revision (defaults to 0) | |
| 194 | |
| 195 Omit the revision, if present, in the output string. | |
| 196 | |
| 197 =back | |
| 198 | |
| 199 Returns the string representation of the version number. | |
| 200 | |
| 201 =cut | |
| 202 | |
| 203 sub as_string { | |
| 204 my ($self, %opts) = @_; | |
| 205 my $no_epoch = $opts{omit_epoch} || $self->{no_epoch}; | |
| 206 my $no_revision = $opts{omit_revision} || $self->{no_revision}; | |
| 207 | |
| 208 my $str = ''; | |
| 209 $str .= $self->{epoch} . ':' unless $no_epoch; | |
| 210 $str .= $self->{version}; | |
| 211 $str .= '-' . $self->{revision} unless $no_revision; | |
| 212 return $str; | |
| 213 } | |
| 214 | |
| 215 =back | |
| 216 | |
| 217 =head1 FUNCTIONS | |
| 218 | |
| 219 All the functions are exported by default. | |
| 220 | |
| 221 =over 4 | |
| 222 | |
| 223 =item version_compare($a, $b) | |
| 224 | |
| 225 Returns -1 if $a is earlier than $b, 0 if they are equal and 1 if $a | |
| 226 is later than $b. | |
| 227 | |
| 228 If $a or $b are not valid version numbers, it dies with an error. | |
| 229 | |
| 230 =cut | |
| 231 | |
| 232 sub version_compare($$) { | |
| 233 my ($a, $b) = @_; | |
| 234 my $va = Dpkg::Version->new($a, check => 1); | |
| 235 defined($va) || error(_g('%s is not a valid version'), "$a"); | |
| 236 my $vb = Dpkg::Version->new($b, check => 1); | |
| 237 defined($vb) || error(_g('%s is not a valid version'), "$b"); | |
| 238 return $va <=> $vb; | |
| 239 } | |
| 240 | |
| 241 =item version_compare_relation($a, $rel, $b) | |
| 242 | |
| 243 Returns the result (0 or 1) of the given comparison operation. This | |
| 244 function is implemented on top of version_compare(). | |
| 245 | |
| 246 Allowed values for $rel are the exported constants REL_GT, REL_GE, | |
| 247 REL_EQ, REL_LE, REL_LT. Use version_normalize_relation() if you | |
| 248 have an input string containing the operator. | |
| 249 | |
| 250 =cut | |
| 251 | |
| 252 sub version_compare_relation($$$) { | |
| 253 my ($a, $op, $b) = @_; | |
| 254 my $res = version_compare($a, $b); | |
| 255 | |
| 256 if ($op eq REL_GT) { | |
| 257 return $res > 0; | |
| 258 } elsif ($op eq REL_GE) { | |
| 259 return $res >= 0; | |
| 260 } elsif ($op eq REL_EQ) { | |
| 261 return $res == 0; | |
| 262 } elsif ($op eq REL_LE) { | |
| 263 return $res <= 0; | |
| 264 } elsif ($op eq REL_LT) { | |
| 265 return $res < 0; | |
| 266 } else { | |
| 267 croak "unsupported relation for version_compare_relation(): '$op'"; | |
| 268 } | |
| 269 } | |
| 270 | |
| 271 =item my $rel = version_normalize_relation($rel_string) | |
| 272 | |
| 273 Returns the normalized constant of the relation $rel (a value | |
| 274 among REL_GT, REL_GE, REL_EQ, REL_LE and REL_LT). Supported | |
| 275 relations names in input are: "gt", "ge", "eq", "le", "lt", ">>", ">=", | |
| 276 "=", "<=", "<<". ">" and "<" are also supported but should not be used as | |
| 277 they are obsolete aliases of ">=" and "<=". | |
| 278 | |
| 279 =cut | |
| 280 | |
| 281 sub version_normalize_relation($) { | |
| 282 my $op = shift; | |
| 283 | |
| 284 warning('relation %s is deprecated: use %s or %s', | |
| 285 $op, "$op$op", "$op=") if ($op eq '>' or $op eq '<'); | |
| 286 | |
| 287 if ($op eq '>>' or $op eq 'gt') { | |
| 288 return REL_GT; | |
| 289 } elsif ($op eq '>=' or $op eq 'ge' or $op eq '>') { | |
| 290 return REL_GE; | |
| 291 } elsif ($op eq '=' or $op eq 'eq') { | |
| 292 return REL_EQ; | |
| 293 } elsif ($op eq '<=' or $op eq 'le' or $op eq '<') { | |
| 294 return REL_LE; | |
| 295 } elsif ($op eq '<<' or $op eq 'lt') { | |
| 296 return REL_LT; | |
| 297 } else { | |
| 298 croak "bad relation '$op'"; | |
| 299 } | |
| 300 } | |
| 301 | |
| 302 =item version_compare_string($a, $b) | |
| 303 | |
| 304 String comparison function used for comparing non-numerical parts of version | |
| 305 numbers. Returns -1 if $a is earlier than $b, 0 if they are equal and 1 if $a | |
| 306 is later than $b. | |
| 307 | |
| 308 The "~" character always sort lower than anything else. Digits sort lower | |
| 309 than non-digits. Among remaining characters alphabetic characters (A-Za-z) | |
| 310 sort lower than the other ones. Within each range, the ASCII decimal value | |
| 311 of the character is used to sort between characters. | |
| 312 | |
| 313 =cut | |
| 314 | |
| 315 sub _version_order { | |
| 316 my ($x) = @_; | |
| 317 | |
| 318 if ($x eq '~') { | |
| 319 return -1; | |
| 320 } elsif ($x =~ /^\d$/) { | |
| 321 return $x * 1 + 1; | |
| 322 } elsif ($x =~ /^[A-Za-z]$/) { | |
| 323 return ord($x); | |
| 324 } else { | |
| 325 return ord($x) + 256; | |
| 326 } | |
| 327 } | |
| 328 | |
| 329 sub version_compare_string($$) { | |
| 330 my @a = map { _version_order($_) } split(//, shift); | |
| 331 my @b = map { _version_order($_) } split(//, shift); | |
| 332 while (1) { | |
| 333 my ($a, $b) = (shift @a, shift @b); | |
| 334 return 0 if not defined($a) and not defined($b); | |
| 335 $a ||= 0; # Default order for "no character" | |
| 336 $b ||= 0; | |
| 337 return 1 if $a > $b; | |
| 338 return -1 if $a < $b; | |
| 339 } | |
| 340 } | |
| 341 | |
| 342 =item version_compare_part($a, $b) | |
| 343 | |
| 344 Compare two corresponding sub-parts of a version number (either upstream | |
| 345 version or debian revision). | |
| 346 | |
| 347 Each parameter is split by version_split_digits() and resulting items | |
| 348 are compared together. As soon as a difference happens, it returns -1 if | |
| 349 $a is earlier than $b, 0 if they are equal and 1 if $a is later than $b. | |
| 350 | |
| 351 =cut | |
| 352 | |
| 353 sub version_compare_part($$) { | |
| 354 my @a = version_split_digits(shift); | |
| 355 my @b = version_split_digits(shift); | |
| 356 while (1) { | |
| 357 my ($a, $b) = (shift @a, shift @b); | |
| 358 return 0 if not defined($a) and not defined($b); | |
| 359 $a ||= 0; # Default value for lack of version | |
| 360 $b ||= 0; | |
| 361 if ($a =~ /^\d+$/ and $b =~ /^\d+$/) { | |
| 362 # Numerical comparison | |
| 363 my $cmp = $a <=> $b; | |
| 364 return $cmp if $cmp; | |
| 365 } else { | |
| 366 # String comparison | |
| 367 my $cmp = version_compare_string($a, $b); | |
| 368 return $cmp if $cmp; | |
| 369 } | |
| 370 } | |
| 371 } | |
| 372 | |
| 373 =item my @items = version_split_digits($version) | |
| 374 | |
| 375 Splits a string in items that are each entirely composed either | |
| 376 of digits or of non-digits. For instance for "1.024~beta1+svn234" it would | |
| 377 return ("1", ".", "024", "~beta", "1", "+svn", "234"). | |
| 378 | |
| 379 =cut | |
| 380 | |
| 381 sub version_split_digits($) { | |
| 382 return split(/(?<=\d)(?=\D)|(?<=\D)(?=\d)/, $_[0]); | |
| 383 } | |
| 384 | |
| 385 =item my ($ok, $msg) = version_check($version) | |
| 386 | |
| 387 =item my $ok = version_check($version) | |
| 388 | |
| 389 Checks the validity of $version as a version number. Returns 1 in $ok | |
| 390 if the version is valid, 0 otherwise. In the latter case, $msg | |
| 391 contains a description of the problem with the $version scalar. | |
| 392 | |
| 393 =cut | |
| 394 | |
| 395 sub version_check($) { | |
| 396 my $version = shift; | |
| 397 my $str; | |
| 398 if (defined $version) { | |
| 399 $str = "$version"; | |
| 400 $version = Dpkg::Version->new($str) unless ref($version); | |
| 401 } | |
| 402 if (not defined($str) or not length($str)) { | |
| 403 my $msg = _g('version number cannot be empty'); | |
| 404 return (0, $msg) if wantarray; | |
| 405 return 0; | |
| 406 } | |
| 407 if ($version->version() =~ m/^[^\d]/) { | |
| 408 my $msg = _g('version number does not start with digit'); | |
| 409 return (0, $msg) if wantarray; | |
| 410 return 0; | |
| 411 } | |
| 412 if ($str =~ m/([^-+:.0-9a-zA-Z~])/o) { | |
| 413 my $msg = sprintf(_g("version number contains illegal character `%s'"),
$1); | |
| 414 return (0, $msg) if wantarray; | |
| 415 return 0; | |
| 416 } | |
| 417 if ($version->epoch() !~ /^\d*$/) { | |
| 418 my $msg = sprintf(_g('epoch part of the version number ' . | |
| 419 "is not a number: '%s'"), $version->epoch()); | |
| 420 return (0, $msg) if wantarray; | |
| 421 return 0; | |
| 422 } | |
| 423 return (1, '') if wantarray; | |
| 424 return 1; | |
| 425 } | |
| 426 | |
| 427 =back | |
| 428 | |
| 429 =head1 CHANGES | |
| 430 | |
| 431 =head2 Version 1.01 | |
| 432 | |
| 433 New argument: Accept an options argument in $v->as_string(). | |
| 434 | |
| 435 New method: $v->is_native(). | |
| 436 | |
| 437 =head1 AUTHOR | |
| 438 | |
| 439 Don Armstrong <don@donarmstrong.com>, Colin Watson | |
| 440 <cjwatson@debian.org> and Raphaël Hertzog <hertzog@debian.org>, based on | |
| 441 the implementation in F<dpkg/lib/version.c> by Ian Jackson and others. | |
| 442 | |
| 443 =cut | |
| 444 | |
| 445 1; | |
| OLD | NEW |
|---|
Chromium Code Reviews
Issue 2425693003:
Revert of Linux build: Use sysroot when calculating dependencies (Closed)
