Test::Numeric - Testing utilities for numbers.

 use Test::Numeric tests => 8;

 # The following functions are all exported by Test::Numeric

 is_number   '12.34e56',  "valid number";
 is_number   '-12.34E56', "valid number";
 isnt_number 'test',      "not a number";

 is_even 2, "an even number";
 is_odd  3, "an odd number";

 is_integer   '123',    'an integer';
 isnt_integer '123.45', 'not an integer';

 is_formatted   '1-.2', '123.45';
 isnt_formatted '1-.2', '123.4';

use strict;
use warnings;

package Test::Numeric;

our $VERSION = '0.3';

use Test::Builder;
require Exporter;
our @ISA    = qw(Exporter);
our @EXPORT = qw(
  is_number isnt_number
  is_integer isnt_integer
  is_even is_odd
  is_formatted isnt_formatted
  is_money isnt_money
);

my $Test = Test::Builder->new;

sub import {
    my ($self) = shift;
    my $pack = caller;

    $Test->exported_to($pack);
    $Test->plan(@_);

    $self->export_to_level( 1, $self, $_ ) for @EXPORT;
}

################################################################################

sub _test_number {
    my $number = shift;

    return 0 unless defined $number && length $number;

    # Accept obviously right things.
    return 1 if $number =~ m/^\d+$/;

    # Throw out obviously wrong things.
    return 0 if $number =~ m/[^+\-\.eE0-9]/;

    # Split the number into parts.
    my ( $num, $e, $exp ) = split /(e|E)/, $number, 2;

    # Check that the exponent is valid.
    if ($e) { return 0 unless $exp =~ m/^[+\-]?\d+$/; }

    # Check the number.
    return 0 unless $num =~ m/\d/;
    return 0 unless $num =~ m/^[+\-]?\d*\.?\d*$/;

    return 1;
}

sub is_number {
    my ( $test, $name ) = @_;
    $Test->ok( _test_number($test), $name );
}

sub isnt_number {
    my ( $test, $name ) = @_;
    $Test->ok( !_test_number($test), $name );
}

################################################################################

sub _test_integer {
    my $number = shift;
    return undef unless _test_number($number);
    return 1 if $number =~ m/^[+\-]?\d+\.?0*$/;
    #return int($number) == $number;
    return 0;
}

sub is_integer {
    my ( $test, $name ) = @_;
    my $result = _test_integer( $test );
    $Test->diag("The value given is not a number - failing test.")
	unless defined $result;
    $Test->ok( defined $result && $result, $name );
}

sub isnt_integer {
    my ( $test, $name ) = @_;
    my $result = _test_integer( $test );
    $Test->diag("The value given is not a number - failing test.")
	unless defined $result;
    $Test->ok( defined $result && ! $result, $name );
}

################################################################################

sub _test_even {
    my $number = shift;
    return undef unless _test_integer($number);
    return $number % 2 == 0 ? 1 : 0;
}

sub _test_odd {
    my $number = shift;
    return undef unless _test_integer($number);
    return $number % 2 == 0 ? 0 : 1;
}

sub is_even {
    my ( $test, $name ) = @_;
    my $result = _test_even( $test );
    $Test->diag('The number in not an integer - failing test.')
	unless defined $result;
    $Test->ok( defined $result && $result, $name );
}

sub is_odd {
    my ( $test, $name ) = @_;
    my $result = _test_odd( $test );
    $Test->diag('The number in not an integer - failing test.')
	unless defined $result;
    $Test->ok( defined $result && $result, $name );
}

################################################################################

sub _split_format_error {
    my $format = shift;
    $Test->diag("The format '$format' is not valid");
    return 0;
}

sub _split_format {
    my $format  = shift;
    my @returns = ();

    my ( $pre, $suf ) = split /\./, $format, 2;

    foreach my $arg ( $pre, $suf ) {
        return _split_format_error($format) unless defined $arg && length $arg;

        my ( $min, $sep, $max ) = split /(\-)/, $arg, 2;

        unless ( defined $max && length $max ) {
            $max = $sep ? undef: $min;
        }

        return _split_format_error($format)
          unless _test_integer($min) && $min >= 0;

        if ( defined $max && length $max ) {
            return _split_format_error($format)
              unless _test_integer($max) && $max >= $min;
        }

        push @returns, $min, $max;
    }

    return @returns;
}

sub _test_formatted {
    my $format = shift;
    my $number = shift;

    my ( $pre_min, $pre_max, $suf_min, $suf_max ) = _split_format($format);
    return undef unless defined $suf_min;

    my ( $pre_len, $suf_len ) = map { defined $_ ? length $_ : 0 } split /\./,
      $number, 2;

    return 0 unless $pre_len >= $pre_min;
    return 0 unless $suf_len >= $suf_min;

    if ( defined $pre_max ) { return 0 unless $pre_len <= $pre_max }
    if ( defined $suf_max ) { return 0 unless $suf_len <= $suf_max }

    return 1;
}

sub is_formatted {
    my ( $format, $test, $name ) = @_;
    my $result = _test_formatted( $format, $test );
    $Test->ok( defined $result && $result, $name );
}

sub isnt_formatted {
    my ( $format, $test, $name ) = @_;
    my $result = _test_formatted( $format, $test );
    $Test->ok( defined $result && !$result, $name );
}

sub is_money {
    my ( $test, $name ) = @_;
    my $result = _test_formatted( '0-.2', $test );
    $Test->ok( defined $result && $result, $name );
}

sub isnt_money {
    my ( $test, $name ) = @_;
    my $result = _test_formatted( '0-.2', $test );
    $Test->ok( defined $result && ! $result, $name );
}

1;