git.maemo.org Git - dh-make-perl/blob - dev/i386/libmodule-build-perl/libmodule-build-perl-0.2808.01/lib/Module/Build/Version.pm

   1 package Module::Build::Version;
   2 use strict;
   3
   4 use vars qw($VERSION);
   5 $VERSION = 0.7203;
   6
   7 eval "use version $VERSION";
   8 if ($@) { # can't locate version files, use our own
   9
  10     # Avoid redefined warnings if an old version.pm was available
  11     delete $version::{$_} foreach keys %version::;
  12
  13     # first we get the stub version module
  14     my $version;
  15     while (<DATA>) {
  16         s/(\$VERSION)\s=\s\d+/\$VERSION = 0/;
  17         $version .= $_ if $_;
  18         last if /^1;$/;
  19     }
  20
  21     # and now get the current version::vpp code
  22     my $vpp;
  23     while (<DATA>) {
  24         s/(\$VERSION)\s=\s\d+/\$VERSION = 0/;
  25         $vpp .= $_ if $_;
  26         last if /^1;$/;
  27     }
  28
  29     # but we eval them in reverse order since version depends on
  30     # version::vpp to already exist
  31     eval $vpp; die $@ if $@;
  32     $INC{'version/vpp.pm'} = 'inside Module::Build::Version';
  33     eval $version; die $@ if $@;
  34     $INC{'version.pm'} = 'inside Module::Build::Version';
  35 }
  36
  37 # now we can safely subclass version, installed or not
  38 use vars qw(@ISA);
  39 @ISA = qw(version);
  40
  41 1;
  42 __DATA__
  43 # stub version module to make everything else happy
  44 package version;
  45
  46 use 5.005_04;
  47 use strict;
  48
  49 use vars qw(@ISA $VERSION $CLASS *qv);
  50
  51 $VERSION = 0.000;
  52
  53 $CLASS = 'version';
  54
  55 push @ISA, "version::vpp";
  56 *version::qv = \&version::vpp::qv;
  57
  58 # Preloaded methods go here.
  59 sub import {
  60     my ($class) = @_;
  61     my $callpkg = caller();
  62     no strict 'refs';
  63
  64     *{$callpkg."::qv"} =
  65             sub {return bless version::qv(shift), $class }
  66         unless defined(&{"$callpkg\::qv"});
  67
  68 }
  69
  70 1;
  71 # replace everything from here to the end with the current version/vpp.pm
  72
  73 package version::vpp;
  74 use strict;
  75
  76 use locale;
  77 use vars qw ($VERSION @ISA @REGEXS);
  78 $VERSION = 0.7203;
  79
  80 push @REGEXS, qr/
  81         ^v?     # optional leading 'v'
  82         (\d*)   # major revision not required
  83         \.      # requires at least one decimal
  84         (?:(\d+)\.?){1,}
  85         /x;
  86
  87 use overload (
  88     '""'       => \&stringify,
  89     '0+'       => \&numify,
  90     'cmp'      => \&vcmp,
  91     '<=>'      => \&vcmp,
  92     'bool'     => \&vbool,
  93     'nomethod' => \&vnoop,
  94 );
  95
  96 sub new
  97 {
  98         my ($class, $value) = @_;
  99         my $self = bless ({}, ref ($class) || $class);
 100
 101         if ( ref($value) && eval("$value->isa('version')") ) {
 102             # Can copy the elements directly
 103             $self->{version} = [ @{$value->{version} } ];
 104             $self->{qv} = 1 if $value->{qv};
 105             $self->{alpha} = 1 if $value->{alpha};
 106             $self->{original} = ''.$value->{original};
 107             return $self;
 108         }
 109
 110         require POSIX;
 111         my $currlocale = POSIX::setlocale(&POSIX::LC_ALL);
 112         my $radix_comma = ( POSIX::localeconv()->{decimal_point} eq ',' );
 113
 114         if ( not defined $value or $value =~ /^undef$/ ) {
 115             # RT #19517 - special case for undef comparison
 116             # or someone forgot to pass a value
 117             push @{$self->{version}}, 0;
 118             $self->{original} = "0";
 119             return ($self);
 120         }
 121
 122         if ( $#_ == 2 ) { # must be CVS-style
 123             $value = 'v'.$_[2];
 124         }
 125
 126         $value = _un_vstring($value);
 127
 128         # exponential notation
 129         if ( $value =~ /\d+.?\d*e-?\d+/ ) {
 130             $value = sprintf("%.9f",$value);
 131             $value =~ s/(0+)$//;
 132         }
 133
 134         # if the original locale used commas for decimal points, we
 135         # just replace commas with decimal places, rather than changing
 136         # locales
 137         if ( $radix_comma ) {
 138             $value =~ tr/,/./;
 139         }
 140
 141         # This is not very efficient, but it is morally equivalent
 142         # to the XS code (as that is the reference implementation).
 143         # See vutil/vutil.c for details
 144         my $qv = 0;
 145         my $alpha = 0;
 146         my $width = 3;
 147         my $saw_period = 0;
 148         my ($start, $last, $pos, $s);
 149         $s = 0;
 150
 151         while ( substr($value,$s,1) =~ /\s/ ) { # leading whitespace is OK
 152             $s++;
 153         }
 154
 155         if (substr($value,$s,1) eq 'v') {
 156             $s++;    # get past 'v'
 157             $qv = 1; # force quoted version processing
 158         }
 159
 160         $start = $last = $pos = $s;
 161
 162         # pre-scan the input string to check for decimals/underbars
 163         while ( substr($value,$pos,1) =~ /[._\d]/ ) {
 164             if ( substr($value,$pos,1) eq '.' ) {
 165                 if ($alpha) {
 166                     require Carp;
 167                     Carp::croak("Invalid version format ".
 168                         "(underscores before decimal)");
 169                 }
 170                 $saw_period++;
 171                 $last = $pos;
 172             }
 173             elsif ( substr($value,$pos,1) eq '_' ) {
 174                 if ($alpha) {
 175                     require Carp;
 176                     Carp::croak("Invalid version format ".
 177                         "(multiple underscores)");
 178                 }
 179                 $alpha = 1;
 180                 $width = $pos - $last - 1; # natural width of sub-version
 181             }
 182             $pos++;
 183         }
 184
 185         if ( $alpha && !$saw_period ) {
 186             require Carp;
 187             Carp::croak("Invalid version format (alpha without decimal)");
 188         }
 189
 190         if ( $alpha && $saw_period && $width == 0 ) {
 191             require Carp;
 192             Carp::croak("Invalid version format (misplaced _ in number)");
 193         }
 194
 195         if ( $saw_period > 1 ) {
 196             $qv = 1; # force quoted version processing
 197         }
 198
 199         $pos = $s;
 200
 201         if ( $qv ) {
 202             $self->{qv} = 1;
 203         }
 204
 205         if ( $alpha ) {
 206             $self->{alpha} = 1;
 207         }
 208
 209         if ( !$qv && $width < 3 ) {
 210             $self->{width} = $width;
 211         }
 212
 213         while ( substr($value,$pos,1) =~ /\d/ ) {
 214             $pos++;
 215         }
 216
 217         if ( substr($value,$pos,1) !~ /[a-z]/ ) { ### FIX THIS ###
 218             my $rev;
 219
 220             while (1) {
 221                 $rev = 0;
 222                 {
 223
 224                     # this is atoi() that delimits on underscores
 225                     my $end = $pos;
 226                     my $mult = 1;
 227                     my $orev;
 228
 229                     # the following if() will only be true after the decimal
 230                     # point of a version originally created with a bare
 231                     # floating point number, i.e. not quoted in any way
 232                     if ( !$qv && $s > $start && $saw_period == 1 ) {
 233                         $mult *= 100;
 234                         while ( $s < $end ) {
 235                             $orev = $rev;
 236                             $rev += substr($value,$s,1) * $mult;
 237                             $mult /= 10;
 238                             if ( abs($orev) > abs($rev) ) {
 239                                 require Carp;
 240                                 Carp::croak("Integer overflow in version");
 241                             }
 242                             $s++;
 243                             if ( substr($value,$s,1) eq '_' ) {
 244                                 $s++;
 245                             }
 246                         }
 247                     }
 248                     else {
 249                         while (--$end >= $s) {
 250                             $orev = $rev;
 251                             $rev += substr($value,$end,1) * $mult;
 252                             $mult *= 10;
 253                             if ( abs($orev) > abs($rev) ) {
 254                                 require Carp;
 255                                 Carp::croak("Integer overflow in version");
 256                             }
 257                         }
 258                     }
 259                 }
 260
 261                 # Append revision
 262                 push @{$self->{version}}, $rev;
 263                 if ( substr($value,$pos,1) eq '.'
 264                     && substr($value,$pos+1,1) =~ /\d/ ) {
 265                     $s = ++$pos;
 266                 }
 267                 elsif ( substr($value,$pos,1) eq '_'
 268                     && substr($value,$pos+1,1) =~ /\d/ ) {
 269                     $s = ++$pos;
 270                 }
 271                 elsif ( substr($value,$pos,1) =~ /\d/ ) {
 272                     $s = $pos;
 273                 }
 274                 else {
 275                     $s = $pos;
 276                     last;
 277                 }
 278                 if ( $qv ) {
 279                     while ( substr($value,$pos,1) =~ /\d/ ) {
 280                         $pos++;
 281                     }
 282                 }
 283                 else {
 284                     my $digits = 0;
 285                     while (substr($value,$pos,1) =~ /[\d_]/ && $digits < 3) {
 286                         if ( substr($value,$pos,1) ne '_' ) {
 287                             $digits++;
 288                         }
 289                         $pos++;
 290                     }
 291                 }
 292             }
 293         }
 294         if ( $qv ) { # quoted versions always get at least three terms
 295             my $len = scalar @{$self->{version}};
 296             $len = 3 - $len;
 297             while ($len-- > 0) {
 298                 push @{$self->{version}}, 0;
 299             }
 300         }
 301
 302         if ( substr($value,$pos) ) { # any remaining text
 303             warn "Version string '$value' contains invalid data; ".
 304                  "ignoring: '".substr($value,$pos)."'";
 305         }
 306
 307         # cache the original value for use when stringification
 308         $self->{original} = substr($value,0,$pos);
 309
 310         return ($self);
 311 }
 312
 313 sub numify
 314 {
 315     my ($self) = @_;
 316     unless (_verify($self)) {
 317         require Carp;
 318         Carp::croak("Invalid version object");
 319     }
 320     my $width = $self->{width} || 3;
 321     my $alpha = $self->{alpha} || "";
 322     my $len = $#{$self->{version}};
 323     my $digit = $self->{version}[0];
 324     my $string = sprintf("%d.", $digit );
 325
 326     for ( my $i = 1 ; $i < $len ; $i++ ) {
 327         $digit = $self->{version}[$i];
 328         if ( $width < 3 ) {
 329             my $denom = 10**(3-$width);
 330             my $quot = int($digit/$denom);
 331             my $rem = $digit - ($quot * $denom);
 332             $string .= sprintf("%0".$width."d_%d", $quot, $rem);
 333         }
 334         else {
 335             $string .= sprintf("%03d", $digit);
 336         }
 337     }
 338
 339     if ( $len > 0 ) {
 340         $digit = $self->{version}[$len];
 341         if ( $alpha && $width == 3 ) {
 342             $string .= "_";
 343         }
 344         $string .= sprintf("%0".$width."d", $digit);
 345     }
 346     else # $len = 0
 347     {
 348         $string .= sprintf("000");
 349     }
 350
 351     return $string;
 352 }
 353
 354 sub normal
 355 {
 356     my ($self) = @_;
 357     unless (_verify($self)) {
 358         require Carp;
 359         Carp::croak("Invalid version object");
 360     }
 361     my $alpha = $self->{alpha} || "";
 362     my $len = $#{$self->{version}};
 363     my $digit = $self->{version}[0];
 364     my $string = sprintf("v%d", $digit );
 365
 366     for ( my $i = 1 ; $i < $len ; $i++ ) {
 367         $digit = $self->{version}[$i];
 368         $string .= sprintf(".%d", $digit);
 369     }
 370
 371     if ( $len > 0 ) {
 372         $digit = $self->{version}[$len];
 373         if ( $alpha ) {
 374             $string .= sprintf("_%0d", $digit);
 375         }
 376         else {
 377             $string .= sprintf(".%0d", $digit);
 378         }
 379     }
 380
 381     if ( $len <= 2 ) {
 382         for ( $len = 2 - $len; $len != 0; $len-- ) {
 383             $string .= sprintf(".%0d", 0);
 384         }
 385     }
 386
 387     return $string;
 388 }
 389
 390 sub stringify
 391 {
 392     my ($self) = @_;
 393     unless (_verify($self)) {
 394         require Carp;
 395         Carp::croak("Invalid version object");
 396     }
 397     return $self->{original};
 398 }
 399
 400 sub vcmp
 401 {
 402     require UNIVERSAL;
 403     my ($left,$right,$swap) = @_;
 404     my $class = ref($left);
 405     unless ( UNIVERSAL::isa($right, $class) ) {
 406         $right = $class->new($right);
 407     }
 408
 409     if ( $swap ) {
 410         ($left, $right) = ($right, $left);
 411     }
 412     unless (_verify($left)) {
 413         require Carp;
 414         Carp::croak("Invalid version object");
 415     }
 416     unless (_verify($right)) {
 417         require Carp;
 418         Carp::croak("Invalid version object");
 419     }
 420     my $l = $#{$left->{version}};
 421     my $r = $#{$right->{version}};
 422     my $m = $l < $r ? $l : $r;
 423     my $lalpha = $left->is_alpha;
 424     my $ralpha = $right->is_alpha;
 425     my $retval = 0;
 426     my $i = 0;
 427     while ( $i <= $m && $retval == 0 ) {
 428         $retval = $left->{version}[$i] <=> $right->{version}[$i];
 429         $i++;
 430     }
 431
 432     # tiebreaker for alpha with identical terms
 433     if ( $retval == 0
 434         && $l == $r
 435         && $left->{version}[$m] == $right->{version}[$m]
 436         && ( $lalpha || $ralpha ) ) {
 437
 438         if ( $lalpha && !$ralpha ) {
 439             $retval = -1;
 440         }
 441         elsif ( $ralpha && !$lalpha) {
 442             $retval = +1;
 443         }
 444     }
 445
 446     # possible match except for trailing 0's
 447     if ( $retval == 0 && $l != $r ) {
 448         if ( $l < $r ) {
 449             while ( $i <= $r && $retval == 0 ) {
 450                 if ( $right->{version}[$i] != 0 ) {
 451                     $retval = -1; # not a match after all
 452                 }
 453                 $i++;
 454             }
 455         }
 456         else {
 457             while ( $i <= $l && $retval == 0 ) {
 458                 if ( $left->{version}[$i] != 0 ) {
 459                     $retval = +1; # not a match after all
 460                 }
 461                 $i++;
 462             }
 463         }
 464     }
 465
 466     return $retval;
 467 }
 468
 469 sub vbool {
 470     my ($self) = @_;
 471     return vcmp($self,$self->new("0"),1);
 472 }
 473
 474 sub vnoop {
 475     require Carp;
 476     Carp::croak("operation not supported with version object");
 477 }
 478
 479 sub is_alpha {
 480     my ($self) = @_;
 481     return (exists $self->{alpha});
 482 }
 483
 484 sub qv {
 485     my ($value) = @_;
 486
 487     $value = _un_vstring($value);
 488     $value = 'v'.$value unless $value =~ /(^v|\d+\.\d+\.\d)/;
 489     my $version = version->new($value); # always use base class
 490     return $version;
 491 }
 492
 493 sub is_qv {
 494     my ($self) = @_;
 495     return (exists $self->{qv});
 496 }
 497
 498
 499 sub _verify {
 500     my ($self) = @_;
 501     if ( ref($self)
 502         && eval { exists $self->{version} }
 503         && ref($self->{version}) eq 'ARRAY'
 504         ) {
 505         return 1;
 506     }
 507     else {
 508         return 0;
 509     }
 510 }
 511
 512 sub _un_vstring {
 513     my $value = shift;
 514     # may be a v-string
 515     if ( $] >= 5.006_000 && length($value) >= 3 && $value !~ /[._]/ ) {
 516         my $tvalue = sprintf("v%vd",$value);
 517         if ( $tvalue =~ /^v\d+\.\d+\.\d+$/ ) {
 518             # must be a v-string
 519             $value = $tvalue;
 520         }
 521     }
 522     return $value;
 523 }
 524
 525 # Thanks to Yitzchak Scott-Thoennes for this mode of operation
 526 {
 527     local $^W;
 528     *UNIVERSAL::VERSION = sub {
 529         my ($obj, $req) = @_;
 530         my $class = ref($obj) || $obj;
 531
 532         no strict 'refs';
 533         eval "require $class" unless %{"$class\::"}; # already existing
 534         return undef if $@ =~ /Can't locate/ and not defined $req;
 535
 536         if ( not %{"$class\::"} and $] >= 5.008) { # file but no package
 537             require Carp;
 538             Carp::croak( "$class defines neither package nor VERSION"
 539                 ."--version check failed");
 540         }
 541
 542         my $version = eval "\$$class\::VERSION";
 543         if ( defined $version ) {
 544             local $^W if $] <= 5.008;
 545             $version = version::vpp->new($version);
 546         }
 547
 548         if ( defined $req ) {
 549             unless ( defined $version ) {
 550                 require Carp;
 551                 my $msg =  $] < 5.006
 552                 ? "$class version $req required--this is only version "
 553                 : "$class does not define \$$class\::VERSION"
 554                   ."--version check failed";
 555
 556                 if ( $ENV{VERSION_DEBUG} ) {
 557                     Carp::confess($msg);
 558                 }
 559                 else {
 560                     Carp::croak($msg);
 561                 }
 562             }
 563
 564             $req = version::vpp->new($req);
 565
 566             if ( $req > $version ) {
 567                 require Carp;
 568                 if ( $req->is_qv ) {
 569                     Carp::croak(
 570                         sprintf ("%s version %s required--".
 571                             "this is only version %s", $class,
 572                             $req->normal, $version->normal)
 573                     );
 574                 }
 575                 else {
 576                     Carp::croak(
 577                         sprintf ("%s version %s required--".
 578                             "this is only version %s", $class,
 579                             $req->stringify, $version->stringify)
 580                     );
 581                 }
 582             }
 583         }
 584
 585         return defined $version ? $version->stringify : undef;
 586     };
 587 }
 588
 589 1; #this line is important and will help the module return a true value