File Coverage

blib/lib/Lingua/EUS/Numbers.pm
Criterion Covered Total %
statement 99 100 99.0
branch 46 52 88.4
condition 47 58 81.0
subroutine 12 12 100.0
pod 2 4 50.0
total 206 226 91.1


line stmt bran cond sub pod time code
1             # For Emacs: -*- mode:cperl; eval: (folding-mode 1); coding:utf-8; -*-
2              
3             package Lingua::EUS::Numbers;
4             # ABSTRACT: Number 2 word conversion in EUS.
5              
6 5     5   130914 use 5.16.0;
  5         24  
7 5     5   3326 use utf8;
  5         1853  
  5         40  
8 5     5   191 use warnings;
  5         15  
  5         284  
9              
10             # {{{ use block
11              
12 5     5   31 use Carp;
  5         14  
  5         444  
13 5     5   3134 use Export::Attrs;
  5         58205  
  5         37  
14              
15             # }}}
16             # {{{ variables declaration
17              
18             our $VERSION = '0.2603250';
19              
20             # The Bask numeral system is vigesimal (base 20). So far, going to
21             # 999_999_999_999.
22              
23 5     5   553 our %num2alpha :Export = (
  5         16  
  5         30  
24             0 => 'zero',
25             1 => 'bat',
26             2 => 'bi',
27             3 => 'hiru',
28             4 => 'lau',
29             5 => 'bost',
30             6 => 'sei',
31             7 => 'zazpi',
32             8 => 'zortzi',
33             9 => 'bederatzi',
34             10 => 'hamar',
35             11 => 'hamaika',
36             12 => 'hamabi',
37             13 => 'hamahiru',
38             14 => 'hamalau',
39             15 => 'hamabost',
40             16 => 'hamasei',
41             17 => 'hamazazpi',
42             18 => 'hemezortzi',
43             19 => 'hemeretzi',
44             20 => 'hogei',
45             40 => 'berrogei',
46             60 => 'hirurogei',
47             80 => 'laurogei',
48             100 => 'ehun',
49             200 => 'berrehun',
50             300 => 'hirurehun',
51             400 => 'laurehun',
52             500 => 'bostehun',
53             600 => 'seiehun',
54             700 => 'zazpiehun',
55             800 => 'zortziehun',
56             900 => 'bederatziehun',
57             1000 => 'mila',
58             1000000 => 'milioi bat',
59             1000000000 => 'mila milioi'
60             );
61              
62             #Names for quantifiers, every block of 3 digits
63             #(thousands, millions, billions)
64             my %block2alpha = (
65             block1 => 'mila',
66             block2 => 'milioi',
67             block3 => 'mila milioi'
68             );
69              
70             # }}}
71              
72             #This function accepts an integer (scalar) as a parameter and
73             #returns a string (array), which is its Bask cardinal equivalent.
74             # {{{ cardinal2alpha
75              
76             sub cardinal2alpha :Export {
77 318   50 318 1 1109991 my $orig_num = shift // return;
78 318         528 my @result = ();
79 318         485 my ( $thousands, $hundreds, $tens, $units );
80 318         486 my $num = $orig_num;
81              
82             #Input validation
83 318 100       1405 unless ( $num =~ /^\d+$/ ) {
84 5         746 carp "Entry $num not valid. Should be numeric characters only";
85 5         42 return;
86             }
87              
88 313 100 66     1248 if ( $num > 999_999_999_999 or $num < 0 ) {
89 1         121 carp "Entry $num not valid. Number should be an integer between 0 and 999,999,999,999";
90 1         9 return;
91             }
92              
93             #Handling special cases
94 312 100       613 return $num2alpha{0} if $num == 0;
95 310 100       857 return $num2alpha{$num} if $num2alpha{$num};
96              
97 240         383 my $len = length($num);
98              
99             #Main logic: cutting number by block of 3 digits
100 240         496 while ( $len > 3 ) {
101              
102 166         348 $num = reverse($num);
103              
104             #Dealing with the part off the block(s) of three
105 166         485 my $extra_digits = substr( $num, int( ( $len - 1 ) / 3 ) * 3 );
106 166         251 $extra_digits = reverse($extra_digits);
107 166 100       402 push ( @result, triple_digit_handling($extra_digits) )
108             unless $extra_digits == 1;
109              
110             #Adding name for the quantifier
111 166         349 my $quantif = 'block' . ( int( ( $len - 1 ) / 3 ) );
112 166 100       606 push ( @result, $block2alpha{$quantif} ) unless $num =~ /000$/;
113              
114             #Special case for 1 million: adding the term for "one"
115 166 100 66     450 push ( @result, $num2alpha{1} ) if $len == 7 && $extra_digits == 1;
116              
117             #Adding "eta" after millions (except when there's no thousand)
118 166         320 my $whats_left = substr( reverse($num), length($extra_digits) );
119 166 100 100     699 if ( ( $len <= 8 and $len >= 7 )
      100        
      100        
120             && $whats_left != 0
121             && ( reverse($num) !~ /^[^0]000/ ) )
122             {
123 22         72 push ( @result, "eta" );
124             }
125              
126             #Adding 'eta' for hundreds, except when there are tens and/or units
127 166 100       350 if ( length($num) <= 6 ) {
128 78         395 ( $units, $tens, $hundreds, $thousands, my @rest ) =
129             split ( //, reverse($orig_num) );
130              
131 78 100 100     877 if ( ( $hundreds != 0 && $tens == 0 && $units == 0 )
      100        
      100        
      100        
      100        
      100        
      100        
      66        
      66        
      66        
132             || ( $hundreds == 0 && ( $tens || $units ) ) && $num !~ /^0/
133             || ( $thousands == 0 && $hundreds == 0 && ( $tens || $units ) )
134             )
135             {
136 36         84 push ( @result, "eta" );
137             }
138             }
139              
140             #Dealing with the remaining digits
141 166         272 $num = reverse($num);
142 166         298 $num = substr( $num, length($extra_digits) );
143 166         354 $len = length($num);
144              
145             } #end while len > 3
146              
147 240 50       657 if ( $len <= 3 ) {
148 240         478 push ( @result, triple_digit_handling($num) );
149 240         1017 return "@result";
150             }
151 5     5   6008 }
  5         11  
  5         42  
152              
153             # }}}
154              
155             #This function takes an integer (scalar) as a parameter, which is
156             #a 3-digit number or less, and returns a string (array), which is
157             #its Bask equivalent.
158             # {{{ triple_digit_handling
159              
160             sub triple_digit_handling {
161 352     352 0 528 my $num = shift;
162 352         507 my @result = ();
163 352         469 my ( $hundreds, $tens, $units, @tens_n_units );
164              
165             #Handling exceptional cases
166 352 50 33     1072 return if $num > 999 || $num < 0;
167 352 100       759 return if $num == 0;
168 256 100       631 return $num2alpha{$num} if $num2alpha{$num};
169              
170 214         310 my $len = length($num);
171              
172             #Handling 2-digit numbers
173 214 100       381 if ( $len == 2 ) {
174 152         809 ( $tens, $units ) = split ( //, sprintf( "%02d", $num ) );
175 152         396 @result = double_digit_handling( $tens, $units );
176 152         481 return @result;
177             }
178              
179             #Handling 3-digit numbers
180 62 50       202 if ( $len == 3 ) {
181 62         380 ( $hundreds, $tens, $units ) = split ( //, sprintf( "%03d", $num ) );
182 62 100       198 unless ( $hundreds == 0 ) {
183 28         55 $hundreds *= 100;
184 28         76 push ( @result, $num2alpha{$hundreds} );
185 28 50 66     114 push ( @result, "eta" ) if $tens || $units;
186             }
187              
188 62         169 @tens_n_units = double_digit_handling( $tens, $units );
189 62         114 push ( @result, @tens_n_units );
190 62         168 return @result;
191             }
192              
193             }
194              
195             # }}}
196              
197             #This function takes two integers (scalars) as parameters (tens and units)
198             #and returns a string (array), which is their Bask equivalent.
199             # {{{ double_digit_handling
200              
201             sub double_digit_handling {
202 214     214 0 360 my $diz = shift;
203 214         290 my $unit = shift;
204 214         364 my $num = "$diz$unit";
205 214         259 my @result;
206              
207             #Handling exceptional cases
208 214 50       423 return if $num == 0;
209              
210 214 100       463 return $num2alpha{$num} if $num2alpha{$num};
211              
212 192 100       442 return $num2alpha{$unit} unless $diz;
213              
214             #Dealing with base 20
215 154 100       461 if ( $diz =~ /[3579]/ ) {
216 80         179 $diz -= 1;
217 80         143 $unit += 10;
218             }
219 154         247 $diz = $diz * 10;
220              
221 154 50       306 if ($unit) { push ( @result, "$num2alpha{$diz}ta" ); }
  154         441  
222 0         0 else { push ( @result, $num2alpha{$diz} ); }
223 154         313 push ( @result, $num2alpha{$unit} );
224              
225 154         421 return @result;
226             }
227              
228             # }}}
229              
230             #This function accepts an integer (scalar) as a parameter and
231             #returns a string (array), which is its Bask ordinal equivalent.
232             # {{{ ordinal2alpha
233              
234             sub ordinal2alpha :Export {
235 162   50 162 1 406774 my $num = shift // return;
236 162         301 my @result;
237              
238             #Handling special cases
239 162 100       1049 return unless $num =~ /^\d+$/;
240 157 100 66     899 return if ( $num < 0 || $num > 999_999_999_999 );
241 156 100       333 return "lehenengo" if $num == 1;
242              
243 155         426 push ( @result, join ( '', cardinal2alpha($num), "garren" ) );
244 155         606 return "@result";
245 5     5   4539 }
  5         17  
  5         39  
246              
247             # }}}
248              
249             1;
250             __END__