File Coverage

blib/lib/Lingua/IND/Num2Word.pm

Criterion	Covered	Total	%
statement	90	98	91.8
branch	32	42	76.1
condition	50	84	59.5
subroutine	18	21	85.7
pod	11	12	91.6
total	201	257	78.2

# For Emacs: -*- mode:cperl; eval: (folding-mode 1) -*-

package Lingua::IND::Num2Word;
# ABSTRACT: convert number to Indonesian verbage.

use 5.16.0;
use utf8;
use warnings;

# {{{ use block

use Carp;
use Export::Attrs;

# }}}
# {{{ variables declaration
our $VERSION = '0.2603300';

our $Dec_char  = ".";
our $Neg_word  = "negatif";
our $Dec_word  = "koma";
our $Exp_word  = "dikali sepuluh pangkat";
our $Zero_word = "nol";

our %Digit_words = (
        0 => $Zero_word,
        1 => 'satu',
        2 => 'dua',
        3 => 'tiga',
        4 => 'empat',
        5 => 'lima',
        6 => 'enam',
        7 => 'tujuh',
        8 => 'delapan',
        9 => 'sembilan'
);

our %Mult_words = (
        0 => '',
        1 => 'ribu',
        2 => 'juta',
        3 => 'milyar',
        4 => 'triliun'
);

# }}}

### public subs
# {{{ nums2words

sub num2ind_cardinal :Export { goto &nums2words }

sub nums2words :Export {
    my @a = @_;
    return join_it(n2w1(@a));
}

# }}}
# {{{ nums2words_simple

sub nums2words_simple :Export {
    my @a = @_;
    return join_it(n2w5(@a));
}

# }}}

### private subs

# for debugging
our $DEBUG = 0;
sub hmm___ { my @a = @_;print "(", (caller 1)[3], ") Hmm, ", @a if $DEBUG; return; }
# {{{ n2w1                    handle scientific notation
sub n2w1 {
        my $num = shift // return '';

        return $Zero_word if $num >= 10 ** 15;    # not quadrillion and more

        my @words;

        $num =~ /^(.+)[Ee](.+)$/ and
        @words = (n2w2($1), $Exp_word, n2w2($2)) or
        @words = n2w2($num);

        return @words;
}

# }}}
# {{{ n2w2                    handle negative sign and decimal

sub n2w2 {
        my $num = shift // return '';
        my $is_neg;
        my @words = ();

        # negative
        $num < 0 and $is_neg++;
        $num =~ s/^[\s\t]*[+-]*(.*)/$1/;

        # decimal
        $num =~ /^(.+)\Q$Dec_char\E(.+)$/o and
        @words = (n2w3($1), $Dec_word, n2w5($2)) or

        $num =~ /^\Q$Dec_char\E(.+)$/o and
        @words = ($Digit_words{0}, $Dec_word, n2w5($1)) or

        $num =~ /^(.+)(?:\Q$Dec_char\E)?$/o and
        @words = n2w3($1);

        $is_neg and
        unshift @words, $Neg_word;

        return @words;
}

# }}}
# {{{ n2w3                    handle digits before decimal

sub n2w3 {
        my $num = shift // return '';
        my @words = ();
        my $order = 0;
        my $t;

        while($num =~ /^(.*?)([\d\D*]{1,3})$/) {
                $num = $1;
                ($t = $2) =~ s/\D//g;
                $t = $t || 0;
                unshift @words, $Mult_words{$order} if $t > 0;
                unshift @words, n2w4($t, $order);
                $order++;
        }

        @words = ($Zero_word) if not join('',@words)=~/\S/;
        hmm___ "for the left part of decimal i get: @words\n";
        return @words;
}

# }}}
# {{{ n2w4                    handle clusters of thousands

sub n2w4 {
        my $num = shift // return '';
        my $order = shift;
        my @words = ();

        my $n1 = $num % 10;
        my $n2 = ($num % 100 - $n1) / 10;
        my $n3 = ($num - $n2*10 - $n1) / 100;

        ($n3 == 0 && $n2 == 0 && $n1 > 0) && (((
                $n1 == 1 && $order == 1) && (@words = ("se"))) ||
                (@words = ($Digit_words{$n1}) ));

        $n3 == 1 and @words = ("seratus") or
        $n3 >  1 and @words = ($Digit_words{$n3}, "ratus");

        $n2 == 1 and (
                $n1 == 0 and push(@words, "sepuluh") or
                $n1 == 1 and push(@words, "sebelas") or
                push(@words, $Digit_words{$n1}, "belas")
        );

        $n2 > 1 and do {
                push @words, $Digit_words{$n2}, "puluh";
                push @words, $Digit_words{$n1} if $n1 > 0;
        };

        ($n3 > 0 && $n2 == 0 && $n1 > 0) &&
        push @words, $Digit_words{$n1} ;

        ($n3 != 0 || $n2 != 0 || $n1 != 0) &&
        return @words;
}

# }}}
# {{{ n2w5                    handle digits after decimal
sub n2w5 {
        my $num = shift // return '';

        return $Zero_word if $num >= 10 ** 15;    # not quadrillion and more

        my @words = ();
        my $i;
        my $t;

        for( $i=0 ; $i<=length($num)-1 ; $i++ ) {
                $t = substr($num, $i, 1);
                exists $Digit_words{$t} and
                push @words, $Digit_words{$t};
        }

        @words = ($Zero_word) if not join('',@words)=~/\S/;
        return @words;
}

# }}}
# {{{ join_it                 join array of words, also join (se, ratus) -> seratus, etc.
sub join_it {
        my @a = @_;
        my $words = '';
        my $w;

        while(defined( $w = shift @a)) {
                $words .= $w;
                $words .= ' ' unless not length $w or $w eq 'se' or not @a;
        }
        return $words;
}

# }}}


# {{{ num2ind_ordinal                 convert number to ordinal text

sub num2ind_ordinal :Export {
    my $number = shift;

    croak 'You should specify a number from interval [1, 999_999_999_999]'
        if    !defined $number
           || $number !~ m{\A\d+\z}xms
           || $number < 1
           || $number > 999_999_999_999;

    # Indonesian ordinals: "ke-" + cardinal
    # Special case: 1st = "pertama"
    return 'pertama' if $number == 1;

    my $cardinal = nums2words($number);
    $cardinal =~ s{\A\s+|\s+\z}{}gxms;   # trim whitespace

    return 'ke' . $cardinal;
}

# }}}

# {{{ capabilities              declare supported features

sub capabilities {
    return {
        cardinal => 1,
        ordinal  => 1,
    };
}

# }}}
1;
__END__