File Coverage

blib/lib/Lingua/JPN/Word2Num.pm
Criterion Covered Total %
statement 28 28 100.0
branch n/a
condition 2 2 100.0
subroutine 8 8 100.0
pod 2 2 100.0
total 40 40 100.0


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__