File Coverage

blib/lib/Lingua/JPN/Number.pm

Criterion	Covered	Total	%
statement	41	43	95.3
branch	9	12	75.0
condition	9	15	60.0
subroutine	7	7	100.0
pod	0	2	0.0
total	66	79	83.5

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

package Lingua::JPN::Number;
# ABSTRACT: Number 2 word conversion in JPN.

# {{{ use block

use 5.10.1;

use warnings;
use strict;

use Perl6::Export::Attrs;

# }}}
# {{{ variables declaration

our $VERSION     = 0.0682;

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 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;
}

# }}}

1;

__END__