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

=head1 NAME

version::AlphaBeta - Use alphanumeric version objects

=head1 SYNOPSIS

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

=head1 ABSTRACT

  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.

=head1 DESCRIPTION

The base version objects only permit a sequence of numeric values
to be used, which is not how some software chooses to label their
version strings.  This module permits a specific sequence of alpha,
beta, release candidate, release, and patch versions to be specified
instead of strictly numeric versions.  Sorted in increasing order:

=over 2

  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

=back

This module can be used as a basis for other subclasses of version
objects.  The global hash object %IB defines the acceptable non-numeric
version parameters:

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

which, if present at all, must be located in the third sub-version.

=head2 OBJECT METHODS

This module overrides one of the base version object methods:

=over 4

=item * numify()

In order to safely compare version::AlphaBeta objects with non-objects
or base version objects without using the overloaded comparison operators,
for example in Module::Build, this module provides a numification operator.
The floating point number returned may not be immediately obvious, but it
it designed to sort in a consistent fashion as a number.

  $v = version::AlphaBeta->new("1.0a1");  # 0.999997100
  $v = version::AlphaBeta->new("1.0b1");  # 0.999998100
  $v = version::AlphaBeta->new("1.0rc1"); # 0.999999100
  $v = version::AlphaBeta->new("1.0");    # 1.000000
  $v = version::AlphaBeta->new("1.0pl1"); # 1.000001100

=back

Additionally, this module provides two additional logical methods, apart
from those already provided by the base version class.

=over 4

=item * is_alpha

Replacing the base method by the same name, this will return true
only if the version has an 'a' in the third position, i.e.

  $VERSION = new version::AlphaBeta "1.3a1";
  print $VERSION->is_alpha; # prints 1

=item * is_beta

A new method which supplements $obj->is_alpha:

  $VERSION = new version::AlphaBeta "1.3b3";
  print $VERSION->is_alpha; # prints 0
  print $VERSION->is_beta; # prints 1

=back

=head2 EXPORT

None by default.

=head1 SEE ALSO

L<version>

=head1 AUTHOR

John Peacock, E<lt>jpeacock@cpan.orgE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright 2003,2004,2005,2006 by John Peacock

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. 

=cut