File Coverage

blib/lib/Lingua/TLH/Numbers.pm

Criterion	Covered	Total	%
statement	39	39	100.0
branch	14	16	87.5
condition	9	9	100.0
subroutine	8	8	100.0
pod	2	2	100.0
total	72	74	97.3

package Lingua::TLH::Numbers;

use 5.008_001;
use strict;
use warnings;
use Readonly;
use Regexp::Common qw( number );

use base qw( Exporter );
our @EXPORT_OK = qw( num2tlh num2tlh_ordinal );
our %EXPORT_TAGS = ( all => \@EXPORT_OK );

our $VERSION = '0.01';

# up to 9 million supported
Readonly my $MAX_INT_DIGITS => 7;

Readonly my $EMPTY_STR => q{};
Readonly my $SPACE     => q{ };
Readonly my $MINUS     => q{-};

Readonly my $POINT          => q{vI'};
Readonly my $ORDINAL_SUFFIX => q{DIch};

Readonly my @NAMES1  => qw< pagh wa' cha' wej loS vagh jav Soch chorgh Hut >;
Readonly my @NAMES2  => $EMPTY_STR, qw< maH vatlh SaD netlh bIp 'uy' >;

# convert number to words
sub num2tlh {
    my ($number) = @_;
    my $digit_count = 0;
    my @names;

    return unless defined $number;

    # NaN and inf not supported
    return if $number eq 'NaN' || $number =~ m{^ [-+]? inf $}ix;

    return if $number !~ m{^ $RE{num}{real}{-keep} $}x;
    my ($sign, $int, $frac) = ($2, $4, $6);

    # negatives not supported
    return if $sign eq $MINUS;

    return if length $int > $MAX_INT_DIGITS;

    # integer
    DIGIT:
    for my $digit (reverse split $EMPTY_STR, $int) {
        # skip zero unless it is the only digit
        next DIGIT if $digit == 0 && $int != 0;

        unshift @names, $NAMES1[$digit] . $NAMES2[$digit_count];
    }
    continue {
        $digit_count++;
    }

    # fraction
    if (defined $frac && $frac ne $EMPTY_STR) {
        push @names, $POINT, map { $NAMES1[$_] } split $EMPTY_STR, $frac;
    }

    return join $SPACE, @names;
}

# convert number to ordinal words
sub num2tlh_ordinal {
    my ($number) = @_;
    my $name = num2tlh($number);

    return unless defined $name;
    return $name . $ORDINAL_SUFFIX;
}

1;

__END__