view release on metacpan or  search on metacpan

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

    Carp::croak("operation not supported with version object");
}

sub is_alpha {
    my ($self) = @_;
    return (exists $self->{alpha});
}

sub qv {
    my $value = shift;
    my $class = 'version';
    if (@_) {
	$class = ref($value) || $value;
	$value = shift;
    }

    $value = _un_vstring($value);
    $value = 'v'.$value unless $value =~ /(^v|\d+\.\d+\.\d)/;
    my $obj = version->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 charstar $s;
    while ($s) {
	return 0 if isSPACE($s); # early out
	return 1 unless (isALPHA($s) || isDIGIT($s) || $s =~ /[.-]/);
	$s++;
    }
    return 0;
}

sub _un_vstring {
    my $value = shift;
    # 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);