File Coverage

blib/lib/Lingua/JPN/Num2Word.pm

Criterion	Covered	Total	%
statement	46	57	80.7
branch	9	16	56.2
condition	9	21	42.8
subroutine	9	12	75.0
pod	2	5	40.0
total	75	111	67.5

# For Emacs: -*- mode:cperl; eval: (folding-mode 1); coding:utf-8; -*-
#
# Mike Schilli, 2001 ([e-mail])
#

package Lingua::JPN::Num2Word;
# ABSTRACT: Translate Numbers into Japanese

use 5.16.0;
use utf8;
use warnings;

# {{{ use block

use Export::Attrs;

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

my %N2J = qw(
  1 ichi 2 ni 3 san 4 yon 5 go 6 roku 7 nana
  8 hachi 9 kyu 10 ju 100 hyaku 1000 sen);

my %N2J_EXCP = qw(
  300 san-byaku 600 ro-p-pyaku 800 ha-p-pyaku
  3000 san-zen 8000 ha-s-sen);

my @N2J_BLOCK = ("", "man", "oku", "cho");

my %N2J_BLOCK_EXCP = qw( 1 i-t-cho 8 ha-t-cho
  0 ju-t-cho);

# }}}

# {{{ to_string
sub num2jpn_cardinal :Export { goto &to_string }

sub to_string :Export {
    my $n = shift;

    if($n < 1 || $n >= 1E16) {
        warn "$n needs to be >=1 and <1E16.\n";
        return;
    }

    my @result = ();
    $n         = reverse $n;
    my $bix    = 0;

    while($n =~ /(\d{1,4})/g) {
        my $b = scalar reverse($1);
        my @r = blockof4_to_string($b);

        if($bix && @r) {
            if($bix == 3 &&
                $b =~ /[1-9]0$|[18]$/) {
                $r[-1] =  $N2J_BLOCK_EXCP{$b%10};
            } else {
                push @r, $N2J_BLOCK[$bix];
            }
        }
        unshift @result, @r;
        $bix++;
    }

    return @result;
}

# }}}
# {{{ blockof4_to_string

sub blockof4_to_string {
    my $n = shift;

    return if $n > 9999 or $n < 0;
    return "" unless $n;

    my @result  = ();
    my @digits  = split //, sprintf("%04d", $n);
    my @weights = (1000, 100, 10, 1);

    for my $i (0..3) {
        next unless $digits[$i];
        my $v = $digits[$i] * $weights[$i];
        push @result, $N2J_EXCP{$v} ||
                      $N2J{$v} ||
                      ($N2J{$digits[$i]},
                       $N2J{$weights[$i]});
    }

    return @result;
}

# }}}


# {{{ num2jpn_ordinal                 convert number to ordinal text

sub num2jpn_ordinal :Export {
    my $number = shift;

    if (!defined $number || $number < 1 || $number >= 1E16) {
        warn "ordinal needs to be >=1 and <1E16.\n";
        return;
    }

    # Japanese ordinals: cardinal + 番目 (ban-me)
    my @parts = to_string($number);
    return unless @parts;

    return join('-', @parts) . '-ban-me';
}

# }}}

# {{{ capabilities              declare supported features

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

# }}}
1;

__END__