view release on metacpan or  search on metacpan

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

	    }
	}
    }

    return $retval;  
}

sub vbool {
    my ($self) = @_;
    return vcmp($self,$self->new("0"),1);
}

sub vnoop { 
    require Carp; 
    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 $version = $class->new($value);
    return $version;
}

*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 _un_vstring {
    my $value = shift;
    # may be a v-string
    if ( $] >= 5.006_000 && length($value) >= 3 && $value !~ /[._]/
	&& (ord($value) < ord('0') || ord($value) > ord('9')) ) {
	my $tvalue = sprintf("v%vd",$value);
	if ( $tvalue =~ /^v\d+(\.\d+){2,}$/ ) {
	    # must be a v-string
	    $value = $tvalue;
	}
    }
    return $value;
}

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)