File Coverage

blib/lib/Lingua/KIR/Word2Num.pm
Criterion Covered Total %
statement 23 38 60.5
branch 0 6 0.0
condition 2 4 50.0
subroutine 9 11 81.8
pod 4 4 100.0
total 38 63 60.3


line stmt bran cond sub pod time code
1             # For Emacs: -*- mode:cperl; eval: (folding-mode 1); coding:utf-8 -*-
2             package Lingua::KIR::Word2Num;
3             # ABSTRACT: Word to number conversion in Kyrgyz
4              
5 1     1   83564 use 5.16.0;
  1         4  
6 1     1   7 use utf8;
  1         2  
  1         15  
7 1     1   34 use warnings;
  1         2  
  1         75  
8              
9             # {{{ use block
10              
11 1     1   717 use Export::Attrs;
  1         12750  
  1         12  
12 1     1   1408 use Parse::RecDescent;
  1         53604  
  1         10  
13              
14             # }}}
15             # {{{ var block
16             our $VERSION = '0.2603300';
17             my $parser = kir_numerals();
18              
19             # }}}
20              
21             # {{{ w2n convert text to number
22              
23             sub w2n :Export {
24 15   100 15 1 526380 my $input = shift // return;
25              
26 14         178 return $parser->numeral($input);
27 1     1   181 }
  1         2  
  1         10  
28              
29             # }}}
30             # {{{ kir_numerals create parser for kyrgyz numerals
31              
32             sub kir_numerals {
33 1     1 1 10 return Parse::RecDescent->new(q{
34            
35              
36             numeral: mega
37             | kOhOd
38             | { }
39              
40             number: 'нөл' { 0 }
41             | 'бир' { 1 }
42             | 'эки' { 2 }
43             | 'үч' { 3 }
44             | 'төрт' { 4 }
45             | 'беш' { 5 }
46             | 'алты' { 6 }
47             | 'жети' { 7 }
48             | 'сегиз' { 8 }
49             | 'тогуз' { 9 }
50              
51             tens: 'он' { 10 }
52             | 'жыйырма' { 20 }
53             | 'отуз' { 30 }
54             | 'кырк' { 40 }
55             | 'элүү' { 50 }
56             | 'алтымыш' { 60 }
57             | 'жетимиш' { 70 }
58             | 'сексен' { 80 }
59             | 'токсон' { 90 }
60              
61             deca: tens number { $item[1] + $item[2] }
62             | tens
63             | number
64              
65             hecto: number 'жүз' deca { $item[1] * 100 + $item[3] }
66             | number 'жүз' { $item[1] * 100 }
67             | 'жүз' deca { 100 + $item[2] }
68             | 'жүз' { 100 }
69              
70             hOd: hecto
71             | deca
72              
73             kilo: hOd 'миң' hOd { $item[1] * 1000 + $item[3] }
74             | hOd 'миң' { $item[1] * 1000 }
75             | 'миң' hOd { 1000 + $item[2] }
76             | 'миң' { 1000 }
77              
78             kOhOd: kilo
79             | hOd
80              
81             mega: hOd 'миллион' kOhOd { $item[1] * 1_000_000 + $item[3] }
82             | hOd 'миллион' { $item[1] * 1_000_000 }
83             });
84             }
85              
86             # }}}
87              
88             # {{{ capabilities declare supported features
89              
90             sub capabilities {
91             return {
92 0     0 1   w2n => 1,
93             };
94             }
95              
96             # }}}
97             # {{{ ordinal2cardinal convert ordinal text to cardinal text
98              
99             sub ordinal2cardinal :Export {
100 0   0 0 1   my $input = shift // return;
101              
102             # Known cardinal words (from parser vocabulary).
103 0           state $cardinals = { map { $_ => 1 } qw(
  0            
104             нөл бир эки үч төрт беш алты жети сегиз тогуз
105             он жыйырма отуз кырк элүү алтымыш жетимиш сексен токсон
106             жүз миң миллион
107             )};
108              
109             # Kyrgyz ordinal suffixes (Cyrillic, 4-way vowel harmony).
110             # After vowel-final stem: -нчы -нчи -нчу -нчү
111             # After consonant-final stem: -ынчы -инчи -унчу -үнчү
112 0           my @harmony = (
113             [ 'нчы', 'ынчы' ],
114             [ 'нчи', 'инчи' ],
115             [ 'нчу', 'унчу' ],
116             [ 'нчү', 'үнчү' ],
117             );
118              
119 0           for my $pair (@harmony) {
120 0           my ($short, $long) = @{$pair};
  0            
121              
122 0           for my $suffix ($long, $short) {
123 0 0         next unless $input =~ /\Q$suffix\E\z/xms;
124 0           my $candidate = $input =~ s/\Q$suffix\E\z//xmsr;
125 0 0         next unless length $candidate;
126              
127 0           my ($last_word) = $candidate =~ /(\S+)\z/xms;
128 0 0         return $candidate if exists $cardinals->{$last_word};
129             }
130             }
131              
132 0           return; # not an ordinal
133 1     1   732 }
  1         3  
  1         6  
134              
135             # }}}
136              
137             1;
138              
139             __END__