File Coverage

blib/lib/Lingua/LIT/Word2Num.pm
Criterion Covered Total %
statement 24 43 55.8
branch 0 16 0.0
condition 2 9 22.2
subroutine 9 10 90.0
pod 3 3 100.0
total 38 81 46.9


line stmt bran cond sub pod time code
1             # For Emacs: -*- mode:cperl; mode:folding; coding:utf-8; -*-
2              
3             package Lingua::LIT::Word2Num;
4             # ABSTRACT: Word to number conversion in Lithuanian
5              
6 1     1   144568 use 5.16.0;
  1         5  
7 1     1   8 use utf8;
  1         3  
  1         17  
8 1     1   40 use warnings;
  1         3  
  1         132  
9              
10             # {{{ use block
11              
12 1     1   739 use Export::Attrs;
  1         14207  
  1         10  
13 1     1   1575 use Parse::RecDescent;
  1         52312  
  1         13  
14              
15             # }}}
16             # {{{ var block
17             our $VERSION = '0.2603300';
18             my $parser = lit_numerals();
19              
20             # }}}
21              
22             # {{{ w2n convert text to number
23              
24             sub w2n :Export {
25 2   100 2 1 210260 my $input = shift // return;
26              
27 1         9 $input =~ s{\s\z}{}xms;
28              
29 1         26 return $parser->numeral($input);
30 1     1   254 }
  1         3  
  1         19  
31              
32             # }}}
33             # {{{ lit_numerals create parser for Lithuanian numerals
34              
35             sub lit_numerals {
36 1     1 1 7 return Parse::RecDescent->new(q{
37            
38              
39             numeral: mega
40             | kOhOd
41             | 'nulis' { 0 }
42             | { }
43              
44             number: 'vienuolika' { 11 }
45             | 'dvylika' { 12 }
46             | 'trylika' { 13 }
47             | 'keturiolika' { 14 }
48             | 'penkiolika' { 15 }
49             | 'šešiolika' { 16 }
50             | 'septyniolika' { 17 }
51             | 'aštuoniolika' { 18 }
52             | 'devyniolika' { 19 }
53             | 'vienas' { 1 }
54             | 'du' { 2 }
55             | 'trys' { 3 }
56             | 'keturi' { 4 }
57             | 'penki' { 5 }
58             | 'šeši' { 6 }
59             | 'septyni' { 7 }
60             | 'aštuoni' { 8 }
61             | 'devyni' { 9 }
62             | 'dešimt' { 10 }
63              
64             tens: 'dvidešimt' { 20 }
65             | 'trisdešimt' { 30 }
66             | 'keturiasdešimt' { 40 }
67             | 'penkiasdešimt' { 50 }
68             | 'šešiasdešimt' { 60 }
69             | 'septyniasdešimt' { 70 }
70             | 'aštuoniasdešimt' { 80 }
71             | 'devyniasdešimt' { 90 }
72              
73             deca: tens number { $item[1] + $item[2] }
74             | tens
75             | number
76              
77             hecto: number /šimt(as|ai|ų)/ deca { $item[1] * 100 + $item[3] }
78             | number /šimt(as|ai|ų)/ { $item[1] * 100 }
79              
80             hOd: hecto
81             | deca
82              
83             kilo: hOd /tūkstanči(ai|ų)|tūkstantis/ hOd { $item[1] * 1000 + $item[3] }
84             | hOd /tūkstanči(ai|ų)|tūkstantis/ { $item[1] * 1000 }
85              
86             kOhOd: kilo
87             | hOd
88              
89             mega: hOd megas kOhOd { $item[1] * 1_000_000 + $item[3] }
90             | hOd megas { $item[1] * 1_000_000 }
91              
92             megas: /milijon(as|ai|ų)/
93             });
94             }
95              
96             # }}}
97              
98             # {{{ ordinal2cardinal convert ordinal text to cardinal text
99              
100             sub ordinal2cardinal :Export {
101 0   0 0 1   my $input = shift // return;
102              
103             # Lithuanian ordinals are adjectival with -as/-a (masc/fem) endings.
104             # Most have unique stems that must be mapped to cardinal forms.
105             # Compounds: space-separated, only last element is ordinal.
106              
107 0           my %ordinal_to_cardinal = (
108             'pirmas' => 'vienas',
109             'pirma' => 'vienas',
110             'antras' => 'du',
111             'antra' => 'du',
112             'trečias' => 'trys',
113             'trečia' => 'trys',
114             'ketvirtas' => 'keturi',
115             'ketvirta' => 'keturi',
116             'penktas' => 'penki',
117             'penkta' => 'penki',
118             'šeštas' => 'šeši',
119             'šešta' => 'šeši',
120             'septintas' => 'septyni',
121             'septinta' => 'septyni',
122             'aštuntas' => 'aštuoni',
123             'aštunta' => 'aštuoni',
124             'devintas' => 'devyni',
125             'devinta' => 'devyni',
126             'dešimtas' => 'dešimt',
127             'dešimta' => 'dešimt',
128             # Teens
129             'vienuoliktas' => 'vienuolika',
130             'vienuolikta' => 'vienuolika',
131             'dvyliktas' => 'dvylika',
132             'dvylikta' => 'dvylika',
133             'tryliktas' => 'trylika',
134             'trylikta' => 'trylika',
135             'keturioliktas' => 'keturiolika',
136             'keturiolikta' => 'keturiolika',
137             'penkioliktas' => 'penkiolika',
138             'penkiolikta' => 'penkiolika',
139             'šešioliktas' => 'šešiolika',
140             'šešiolikta' => 'šešiolika',
141             'septynioliktas' => 'septyniolika',
142             'septyniolikta' => 'septyniolika',
143             'aštuonioliktas' => 'aštuoniolika',
144             'aštuoniolikta' => 'aštuoniolika',
145             'devynioliktas' => 'devyniolika',
146             'devyniolikta' => 'devyniolika',
147             );
148              
149             # Hundreds/thousands ordinals with special stems:
150             # Standalone: "šimtasis" → "vienas šimtas", "tūkstantasis" → "vienas tūkstantis"
151             # Compound: "du šimtasis" → "du šimtai", "penki tūkstantasis" → "penki tūkstantis"
152 0 0 0       if ($input =~ m{šimtasis\z}xms || $input =~ m{tūkstantasis\z}xms) {
153 0 0         if ($input eq 'šimtasis') { return 'vienas šimtas' }
  0            
154 0 0         if ($input eq 'tūkstantasis') { return 'vienas tūkstantis' }
  0            
155 0 0         $input =~ s{šimtasis\z}{šimtai}xms and return $input;
156 0 0         $input =~ s{tūkstantasis\z}{tūkstantis}xms and return $input;
157             }
158              
159             # Compound: "dvidešimt trečias" → convert last part only
160 0 0         if ($input =~ m{\s}xms) {
161 0           my @words = split /\s+/, $input;
162 0           my $last = pop @words;
163 0   0       my $cardinal = ordinal2cardinal($last) // return;
164 0           push @words, $cardinal;
165 0           return join ' ', @words;
166             }
167              
168 0 0         return $ordinal_to_cardinal{$input} if exists $ordinal_to_cardinal{$input};
169              
170             # Tens ordinals: strip -as/-a ending
171             # dvidešimtas → dvidešimt, trisdešimtas → trisdešimt, etc.
172 0 0         if ($input =~ s{(?:as|a)\z}{}xms) {
173 0           return $input;
174             }
175              
176 0           return; # not an ordinal
177 1     1   1080 }
  1         3  
  1         8  
178              
179             # }}}
180              
181             1;
182              
183             __END__