| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | # For Emacs: -*- mode:cperl; mode:folding; -*- | 
| 2 |  |  |  |  |  |  |  | 
| 3 |  |  |  |  |  |  | package Lingua::JPN::Word2Num; | 
| 4 |  |  |  |  |  |  | # ABSTRACT: Word 2 number conversion in JPN. | 
| 5 |  |  |  |  |  |  |  | 
| 6 |  |  |  |  |  |  | # {{{ use block | 
| 7 |  |  |  |  |  |  |  | 
| 8 | 1 |  |  | 1 |  | 20529 | use 5.10.1; | 
|  | 1 |  |  |  |  | 3 |  | 
|  | 1 |  |  |  |  | 38 |  | 
| 9 |  |  |  |  |  |  |  | 
| 10 | 1 |  |  | 1 |  | 6 | use strict; | 
|  | 1 |  |  |  |  | 1 |  | 
|  | 1 |  |  |  |  | 45 |  | 
| 11 | 1 |  |  | 1 |  | 5 | use warnings; | 
|  | 1 |  |  |  |  | 5 |  | 
|  | 1 |  |  |  |  | 23 |  | 
| 12 |  |  |  |  |  |  |  | 
| 13 | 1 |  |  | 1 |  | 715 | use Perl6::Export::Attrs; | 
|  | 1 |  |  |  |  | 9649 |  | 
|  | 1 |  |  |  |  | 6 |  | 
| 14 |  |  |  |  |  |  |  | 
| 15 | 1 |  |  | 1 |  | 1925 | use Parse::RecDescent; | 
|  | 1 |  |  |  |  | 47453 |  | 
|  | 1 |  |  |  |  | 8 |  | 
| 16 |  |  |  |  |  |  | # }}} | 
| 17 |  |  |  |  |  |  | # {{{ variable declarations | 
| 18 |  |  |  |  |  |  |  | 
| 19 |  |  |  |  |  |  | our $VERSION = 0.0682; | 
| 20 |  |  |  |  |  |  | our $INFO    = { | 
| 21 |  |  |  |  |  |  | rev  => '$Rev: 682 $', | 
| 22 |  |  |  |  |  |  | }; | 
| 23 |  |  |  |  |  |  |  | 
| 24 |  |  |  |  |  |  | my $parser = ja_numerals(); | 
| 25 |  |  |  |  |  |  |  | 
| 26 |  |  |  |  |  |  | # }}} | 
| 27 |  |  |  |  |  |  |  | 
| 28 |  |  |  |  |  |  | # {{{ w2n                                         convert number to text | 
| 29 |  |  |  |  |  |  | # | 
| 30 |  |  |  |  |  |  | sub w2n :Export { | 
| 31 | 4 |  | 100 | 4 | 1 | 216303 | my $input = shift // return; | 
| 32 |  |  |  |  |  |  |  | 
| 33 | 3 |  |  |  |  | 12 | $input =~ s/san-byaku/san hyaku/g;    # Spoken language exceptions, that are being corrected | 
| 34 | 3 |  |  |  |  | 8 | $input =~ s/ro-p-pyaku/roku hyaku/g;  # to use one unique logic | 
| 35 | 3 |  |  |  |  | 8 | $input =~ s/ha-p-pyaku/hachi hyaku/g; | 
| 36 | 3 |  |  |  |  | 8 | $input =~ s/san-zen/san sen/g; | 
| 37 | 3 |  |  |  |  | 10 | $input =~ s/ha-s-sen/hachi sen/g; | 
| 38 | 3 |  |  |  |  | 6 | $input =~ s/hyaku-man/hyman/g; | 
| 39 |  |  |  |  |  |  |  | 
| 40 | 3 |  |  |  |  | 13 | $input =~ s/-/ /g;                   # make space an standard for everything | 
| 41 |  |  |  |  |  |  |  | 
| 42 | 3 |  |  |  |  | 34 | return $parser->numeral($input); | 
| 43 | 1 |  |  | 1 |  | 198 | } | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 9 |  | 
| 44 |  |  |  |  |  |  | # }}} | 
| 45 |  |  |  |  |  |  | # {{{ ja_numerals                                 create parser for numerals | 
| 46 |  |  |  |  |  |  | # | 
| 47 |  |  |  |  |  |  | sub ja_numerals { | 
| 48 | 1 |  |  | 1 | 1 | 4 | return Parse::RecDescent->new(q{ | 
| 49 |  |  |  |  |  |  | numeral: | 
| 50 |  |  |  |  |  |  | numeral: tenmillion   { return $item[1]; } | 
| 51 |  |  |  |  |  |  | |      million      { return $item[1]; } | 
| 52 |  |  |  |  |  |  | |      tenmillenium { return $item[1]; } | 
| 53 |  |  |  |  |  |  | |      millenium    { return $item[1]; } | 
| 54 |  |  |  |  |  |  | |      century      { return $item[1]; } | 
| 55 |  |  |  |  |  |  | |      decade       { return $item[1]; } | 
| 56 |  |  |  |  |  |  | |                   { return undef; } | 
| 57 |  |  |  |  |  |  |  | 
| 58 |  |  |  |  |  |  | number: 'ichi'  { $return = 1; }                                # try to find a word from 1 to 9 | 
| 59 |  |  |  |  |  |  | |     'ni'    { $return = 2; } | 
| 60 |  |  |  |  |  |  | |     'san'   { $return = 3; } | 
| 61 |  |  |  |  |  |  | |     'yon'   { $return = 4; } | 
| 62 |  |  |  |  |  |  | |     'go'    { $return = 5; } | 
| 63 |  |  |  |  |  |  | |     'roku'  { $return = 6; } | 
| 64 |  |  |  |  |  |  | |     'nana'  { $return = 7; } | 
| 65 |  |  |  |  |  |  | |     'hachi' { $return = 8; } | 
| 66 |  |  |  |  |  |  | |     'kyu'   { $return = 9; } | 
| 67 |  |  |  |  |  |  | |     'ju'    { $return = 10; } | 
| 68 |  |  |  |  |  |  |  | 
| 69 |  |  |  |  |  |  | decade: number(?) number(?) number(?)                           # try to find words that represents values | 
| 70 |  |  |  |  |  |  | { my @s;                                                # from 0 to 99 | 
| 71 |  |  |  |  |  |  | for (@item) { | 
| 72 |  |  |  |  |  |  | if (ref $_ && defined $$_[0]) { | 
| 73 |  |  |  |  |  |  | push(@s,$$_[0]); | 
| 74 |  |  |  |  |  |  | } | 
| 75 |  |  |  |  |  |  | } | 
| 76 |  |  |  |  |  |  |  | 
| 77 |  |  |  |  |  |  | $return = shift @s; | 
| 78 |  |  |  |  |  |  | $return = $return * $s[0] + $s[1] if (scalar(@s) == 2); | 
| 79 |  |  |  |  |  |  | $return = $return * $s[0] if (scalar(@s) == 1 && $s[0] == 10); # The order of the 10 multiplier | 
| 80 |  |  |  |  |  |  | $return = $return + $s[0] if (scalar(@s) == 1 && $s[0] != 10); # defines sum or multiply | 
| 81 |  |  |  |  |  |  | } | 
| 82 |  |  |  |  |  |  |  | 
| 83 |  |  |  |  |  |  | century: number(?) 'hyaku' decade(?)                            # try to find words that represents values | 
| 84 |  |  |  |  |  |  | { $return = 0;                                         # from 100 to 999 | 
| 85 |  |  |  |  |  |  | for (@item) { | 
| 86 |  |  |  |  |  |  | if (ref $_ && defined $$_[0]) { | 
| 87 |  |  |  |  |  |  | $return += $$_[0]; | 
| 88 |  |  |  |  |  |  | } elsif ($_ eq "hyaku") { | 
| 89 |  |  |  |  |  |  | $return = ($return>0) ? $return * 100 : 100; | 
| 90 |  |  |  |  |  |  | } | 
| 91 |  |  |  |  |  |  | } | 
| 92 |  |  |  |  |  |  | } | 
| 93 |  |  |  |  |  |  |  | 
| 94 |  |  |  |  |  |  | millenium: century(?) decade(?) 'sen' century(?) decade(?)        # try to find words that represents values | 
| 95 |  |  |  |  |  |  | { $return = 0;                                         # from 1.000 to 9.999 | 
| 96 |  |  |  |  |  |  | for (@item) { | 
| 97 |  |  |  |  |  |  | if (ref $_ && defined $$_[0]) { | 
| 98 |  |  |  |  |  |  | $return += $$_[0]; | 
| 99 |  |  |  |  |  |  | } elsif ($_ eq "sen") { | 
| 100 |  |  |  |  |  |  | $return = ($return>0) ? $return * 1000 : 1000; | 
| 101 |  |  |  |  |  |  | } | 
| 102 |  |  |  |  |  |  | } | 
| 103 |  |  |  |  |  |  | } | 
| 104 |  |  |  |  |  |  |  | 
| 105 |  |  |  |  |  |  | tenmillenium: millenium(?) century(?) decade(?)                    # try to find words that represents values | 
| 106 |  |  |  |  |  |  | 'man'                                                  # from 10.000 to 999.999 | 
| 107 |  |  |  |  |  |  | millenium(?) century(?) decade(?) | 
| 108 |  |  |  |  |  |  | { $return = 0; | 
| 109 |  |  |  |  |  |  | for (@item) { | 
| 110 |  |  |  |  |  |  | if (ref $_ && defined $$_[0]) { | 
| 111 |  |  |  |  |  |  | $return += $$_[0]; | 
| 112 |  |  |  |  |  |  | } elsif ($_ eq "man") { | 
| 113 |  |  |  |  |  |  | $return = ($return>0) ? $return * 10000 : 10000; | 
| 114 |  |  |  |  |  |  | } | 
| 115 |  |  |  |  |  |  | } | 
| 116 |  |  |  |  |  |  | } | 
| 117 |  |  |  |  |  |  |  | 
| 118 |  |  |  |  |  |  | million: tenmillenium(?) millenium(?) century(?) decade(?)            # try to find words that represents values | 
| 119 |  |  |  |  |  |  | 'hyman'                                                      # from  1.000.000 to 999.999.999 | 
| 120 |  |  |  |  |  |  | tenmillenium(?) millenium(?) century(?) decade(?) | 
| 121 |  |  |  |  |  |  | { $return = 0; | 
| 122 |  |  |  |  |  |  | for (@item) { | 
| 123 |  |  |  |  |  |  | if (ref $_ && defined $$_[0]) { | 
| 124 |  |  |  |  |  |  | $return += $$_[0]; | 
| 125 |  |  |  |  |  |  | } elsif ($_ eq "hyman") { | 
| 126 |  |  |  |  |  |  | $return = ($return>0) ? $return * 1000000 : 1000000; | 
| 127 |  |  |  |  |  |  | } | 
| 128 |  |  |  |  |  |  | } | 
| 129 |  |  |  |  |  |  | } | 
| 130 |  |  |  |  |  |  |  | 
| 131 |  |  |  |  |  |  | tenmillion: million(?) tenmillenium(?) millenium(?)                   # try to find words that represents values | 
| 132 |  |  |  |  |  |  | century(?) decade(?)                                      # from 100.000.000 to 999.999.999.999 | 
| 133 |  |  |  |  |  |  | 'oku' | 
| 134 |  |  |  |  |  |  | million(?) tenmillenium(?) millenium(?) | 
| 135 |  |  |  |  |  |  | century(?) decade(?) | 
| 136 |  |  |  |  |  |  | { $return = 0; | 
| 137 |  |  |  |  |  |  | for (@item) { | 
| 138 |  |  |  |  |  |  | if (ref $_ && defined $$_[0]) { | 
| 139 |  |  |  |  |  |  | $return += $$_[0]; | 
| 140 |  |  |  |  |  |  | } elsif ($_ eq "oku") { | 
| 141 |  |  |  |  |  |  | $return = ($return>0) ? $return * 100000000 : 100000000; | 
| 142 |  |  |  |  |  |  | } | 
| 143 |  |  |  |  |  |  | } | 
| 144 |  |  |  |  |  |  | } | 
| 145 |  |  |  |  |  |  | }); | 
| 146 |  |  |  |  |  |  | } | 
| 147 |  |  |  |  |  |  | # }}} | 
| 148 |  |  |  |  |  |  |  | 
| 149 |  |  |  |  |  |  | 1; | 
| 150 |  |  |  |  |  |  |  | 
| 151 |  |  |  |  |  |  | __END__ |