File Coverage

blib/lib/Lingua/EO/Numbers.pm

Criterion	Covered	Total	%
statement	75	76	98.6
branch	30	34	88.2
condition	23	24	95.8
subroutine	12	12	100.0
pod	2	2	100.0
total	142	148	95.9

package Lingua::EO::Numbers;

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

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

our $VERSION = '0.03';

# up to 999,999 vigintillion (long scale) supported
Readonly my $MAX_INT_DIGITS => 126;

Readonly my $EMPTY_STR      => q{};
Readonly my $SPACE          => q{ };
Readonly my $ORDINAL_SUFFIX => q{a};
Readonly my $PLURAL_SUFFIX  => q{j};

Readonly my @NAMES1 => qw< nul unu du tri kvar kvin ses sep ok naŭ >;
Readonly my @NAMES2 => $EMPTY_STR, qw< dek cent >;
Readonly my @GROUPS => (
    undef, qw< mil miliono miliardo >,
    map { $_ . 'iliono' } qw<
        b tr kvadr kvint sekst sept okt non dec undec duodec tredec
        kvatuordec kvindec seksdec septendec oktodec novemdec vigint
    >
);

Readonly my %WORDS => (
    ',' => 'komo',
    '-' => 'negativa',
    '+' => 'positiva',
    inf => 'senfineco',
    NaN => 'ne nombro',
);

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

    return unless defined $number;
    return $WORDS{NaN} if $number eq 'NaN';

    if ($number =~ m/^ ( [-+] )? inf $/ix) {
        # infinity
        push @names, $1 ? $WORDS{$1} : (), $WORDS{inf};
    }
    elsif ($number =~ m/^ $RE{num}{real}{-radix=>'[,.]'}{-keep} $/x) {
        my ($sign, $int, $frac) = ($2, $4, $6);

        return if length $int > $MAX_INT_DIGITS;

        # sign and integer
        unshift @names, $WORDS{$sign} || (), _convert_int($int);

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

    return join $SPACE, @names;
}

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

    return unless defined $name;

    for ($name) {
        s{ (?: oj? | a ) \b }{}gx; # remove word suffixes
        tr{ }{-};
    }

    return $name . $ORDINAL_SUFFIX;
}

# convert integers to words
sub _convert_int {
    my ($int) = @_;
    my @number_groups = _split_groups($int);
    my @name_groups;
    my $group_count = 0;

    GROUP:
    for my $group (reverse @number_groups) {
        # skip zeros unless it is the only digit
        next GROUP if $group == 0 && $int != 0;

        my $type = $GROUPS[$group_count];

        # pluralize nouns
        if ($type && $type ne $GROUPS[1] && $group > 1) {
            $type .= $PLURAL_SUFFIX;
        }

        my @names = do {
            # use thousand instead of one thousand
            if ($group == 1 && $type eq $GROUPS[1]) { () }

            # groups for billions and greater contain thousands sub-groups
            elsif (length $group > 3) { _convert_int(   $group ) }
            else                      { _convert_group( $group ) }
        };

        unshift @name_groups, @names, $type ? $type : ();
    }
    continue {
        $group_count++;
    }

    return @name_groups;
}

# split integer into groups for use with thousands, millions, etc.
# the first 3 groups contain 3 digits and the rest contain 6 digits
sub _split_groups {
    my ($int) = @_;
    my $group_length = 3;
    my @groups;

    while ($int =~ s[ ( .{1,$group_length} ) $ ][]x) {
        unshift @groups, $1;
    }
    continue {
        if (@groups == 4) {
            $group_length = 6;
        }
    }

    return @groups;
}

# the actual integer to word conversion
# this expects an integer group of 1 to 3 digits
sub _convert_group {
    my ($int) = @_;
    my @digits = split $EMPTY_STR, defined $int ? $int : $EMPTY_STR;
    my $digit_count = 0;
    my @names;

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

        # leave off one for ten and hundred
        unshift @names, (
            $digit == 1 && $digit_count ? $EMPTY_STR : $NAMES1[$digit]
        ) . $NAMES2[$digit_count];
    }
    continue {
        $digit_count++;
    }

    return @names;
}

1;

__END__