view release on metacpan or  search on metacpan

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

		    $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;
    my $last;
    my $errstr;
    my $saw_decimal = 0;
    my $width = 3;
    my $alpha = FALSE;
    my $vinf = FALSE;
    my @av;

    $s = new charstar $s;

    while (isSPACE($s)) { # leading whitespace is OK
	$s++;
    }

    $last = prescan_version($s, FALSE, \$errstr, \$qv, \$saw_decimal,
	\$width, \$alpha);

    if ($errstr) {
	# 'undef' is a special case and not an error
	if ( $s ne 'undef') {
	    use Carp;
	    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;

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

    # And finally, store the AV in the hash
    $$rv->{version} = \@av;

    # fix RT#19517 - special case 'undef' as string
    if ($s eq 'undef') {
	$s += 5;
    }

    return $s;
}

sub new
{
	my ($class, $value) = @_;
	my $self = bless ({}, ref ($class) || $class);
	my $qv = FALSE;

	if ( ref($value) && eval('$value->isa("version")') ) {
	    # Can copy the elements directly
	    $self->{version} = [ @{$value->{version} } ];
	    $self->{qv} = 1 if $value->{qv};
	    $self->{alpha} = 1 if $value->{alpha};
	    $self->{original} = ''.$value->{original};
	    return $self;
	}

	my $currlocale = setlocale(LC_ALL);

	# if the current locale uses commas for decimal points, we
	# just replace commas with decimal places, rather than changing
	# locales
	if ( localeconv()->{decimal_point} eq ',' ) {
	    $value =~ tr/,/./;
	}

	if ( not defined $value or $value =~ /^undef$/ ) {
	    # RT #19517 - special case for undef comparison
	    # or someone forgot to pass a value
	    push @{$self->{version}}, 0;
	    $self->{original} = "0";
	    return ($self);
	}

	if ( $#_ == 2 ) { # must be CVS-style
	    $value = $_[2];
	    $qv = TRUE;
	}

	$value = _un_vstring($value);

	# exponential notation
	if ( $value =~ /\d+.?\d*e[-+]?\d+/ ) {
	    $value = sprintf("%.9f",$value);
	    $value =~ s/(0+)$//; # trim trailing zeros
	}

	my $s = scan_version($value, \$self, $qv);

	if ($s) { # must be something left over
	    warn("Version string '%s' contains invalid data; "
                       ."ignoring: '%s'", $value, $s);
	}

	return ($self);
}

*parse = \&new;

sub numify
{
    my ($self) = @_;
    unless (_verify($self)) {
	require Carp;
	Carp::croak("Invalid version object");
    }
    my $width = $self->{width} || 3;
    my $alpha = $self->{alpha} || "";
    my $len = $#{$self->{version}};
    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 # $len = 0
    {
	$string .= sprintf("000");
    }

    return $string;
}

sub normal
{
    my ($self) = @_;
    unless (_verify($self)) {
	require Carp;
	Carp::croak("Invalid version object");
    }
    my $alpha = $self->{alpha} || "";
    my $len = $#{$self->{version}};
    my $digit = $self->{version}[0];
    my $string = sprintf("v%d", $digit );