File Coverage

blib/lib/Lingua/JA/Number.pm

Criterion	Covered	Total	%
statement	35	37	94.5
branch	9	12	75.0
condition	9	15	60.0
subroutine	5	5	100.0
pod	0	2	0.0
total	58	71	81.6

##################################################
# Lingua::JA::Number
#
# Mike Schilli, 2001 ([e-mail])
##################################################
package Lingua::JA::Number;

use warnings;
use strict;

use Exporter ();
our $VERSION     = 0.01;
our @ISA         = qw (Exporter);
our @EXPORT      = qw ();
our @EXPORT_OK   = qw ( to_string );
our %EXPORT_TAGS = ();

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

##################################################
sub to_string {
##################################################
    my $n = shift;

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

    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[$#r] =  $N2J_BLOCK_EXCP{$b%10};
            } else {
                push @r, $N2J_BLOCK[$bix];
            }
        }
        unshift @result, @r;
        $bix++;
    }

    return @result;
}

##################################################
sub blockof4_to_string {
##################################################
    my $n = shift;

    return undef 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__