1 package Module::Build::Version;
4 eval "use version 0.661";
5 if ($@) { # can't locate version files, use our own
7 # Avoid redefined warnings if an old version.pm was available
8 delete $version::{$_} foreach keys %version::;
10 # first we get the stub version module
13 s/(\$VERSION)\s=\s\d+/\$VERSION = 0/;
18 # and now get the current version::vpp code
21 s/(\$VERSION)\s=\s\d+/\$VERSION = 0/;
26 # but we eval them in reverse order since version depends on
27 # version::vpp to already exist
29 $INC{'version/vpp.pm'} = 'inside Module::Build::Version';
31 $INC{'version.pm'} = 'inside Module::Build::Version';
34 # now we can safely subclass version, installed or not
43 my ($class, $value) = @_;
44 my $self = $class->SUPER::new($value);
45 $self->original($value);
51 $self->{original} = shift if @_;
52 return $self->{original};
57 return $self->original;
62 # stub version module to make everything else happy
68 use vars qw(@ISA $VERSION $CLASS *qv);
74 push @ISA, "version::vpp";
75 *version::qv = \&version::vpp::qv;
77 # Preloaded methods go here.
80 my $callpkg = caller();
84 sub {return bless version::qv(shift), $class }
85 unless defined(&{"$callpkg\::qv"});
90 # replace everything from here to the end with the current version/vpp.pm
96 use vars qw ($VERSION @ISA @REGEXS);
100 ^v? # optional leading 'v'
101 (\d*) # major revision not required
102 \. # requires at least one decimal
114 my ($class, $value) = @_;
115 my $self = bless ({}, ref ($class) || $class);
117 if ( not defined $value or $value =~ /^undef$/ ) {
118 # RT #19517 - special case for undef comparison
119 # or someone forgot to pass a value
120 push @{$self->{version}}, 0;
124 if ( $#_ == 2 ) { # must be CVS-style
129 if ( $] >= 5.006_002 && length($value) >= 3 && $value !~ /[._]/ ) {
130 my $tvalue = sprintf("%vd",$value);
131 if ( $tvalue =~ /^\d+\.\d+\.\d+$/ ) {
137 # This is not very efficient, but it is morally equivalent
138 # to the XS code (as that is the reference implementation).
139 # See vutil/vutil.c for details
144 my ($start, $last, $pos, $s);
147 while ( substr($value,$s,1) =~ /\s/ ) { # leading whitespace is OK
151 if (substr($value,$s,1) eq 'v') {
153 $qv = 1; # force quoted version processing
156 $start = $last = $pos = $s;
158 # pre-scan the input string to check for decimals/underbars
159 while ( substr($value,$pos,1) =~ /[._\d]/ ) {
160 if ( substr($value,$pos,1) eq '.' ) {
161 die "Invalid version format (underscores before decimal)"
166 elsif ( substr($value,$pos,1) eq '_' ) {
167 die "Invalid version format (multiple underscores)"
170 $width = $pos - $last - 1; # natural width of sub-version
175 if ( $alpha && !$saw_period ) {
176 die "Invalid version format (alpha without decimal)";
179 if ( $saw_period > 1 ) {
180 $qv = 1; # force quoted version processing
193 if ( !$qv && $width < 3 ) {
194 $self->{width} = $width;
197 while ( substr($value,$pos,1) =~ /\d/ ) {
201 if ( substr($value,$pos,1) !~ /[a-z]/ ) { ### FIX THIS ###
208 # this is atoi() that delimits on underscores
213 # the following if() will only be true after the decimal
214 # point of a version originally created with a bare
215 # floating point number, i.e. not quoted in any way
216 if ( !$qv && $s > $start && $saw_period == 1 ) {
218 while ( $s < $end ) {
220 $rev += substr($value,$s,1) * $mult;
222 if ( abs($orev) > abs($rev) ) {
223 die "Integer overflow in version";
226 if ( substr($value,$s,1) eq '_' ) {
232 while (--$end >= $s) {
234 $rev += substr($value,$end,1) * $mult;
236 if ( abs($orev) > abs($rev) ) {
237 die "Integer overflow in version";
244 push @{$self->{version}}, $rev;
245 if ( substr($value,$pos,1) eq '.'
246 && substr($value,$pos+1,1) =~ /\d/ ) {
249 elsif ( substr($value,$pos,1) eq '_'
250 && substr($value,$pos+1,1) =~ /\d/ ) {
253 elsif ( substr($value,$pos,1) =~ /\d/ ) {
261 while ( substr($value,$pos,1) =~ /\d/ ) {
267 while (substr($value,$pos,1) =~ /[\d_]/ && $digits < 3) {
268 if ( substr($value,$pos,1) ne '_' ) {
276 if ( $qv ) { # quoted versions always get at least three terms
277 my $len = scalar @{$self->{version}};
280 push @{$self->{version}}, 0;
284 if ( substr($value,$pos) ) { # any remaining text
285 warn "Version string '$value' contains invalid data; ".
286 "ignoring: '".substr($value,$pos)."'";
295 unless (_verify($self)) {
296 die "Invalid version object";
298 my $width = $self->{width} || 3;
299 my $alpha = $self->{alpha} || "";
300 my $len = $#{$self->{version}};
301 my $digit = $self->{version}[0];
302 my $string = sprintf("%d.", $digit );
304 for ( my $i = 1 ; $i < $len ; $i++ ) {
305 $digit = $self->{version}[$i];
307 my $denom = 10**(3-$width);
308 my $quot = int($digit/$denom);
309 my $rem = $digit - ($quot * $denom);
310 $string .= sprintf("%0".$width."d_%d", $quot, $rem);
313 $string .= sprintf("%03d", $digit);
318 $digit = $self->{version}[$len];
319 if ( $alpha && $width == 3 ) {
322 $string .= sprintf("%0".$width."d", $digit);
326 $string .= sprintf("000");
335 unless (_verify($self)) {
336 die "Invalid version object";
338 my $alpha = $self->{alpha} || "";
339 my $len = $#{$self->{version}};
340 my $digit = $self->{version}[0];
341 my $string = sprintf("v%d", $digit );
343 for ( my $i = 1 ; $i < $len ; $i++ ) {
344 $digit = $self->{version}[$i];
345 $string .= sprintf(".%d", $digit);
349 $digit = $self->{version}[$len];
351 $string .= sprintf("_%0d", $digit);
354 $string .= sprintf(".%0d", $digit);
359 for ( $len = 2 - $len; $len != 0; $len-- ) {
360 $string .= sprintf(".%0d", 0);
370 unless (_verify($self)) {
371 die "Invalid version object";
373 if ( exists $self->{qv} ) {
374 return $self->normal;
377 return $self->numify;
384 my ($left,$right,$swap) = @_;
385 my $class = ref($left);
386 unless ( UNIVERSAL::isa($right, $class) ) {
387 $right = $class->new($right);
391 ($left, $right) = ($right, $left);
393 unless (_verify($left)) {
394 die "Invalid version object";
396 unless (_verify($right)) {
397 die "Invalid version object";
399 my $l = $#{$left->{version}};
400 my $r = $#{$right->{version}};
401 my $m = $l < $r ? $l : $r;
402 my $lalpha = $left->is_alpha;
403 my $ralpha = $right->is_alpha;
406 while ( $i <= $m && $retval == 0 ) {
407 $retval = $left->{version}[$i] <=> $right->{version}[$i];
411 # tiebreaker for alpha with identical terms
414 && $left->{version}[$m] == $right->{version}[$m]
415 && ( $lalpha || $ralpha ) ) {
417 if ( $lalpha && !$ralpha ) {
420 elsif ( $ralpha && !$lalpha) {
425 # possible match except for trailing 0's
426 if ( $retval == 0 && $l != $r ) {
428 while ( $i <= $r && $retval == 0 ) {
429 if ( $right->{version}[$i] != 0 ) {
430 $retval = -1; # not a match after all
436 while ( $i <= $l && $retval == 0 ) {
437 if ( $left->{version}[$i] != 0 ) {
438 $retval = +1; # not a match after all
450 return (exists $self->{alpha});
456 if ( $value =~ /\d+e-?\d+/ ) { # exponential notation
457 $value = sprintf("%.9f",$value);
461 my $eval = eval 'Scalar::Util::isvstring($value)';
462 if ( !$@ and $eval ) {
463 $value = sprintf("v%vd",$value);
466 $value = 'v'.$value unless $value =~ /^v/;
468 return version->new($value); # always use base class
473 if ( Scalar::Util::reftype($self) eq 'HASH'
474 && exists $self->{version}
475 && ref($self->{version}) eq 'ARRAY'
484 # Thanks to Yitzchak Scott-Thoennes for this mode of operation
487 *UNIVERSAL::VERSION = sub {
488 my ($obj, $req) = @_;
489 my $class = ref($obj) || $obj;
492 eval "require $class" unless %{"$class\::"}; # already existing
493 die "$class defines neither package nor VERSION--version check failed"
494 if $@ or not %{"$class\::"};
496 my $version = eval "\$$class\::VERSION";
497 if ( defined $version ) {
498 $version = version::vpp->new($version);
501 if ( defined $req ) {
502 if ( $req =~ /\d+e-?\d+/ ) { # exponential notation
503 $req = sprintf("%.9f",$req);
506 unless ( defined $version ) {
507 my $msg = "$class does not define ".
508 "\$$class\::VERSION--version check failed";
509 if ( $ENV{VERSION_DEBUG} ) {
518 $req = version::vpp->new($req);
520 if ( $req > $version ) {
521 die sprintf ("%s version %s (%s) required--".
522 "this is only version %s (%s)", $class,
523 $req->numify, $req->normal,
524 $version->numify, $version->normal);
528 return defined $version ? $version->numify : undef;
532 1; #this line is important and will help the module return a true value