File Coverage

blib/lib/Lingua/TL/Numbers.pm

Criterion	Covered	Total	%
statement	64	64	100.0
branch	51	56	91.0
condition	1	3	33.3
subroutine	10	10	100.0
pod	2	2	100.0
total	128	135	94.8

package Lingua::TL::Numbers;

use strict;
use warnings;

use integer;

use base qw(Exporter);
our @EXPORT_OK = qw(num2tl num2tl_ordinal);

our $VERSION = 0.02;

my @CARDINAL_UNITS = (undef, qw(
    isa dalawa tatlo apat lima anim pito walo siyam sampu labing-isa labindalawa
    labintatlo labing-apat labinlima labing-anim labimpito labingwalo labinsiyam
));

my @CARDINAL_TENS = (undef, qw(
    sampu dalawampu tatlumpu apatnapu limampu animnapu pitumpu walumpu siyamnapu
));


sub _cardinal_thousands {
    my ($number, $div, $suffix, $at) = @_;

    my $word = _cardinal($number / $div);
    if    ($word =~ /[aeiou]$/) { $word .= 'ng '  . $suffix }
    elsif ($word =~ /n$/)       { $word .= 'g '   . $suffix }
    else                        { $word .= ' na ' . $suffix }
    $word .= $at . _cardinal($number % $div) if $number % $div;
    return $word;
}

sub _cardinal {
    my $number = shift;

    return $CARDINAL_UNITS[$number] if $number < 20;

    if ($number < 100) {
        my $word = $CARDINAL_TENS[$number / 10];
        $word .= "'t " . $CARDINAL_UNITS[$number % 10] if $number % 10;
        return $word;
    }
    if ($number < 1000) {
        my $word = _cardinal($number / 100);
        $word .= $word =~ /[aeiou]$/ ? 'ng daan' : ' na raan';
        $word = substr($word, 0, -1) . "'t " . _cardinal($number % 100) if $number % 100;
        return $word;
    }

    return _cardinal_thousands($number, 1_000, 'libo', "'t ")        if $number < 1_000_000;
    return _cardinal_thousands($number, 1_000_000, 'milyon', ' at ') if $number < 1_000_000_000;
}

sub num2tl {
    my $number = shift;

    return if $number < 1 or $number > 999_999_999;

    return _cardinal($number);
}

sub _ordinal_ika {
    my $number = shift;

    return 'una'     if 1 == $number;
    return 'ikalawa' if 2 == $number;
    return 'ikatlo'  if 3 == $number;

    my $word = num2tl($number) or return;

    my $prefix = 'ika';
    $prefix .= '-' if  $word =~ /^[aeiou]/;

    return $prefix . $word;
}

sub _ordinal_pang {
    my $number = shift;

    return 'panguna'   if 1 == $number;
    return 'pangalawa' if 2 == $number;
    return 'pangatlo'  if 3 == $number;

    my $word = num2tl($number) or return;

    my $prefix = '';
    if    ($word =~ /^[aieou]/) { $prefix = 'pang-' }
    elsif ($word =~ /^w/)       { $prefix = 'pang'  }
    elsif ($word =~ /^[dtls]/)  { $prefix = 'pan'   }
    elsif ($word =~ /^p/)       { $prefix = 'pam'   }

    return $prefix . $word;
}

sub num2tl_ordinal {
    my $number = shift;
    my %options = @_;

    my %opts = (
        ika   => 0,
        hypen => 0,
    );
    foreach my $key (keys %opts) {
        $opts{$key} = ! !$options{$key} if exists $options{$key};
    }

    my $word =  $opts{ika} ? _ordinal_ika($number)
                           : _ordinal_pang($number);

    $word =~ tr/ /-/ if $opts{hypen};

    return $word;
}

1;

__END__