AFS
12 results

 view release on metacpan or  search on metacpan

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

	if (length($right) == 1) { # comparing single character only
	    return $left->thischar cmp $right;
	}
	$right = $left->new($right);
    }
    return $left->currstr cmp $right->currstr;
}

sub bool {
    my ($self) = @_;
    my $char = $self->thischar;
    return ($char ne '');
}

sub clone {
    my ($left, $right, $swapped) = @_;
    $right = {
	string  => [@{$left->{string}}],
	current => $left->{current},
    };
    return bless $right, ref($left);
}

sub currstr {
    my ($self, $s) = @_;
    my $curr = $self->{current};
    my $last = $#{$self->{string}};
    if (defined($s) && $s->{current} < $last) {
	$last = $s->{current};
    }

    my $string = join('', @{$self->{string}}[$curr..$last]);
    return $string;
}

package version::vpp;
use strict;

use POSIX qw/locale_h/;
use locale;
use vars qw ($VERSION @ISA @REGEXS);
$VERSION = 0.96;

use overload (
    '""'       => \&stringify,
    '0+'       => \&numify,
    'cmp'      => \&vcmp,
    '<=>'      => \&vcmp,
    'bool'     => \&vbool,
    '+'        => \&vnoop,
    '-'        => \&vnoop,
    '*'        => \&vnoop,
    '/'        => \&vnoop,
    '+='        => \&vnoop,
    '-='        => \&vnoop,
    '*='        => \&vnoop,
    '/='        => \&vnoop,
    'abs'      => \&vnoop,
);

eval "use warnings";
if ($@) {
    eval '
	package
	warnings;
	sub enabled {return $^W;}
	1;
    ';
}

my $VERSION_MAX = 0x7FFFFFFF;

# implement prescan_version as closely to the C version as possible
use constant TRUE  => 1;
use constant FALSE => 0;

sub isDIGIT {
    my ($char) = shift->thischar();
    return ($char =~ /\d/);
}

sub isALPHA {
    my ($char) = shift->thischar();
    return ($char =~ /[a-zA-Z]/);
}

sub isSPACE {
    my ($char) = shift->thischar();
    return ($char =~ /\s/);
}

sub BADVERSION {
    my ($s, $errstr, $error) = @_;
    if ($errstr) {
	$$errstr = $error;
    }
    return $s;
}

sub prescan_version {
    my ($s, $strict, $errstr, $sqv, $ssaw_decimal, $swidth, $salpha) = @_;
    my $qv          = defined $sqv          ? $$sqv          : FALSE;
    my $saw_decimal = defined $ssaw_decimal ? $$ssaw_decimal : 0;
    my $width       = defined $swidth       ? $$swidth       : 3;
    my $alpha       = defined $salpha       ? $$salpha       : FALSE;

    my $d = $s;

    if ($qv && isDIGIT($d)) {
	goto dotted_decimal_version;
    }

    if ($d eq 'v') { # explicit v-string
	$d++;
	if (isDIGIT($d)) {
	    $qv = TRUE;
	}
	else { # degenerate v-string
	    # requires v1.2.3
	    return BADVERSION($s,$errstr,"Invalid version format (dotted-decimal versions require at least three parts)");
	}

dotted_decimal_version:

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

	    else {
		my $digits = 0;
		while ( ( isDIGIT($pos) || $pos eq '_' ) && $digits < 3 ) {
		    if ( $pos ne '_' ) {
			$digits++;
		    }
		    $pos++;
		}
	    }
	}
    }
    if ( $qv ) { # quoted versions always get at least three terms
	my $len = $#av;
	#  This for loop appears to trigger a compiler bug on OS X, as it
	#  loops infinitely. Yes, len is negative. No, it makes no sense.
	#  Compiler in question is:
	#  gcc version 3.3 20030304 (Apple Computer, Inc. build 1640)
	#  for ( len = 2 - len; len > 0; len-- )
	#  av_push(MUTABLE_AV(sv), newSViv(0));
	#
	$len = 2 - $len;
	while ($len-- > 0) {
	    push @av, 0;
	}
    }

    # need to save off the current version string for later
    if ( $vinf ) {
	$$rv->{original} = "v.Inf";
	$$rv->{vinf} = 1;
    }
    elsif ( $s > $start ) {
	$$rv->{original} = $start->currstr($s);
	if ( $qv && $saw_decimal == 1 && $start ne 'v' ) {
	    # need to insert a v to be consistent
	    $$rv->{original} = 'v' . $$rv->{original};
	}
    }
    else {
	$$rv->{original} = '0';
	push(@av, 0);
    }

    # 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}};

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

	    while ( $i <= $r && $retval == 0 ) {
		if ( $right->{version}[$i] != 0 ) {
		    $retval = -1; # not a match after all
		}
		$i++;
	    }
	}
	else {
	    while ( $i <= $l && $retval == 0 ) {
		if ( $left->{version}[$i] != 0 ) {
		    $retval = +1; # not a match after all
		}
		$i++;
	    }
	}
    }

    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 $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);
	    }
	}

	$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



( run in 0.921 second using v1.01-cache-2.11-cpan-5a3173703d6 )