File Coverage

blib/lib/Number/AnyBase.pm

Criterion	Covered	Total	%
statement	76	88	86.3
branch	22	24	91.6
condition	3	3	100.0
subroutine	13	24	54.1
pod	19	19	100.0
total	133	158	84.1

# ABSTRACT: Converts decimals to and from any alphabet of any size (for shortening IDs, URLs etc.)

# no critic
package Number::AnyBase;
{
  $Number::AnyBase::VERSION = '1.60000';
}
## use critic

use strict;
use warnings;

use base 'Class::Accessor::Faster';

use Carp qw(croak);

Number::AnyBase->mk_ro_accessors( qw/
    alphabet
    _inverted_alphabet
/);

sub new {
    my ($class, @in_alphabet) = @_;

    croak 'No alphabet passed to Number::AnyBase->new()'
        unless @in_alphabet;

    my $type = ref $in_alphabet[0];

    my $tmp_alphabet
        = $type eq 'ARRAY'
        ? $in_alphabet[0]
        : scalar @in_alphabet == 1
        ? [ split '', $in_alphabet[0] ]
        : \@in_alphabet;

    my %seen;
    my @normalized_alphabet;
    for ( @$tmp_alphabet ) {
        push @normalized_alphabet, $_ unless $seen{$_}++
    }

    croak 'The given alphabet must have at least two symbols'
        if @normalized_alphabet < 2;

    for (@normalized_alphabet) {
        croak 'Symbols in the given alphabet cannot be more than one character long'
            if length > 1
    }

    $class->fastnew(\@normalized_alphabet)
}

sub fastnew {
    my ($class, $alphabet) = @_;

    my %inverted_alphabet;
    @inverted_alphabet{ @$alphabet } = 0 .. $#{ $alphabet };

    $class->SUPER::new({
        alphabet           => $alphabet,
        _inverted_alphabet => \%inverted_alphabet
    })
}

sub new_bin {
    shift->fastnew( ['0', '1'] )
}

sub new_oct {
    shift->fastnew( ['0'..'7'] )
}

sub new_hex {
    shift->fastnew( ['0'..'9', 'A'..'F'] )
}

sub new_hex_lc {
    shift->fastnew( ['0'..'9', 'a'..'f'] )
}

sub new_base36 {
    shift->fastnew( ['0'..'9', 'A'..'Z'] )
}

sub new_base62 {
    shift->fastnew( ['0'..'9', 'A'..'Z', 'a'..'z'] )
}

sub new_base64 {
    shift->fastnew( ['+', '/', '0'..'9', 'A'..'Z', '_', 'a'..'z'] )
}

sub new_base64url {
    shift->fastnew( ['-', '0'..'9', 'A'..'Z', '_', 'a'..'z'] )
}

sub new_urisafe {
    shift->fastnew( ['-', '.', '0'..'9', 'A'..'Z', '_', 'a'..'z', '~'] )
}

sub new_dna {
    shift->fastnew( ['A', 'C', 'G', 'T'] )
}

sub new_dna_lc {
    shift->fastnew( ['a', 'c', 'g', 't'] )
}

sub new_ascii {
    shift->fastnew([
        '!', '"' , '#', '$', '%', '&', "'", '(', ')', '*', '+', '-', '.', '/',
        '0'..'9' , ':', ';', '<', '=', '>', '?', '@', 'A'..'Z',
        '[', '\\', ']', '^', '_', '`', 'a'..'z', '{', '|', '}', '~'
    ])
}

sub new_bytes {
    shift->fastnew( [ map {chr} 0..255 ] )
}

sub to_base {
    my ($self, $dec_num) = @_;

    my $alphabet      = $self->alphabet;
    my $alphabet_size = @{ $alphabet };

    my $base_num = '';
    use integer;
    do { $base_num .= $alphabet->[ $dec_num % $alphabet_size ] }
        while $dec_num /= $alphabet_size;

    return scalar reverse $base_num
}

sub to_dec {
    my $self = shift;
    my $reversed_base_num = reverse shift;

    my $inverted_alphabet = $self->_inverted_alphabet;
    my $alphabet_size     = @{ $self->alphabet };

    # Make $dec_num a bignum upon request.
    my $dec_num = defined $_[0] ? $_[0] * 0 : 0;

    #$base_num = reverse $base_num;
    $dec_num
        = $dec_num * $alphabet_size
        + $inverted_alphabet->{ chop $reversed_base_num }
            while length $reversed_base_num;

    return $dec_num
}

sub next {
    my ($self, $curr) = @_;

    my $alphabet          = $self->alphabet;
    my $alphabet_size     = @{ $alphabet };
    my $inverted_alphabet = $self->_inverted_alphabet;

    my $next_char_value;
    my $next_num = '';
    while ( length $curr ) {
        if (
            ( $next_char_value = $inverted_alphabet->{chop $curr} + 1 )
                < $alphabet_size
        ) {
            $next_num .= $alphabet->[$next_char_value];
            last
        } else {
            $next_num .= $alphabet->[0]
        }
    }

    $next_num .= $alphabet->[1] if $next_char_value >= $alphabet_size;

    return $curr . reverse $next_num
}

sub prev {
    my ($self, $curr) = @_;

    my $alphabet = $self->alphabet;
    return if $curr eq $alphabet->[0];

    my $inverted_alphabet = $self->_inverted_alphabet;

    my $prev_char_value;
    my $prev_num = '';
    while ( length $curr ) {
        if (
            ( $prev_char_value = $inverted_alphabet->{chop $curr} ) == 0
        ) {
            $prev_num .= $alphabet->[-1]
        } else {
            $prev_num .= $alphabet->[$prev_char_value - 1];
            last
        }
    }

    chop $prev_num if $prev_char_value == 1 && !length($curr);

    return $curr . reverse $prev_num
}

1;

__END__