'""'
=> \
&thischar
,
'0+'
=> \
&thischar
,
'++'
=> \
&increment
,
'--'
=> \
&decrement
,
'+'
=> \
&plus
,
'-'
=> \
&minus
,
'*'
=> \
&multiply
,
'cmp'
=> \
&cmp
,
'<=>'
=> \
&spaceship
,
'bool'
=> \
&thischar
,
'='
=> \
&clone
,
);
sub
new {
my
(
$self
,
$string
) =
@_
;
my
$class
=
ref
(
$self
) ||
$self
;
my
$obj
= {
string
=> [
split
(//,
$string
)],
current
=> 0,
};
return
bless
$obj
,
$class
;
}
sub
thischar {
my
(
$self
) =
@_
;
my
$last
= $
my
$curr
=
$self
->{current};
if
(
$curr
>= 0 &&
$curr
<=
$last
) {
return
$self
->{string}->[
$curr
];
}
else
{
return
''
;
}
}
sub
increment {
my
(
$self
) =
@_
;
$self
->{current}++;
}
sub
decrement {
my
(
$self
) =
@_
;
$self
->{current}--;
}
sub
plus {
my
(
$self
,
$offset
) =
@_
;
my
$rself
=
$self
->clone;
$rself
->{current} +=
$offset
;
return
$rself
;
}
sub
minus {
my
(
$self
,
$offset
) =
@_
;
my
$rself
=
$self
->clone;
$rself
->{current} -=
$offset
;
return
$rself
;
}
sub
multiply {
my
(
$left
,
$right
,
$swapped
) =
@_
;
my
$char
=
$left
->thischar();
return
$char
*
$right
;
}
sub
spaceship {
my
(
$left
,
$right
,
$swapped
) =
@_
;
unless
(
ref
(
$right
)) {
$right
=
$left
->new(
$right
);
}
return
$left
->{current} <=>
$right
->{current};
}
sub
cmp {
my
(
$left
,
$right
,
$swapped
) =
@_
;
unless
(
ref
(
$right
)) {
if
(
length
(
$right
) == 1) {
return
$left
->thischar cmp
$right
;
}
$right
=
$left
->new(
$right
);
}
return
$left
->currstr cmp
$right
->currstr;
}
sub
bool {
my
(
$self
) =
@_
;
my
$char
=
$self
->thischar;
return
(
$char
ne
''
);
}
sub
clone {
my
(
$left
,
$right
,
$swapped
) =
@_
;
$right
= {
string
=> [@{
$left
->{string}}],
current
=>
$left
->{current},
};
return
bless
$right
,
ref
(
$left
);
}
sub
currstr {
my
(
$self
,
$s
) =
@_
;
my
$curr
=
$self
->{current};
my
$last
= $
if
(
defined
(
$s
) &&
$s
->{current} <
$last
) {
$last
=
$s
->{current};
}
my
$string
=
join
(
''
, @{
$self
->{string}}[
$curr
..
$last
]);
return
$string
;
}
use
5.006001;
use
vars
qw($VERSION $CLASS @ISA $LAX $STRICT)
;
$VERSION
=
'7.71_02'
;
$VERSION
=~
tr
/_//d;
$CLASS
=
'ExtUtils::MakeMaker::version::vpp'
;
*ExtUtils::MakeMaker::version::vpp::is_strict
= \
&ExtUtils::MakeMaker::version::regex::is_strict
;
*ExtUtils::MakeMaker::version::vpp::is_lax
= \
&ExtUtils::MakeMaker::version::regex::is_lax
;
*LAX
= \
$ExtUtils::MakeMaker::version::regex::LAX
;
*STRICT
= \
$ExtUtils::MakeMaker::version::regex::STRICT
;
'""'
=> \
&stringify
,
'0+'
=> \
&numify
,
'cmp'
=> \
&vcmp
,
'<=>'
=> \
&vcmp
,
'bool'
=> \
&vbool
,
'+'
=> \
&vnoop
,
'-'
=> \
&vnoop
,
'*'
=> \
&vnoop
,
'/'
=> \
&vnoop
,
'+='
=> \
&vnoop
,
'-='
=> \
&vnoop
,
'*='
=> \
&vnoop
,
'/='
=> \
&vnoop
,
'abs'
=> \
&vnoop
,
);
eval
"use warnings"
;
if
($@) {
eval
'
package
warnings;
sub
enabled {
return
$^W;}
1;
';
}
sub
import
{
no
strict
'refs'
;
my
(
$class
) =
shift
;
unless
(
$class
eq
$CLASS
) {
no
warnings;
*{
$class
.
'::declare'
} = \&{
$CLASS
.
'::declare'
};
*{
$class
.
'::qv'
} = \&{
$CLASS
.
'::qv'
};
}
my
%args
;
if
(
@_
) {
map
{
$args
{
$_
} = 1 }
@_
}
else
{
%args
=
(
qv
=> 1,
'UNIVERSAL::VERSION'
=> 1,
);
}
my
$callpkg
=
caller
();
if
(
exists
(
$args
{declare})) {
*{
$callpkg
.
'::declare'
} =
sub
{
return
$class
->declare(
shift
) }
unless
defined
(&{
$callpkg
.
'::declare'
});
}
if
(
exists
(
$args
{qv})) {
*{
$callpkg
.
'::qv'
} =
sub
{
return
$class
->qv(
shift
) }
unless
defined
(&{
$callpkg
.
'::qv'
});
}
if
(
exists
(
$args
{
'UNIVERSAL::VERSION'
})) {
no
warnings;
*UNIVERSAL::VERSION
= \&{
$CLASS
.
'::_VERSION'
};
}
if
(
exists
(
$args
{
'VERSION'
})) {
*{
$callpkg
.
'::VERSION'
} = \&{
$CLASS
.
'::_VERSION'
};
}
if
(
exists
(
$args
{
'is_strict'
})) {
*{
$callpkg
.
'::is_strict'
} = \&{
$CLASS
.
'::is_strict'
}
unless
defined
(&{
$callpkg
.
'::is_strict'
});
}
if
(
exists
(
$args
{
'is_lax'
})) {
*{
$callpkg
.
'::is_lax'
} = \&{
$CLASS
.
'::is_lax'
}
unless
defined
(&{
$callpkg
.
'::is_lax'
});
}
}
my
$VERSION_MAX
= 0x7FFFFFFF;
sub
isDIGIT {
my
(
$char
) =
shift
->thischar();
return
(
$char
=~ /\d/);
}
sub
isALPHA {
my
(
$char
) =
shift
->thischar();
return
(
$char
=~ /[a-zA-Z]/);
}
sub
isSPACE {
my
(
$char
) =
shift
->thischar();
return
(
$char
=~ /\s/);
}
sub
BADVERSION {
my
(
$s
,
$errstr
,
$error
) =
@_
;
if
(
$errstr
) {
$$errstr
=
$error
;
}
return
$s
;
}
sub
prescan_version {
my
(
$s
,
$strict
,
$errstr
,
$sqv
,
$ssaw_decimal
,
$swidth
,
$salpha
) =
@_
;
my
$qv
=
defined
$sqv
?
$$sqv
: FALSE;
my
$saw_decimal
=
defined
$ssaw_decimal
?
$$ssaw_decimal
: 0;
my
$width
=
defined
$swidth
?
$$swidth
: 3;
my
$alpha
=
defined
$salpha
?
$$salpha
: FALSE;
my
$d
=
$s
;
if
(
$qv
&& isDIGIT(
$d
)) {
goto
dotted_decimal_version;
}
if
(
$d
eq
'v'
) {
$d
++;
if
(isDIGIT(
$d
)) {
$qv
= TRUE;
}
else
{
return
BADVERSION(
$s
,
$errstr
,
"Invalid version format (dotted-decimal versions require at least three parts)"
);
}
dotted_decimal_version:
if
(
$strict
&&
$d
eq
'0'
&& isDIGIT(
$d
+1)) {
return
BADVERSION(
$s
,
$errstr
,
"Invalid version format (no leading zeros)"
);
}
while
(isDIGIT(
$d
)) {
$d
++;
}
if
(
$d
eq
'.'
)
{
$saw_decimal
++;
$d
++;
}
else
{
if
(
$strict
) {
return
BADVERSION(
$s
,
$errstr
,
"Invalid version format (dotted-decimal versions require at least three parts)"
);
}
else
{
goto
version_prescan_finish;
}
}
{
my
$i
= 0;
my
$j
= 0;
while
(isDIGIT(
$d
)) {
$i
++;
while
(isDIGIT(
$d
)) {
$d
++;
$j
++;
if
(
$strict
&&
$j
> 3) {
return
BADVERSION(
$s
,
$errstr
,
"Invalid version format (maximum 3 digits between decimals)"
);
}
}
if
(
$d
eq
'_'
) {
if
(
$strict
) {
return
BADVERSION(
$s
,
$errstr
,
"Invalid version format (no underscores)"
);
}
if
(
$alpha
) {
return
BADVERSION(
$s
,
$errstr
,
"Invalid version format (multiple underscores)"
);
}
$d
++;
$alpha
= TRUE;
}
elsif
(
$d
eq
'.'
) {
if
(
$alpha
) {
return
BADVERSION(
$s
,
$errstr
,
"Invalid version format (underscores before decimal)"
);
}
$saw_decimal
++;
$d
++;
}
elsif
(!isDIGIT(
$d
)) {
last
;
}
$j
= 0;
}
if
(
$strict
&&
$i
< 2) {
return
BADVERSION(
$s
,
$errstr
,
"Invalid version format (dotted-decimal versions require at least three parts)"
);
}
}
}
else
{
my
$j
= 0;
if
(
$strict
) {
if
(
$d
eq
'.'
) {
return
BADVERSION(
$s
,
$errstr
,
"Invalid version format (0 before decimal required)"
);
}
if
(
$d
eq
'0'
&& isDIGIT(
$d
+1)) {
return
BADVERSION(
$s
,
$errstr
,
"Invalid version format (no leading zeros)"
);
}
}
if
(
$d
eq
'-'
) {
return
BADVERSION(
$s
,
$errstr
,
"Invalid version format (negative version number)"
);
}
while
(isDIGIT(
$d
)) {
$d
++;
}
if
(
$d
eq
'.'
) {
$saw_decimal
++;
$d
++;
}
elsif
(!
$d
||
$d
eq
';'
|| isSPACE(
$d
) ||
$d
eq
'}'
) {
if
(
$d
==
$s
) {
return
BADVERSION(
$s
,
$errstr
,
"Invalid version format (version required)"
);
}
goto
version_prescan_finish;
}
elsif
(
$d
==
$s
) {
return
BADVERSION(
$s
,
$errstr
,
"Invalid version format (non-numeric data)"
);
}
elsif
(
$d
eq
'_'
) {
if
(
$strict
) {
return
BADVERSION(
$s
,
$errstr
,
"Invalid version format (no underscores)"
);
}
elsif
(isDIGIT(
$d
+1)) {
return
BADVERSION(
$s
,
$errstr
,
"Invalid version format (alpha without decimal)"
);
}
else
{
return
BADVERSION(
$s
,
$errstr
,
"Invalid version format (misplaced underscore)"
);
}
}
elsif
(
$d
) {
return
BADVERSION(
$s
,
$errstr
,
"Invalid version format (non-numeric data)"
);
}
if
(
$d
&& !isDIGIT(
$d
) && (
$strict
|| ! (
$d
eq
';'
|| isSPACE(
$d
) ||
$d
eq
'}'
) )) {
return
BADVERSION(
$s
,
$errstr
,
"Invalid version format (fractional part required)"
);
}
while
(isDIGIT(
$d
)) {
$d
++;
$j
++;
if
(
$d
eq
'.'
&& isDIGIT(
$d
-1)) {
if
(
$alpha
) {
return
BADVERSION(
$s
,
$errstr
,
"Invalid version format (underscores before decimal)"
);
}
if
(
$strict
) {
return
BADVERSION(
$s
,
$errstr
,
"Invalid version format (dotted-decimal versions must begin with 'v')"
);
}
$d
=
$s
;
$qv
= TRUE;
goto
dotted_decimal_version;
}
if
(
$d
eq
'_'
) {
if
(
$strict
) {
return
BADVERSION(
$s
,
$errstr
,
"Invalid version format (no underscores)"
);
}
if
(
$alpha
) {
return
BADVERSION(
$s
,
$errstr
,
"Invalid version format (multiple underscores)"
);
}
if
( ! isDIGIT(
$d
+1) ) {
return
BADVERSION(
$s
,
$errstr
,
"Invalid version format (misplaced underscore)"
);
}
$width
=
$j
;
$d
++;
$alpha
= TRUE;
}
}
}
version_prescan_finish:
while
(isSPACE(
$d
)) {
$d
++;
}
if
(
$d
&& !isDIGIT(
$d
) && (! (
$d
eq
';'
||
$d
eq
'}'
) )) {
return
BADVERSION(
$s
,
$errstr
,
"Invalid version format (non-numeric data)"
);
}
if
(
defined
$sqv
) {
$$sqv
=
$qv
;
}
if
(
defined
$swidth
) {
$$swidth
=
$width
;
}
if
(
defined
$ssaw_decimal
) {
$$ssaw_decimal
=
$saw_decimal
;
}
if
(
defined
$salpha
) {
$$salpha
=
$alpha
;
}
return
$d
;
}
sub
scan_version {
my
(
$s
,
$rv
,
$qv
) =
@_
;
my
$start
;
my
$pos
;
my
$last
;
my
$errstr
;
my
$saw_decimal
= 0;
my
$width
= 3;
my
$alpha
= FALSE;
my
$vinf
= FALSE;
my
@av
;
$s
= new ExtUtils::MakeMaker::charstar
$s
;
while
(isSPACE(
$s
)) {
$s
++;
}
$last
= prescan_version(
$s
, FALSE, \
$errstr
, \
$qv
, \
$saw_decimal
,
\
$width
, \
$alpha
);
if
(
$errstr
) {
if
(
$s
ne
'undef'
) {
Carp::croak(
$errstr
);
}
}
$start
=
$s
;
if
(
$s
eq
'v'
) {
$s
++;
}
$pos
=
$s
;
if
(
$qv
) {
$$rv
->{qv} =
$qv
;
}
if
(
$alpha
) {
$$rv
->{alpha} =
$alpha
;
}
if
( !
$qv
&&
$width
< 3 ) {
$$rv
->{width} =
$width
;
}
while
(isDIGIT(
$pos
)) {
$pos
++;
}
if
(!isALPHA(
$pos
)) {
my
$rev
;
for
(;;) {
$rev
= 0;
{
my
$end
=
$pos
;
my
$mult
= 1;
my
$orev
;
if
( !
$qv
&&
$s
>
$start
&&
$saw_decimal
== 1 ) {
$mult
*= 100;
while
(
$s
<
$end
) {
$orev
=
$rev
;
$rev
+=
$s
*
$mult
;
$mult
/= 10;
if
( (
abs
(
$orev
) >
abs
(
$rev
))
|| (
abs
(
$rev
) >
$VERSION_MAX
)) {
warn
(
"Integer overflow in version %d"
,
$VERSION_MAX
);
$s
=
$end
- 1;
$rev
=
$VERSION_MAX
;
$vinf
= 1;
}
$s
++;
if
(
$s
eq
'_'
) {
$s
++;
}
}
}
else
{
while
(--
$end
>=
$s
) {
$orev
=
$rev
;
$rev
+=
$end
*
$mult
;
$mult
*= 10;
if
( (
abs
(
$orev
) >
abs
(
$rev
))
|| (
abs
(
$rev
) >
$VERSION_MAX
)) {
warn
(
"Integer overflow in version"
);
$end
=
$s
- 1;
$rev
=
$VERSION_MAX
;
$vinf
= 1;
}
}
}
}
push
@av
,
$rev
;
if
(
$vinf
) {
$s
=
$last
;
last
;
}
elsif
(
$pos
eq
'.'
) {
$s
= ++
$pos
;
}
elsif
(
$pos
eq
'_'
&& isDIGIT(
$pos
+1) ) {
$s
= ++
$pos
;
}
elsif
(
$pos
eq
','
&& isDIGIT(
$pos
+1) ) {
$s
= ++
$pos
;
}
elsif
( isDIGIT(
$pos
) ) {
$s
=
$pos
;
}
else
{
$s
=
$pos
;
last
;
}
if
(
$qv
) {
while
( isDIGIT(
$pos
) ) {
$pos
++;
}
}
else
{
my
$digits
= 0;
while
( ( isDIGIT(
$pos
) ||
$pos
eq
'_'
) &&
$digits
< 3 ) {
if
(
$pos
ne
'_'
) {
$digits
++;
}
$pos
++;
}
}
}
}
if
(
$qv
) {
my
$len
=
$#av
;
$len
= 2 -
$len
;
while
(
$len
-- > 0) {
push
@av
, 0;
}
}
if
(
$vinf
) {
$$rv
->{original} =
"v.Inf"
;
$$rv
->{vinf} = 1;
}
elsif
(
$s
>
$start
) {
$$rv
->{original} =
$start
->currstr(
$s
);
if
(
$qv
&&
$saw_decimal
== 1 &&
$start
ne
'v'
) {
$$rv
->{original} =
'v'
.
$$rv
->{original};
}
}
else
{
$$rv
->{original} =
'0'
;
push
(
@av
, 0);
}
$$rv
->{version} = \
@av
;
if
(
$s
eq
'undef'
) {
$s
+= 5;
}
return
$s
;
}
sub
new {
my
$class
=
shift
;
unless
(
defined
$class
or
$#_
> 1) {
Carp::croak(
'Usage: version::new(class, version)'
);
}
my
$self
=
bless
({},
ref
(
$class
) ||
$class
);
my
$qv
= FALSE;
if
(
$#_
== 1 ) { # must be CVS-style
$qv
= TRUE;
}
my
$value
=
pop
;
if
(
ref
(
$value
) &&
eval
(
'$value->isa("version")'
) ) {
$self
->{version} = [ @{
$value
->{version} } ];
$self
->{qv} = 1
if
$value
->{qv};
$self
->{alpha} = 1
if
$value
->{alpha};
$self
->{original} =
''
.
$value
->{original};
return
$self
;
}
if
( not
defined
$value
or
$value
=~ /^
undef
$/ ) {
push
@{
$self
->{version}}, 0;
$self
->{original} =
"0"
;
return
(
$self
);
}
if
(
ref
(
$value
) =~ m/ARRAY|HASH/) {
Carp::croak(
"Invalid version format (non-numeric data)"
);
}
$value
= _un_vstring(
$value
);
if
(
$Config
{d_setlocale} &&
eval
{
require
POSIX } ) {
my
$currlocale
= POSIX::setlocale(
&POSIX::LC_ALL
);
if
( POSIX::localeconv()->{decimal_point} eq
','
) {
$value
=~
tr
/,/./;
}
}
if
(
$value
=~ /\d+.?\d
*e
[-+]?\d+/ ) {
$value
=
sprintf
(
"%.9f"
,
$value
);
$value
=~ s/(0+)$//;
}
my
$s
= scan_version(
$value
, \
$self
,
$qv
);
if
(
$s
) {
warn
(
"Version string '%s' contains invalid data; "
.
"ignoring: '%s'"
,
$value
,
$s
);
}
return
(
$self
);
}
*parse
= \
&new
;
sub
numify {
my
(
$self
) =
@_
;
unless
(_verify(
$self
)) {
Carp::croak(
"Invalid version object"
);
}
my
$width
=
$self
->{width} || 3;
my
$alpha
=
$self
->{alpha} ||
""
;
my
$len
= $
my
$digit
=
$self
->{version}[0];
my
$string
=
sprintf
(
"%d."
,
$digit
);
for
(
my
$i
= 1 ;
$i
<
$len
;
$i
++ ) {
$digit
=
$self
->{version}[
$i
];
if
(
$width
< 3 ) {
my
$denom
= 10**(3-
$width
);
my
$quot
=
int
(
$digit
/
$denom
);
my
$rem
=
$digit
- (
$quot
*
$denom
);
$string
.=
sprintf
(
"%0"
.
$width
.
"d_%d"
,
$quot
,
$rem
);
}
else
{
$string
.=
sprintf
(
"%03d"
,
$digit
);
}
}
if
(
$len
> 0 ) {
$digit
=
$self
->{version}[
$len
];
if
(
$alpha
&&
$width
== 3 ) {
$string
.=
"_"
;
}
$string
.=
sprintf
(
"%0"
.
$width
.
"d"
,
$digit
);
}
else
{
$string
.=
sprintf
(
"000"
);
}
return
$string
;
}
sub
normal {
my
(
$self
) =
@_
;
unless
(_verify(
$self
)) {
Carp::croak(
"Invalid version object"
);
}
my
$alpha
=
$self
->{alpha} ||
""
;
my
$len
= $
my
$digit
=
$self
->{version}[0];
my
$string
=
sprintf
(
"v%d"
,
$digit
);
for
(
my
$i
= 1 ;
$i
<
$len
;
$i
++ ) {
$digit
=
$self
->{version}[
$i
];
$string
.=
sprintf
(
".%d"
,
$digit
);
}
if
(
$len
> 0 ) {
$digit
=
$self
->{version}[
$len
];
if
(
$alpha
) {
$string
.=
sprintf
(
"_%0d"
,
$digit
);
}
else
{
$string
.=
sprintf
(
".%0d"
,
$digit
);
}
}
if
(
$len
<= 2 ) {
for
(
$len
= 2 -
$len
;
$len
!= 0;
$len
-- ) {
$string
.=
sprintf
(
".%0d"
, 0);
}
}
return
$string
;
}
sub
stringify {
my
(
$self
) =
@_
;
unless
(_verify(
$self
)) {
Carp::croak(
"Invalid version object"
);
}
return
exists
$self
->{original}
?
$self
->{original}
:
exists
$self
->{qv}
?
$self
->normal
:
$self
->numify;
}
sub
vcmp {
my
(
$left
,
$right
,
$swap
) =
@_
;
my
$class
=
ref
(
$left
);
unless
( UNIVERSAL::isa(
$right
,
$class
) ) {
$right
=
$class
->new(
$right
);
}
if
(
$swap
) {
(
$left
,
$right
) = (
$right
,
$left
);
}
unless
(_verify(
$left
)) {
Carp::croak(
"Invalid version object"
);
}
unless
(_verify(
$right
)) {
Carp::croak(
"Invalid version format"
);
}
my
$l
= $
my
$r
= $
my
$m
=
$l
<
$r
?
$l
:
$r
;
my
$lalpha
=
$left
->is_alpha;
my
$ralpha
=
$right
->is_alpha;
my
$retval
= 0;
my
$i
= 0;
while
(
$i
<=
$m
&&
$retval
== 0 ) {
$retval
=
$left
->{version}[
$i
] <=>
$right
->{version}[
$i
];
$i
++;
}
if
(
$retval
== 0
&&
$l
==
$r
&&
$left
->{version}[
$m
] ==
$right
->{version}[
$m
]
&& (
$lalpha
||
$ralpha
) ) {
if
(
$lalpha
&& !
$ralpha
) {
$retval
= -1;
}
elsif
(
$ralpha
&& !
$lalpha
) {
$retval
= +1;
}
}
if
(
$retval
== 0 &&
$l
!=
$r
) {
if
(
$l
<
$r
) {
while
(
$i
<=
$r
&&
$retval
== 0 ) {
if
(
$right
->{version}[
$i
] != 0 ) {
$retval
= -1;
}
$i
++;
}
}
else
{
while
(
$i
<=
$l
&&
$retval
== 0 ) {
if
(
$left
->{version}[
$i
] != 0 ) {
$retval
= +1;
}
$i
++;
}
}
}
return
$retval
;
}
sub
vbool {
my
(
$self
) =
@_
;
return
vcmp(
$self
,
$self
->new(
"0"
),1);
}
sub
vnoop {
Carp::croak(
"operation not supported with version object"
);
}
sub
is_alpha {
my
(
$self
) =
@_
;
return
(
exists
$self
->{alpha});
}
sub
qv {
my
$value
=
shift
;
my
$class
=
$CLASS
;
if
(
@_
) {
$class
=
ref
(
$value
) ||
$value
;
$value
=
shift
;
}
$value
= _un_vstring(
$value
);
$value
=
'v'
.
$value
unless
$value
=~ /(^v|\d+\.\d+\.\d)/;
my
$obj
=
$CLASS
->new(
$value
);
return
bless
$obj
,
$class
;
}
*declare
= \
&qv
;
sub
is_qv {
my
(
$self
) =
@_
;
return
(
exists
$self
->{qv});
}
sub
_verify {
my
(
$self
) =
@_
;
if
(
ref
(
$self
)
&&
eval
{
exists
$self
->{version} }
&&
ref
(
$self
->{version}) eq
'ARRAY'
) {
return
1;
}
else
{
return
0;
}
}
sub
_is_non_alphanumeric {
my
$s
=
shift
;
$s
= new ExtUtils::MakeMaker::charstar
$s
;
while
(
$s
) {
return
0
if
isSPACE(
$s
);
return
1
unless
(isALPHA(
$s
) || isDIGIT(
$s
) ||
$s
=~ /[.-]/);
$s
++;
}
return
0;
}
sub
_un_vstring {
my
$value
=
shift
;
if
(
length
(
$value
) >= 3 &&
$value
!~ /[._]/
&& _is_non_alphanumeric(
$value
)) {
my
$tvalue
;
if
(
"$]"
>= 5.008_001 ) {
$tvalue
= _find_magic_vstring(
$value
);
$value
=
$tvalue
if
length
$tvalue
;
}
elsif
(
"$]"
>= 5.006_000 ) {
$tvalue
=
sprintf
(
"v%vd"
,
$value
);
if
(
$tvalue
=~ /^v\d+(\.\d+){2,}$/ ) {
$value
=
$tvalue
;
}
}
}
return
$value
;
}
sub
_find_magic_vstring {
my
$value
=
shift
;
my
$tvalue
=
''
;
my
$sv
= B::svref_2object(\
$value
);
my
$magic
=
ref
(
$sv
) eq
'B::PVMG'
?
$sv
->MAGIC :
undef
;
while
(
$magic
) {
if
(
$magic
->TYPE eq
'V'
) {
$tvalue
=
$magic
->PTR;
$tvalue
=~ s/^v?(.+)$/v$1/;
last
;
}
else
{
$magic
=
$magic
->MOREMAGIC;
}
}
return
$tvalue
;
}
sub
_VERSION {
my
(
$obj
,
$req
) =
@_
;
my
$class
=
ref
(
$obj
) ||
$obj
;
no
strict
'refs'
;
if
(
exists
$INC
{
"$class.pm"
} and not %{
"$class\::"
} and
"$]"
>= 5.008) {
Carp::croak(
"$class defines neither package nor VERSION"
.
"--version check failed"
);
}
my
$version
=
eval
"\$$class\::VERSION"
;
if
(
defined
$version
) {
local
$^W
if
"$]"
<= 5.008;
$version
= ExtUtils::MakeMaker::version::vpp->new(
$version
);
}
if
(
defined
$req
) {
unless
(
defined
$version
) {
my
$msg
=
"$]"
< 5.006
?
"$class version $req required--this is only version "
:
"$class does not define \$$class\::VERSION"
.
"--version check failed"
;
if
(
$ENV
{VERSION_DEBUG} ) {
Carp::confess(
$msg
);
}
else
{
Carp::croak(
$msg
);
}
}
$req
= ExtUtils::MakeMaker::version::vpp->new(
$req
);
if
(
$req
>
$version
) {
if
(
$req
->is_qv ) {
Carp::croak(
sprintf
(
"%s version %s required--"
.
"this is only version %s"
,
$class
,
$req
->normal,
$version
->normal)
);
}
else
{
Carp::croak(
sprintf
(
"%s version %s required--"
.
"this is only version %s"
,
$class
,
$req
->stringify,
$version
->stringify)
);
}
}
}
return
defined
$version
?
$version
->stringify :
undef
;
}
1;