File Coverage

blib/lib/version/AlphaBeta.pm

Criterion	Covered	Total	%
statement	68	71	95.7
branch	27	42	64.2
condition	6	12	50.0
subroutine	13	13	100.0
pod	4	6	66.6
total	118	144	81.9

#!/usr/bin/perl -w
package version::AlphaBeta;

use 5.005_03;
use strict;
use version;
use Exporter;

use overload (
    '""'  => \&stringify,
    '<=>' => \&spaceship,
    'cmp' => \&spaceship,
);

use vars qw($VERSION %IB %OB $TYPE);

use base qw(version);

$VERSION = '0.06';

%IB = (
    'a' => -3,
    'b' => -2,
    'rc'=> -1,
    ''  => 0,
    'pl'=> 1
);

%OB = reverse %IB;

$TYPE = join( "|", grep { $_ } keys(%IB) );

# Preloaded methods go here.

sub new {
    my $proto  = shift;
    my $class  = ref($proto) || $proto;
    my $parent = $proto if ref($proto);
    my $ival   = shift;

    my @value  = ( grep { defined $_ }
        ($ival =~
	    /^v?         # optional prefix
	     (\d+)	# Major
	     \.		# Seperator
	     (\d+)	# Minor
	     (?!\.)     # No seperator here
	     ($TYPE)?   # Type
	     (\d+)?	# Subversion
	    $/x)
    );

    die "Illegal version string format: \"$ival\""
	unless scalar(@value) >= 2  # something matched
	    and scalar(@value) <= 4;# but not too much

    die "Illegal version string format:  \"$ival\""
    	if $value[0] == 0 and $value[1] == 0
	    and defined $value[2]; # cannot be 0.0b1

    $value[2] = $IB{
	(defined $value[2] ? $value[2] : "")
    };

    my $self = \@value;
    bless $self, $class;

    return $self;
}

sub stringify {
    my $self = shift;
    my @values = @$self;

    $values[2] = $OB{$values[2]} if defined $values[2];
    my $fmt = "%d.%d".
    	(defined $values[2] ? "%s" : "").
    	(defined $values[3] ? "%d" : "");
    return sprintf($fmt,@values);
}

sub numify {
    my $self = shift;
    my @values = @$self;

    $values[1] *= ($values[1] < 10 ? 100 : 10); # 3 decimal-places needed
    if ( defined $values[2] ) { # need to handle specially
	if ($values[2]  < 0 ) {
	    $values[2] += 1000;
	    $values[1] -= 1;
	}
	if ($values[1]  < 0 ) {
	    $values[1] += 1000;
	    $values[0] -= 1;
	}
    }
    if ( defined $values[3] ) {
	$values[3] *= ($values[3] < 10 ? 100 : 10); # 3 decimal-places
    }

    my $fmt = "%d.%03d".
    	(defined $values[2] ? "%03d" : "").
    	(defined $values[3] ? "%03d" : "");
    return sprintf($fmt,@values);
}

sub spaceship {
    my ($left, $right, $swap) = @_;
    my $test;

    unless ( UNIVERSAL::isa($right, ref($left)) ) {
	# try to bless $right into our class
	eval {
	    $right = $left->new($right);
	};
	if ($@) {
	    return -1;
	}
    }

    my $max = $#$left > $#$right ? $#$left : $#$right;

    for ( my $i=0; $i <= $max; $i++ ) {
	$test = $$left[$i] <=> $$right[$i];
	$test *= -1 if $swap;
	return $test if $test;
    }

    $test = $#$left <=> $#$right;
    $test *= -1 if $swap;

    return $test;
}

sub is_alpha {
    my $self = shift;

    return ($$self[2] == $IB{'a'});
}

sub is_beta {
    my $self = shift;

    return ($$self[2] == $IB{'b'});
}

1;
__END__