File Coverage

blib/lib/Lingua/JPN/Word2Num.pm

Criterion	Covered	Total	%
statement	26	31	83.8
branch	0	6	0.0
condition	2	4	50.0
subroutine	9	10	90.0
pod	3	3	100.0
total	40	54	74.0

# For Emacs: -*- mode:cperl; eval: (folding-mode 1); coding:utf-8; -*-
#
# Copyright (c) PetaMem, s.r.o. 2004-present

package Lingua::JPN::Word2Num;
# ABSTRACT: Word to number conversion in Japanese

use 5.16.0;
use utf8;
use warnings;

# {{{ use block

use Export::Attrs;
use Parse::RecDescent;

# }}}
# {{{ var block

our $VERSION = '0.2604300';
my $parser   = jpn_numerals();

# }}}

# {{{ w2n                       convert text to number

sub w2n :Export {
    my $input = shift // return;

    # Strip ASCII hyphens (didactic romaji forms like "san-zen" or "ichi-man"
    # become "sanzen" / "ichiman"). Also strip leading/trailing whitespace.
    $input =~ s/-/ /g;
    $input =~ s/\A\s+//;
    $input =~ s/\s+\z//;

    return $parser->numeral($input);
}

# }}}
# {{{ jpn_numerals              create parser for Japanese numerals

