File Coverage

blib/lib/version/Limit.pm

Criterion	Covered	Total	%
statement	39	40	97.5
branch	7	10	70.0
condition			n/a
subroutine	6	6	100.0
pod	0	1	0.0
total	52	57	91.2

package version::Limit;

require 5.005_03;
use strict;
use version 0.6701;

require Exporter;

use vars qw/@ISA $VERSION/;

@ISA = qw(Exporter);

$VERSION = 0.0301;

# Preloaded methods go here.

sub import {
    my $self = shift;
    my $package = (caller())[0];
    $self->SUPER::import(@_);
    $self->export_to_level(1,$self,@_);
    eval "\*$package\::VERSION = \\&_VERSION";
}

sub Scope {
    my $package = (caller())[0];
    my $self;
    if ( scalar(@_) % 2 == 1 ) { # called as class method
    	$self = shift;
    }
    while ( @_ ) {
	my ($range, $reason) = (shift, shift);
	${$package::_INCOMPATIBILITY}{$range} = $reason;
    }
}

sub _VERSION {
    my ($package,$req) = @_;
    $req = version->new($req);
    my $version = version->new(eval("\$$package\::VERSION"));
    if ( $req > $version ) {
	die "$package version $req required--this is only version $version";
    }

    my @ranges = keys %{$package::_INCOMPATIBILITY};
    foreach my $range ( @ranges ) {
	my ($lb,$lower,$upper,$ub) =
		( $range =~ /(.)([0-9.]+),([0-9.]+)(.)/ );
	$lb = '>' . ( $lb eq '[' ? '=' : '');
	$ub = '<' . ( $ub eq ']' ? '=' : '');
	$lower = version->new($lower);
	$upper = version->new($upper);
	my $test = "(\$req $lb \$lower and \$req $ub \$upper)";
	if ( eval $test ) {
	    die "Cannot 'use $package $req': "
	    	. ${$package::_INCOMPATIBILITY}{$range}
		."\n".$test;
	}
    }
    return $version;
}

1;
__END__