version::AlphaBeta - Use alphanumeric version objects

  use version::AlphaBeta;
  $VERSION = version::AlphaBeta->new("v1.2b");

  Derived class of version objects which permits use of specific
  alphanumeric version objects, patterned after the version strings
  used by many open source programs, like Mozilla.

  Version     Meaning
  1.3a        1.3 alpha release
  1.3b        1.3 beta release
  1.3b2       1.3 second beta release
  1.3rc       1.3 release candidate
  1.3rc2      1.3 second release candidate
  1.3         1.3 final release
  1.3pl       1.3 first patch release
  1.3pl2      1.3 second patch release

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

#!/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__