view release on metacpan or  search on metacpan

src/inc/version/vpp.pm  view on Meta::CPAN

	    $saw_decimal++;
	    $d++; 		# decimal point
	}
	else
	{
	    if ($strict) {
		# require v1.2.3
		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)) {	# just keep reading
		$i++;
		while (isDIGIT($d)) {
		    $d++; $j++;
		    # maximum 3 digits between decimal
		    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) {
		# requires v1.2.3
		return BADVERSION($s,$errstr,"Invalid version format (dotted-decimal versions require at least three parts)");
	    }
	}
    } 					# end if dotted-decimal
    else
    {					# decimal versions
	# special $strict case for leading '.' or '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)");
	    }
	}

	# and we never support negative version numbers
	if ($d eq '-') {
	    return BADVERSION($s,$errstr,"Invalid version format (negative version number)");
	}

	# consume all of the integer part
	while (isDIGIT($d)) {
	    $d++;
	}

	# look for a fractional part
	if ($d eq '.') {
	    # we found it, so consume it
	    $saw_decimal++;
	    $d++;
	}
	elsif (!$d || $d eq ';' || isSPACE($d) || $d eq '}') {
	    if ( $d == $s ) {
		# found nothing
		return BADVERSION($s,$errstr,"Invalid version format (version required)");
	    }
	    # found just an integer
	    goto version_prescan_finish;
	}
	elsif ( $d == $s ) {
	    # didn't find either integer or period
	    return BADVERSION($s,$errstr,"Invalid version format (non-numeric data)");
	}
	elsif ($d eq '_') {
	    # underscore can't come after integer part
	    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) {
	    # anything else after integer part is just invalid data
	    return BADVERSION($s,$errstr,"Invalid version format (non-numeric data)");
	}

	# scan the fractional part after the decimal point
	if ($d && !isDIGIT($d) && ($strict || ! ($d eq ';' || isSPACE($d) || $d eq '}') )) {
		# $strict or lax-but-not-the-end
		return BADVERSION($s,$errstr,"Invalid version format (fractional part required)");
	}

	while (isDIGIT($d)) {
	    $d++;
	    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; # start all over again
		$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)");
		}
		$d++;
		$alpha = TRUE;
	    }
	}
    }

version_prescan_finish:
    while (isSPACE($d)) {
	$d++;
    }

    if ($d && !isDIGIT($d) && (! ($d eq ';' || $d eq '}') )) {
	# trailing non-numeric data
	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;

src/inc/version/vpp.pm  view on Meta::CPAN

    # may be a v-string
    if ( length($value) >= 3 && $value !~ /[._]/
	&& _is_non_alphanumeric($value)) {
	my $tvalue;
	if ( $] ge 5.008_001 ) {
	    $tvalue = _find_magic_vstring($value);
	    $value = $tvalue if length $tvalue;
	}
	elsif ( $] ge 5.006_000 ) {
	    $tvalue = sprintf("v%vd",$value);
	    if ( $tvalue =~ /^v\d+(\.\d+){2,}$/ ) {
		# must be a v-string
		$value = $tvalue;
	    }
	}
    }
    return $value;
}

sub _find_magic_vstring {
    my $value = shift;
    my $tvalue = '';
    require B;
    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) {
	 # file but no package
	require Carp;
	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 = version::vpp->new($version);
    }

    if ( defined $req ) {
	unless ( defined $version ) {
	    require Carp;
	    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 = version::vpp->new($req);

	if ( $req > $version ) {
	    require Carp;
	    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; #this line is important and will help the module return a true value