sub jpn_numerals {
    return Parse::RecDescent->new(<<'GRAMMAR');

      # ── Top-level: try the largest scale first, fall through ─────────────
      numeral:    cho_block      { $item[1] }
                | oku_block      { $item[1] }
                | man_block      { $item[1] }
                | sen_block      { $item[1] }
                | hyaku_block    { $item[1] }
                | ju_block       { $item[1] }
                | digit          { $item[1] }
                | { undef }

      # ── Atomic digits 0..9 in three scripts ───────────────────────────────
      digit:    /(?:零|〇|ぜろ|zero)/i              { 0 }
              | /(?:一|いち|ichi)/i                 { 1 }
              | /(?:二|に|ni)/i                     { 2 }
              | /(?:三|さん|san)/i                  { 3 }
              | /(?:四|よん|よ|yon|shi)/i           { 4 }
              | /(?:五|ご|go)/i                     { 5 }
              | /(?:六|ろく|roku)/i                 { 6 }
              | /(?:七|なな|しち|nana|shichi)/i      { 7 }
              | /(?:八|はち|hachi)/i                { 8 }
              | /(?:九|きゅう|く|kyu|kyuu|ku)/i      { 9 }

      # ── Tens: "十" / "じゅう" / "ju" — bare or digit-prefixed ─────────────
      ju_word:  /(?:十|じゅう|ju)/i

      ju_block:   digit ju_word digit   { $item[1] * 10 + $item[3] }
                | digit ju_word         { $item[1] * 10 }
                | ju_word digit         { 10 + $item[2] }
                | ju_word               { 10 }

      # ── Hundreds — bare 100, irregular 300/600/800, regular 200/400/etc ──
      hyaku_word:  /(?:百|ひゃく|hyaku)/i

      # Irregular hundreds (rendaku/gemination) — kanji form has no
      # phonological irregularity (三百), but hiragana/romaji do.
      hyaku_irregular_3: /(?:さんびゃく|sanbyaku|san\s*byaku)/i        { 300 }
      hyaku_irregular_6: /(?:ろっぴゃく|roppyaku|roku\s*hyaku)/i        { 600 }
      hyaku_irregular_8: /(?:はっぴゃく|happyaku|hachi\s*hyaku)/i       { 800 }

      hyaku_term:   hyaku_irregular_3                       { $item[1] }
                  | hyaku_irregular_6                       { $item[1] }
                  | hyaku_irregular_8                       { $item[1] }
                  | /三/ hyaku_word                          { 300 }
                  | /六/ hyaku_word                          { 600 }
                  | /八/ hyaku_word                          { 800 }
                  | digit hyaku_word                         { $item[1] * 100 }
                  | hyaku_word                               { 100 }

      hyaku_block:  hyaku_term ju_block                      { $item[1] + $item[2] }
                  | hyaku_term digit                         { $item[1] + $item[2] }
                  | hyaku_term

      # ── Thousands — bare 1000, irregular 3000/8000, regular ──────────────
      sen_word:  /(?:千|せん|sen)/i

      sen_irregular_3: /(?:さんぜん|sanzen|san\s*zen|san\s*sen)/i     { 3000 }
      sen_irregular_8: /(?:はっせん|hassen|hachi\s*sen)/i              { 8000 }

      sen_term:   sen_irregular_3                            { $item[1] }
                | sen_irregular_8                            { $item[1] }
                | /三/ sen_word                               { 3000 }
                | /八/ sen_word                               { 8000 }
                | digit sen_word                             { $item[1] * 1000 }
                | sen_word                                   { 1000 }

      sen_block:  sen_term hyaku_block                       { $item[1] + $item[2] }
                | sen_term ju_block                          { $item[1] + $item[2] }
                | sen_term digit                             { $item[1] + $item[2] }
                | sen_term

      # ── 10,000 (man) ──────────────────────────────────────────────────────
      man_word:  /(?:万|まん|man)/i

      # 一万 — bare "man" is also valid input (like Mike Schilli's old API)
      man_term:   sen_block man_word                         { $item[1] * 10_000 }
                | hyaku_block man_word                       { $item[1] * 10_000 }
                | ju_block man_word                          { $item[1] * 10_000 }
                | digit man_word                             { $item[1] * 10_000 }
                | man_word                                   { 10_000 }

      man_block:  man_term sen_block                         { $item[1] + $item[2] }
                | man_term hyaku_block                       { $item[1] + $item[2] }
                | man_term ju_block                          { $item[1] + $item[2] }
                | man_term digit                             { $item[1] + $item[2] }
                | man_term

      # ── 100,000,000 (oku) ────────────────────────────────────────────────
      oku_word:  /(?:億|おく|oku)/i

      oku_term:   sen_block oku_word                         { $item[1] * 100_000_000 }
                | hyaku_block oku_word                       { $item[1] * 100_000_000 }
                | ju_block oku_word                          { $item[1] * 100_000_000 }
                | digit oku_word                             { $item[1] * 100_000_000 }
                | oku_word                                   { 100_000_000 }

      oku_block:  oku_term man_block                         { $item[1] + $item[2] }
                | oku_term sen_block                         { $item[1] + $item[2] }
                | oku_term hyaku_block                       { $item[1] + $item[2] }
                | oku_term ju_block                          { $item[1] + $item[2] }
                | oku_term digit                             { $item[1] + $item[2] }
                | oku_term

      # ── 1,000,000,000,000 (cho) — with whole-block irregular leaders ─────
      cho_word:  /(?:兆|ちょう|cho)/i

      cho_irregular_1:  /(?:いっちょう|itcho|ittchou)/i           { 1_000_000_000_000 }
      cho_irregular_8:  /(?:はっちょう|hatcho|hatchou)/i           { 8_000_000_000_000 }
      cho_irregular_10: /(?:じゅっちょう|jutcho|jucchou|juccho)/i  { 10_000_000_000_000 }

      cho_term:   cho_irregular_1                            { $item[1] }
                | cho_irregular_8                            { $item[1] }
                | cho_irregular_10                           { $item[1] }
                | sen_block cho_word                         { $item[1] * 1_000_000_000_000 }
                | hyaku_block cho_word                       { $item[1] * 1_000_000_000_000 }
                | ju_block cho_word                          { $item[1] * 1_000_000_000_000 }
                | digit cho_word                             { $item[1] * 1_000_000_000_000 }
                | cho_word                                   { 1_000_000_000_000 }

      cho_block:  cho_term oku_block                         { $item[1] + $item[2] }
                | cho_term man_block                         { $item[1] + $item[2] }
                | cho_term sen_block                         { $item[1] + $item[2] }
                | cho_term hyaku_block                       { $item[1] + $item[2] }
                | cho_term ju_block                          { $item[1] + $item[2] }
                | cho_term digit                             { $item[1] + $item[2] }
                | cho_term

GRAMMAR
}

# }}}
# {{{ ordinal2cardinal          convert ordinal text to cardinal text

sub ordinal2cardinal :Export {
    my $input = shift // return;

    # Japanese ordinal suffix:
    #   kanji:    番目
    #   hiragana: ばんめ
    #   romaji:   -ban-me  (or "ban me" / "banme")
    $input =~ s{番目\z}{}xms                  and return $input;
    $input =~ s{ばんめ\z}{}xms                  and return $input;
    $input =~ s{[\s-]?ban[\s-]?me\z}{}xms      and return $input;

    return;  # not an ordinal
}

# }}}

1;

__END__