1 package Module::Build::Version;
7 eval "use version $VERSION";
8 if ($@) { # can't locate version files, use our own
10 # Avoid redefined warnings if an old version.pm was available
11 delete $version::{$_} foreach keys %version::;
13 # first we get the stub version module
16 s/(\$VERSION)\s=\s\d+/\$VERSION = 0/;
21 # and now get the current version::vpp code
24 s/(\$VERSION)\s=\s\d+/\$VERSION = 0/;
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';
37 # now we can safely subclass version, installed or not
43 # stub version module to make everything else happy
49 use vars qw(@ISA $VERSION $CLASS *declare *qv);
55 push @ISA, "version::vpp";
57 *version::qv = \&version::vpp::qv;
58 *version::declare = \&version::vpp::declare;
59 *version::_VERSION = \&version::vpp::_VERSION;
60 if ($] > 5.009001 && $] <= 5.010000) {
62 *{'version::stringify'} = \*version::vpp::stringify;
63 *{'version::(""'} = \*version::vpp::stringify;
64 *{'version::new'} = \*version::vpp::new;
67 # Preloaded methods go here.
72 # Set up any derived class
73 unless ($class eq 'version') {
75 *{$class.'::declare'} = \&version::declare;
76 *{$class.'::qv'} = \&version::qv;
80 if (@_) { # any remaining terms are arguments
81 map { $args{$_} = 1 } @_
83 else { # no parameters at all on use line
87 'UNIVERSAL::VERSION' => 1,
91 my $callpkg = caller();
93 if (exists($args{declare})) {
94 *{$callpkg."::declare"} =
95 sub {return $class->declare(shift) }
96 unless defined(&{$callpkg.'::declare'});
99 if (exists($args{qv})) {
101 sub {return $class->qv(shift) }
102 unless defined(&{"$callpkg\::qv"});
105 if (exists($args{'UNIVERSAL::VERSION'})) {
107 *UNIVERSAL::VERSION = \&version::_VERSION;
110 if (exists($args{'VERSION'})) {
111 *{$callpkg."::VERSION"} = \&version::_VERSION;
117 # replace everything from here to the end with the current version/vpp.pm
118 package version::vpp;
121 use POSIX qw/locale_h/;
123 use vars qw ($VERSION @ISA @REGEXS);
125 $VERSION = eval $VERSION;
128 ^v? # optional leading 'v'
129 (\d*) # major revision not required
130 \. # requires at least one decimal
140 'nomethod' => \&vnoop,
143 my $VERSION_MAX = 0x7FFFFFFF;
149 sub enabled {return $^W;}
156 my ($class, $value) = @_;
157 my $self = bless ({}, ref ($class) || $class);
159 if ( ref($value) && eval('$value->isa("version")') ) {
160 # Can copy the elements directly
161 $self->{version} = [ @{$value->{version} } ];
162 $self->{qv} = 1 if $value->{qv};
163 $self->{alpha} = 1 if $value->{alpha};
164 $self->{original} = ''.$value->{original};
168 my $currlocale = setlocale(LC_ALL);
170 # if the current locale uses commas for decimal points, we
171 # just replace commas with decimal places, rather than changing
173 if ( localeconv()->{decimal_point} eq ',' ) {
177 if ( not defined $value or $value =~ /^undef$/ ) {
178 # RT #19517 - special case for undef comparison
179 # or someone forgot to pass a value
180 push @{$self->{version}}, 0;
181 $self->{original} = "0";
185 if ( $#_ == 2 ) { # must be CVS-style
189 $value = _un_vstring($value);
191 # exponential notation
192 if ( $value =~ /\d+.?\d*e[-+]?\d+/ ) {
193 $value = sprintf("%.9f",$value);
194 $value =~ s/(0+)$//; # trim trailing zeros
197 # This is not very efficient, but it is morally equivalent
198 # to the XS code (as that is the reference implementation).
199 # See vutil/vutil.c for details
205 my ($start, $last, $pos, $s);
208 while ( substr($value,$s,1) =~ /\s/ ) { # leading whitespace is OK
212 if (substr($value,$s,1) eq 'v') {
214 $qv = 1; # force quoted version processing
217 $start = $last = $pos = $s;
219 # pre-scan the input string to check for decimals/underbars
220 while ( substr($value,$pos,1) =~ /[._\d,]/ ) {
221 if ( substr($value,$pos,1) eq '.' ) {
223 Carp::croak("Invalid version format ".
224 "(underscores before decimal)");
229 elsif ( substr($value,$pos,1) eq '_' ) {
232 Carp::croak("Invalid version format ".
233 "(multiple underscores)");
236 $width = $pos - $last - 1; # natural width of sub-version
238 elsif ( substr($value,$pos,1) eq ','
239 and substr($value,$pos+1,1) =~ /[0-9]/ ) {
240 # looks like an unhandled locale
247 if ( $alpha && !$saw_period ) {
249 Carp::croak("Invalid version format ".
250 "(alpha without decimal)");
253 if ( $alpha && $saw_period && $width == 0 ) {
255 Carp::croak("Invalid version format ".
256 "(misplaced _ in number)");
259 if ( $saw_period > 1 ) {
260 $qv = 1; # force quoted version processing
274 if ( !$qv && $width < 3 ) {
275 $self->{width} = $width;
278 while ( substr($value,$pos,1) =~ /\d/ ) {
282 if ( substr($value,$pos,1) !~ /[a-z]/ ) { ### FIX THIS ###
289 # this is atoi() that delimits on underscores
294 # the following if() will only be true after the decimal
295 # point of a version originally created with a bare
296 # floating point number, i.e. not quoted in any way
297 if ( !$qv && $s > $start && $saw_period == 1 ) {
299 while ( $s < $end ) {
301 $rev += substr($value,$s,1) * $mult;
303 if ( abs($orev) > abs($rev)
304 || abs($rev) > abs($VERSION_MAX) ) {
305 if ( warnings::enabled("overflow") ) {
307 Carp::carp("Integer overflow in version");
313 if ( substr($value,$s,1) eq '_' ) {
319 while (--$end >= $s) {
321 $rev += substr($value,$end,1) * $mult;
323 if ( abs($orev) > abs($rev)
324 || abs($rev) > abs($VERSION_MAX) ) {
325 if ( warnings::enabled("overflow") ) {
327 Carp::carp("Integer overflow in version");
337 push @{$self->{version}}, $rev;
338 if ( substr($value,$pos,1) eq '.'
339 && substr($value,$pos+1,1) =~ /\d/ ) {
342 elsif ( substr($value,$pos,1) eq '_'
343 && substr($value,$pos+1,1) =~ /\d/ ) {
346 elsif ( substr($value,$pos,1) eq ','
347 && substr($value,$pos+1,1) =~ /\d/ ) {
350 elsif ( substr($value,$pos,1) =~ /\d/ ) {
358 while ( substr($value,$pos,1) =~ /\d/ ) {
364 while (substr($value,$pos,1) =~ /[\d_]/ && $digits < 3) {
365 if ( substr($value,$pos,1) ne '_' ) {
373 if ( $qv ) { # quoted versions always get at least three terms
374 my $len = scalar @{$self->{version}};
377 push @{$self->{version}}, 0;
381 if ( substr($value,$pos) ) { # any remaining text
382 if ( warnings::enabled("misc") ) {
384 Carp::carp("Version string '$value' contains invalid data; ".
385 "ignoring: '".substr($value,$pos)."'");
389 # cache the original value for use when stringification
392 $self->{original} = 'v.Inf';
395 $self->{original} = substr($value,0,$pos);
406 unless (_verify($self)) {
408 Carp::croak("Invalid version object");
410 my $width = $self->{width} || 3;
411 my $alpha = $self->{alpha} || "";
412 my $len = $#{$self->{version}};
413 my $digit = $self->{version}[0];
414 my $string = sprintf("%d.", $digit );
416 for ( my $i = 1 ; $i < $len ; $i++ ) {
417 $digit = $self->{version}[$i];
419 my $denom = 10**(3-$width);
420 my $quot = int($digit/$denom);
421 my $rem = $digit - ($quot * $denom);
422 $string .= sprintf("%0".$width."d_%d", $quot, $rem);
425 $string .= sprintf("%03d", $digit);
430 $digit = $self->{version}[$len];
431 if ( $alpha && $width == 3 ) {
434 $string .= sprintf("%0".$width."d", $digit);
438 $string .= sprintf("000");
447 unless (_verify($self)) {
449 Carp::croak("Invalid version object");
451 my $alpha = $self->{alpha} || "";
452 my $len = $#{$self->{version}};
453 my $digit = $self->{version}[0];
454 my $string = sprintf("v%d", $digit );
456 for ( my $i = 1 ; $i < $len ; $i++ ) {
457 $digit = $self->{version}[$i];
458 $string .= sprintf(".%d", $digit);
462 $digit = $self->{version}[$len];
464 $string .= sprintf("_%0d", $digit);
467 $string .= sprintf(".%0d", $digit);
472 for ( $len = 2 - $len; $len != 0; $len-- ) {
473 $string .= sprintf(".%0d", 0);
483 unless (_verify($self)) {
485 Carp::croak("Invalid version object");
487 return exists $self->{original}
497 my ($left,$right,$swap) = @_;
498 my $class = ref($left);
499 unless ( UNIVERSAL::isa($right, $class) ) {
500 $right = $class->new($right);
504 ($left, $right) = ($right, $left);
506 unless (_verify($left)) {
508 Carp::croak("Invalid version object");
510 unless (_verify($right)) {
512 Carp::croak("Invalid version object");
514 my $l = $#{$left->{version}};
515 my $r = $#{$right->{version}};
516 my $m = $l < $r ? $l : $r;
517 my $lalpha = $left->is_alpha;
518 my $ralpha = $right->is_alpha;
521 while ( $i <= $m && $retval == 0 ) {
522 $retval = $left->{version}[$i] <=> $right->{version}[$i];
526 # tiebreaker for alpha with identical terms
529 && $left->{version}[$m] == $right->{version}[$m]
530 && ( $lalpha || $ralpha ) ) {
532 if ( $lalpha && !$ralpha ) {
535 elsif ( $ralpha && !$lalpha) {
540 # possible match except for trailing 0's
541 if ( $retval == 0 && $l != $r ) {
543 while ( $i <= $r && $retval == 0 ) {
544 if ( $right->{version}[$i] != 0 ) {
545 $retval = -1; # not a match after all
551 while ( $i <= $l && $retval == 0 ) {
552 if ( $left->{version}[$i] != 0 ) {
553 $retval = +1; # not a match after all
565 return vcmp($self,$self->new("0"),1);
570 Carp::croak("operation not supported with version object");
575 return (exists $self->{alpha});
580 my $class = 'version';
582 $class = ref($value) || $value;
586 $value = _un_vstring($value);
587 $value = 'v'.$value unless $value =~ /(^v|\d+\.\d+\.\d)/;
588 my $version = $class->new($value);
596 return (exists $self->{qv});
603 && eval { exists $self->{version} }
604 && ref($self->{version}) eq 'ARRAY'
616 if ( $] >= 5.006_000 && length($value) >= 3 && $value !~ /[._]/ ) {
617 my $tvalue = sprintf("v%vd",$value);
618 if ( $tvalue =~ /^v\d+\.\d+\.\d+$/ ) {
627 my ($obj, $req) = @_;
628 my $class = ref($obj) || $obj;
631 if ( exists $INC{"$class.pm"} and not %{"$class\::"} and $] >= 5.008) {
632 # file but no package
634 Carp::croak( "$class defines neither package nor VERSION"
635 ."--version check failed");
638 my $version = eval "\$$class\::VERSION";
639 if ( defined $version ) {
640 local $^W if $] <= 5.008;
641 $version = version::vpp->new($version);
644 if ( defined $req ) {
645 unless ( defined $version ) {
648 ? "$class version $req required--this is only version "
649 : "$class does not define \$$class\::VERSION"
650 ."--version check failed";
652 if ( $ENV{VERSION_DEBUG} ) {
660 $req = version::vpp->new($req);
662 if ( $req > $version ) {
666 sprintf ("%s version %s required--".
667 "this is only version %s", $class,
668 $req->normal, $version->normal)
673 sprintf ("%s version %s required--".
674 "this is only version %s", $class,
675 $req->stringify, $version->stringify)
681 return defined $version ? $version->stringify : undef;
684 1; #this line is important and will help the module return a true value