File Coverage

blib/lib/Lingua/EUS/Numbers.pm
Criterion Covered Total %
statement 91 92 98.9
branch 46 52 88.4
condition 45 58 77.5
subroutine 9 9 100.0
pod 2 4 50.0
total 193 215 89.7


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