| 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__ |