File Coverage

blib/lib/Lingua/Num2Word.pm
Criterion Covered Total %
statement 38 59 64.4
branch 5 26 19.2
condition 4 4 100.0
subroutine 13 14 92.8
pod 5 5 100.0
total 65 108 60.1


line stmt bran cond sub pod time code
1             # For Emacs: -*- mode:cperl; mode:folding -*-
2             #
3             # Copyright (C) PetaMem, s.r.o. 2002-present
4             #
5             package Lingua::Num2Word;
6             # ABSTRACT: A wrapper for Lingua::XXX::num2word modules.
7              
8             # {{{ use block
9              
10 1     1   37205 use 5.10.1;
  1         4  
  1         46  
11              
12 1     1   5 use strict;
  1         2  
  1         81  
13 1     1   7 use warnings;
  1         7  
  1         31  
14              
15 1     1   13 use utf8;
  1         1  
  1         9  
16              
17 1     1   24 use Carp;
  1         2  
  1         83  
18 1     1   1072 use Encode;
  1         12442  
  1         106  
19              
20             # }}}
21             # {{{ BEGIN
22              
23             our $VERSION = 0.0682;
24              
25             BEGIN {
26 1     1   7 use Exporter ();
  1         3  
  1         22  
27 1     1   7 use vars qw($VERSION $REVISION @ISA @EXPORT_OK %known);
  1         1  
  1         144  
28 1     1   5 ($REVISION) = '$Rev: 682 $' =~ /([\d.]+)/; #'
29 1         15 @ISA = qw(Exporter);
30 1         1028 @EXPORT_OK = qw(cardinal get_interval known_langs langs preprocess_code);
31             }
32              
33             # }}}
34              
35             # {{{ templates for functional and object interface
36              
37             my $template_func = q{ use __PACKAGE_WITH_VERSION__ ();
38             $result = __PACKAGE__::__FUNCTION__($number);
39             };
40              
41             my $template_obj = q{ use __PACKAGE_WITH_VERSION__ ();
42             my $tmp_obj = new __PACKAGE__;
43             $result = $tmp_obj->__FUNCTION__($number);
44             };
45              
46             # }}}
47             # {{{ %known language codes from iso639 mapped to respective interface
48              
49             %known = (
50             afr => {
51             package => 'Numbers',
52             version => '',
53             limit_lo => 0,
54             limit_hi => 99_999_999_999,
55             function => 'parse',
56             code => $template_obj,
57             },
58             ces => {
59             package => 'Num2Word',
60             version => '',
61             limit_lo => 0,
62             limit_hi => 999_999_999,
63             function => 'num2ces_cardinal',
64             code => $template_func,
65             },
66             deu => {
67             package => 'Num2Word',
68             version => '',
69             limit_lo => 0,
70             limit_hi => 999_999_999,
71             function => 'num2deu_cardinal',
72             code => $template_func,
73             },
74             eng => {
75             package => 'Numbers',
76             version => '',
77             limit_lo => 1,
78             limit_hi => 999_999_999_999_999, # 1e63
79             function => '',
80             code => q{ use __PACKAGE_WITH_VERSION__ qw(American);
81             my $tmp_obj = new __PACKAGE__;
82             $tmp_obj->parse($number);
83             $result = $tmp_obj->get_string;
84             },
85             },
86             eus => {
87             package => 'Numbers',
88             version => '',
89             limit_lo => 0,
90             limit_hi => 999_999_999_999,
91             function => 'cardinal2alpha',
92             code => $template_func,
93             },
94             fra => {
95             package => 'Nums2Words',
96             version => '',
97             limit_lo => 0,
98             limit_hi => 999_999_999_999_999, # < 1e52
99             function => 'num2word',
100             code => $template_func,
101             },
102             ind => {
103             package => 'Nums2Words',
104             version => '',
105             limit_lo => 0,
106             limit_hi => 999_999_999_999_999,
107             function => 'nums2words',
108             code => $template_func,
109             },
110             ita => {
111             package => 'Numbers',
112             version => '',
113             limit_lo => 0,
114             limit_hi => 999_999_999_999,
115             function => 'number_to_it',
116             code => $template_func,
117             },
118             jpn => {
119             package => 'Number',
120             version => '',
121             limit_lo => 1,
122             limit_hi => 999_999_999_999_999,
123             function => 'to_string',
124             code => q{ use __PACKAGE_WITH_VERSION__ ();
125             my @words = __PACKAGE__::__FUNCTION__($number);
126             $result = join ' ', @words;
127             },
128             },
129             nld => {
130             package => 'Numbers',
131             version => '',
132             limit_lo => 0,
133             limit_hi => 99_999_999_999,
134             function => 'parse',
135             code => $template_obj,
136             },
137             nor => {
138             package => 'Num2Word',
139             version => '',
140             limit_lo => 0,
141             limit_hi => 999_999_999,
142             function => 'num2no_cardinal',
143             code => $template_obj,
144             },
145             pol => {
146             package => 'Numbers',
147             version => '',
148             limit_lo => 0,
149             limit_hi => 9_999_999_999_999,
150             function => 'parse',
151             code => $template_obj,
152             },
153             por => {
154             package => 'Nums2Words',
155             version => '',
156             limit_lo => 0,
157             limit_hi => 999_999_999_999_999,
158             function => 'num2word',
159             code => $template_func,
160             },
161             rus => {
162             package => 'Number',
163             version => '',
164             limit_lo => 0,
165             limit_hi => 999_999_999_999_999,
166             function => 'rur_in_words',
167             code => q{ use __PACKAGE_WITH_VERSION__ ();
168             $result = __PACKAGE__::__FUNCTION__($number);
169             if ($result) {
170             if ($number) {
171             $result =~ s/\s+\S+\s+\S+\s+\S+$//;
172             }
173             else {
174             $result =~ s/\s+\S+$//;
175             }
176             $result =~ s/^\s+//;
177             }
178             },
179             },
180             spa => {
181             package => 'Numeros',
182             version => '',
183             limit_lo => 0,
184             limit_hi => 999_999_999_999_999,
185             function => 'cardinal',
186             code => $template_obj,
187             },
188             swe => {
189             package => 'Num2Word',
190             version => '',
191             limit_lo => 0,
192             limit_hi => 999_999_999,
193             function => 'num2sv_cardinal',
194             code => $template_func,
195             },
196             zho => {
197             package => 'Numbers',
198             version => '',
199             limit_lo => 1,
200             limit_hi => 999_999_999_999_999,
201             function => '',
202             code => q{ use __PACKAGE_WITH_VERSION__ qw(traditional);
203             my $tmp_obj = new __PACKAGE__;
204             $tmp_obj->parse($number);
205             $result = $tmp_obj->get_string;
206             },
207             },
208             );
209              
210             # }}}
211             # {{{ new constructor
212              
213             sub new {
214 5     5 1 30 return bless {}, shift;
215             }
216              
217             # }}}
218             # {{{ known_langs list of currently supported languages
219              
220             sub known_langs {
221 0 0   0 1 0 return wantarray ? sort keys %known : [ sort keys %known ];
222             }
223              
224             # }}}
225             # {{{ get_interval get minimal and maximal supported number
226              
227             # Return:
228             # undef for unsupported language
229             # list or list reference (depending to calling context) with
230             # minimal and maximal supported number
231             #
232             sub get_interval {
233 2 50   2 1 1026 my $self = ref($_[0]) ? shift : Lingua::Num2Word->new();
234 2   100     11 my $lang = shift || return;
235 1         3 my @limits;
236              
237 1 50       127 return if (!defined $known{$lang});
238              
239 0         0 @limits = ($known{$lang}{limit_lo}, $known{$lang}{limit_hi});
240              
241 0 0       0 return @limits if (wantarray);
242 0         0 return \@limits;
243             }
244              
245             # }}}
246             # {{{ cardinal convert number to text
247              
248             sub cardinal {
249 2 50   2 1 1247 my $self = ref($_[0]) ? shift : Lingua::Num2Word->new();
250 2         5 my $result = '';
251 2 50       12 my $lang = defined $_[0] ? shift : return $result;
252 0 0       0 my $number = defined $_[0] ? shift : return $result;
253              
254 0         0 $lang = lc $lang;
255              
256 0 0       0 return $result if (!defined $known{$lang});
257              
258 0 0       0 if (defined $known{$lang}{lang}) {
259 0         0 eval $self->preprocess_code($known{$lang}{lang}); ## no critic
260 0 0       0 carp $@ if ($@);
261             }
262             else {
263 0         0 eval $self->preprocess_code($lang); ## no critic
264 0 0       0 carp $@ if ($@);
265             }
266              
267 0         0 return $result;
268             }
269              
270             # }}}
271             # {{{ preprocess_code prepare code for evaluation
272              
273             sub preprocess_code {
274 2     2 1 949 my $self = shift;
275 2   100     9 my $lang = shift // return;
276              
277 1 50       7 return if !exists $known{$lang};
278              
279 0           my $result = $known{$lang}{code};
280 0           my $pkg_name = 'Lingua::' . uc($lang) . '::' . $known{$lang}{package};
281 0 0         my $pkg_name_with_version = $known{$lang}{version} ne ''
282             ? "$pkg_name $known{$lang}{version}"
283             : $pkg_name
284             ;
285              
286 0           my $function = $known{$lang}{function};
287              
288 0           $result =~ s/__PACKAGE_WITH_VERSION__/$pkg_name_with_version/g;
289 0           $result =~ s/__PACKAGE__/$pkg_name/g;
290 0           $result =~ s/__FUNCTION__/$function/g;
291              
292 0           return $result;
293             }
294             # }}}
295              
296             1;
297              
298             __END__