File Coverage

blib/lib/Math/Pandigital.pm

Criterion	Covered	Total	%
statement	44	44	100.0
branch	22	22	100.0
condition	9	9	100.0
subroutine	10	10	100.0
pod	1	2	50.0
total	86	87	98.8

package Math::Pandigital;

use Moo;
use MooX::Types::MooseLike::Base qw( Int Bool ArrayRef RegexpRef );

use strict;
use warnings;

use Carp;

our $VERSION = '0.04';

has base     => ( is => 'ro', isa => Int,  default => sub { 10; } );
has unique   => ( is => 'ro', isa => Bool, default => sub { 0; } );
has zeroless => ( is => 'ro', isa => Bool, default => sub { 0; } );


has _digits_array => (
    is      => 'ro',
    isa     => ArrayRef,
    lazy    => 1,
    builder => '_build_digits_array'
);

has _digits_regexp => (
    is      => 'ro',
    isa     => RegexpRef,
    lazy    => 1,
    builder => '_build_digits_regexp'
);

has _min_length => (
    is      => 'ro',
    isa     => Int,
    lazy    => 1,
    builder => '_build_min_length'
);

sub BUILD {
    my $self = shift;
    if( $self->base != 16 ) {
      if( $self->base <= 0 || $self->base > 10 ) {
        croak "Base must be 1 .. 10, or 16";
      }
    }
    croak "Unary base must be zeroless."
      if $self->base == 1 && ! $self->zeroless;
    return;
}

sub _build_digits_array {
    my $self  = shift;
    my $base = $self->base;

    # Special case for unary: 1 is the only reasonable digit.
    return [1] if $base == 1;

    # Determine our set's lowest value.
    my $start = $self->zeroless ? 1 : 0;

    # A hexidecimal set.
    return [ $start .. 9, 'A' .. 'F' ] if $base == 16;

    # Base 2 - 10 set.
    return [ $start .. $base - 1 ];
}

sub _build_digits_regexp {
    my $self = shift;

    # Calculate the quantifier.
    my $min_length = $self->_min_length;
    my $quantifier = $self->unique ? "{$min_length}" : "{$min_length,}";

    # Compose a regex string with character class and quantifier.
    # Will look similar to "(?i:^[0123456789]{4,})", for example.
    my $re_str =
      join( '', '(?i:^[', @{ $self->_digits_array() }, "]$quantifier)\$" );

    # Turn it into a Regexp object and return.
    return qr/$re_str/;
}

sub _build_min_length {
    my $self = shift;

    # Special case for unary
    return 1 if $self->base == 1;

    # Calculate the minimum possible input length for $value to qualify.
    return $self->base - ( $self->zeroless ? 1 : 0 );
}

sub is_pandigital {
    my ( $self, $value ) = @_;
    $value =~ s/^0+//; # Strip insignificant leading zeros from strings.

    # The regexp test is done before we proceed to even more work.
    return if not $value =~ $self->_digits_regexp; # Case insensitive.

    # Next, count individual digits to verify we have enough of each digit, and
    # that we don't violate unique settings.
    my $unique = $self->unique;
    my %hash;
    for my $digit ( split //,  uc $value ) {
      return if ++$hash{$digit} > 1 && $unique;
    }
    return keys %hash == $self->_min_length;

}

1;

__END__