File Coverage

blib/lib/Lingua/ES/Numeros.pm
Criterion Covered Total %
statement 248 251 98.8
branch 134 144 93.0
condition 24 26 92.3
subroutine 36 36 100.0
pod 17 18 94.4
total 459 475 96.6


line stmt bran cond sub pod time code
1              
2             =head1 NAME
3              
4             Lingua::ES::Numeros - Translates numbers to spanish text
5              
6             =head1 SYNOPSIS
7              
8             use Lingua::ES::Numeros ":constants";
9              
10             my $obj = new Lingua::ES::Numeros ('MAYUSCULAS' => 1);
11             print $obj->cardinal(124856), "\n";
12             print $obj->real(124856.531), "\n";
13             $obj->{GENERO} = FEMALE;
14             print $obj->ordinal(124856), "\n";
15              
16             =head1 DESCRIPTION
17              
18             This module supports the translation of cardinal, ordinal and, real numbers, the
19             module handles integer numbers up to vigintillions (that's 1e120), since Perl
20             does not handle such numbers natively, numbers are kept as text strings because
21             processing does not justify using bigint.
22              
23             Currently Lingua::ES::Numeros handles numbers up to 1e127-1 (999999 vigintillions).
24              
25             =cut
26              
27             #######################################################################
28             # Jose Luis Rey Barreira (C) 2001-2009
29             #######################################################################
30              
31             package Lingua::ES::Numeros;
32              
33 4     4   115651 use 5.006;
  4         18  
  4         709  
34 4     4   24 use utf8;
  4         7  
  4         29  
35 4     4   140 use strict;
  4         18  
  4         128  
36 4     4   28 use warnings;
  4         5  
  4         135  
37              
38 4     4   20 use Carp;
  4         7  
  4         653  
39              
40 4     4   20 use base qw( Exporter );
  4         6  
  4         907  
41              
42             our $VERSION = '0.09';
43              
44             our @EXPORT = qw( );
45             our @EXPORT_OK = qw( MALE FEMALE NEUTRAL MASCULINO FEMENINO NEUTRO );
46             our %EXPORT_TAGS = ( constants => [qw(MALE FEMALE NEUTRAL MASCULINO FEMENINO NEUTRO)] );
47              
48             # Perl 5.6 fails with this
49             #use constant {
50             # MALE => 'o',
51             # FEMALE => 'a',
52             # NEUTRAL => '' };
53              
54 4     4   23 use constant MALE => 'o';
  4         6  
  4         368  
55 4     4   30 use constant FEMALE => 'a';
  4         8  
  4         273  
56 4     4   31 use constant NEUTRAL => '';
  4         15  
  4         176  
57              
58 4     4   54 use constant MASCULINO => 'o';
  4         6  
  4         157  
59 4     4   18 use constant FEMENINO => 'a';
  4         8  
  4         217  
60 4     4   20 use constant NEUTRO => '';
  4         8  
  4         264  
61              
62 4         26 use fields qw/ ACENTOS MAYUSCULAS UNMIL HTML DECIMAL SEPARADORES GENERO
63 4     4   4061 POSITIVO NEGATIVO FORMATO /;
  4         7164  
64              
65             =head1 METHODS
66              
67             =head2 CONSTRUCTOR: new
68              
69             To create a new Lingua::ES::Numeros, use the B class method. This method can
70             receive as parameters any of the above mentioned fields.
71              
72             Examples:
73              
74             use Lingua::ES::Numeros ':constants';
75            
76             # Use the fields' default values
77             $obj = new Lingua::ES::Numeros;
78            
79             # Specifies the values of some of them
80             $obj = Lingua::ES::Numeros->new( ACENTOS => 0,
81             MAYUSCULAS => 1, GENERO => FEMALE,
82             DECIMAL => ',', SEPARADORES=> '"_' );
83              
84             =over 4
85              
86             =item DECIMAL
87              
88             Specifies the character string that will be used to separate the integer
89             from the fractional part of the number to convert. The default value for
90             DECIMAL is '.'
91              
92             =item SEPARADORES
93              
94             Character string including all of the format characters used when
95             representing a number. All of the characters in this string will be ignored
96             by the parser when analyzing the number. The default value for SEPARADORES
97             is '_'
98              
99             =item ACENTOS
100              
101             Affects the way in which the generated string for the translated numbers is
102             given; if it is false, the textual representation will not have any
103             accented characters. The default value for this field is true (with
104             accents).
105              
106             =item MAYUSCULAS
107              
108             If this is a true value, the textual representation of the number will be
109             an uppercase character string. The default value for this field is false
110             (lowercase).
111              
112             =item HTML
113              
114             If this is a true value, the textual representation of the number will be a
115             HTML-valid string character (accents will be represented by their
116             respective HTML entities). The default value is 0 (text).
117              
118             =item GENERO
119              
120             The gender of the numbers can be MALE, FEMALE or NEUTRAL, respectively for
121             femenine, masculine or neutral numbers. The default value is MALE.
122              
123             The following table shows the efect of GENDER on translation of Cardinal
124             and Ordinal numbers:
125              
126             +---+---------------------+-----------------------------+
127             | N | CARDINAL | ORDINAL |
128             | u +------+------+-------+---------+---------+---------+
129             | m | MALE |FEMALE|NEUTRAL| MALE | FEMALE | NEUTRAL |
130             +---+------+------+-------+---------+---------+---------+
131             | 1 | uno | una | un | primero | primera | primer |
132             | 2 | dos | dos | dos | segundo | segunda | segundo |
133             | 3 | tres | tres | tres | tercero | tercera | tercer |
134             +---+------+------+-------+---------+---------+---------+
135              
136             The constants MALE, FEMALE and NEUTRAL and their spanish counterparts MASCULINO,
137             FEMENINO and NEUTRO, may be imported with the tag ":constants" on module use.
138              
139             =item SEXO
140              
141             Deprecated option only for backward compatibility, use GENERO instead.
142              
143             =item UNMIL
144              
145             This field affects only the translation of cardinal numbers. When it is a true
146             value, the number 1000 is translated to 'un mil' (one thousand), otherwise it
147             is translated to the more colloquial 'mil' (thousand). The default value is 1.
148              
149             =item NEGATIVO
150              
151             Contains the character string with the text to which the negative sign (-) will
152             be translated with. Defaults to 'menos'.
153              
154             For example: default translation of -5 will yield "menos cinco".
155              
156             =item POSITIVO
157              
158             Contains the character string with the text to which the positive sign will be
159             translated with. Defaults to ''.
160              
161             For example: default translation of 5 will yield "cinco".
162              
163             =item FORMATO
164              
165             A character string specifying how the decimals of a real number are to be
166             translated. Its default value is 'con %2d ctms.' (see the B method)
167              
168             =back
169              
170             =head3 Aliases
171              
172             All the options have the following english aliases.
173              
174             English Option name
175             --------------------------
176             ACCENTS ACENTOS
177             UPPERCASE MAYUSCULAS
178             SEPARATORS SEPARADORES
179             GENDER GENERO
180             POSITIVE POSITIVO
181             NEGATIVE NEGATIVO
182             FORMAT FORMATO
183              
184             =cut
185              
186             my %opt_alias = qw(
187             ACCENTS ACENTOS
188             UPPERCASE MAYUSCULAS
189             SEPARATORS SEPARADORES
190             GENDER GENERO
191             POSITIVE POSITIVO
192             NEGATIVE NEGATIVO
193             FORMAT FORMATO );
194              
195             my %new_defaults = (
196             ACENTOS => 1,
197             MAYUSCULAS => 0,
198             UNMIL => 1,
199             HTML => 0,
200             DECIMAL => '.',
201             SEPARADORES => '_',
202             GENERO => MALE,
203             POSITIVO => '',
204             NEGATIVO => 'menos',
205             FORMATO => 'con %02d ctms.',
206             );
207              
208             sub new {
209 7     7 1 3942 my $self = shift;
210 7 100       37 unless ( ref $self ) {
211 6         36 $self = fields::new($self);
212             }
213              
214             #%$self = (%new_defaults, @_);
215             { # Compatibility conversion of SEXO into GENERO
216 7         13681 my %opts = ( %new_defaults, @_ );
  7         96  
217 7 100       33 if ( $opts{'SEXO'} ) {
218 1         3 $opts{'GENERO'} = $opts{'SEXO'};
219 1         4 delete $opts{'SEXO'};
220             }
221 7         62 %$self = %opts
222             }
223 7         35 return $self;
224             }
225              
226             =head2 cardinal
227              
228             SYNOPSIS:
229             $text = $obj->cardinal($num)
230              
231             =head3 Parameters
232              
233             =over 4
234              
235             =item $num
236              
237             the number.
238              
239             =back
240              
241             =head3 Description
242              
243             Translates a cardinal number ($num) to spanish text, translation
244             is performed according to the following object ($obj) settings:
245             DECIMAL, SEPARADORES, SEXO, ACENTOS, MAYUSCULAS, POSITIVO and
246             NEGATIVO.
247              
248             This method ignores any fraction part of the number ($num).
249              
250             =head3 Return Value
251              
252             Textual representation of the number as a string
253              
254             =cut
255              
256             sub cardinal_str($) {
257 10570     10570 0 15646 my $self = shift;
258 10570         13935 my $num = shift;
259 10570         36701 my ( $sgn, $ent, $frc, $exp ) = parse_num( $num, $self->{'DECIMAL'}, $self->{'SEPARADORES'} );
260 10570         39189 my @words = cardinal_simple( $ent, $exp, $self->{'UNMIL'}, $self->{'GENERO'} );
261 10570 100       30175 if (@words) {
262 10569 100 66     28755 unshift @words, $self->{'NEGATIVO'} if $sgn < 0 and $self->{'NEGATIVO'};
263 10569 100 100     53813 unshift @words, $self->{'POSITIVO'} if $sgn > 0 and $self->{'POSITIVO'};
264 10569         77596 return join( " ", @words );
265             }
266             else {
267 1         5 'cero';
268             }
269             }
270              
271             sub cardinal($) {
272 10449     10449 1 6749693 my $self = shift;
273 10449         26179 $self->retval($self->cardinal_str(shift));
274             }
275              
276             =head2 real
277              
278             SYNOPSIS:
279             $text = real($n; $genf, $genm)
280              
281             Translates the real number ($n) to spanish text.
282              
283             The optional $genf and $genm parameters are used to specify gender of the
284             fraction part and fraction part magnitude in that order. If $genf is missing
285             it will default to the GENDER option, and $genm will default to the $genf's
286             value.
287              
288             This translation is affected by the options: DECIMAL, SEPARADORES, GENDER,
289             ACENTOS, MAYUSCULAS, POSITIVO, NEGATIVO and FORMATO.
290              
291             =head3 Fraction format (FORMATO)
292              
293             FORMAT option is a formatting string like printf, it is used to format the
294             fractional part before appending it to the integer part. It has the following
295             format specifiers:
296              
297             =over 4
298              
299             =item %Ns
300              
301             Formats the fractional part as text with precisión of N digits, for example:
302             number '124.345' formated with string 'CON %s.' will yield the text 'ciento
303             veinticuatro CON trescientas cuarenta y cinco milEsimas', and
304             formatted with string 'CON %2s.' will yield 'ciento veinticuatro CON treinta
305             y cuatro centEsimas'.
306              
307             =item %Nd
308              
309             Formats the fractional part as a number (no translation), with precision
310             of N digits, veri similar to sprintf's %d format, for example: number
311             '124.045' formated with 'CON %2d ctms.' will yield: 'ciento veinticuatro
312             CON 04 ctms.'
313              
314             =back
315              
316             =cut
317              
318             sub real($;$$) {
319 123     123 1 49821 my $self = shift;
320 123         205 my ( $num, $genf, $genm ) = @_;
321 123         440 my ( $sgn, $ent, $frc, $exp ) = parse_num( $num, $self->{'DECIMAL'}, $self->{'SEPARADORES'} );
322              
323 121         293 my $gen = $self->{'GENERO'};
324 121 50       239 $genf = $gen unless defined $genf;
325 121 50       291 $genm = $genf unless defined $genm;
326              
327             # Convertir la parte entera ajustando el sexo
328             #my @words = cardinal_simple($ent, $exp, $self->{'UNMIL'}, $gen);
329              
330             # Traducir la parte decimal de acuerdo al formato
331 121         255 for ( $self->{'FORMATO'} ) {
332 121 100       459 /%([0-9]*)s/ && do {
333              
334             # Textual, se traduce según el genero
335 18 50       58 $frc = substr( '0' x $exp . $frc, 0, $1 ) if $1;
336 18         43 $frc = join( " ", fraccion_simple( $frc, $exp, $self->{'UNMIL'}, $genf, $genm ) );
337 18 50       82 $frc = $frc ? sprintf( $self->{'FORMATO'}, $frc ) : '';
338 18         32 last;
339             };
340 103 100       340 /%([0-9]*)d/ && do {
341              
342             # Numérico, se da formato a los dígitos
343 102         430 $frc = substr( '0' x $exp . $frc . '0' x $1, 0, $1 );
344 102         391 $frc = sprintf( $self->{'FORMATO'}, $frc );
345 102         151 last;
346             };
347 1         2 do {
348              
349             # Sin formato, se ignoran los decimales
350 1         3 $frc = '';
351 1         2 last;
352             };
353             }
354 121 50       206 if ($ent) {
355 121 100       390 $ent = $self->cardinal_str( ( $sgn < 0 ? '-' : '+' ) . $ent );
356             }
357             else {
358 0         0 $ent = 'cero';
359             }
360 121 100 66     753 $ent .= ' ' . $frc if $ent and $frc;
361 121         329 return $self->retval($ent);
362             }
363              
364             =head2 ordinal
365              
366             SYNOPSIS:
367             $text = $obj->ordinal($num)
368              
369             =head3 Parameters
370              
371             =over 4
372              
373             =item $num
374              
375             the number.
376              
377             =back
378              
379             =head3 Description
380              
381             Translates an ordinal number ($num) to spanish text, translation
382             is performed according to the following object ($obj) settings:
383             DECIMAL, SEPARADORES, GENERO, ACENTOS, MAYUSCULAS, POSITIVO and
384             NEGATIVO.
385              
386             This method croacks if $num <= 0 and carps if $num has a fractional
387             part.
388              
389             =head3 Return Value
390              
391             Textual representation of the number as a string
392              
393             =cut
394              
395             sub ordinal($) {
396 10451     10451 1 10844243 my $self = shift;
397 10451         16432 my $num = shift;
398 10451         34738 my ( $sgn, $ent, $frc, $exp ) = parse_num( $num, $self->{'DECIMAL'}, $self->{'SEPARADORES'} );
399              
400 10451 100       25654 croak "Ordinal negativo" if $sgn < 0;
401 10450 100       19365 carp "Ordinal con decimales" if $frc;
402              
403 10450 100       32126 if ( $ent =~ /^0*$/ ) {
404 2         219 carp "Ordinal cero";
405 2         270 return '';
406             }
407              
408 10448         36045 my $text = join( " ", ordinal_simple( $ent, $exp, $self->{'GENERO'} ) );
409              
410 10447         38240 return $self->retval($text);
411             }
412              
413             =head2 Accessors
414              
415             Each of the options has a setter/getter with the name of the option in
416             lowercase, all the accessors have the following sintax:
417              
418             =head3 Getters
419              
420             $obj->name_of_option()
421              
422             Returns the current value of the option.
423              
424             =head3 Setters
425              
426             $obj->name_of_option( $value )
427              
428             Sets the option to $value and returns $obj
429              
430             =head3 List of accessors
431              
432             $obj->accents
433             $obj->acentos
434             $obj->uppercase
435             $obj->mayusculas
436             $obj->unmil
437             $obj->html
438             $obj->decimal
439             $obj->separators
440             $obj->separadores
441             $obj->gender
442             $obj->genero
443             $obj->positive
444             $obj->positivo
445             $obj->negative
446             $obj->negativo
447             $obj->format
448             $obj->formato
449              
450             =cut
451              
452             { # Build the accessors
453              
454             my %names = ( ( map { $_ => $_ } keys %new_defaults ), %opt_alias );
455             while ( my ( $opt, $alias ) = each %names ) {
456             $opt = lc $opt;
457 4     4   5933 no strict 'refs';
  4         16  
  4         14339  
458             *$opt = sub {
459 57     57   118 my $self = shift;
460 57 100       300 return $self->{$alias} unless @_;
461 16         34 $self->{$alias} = shift;
462 16         143 return $self;
463             }
464             }
465             }
466              
467             =head1 INTERNALS
468              
469             Functions in this secction are generally not used, but are docummented
470             here for completeness.
471              
472             This is not part of the module's API and is subject to change.
473              
474             =head2 CARDINAL SUPPORT
475              
476             Construction of cardinal numbers
477              
478             =cut
479              
480             #####################################################################
481             #
482             # Soporte para números CARDINALES
483             #
484             ####################################################################
485              
486             my @cardinal_30 = qw/ cero un dos tres cuatro cinco seis siete ocho nueve diez
487             once doce trece catorce quince dieciséis diecisiete dieciocho diecinueve
488             veinte veintiun veintidós veintitrés veinticuatro veinticinco veintiséis
489             veintisiete veintiocho veintinueve /;
490              
491             my @cardinal_dec = qw/
492             0 1 2 treinta cuarenta cincuenta sesenta setenta ochenta noventa /;
493              
494             my @cardinal_centenas = (
495             "", qw/
496             ciento doscientos trescientos cuatrocientos quinientos
497             seiscientos setecientos ochocientos novecientos /
498             );
499              
500             my @cardinal_megas = (
501             "", qw/ m b tr cuatr quint sext sept oct non dec undec
502             dudec tredec cuatordec quindec sexdec sepdec octodec novendec vigint /
503             );
504              
505             my $MAX_DIGITS = 6 * @cardinal_megas;
506              
507             =head3 cardinal_e2
508              
509             =over 4
510              
511             =item SYNOPSIS
512              
513             cardinal_e2($n, $nn)
514              
515             =item PARAMETERS
516              
517             =over 4
518              
519             =item $n
520              
521             the number.
522              
523             =item $nn
524              
525             word stack.
526              
527             =back
528              
529             =item DESCRIPTION
530              
531             This procedure takes $n (an integer in the range [0 .. 99], not verified) and
532             adds the numbers text translation to $nn (a word stack), on a word by word basis.
533             If $n == 0 nothing is pushed into $nn.
534              
535             =back
536              
537             =cut
538              
539             sub cardinal_e2($$) {
540 110390     110390 1 167851 my ( $n, $nn ) = @_;
541              
542 110390 100       239179 return if $n == 0;
543 110186 100       242375 do { push @$nn, $cardinal_30[$n]; return } if $n < 30;
  65078         131051  
  65078         114430  
544 45108         147822 $n =~ /^(.)(.)$/;
545 45108 100       181264 push @$nn, $cardinal_30[$2], "y" if $2;
546 45108         130297 push @$nn, $cardinal_dec[$1];
547             }
548              
549             =head3 cardinal_e3
550              
551             =over 4
552              
553             =item SYNOPSIS
554              
555             cardinal_e3($n, $nn)
556              
557             =item PARAMETERS
558              
559             =over 4
560              
561             =item $n
562              
563             the number.
564              
565             =item $nn
566              
567             word stack.
568              
569             =back
570              
571             =item DESCRIPTION
572              
573             This procedure takes $n (an integer in the range [0 .. 99], not verified) and
574             adds the numbers text translation to $nn (a word stack), on a word by word basis.
575             If $n == 0 nothing is pushed into $nn.
576              
577             =back
578              
579             =cut
580              
581             sub cardinal_e3($$) {
582 112879     112879 1 168931 my ( $n, $nn ) = @_;
583              
584 112879 100       227219 return if $n == 0;
585 111388 100       221381 $n == 100 and do { push @$nn, "cien"; return };
  998         1820  
  998         2901  
586 110390         282872 cardinal_e2( $n % 100, $nn );
587 110390 100       593191 $n >= 100 and push @$nn, $cardinal_centenas[ int( $n / 100 ) ];
588             }
589              
590             =head3 cardinal_e6
591              
592             =over 4
593              
594             =item SYNOPSIS
595              
596             cardinal_e6($n, $nn, $mag, $un_mil, $postfix)
597              
598             =item PARAMETERS
599              
600             =over 4
601              
602             =item $n
603              
604             the number.
605              
606             =item $nn
607              
608             word stack.
609              
610             =item $mag
611              
612             magnitude of the number 1 for millions, 2 for billions, etc.
613              
614             =item $un_mil
615              
616             if true 1000 is translated as "un mil" otherwise "mil"
617              
618             =item $postfix
619              
620             array representing plural & singular magnitude of the number, in this
621             order.
622              
623             =back
624              
625             =item DESCRIPTION
626              
627             This procedure takes $n, and pushes the numbers text translation into $nn,
628             on a word by word basis, with the proper translated magnitude. If $n == 0
629             nothing is pushed into $nn.
630              
631             =back
632              
633             =cut
634              
635             sub cardinal_e6($$$$$) {
636 63586     63586 1 203778 my ( $n, $nn, $mag, $un_mil, $postfix ) = @_;
637              
638 63586 100       298561 return if $n == 0;
639 57916 100       148775 push @$nn, $cardinal_megas[$mag] . $postfix->[ $n == 1 ] if $mag;
640 57916         159487 cardinal_e3( $n % 1000, $nn );
641 57916         95240 my $n3 = int( $n / 1000 );
642 57916 100       293873 if ($n3) {
643 37116         64183 push @$nn, "mil";
644 37116 100 100     169451 cardinal_e3( $n3, $nn ) if $n3 != 1 or $un_mil;
645             }
646             }
647              
648             =head3 cardinal_generic
649              
650             =over 4
651              
652             =item SYNOPSIS
653              
654             cardinal_generic($n, $exp, $fmag, $gen)
655              
656             =item PARAMETERS
657              
658             =over 4
659              
660             =item $n
661              
662             the number.
663              
664             =item $exp
665              
666             exponent.
667              
668             =item $fmag
669              
670             closure to format the 6 digits groups.
671              
672             =item $gen
673              
674             gender of the magnitude (optional defaults to NEUTRAL):
675             FEMALE for female gender (1 -> una).
676             MALE for male gender (1 -> uno).
677             NEUTRAL for neutral gender (1 -> un).
678              
679             =back
680              
681             =item DESCRIPTION
682              
683             This function translate the natural number $n to spanish words, adding
684             gender where needed.
685              
686             =item RETURN VALUE
687              
688             Translation of $n to spanish text as a list of words.
689              
690             =back
691              
692             =cut
693              
694             sub cardinal_generic($$$$) {
695 24081     24081 1 52422 my ( $n, $exp, $fmag, $gen ) = @_;
696              
697 24081         93624 $n =~ s/^0*//; # eliminar ceros a la izquierda
698 24081 100       80226 return () unless $n;
699 24079 100       70637 croak("Fuera de rango") if length($n) + $exp > $MAX_DIGITS;
700 24076         62998 $n .= "0" x ( $exp % 6 ); # agregar ceros a la derecha
701 24076         44436 my $mag = int( $exp / 6 );
702 24076         56201 my @group = ();
703              
704             # Translate the lower 6 digits for female numbers
705 24076 100       75051 if ($gen eq FEMALE) {
706 10562         66084 $n =~ s/(.{1,6})$//x;
707 10562         32993 $fmag->( $1, \@group, $mag++ );
708 10562         96703 s/cientos$/cientas/g for @group;
709             }
710              
711 24076         174821 $fmag->( $1, \@group, $mag++ ) while $n =~ s/(.{1,6})$//x;
712 24076 100       72704 $group[0] .= $gen if $group[0] =~ /un$/;
713 24076         235468 reverse @group;
714             }
715              
716             =head3 cardinal_simple
717              
718             =over 4
719              
720             =item SYNOPSIS
721              
722             cardinal_simple($n, $exp, $un_mil; $gen)
723              
724             =item PARAMETERS
725              
726             =over 4
727              
728             =item $n
729              
730             the number.
731              
732             =item $exp
733              
734             exponent.
735              
736             =item $un_mil
737              
738             if true 1000 is translated as "un mil" otherwise "mil"
739              
740             =item $gen
741              
742             gender of the magnitude (optional defaults to NEUTRAL):
743             FEMALE for female gender (1 -> una).
744             MALE for male gender (1 -> uno).
745             NEUTRAL for neutral gender (1 -> un).
746              
747             =back
748              
749             =item DESCRIPTION
750              
751             This function translate the natural number $n to spanish words, adding
752             gender where needed.
753              
754             This procedure just builds a closure with format information, to call
755             cardinal_e6, and then calls cardinal_generic to do the work.
756              
757             =item RETURN VALUE
758              
759             Translation of $n to spanish text as a list of words.
760              
761             =back
762              
763             =cut
764              
765             sub cardinal_simple($$$;$) {
766 22842     22842 1 7113698 my ( $n, $exp, $un_mil, $gen ) = @_;
767              
768 22842 100       52425 $un_mil = $un_mil ? 1 : 0;
769 22842 100       77956 $gen = NEUTRAL unless $gen;
770             my $format = sub {
771 45310     45310   183628 cardinal_e6( $_[0], $_[1], $_[2], $un_mil, [ 'illones', 'illón' ] );
772 22842         121527 };
773 22842         66776 cardinal_generic( $n, $exp, $format, $gen );
774             }
775              
776             =head3 fraccion_mag_prefix
777              
778             =over 4
779              
780             =item SYNOPSIS
781              
782             fraccion_mag_prefix($mag, $gp)
783              
784             =item PARAMETERS
785              
786             =over 4
787              
788             =item $n
789              
790             the number.
791              
792             =item $exp
793              
794             exponent.
795              
796             =item $mag
797              
798             magnitude of the number 1 for millionths, 2 for billionths, etc.
799              
800             =item $gp
801              
802             gender and plural of the number, is the concatenation of gender and plural
803             gender must be one of FEMALE, MALE or NEUTRAL, and plural must be '' for
804             singular and 's' for plural.
805              
806             Note that NEUTRAL + plural is a nonsense.
807              
808             =item $ngen
809              
810             gender of the number (same values as $gen).
811              
812             =back
813              
814             =item DESCRIPTION
815              
816             This function returns the name of the magnitude of a fraction, $mag
817             is the number of decimal digits. For example 0.001 has $mag == 3 and
818             translates to "milesimos" if $gp is (MALE . 's').
819              
820             =item RETURN VALUE
821              
822             Translation of $n to spanish text as a string.
823              
824             =back
825              
826             =cut
827              
828             sub fraccion_mag_prefix($$) {
829 1255     1255 1 1960 my ( $mag, $gp ) = @_;
830              
831 1255 50       2475 return "" unless $mag;
832 1255 100       2653 return "décim" . $gp if $mag == 1;
833 1247 100       2259 return "centésim" . $gp if $mag == 2;
834             my $format = sub {
835 1236     1236   5071 cardinal_e6( $_[0], $_[1], $_[2], 0, [ 'illon', 'illon' ] );
836 1239         7946 };
837 1239         2579 my @name = cardinal_generic( 1, $mag, $format, "" );
838 1236 100       3510 shift @name unless $mag % 6;
839 1236         9424 join( "", @name, "ésim", $gp );
840             }
841              
842             =head3 fraccion_simple
843              
844             =over 4
845              
846             =item SYNOPSIS
847              
848             fraccion_simple($n, $exp, $un_mil, $gen; $ngen)
849              
850             =item PARAMETERS
851              
852             =over 4
853              
854             =item $n
855              
856             the number.
857              
858             =item $exp
859              
860             exponent.
861              
862             =item $un_mil
863              
864             if true 1000 is translated as "un mil" otherwise "mil"
865              
866             =item $gen
867              
868             gender of the magnitude (optional defaults to NEUTRAL):
869             FEMALE for female gender (1 -> primera).
870             MALE for male gender (1 -> primero).
871             NEUTRAL for neutral gender (1 -> primer).
872              
873             =item $ngen
874              
875             gender of the number (same values as $gen).
876              
877             =back
878              
879             =item DESCRIPTION
880              
881             This function translate the fraction $n to spanish words, adding
882             gender where needed.
883              
884             This procedure just builds a closure with format information, to call
885             cardinal_e6, and then calls cardinal_generic to do the work.
886              
887             =item RETURN VALUE
888              
889             Translation of $n to spanish text as a list of words.
890              
891             =back
892              
893             =cut
894              
895             sub fraccion_simple($$$$;$) {
896 1258     1258 1 515406 my ( $n, $exp, $un_mil, $gen, $ngen ) = @_;
897              
898 1258         18932 $n =~ s/0*$//; # eliminar 0 a la derecha
899 1258 50       5126 return () if $n == 0;
900 1258 100       5033 $ngen = $gen unless defined $ngen;
901 1258         1937 $exp = -$exp + length $n; # adjust exponent
902 1258 100       3012 croak("Fuera de rango") if $exp > $MAX_DIGITS;
903 1255 100       4733 $gen .= "s" unless $n =~ /^0*1$/;
904 1255         3042 ( cardinal_simple( $n, 0, $un_mil, $ngen ), fraccion_mag_prefix( $exp, $gen ) );
905             }
906              
907             =head2 ORDINAL SUPPORT
908              
909             Construction of ordinal numbers
910              
911             =cut
912              
913             #####################################################################
914             #
915             # Soporte para números ORDINALES
916             #
917             ####################################################################
918              
919             my @ordinal_13 = (
920             '', qw/ primer_ segund_ tercer_ cuart_ quint_ sext_
921             séptim_ octav_ noven_ décim_ undécim_ duodécim_ /
922             );
923              
924             my @ordinal_dec = qw/ 0 1 vi tri cuadra quicua sexa septua octo nona /;
925              
926             my @ordinal_cen = qw/ 0 c duoc tric cuadring quing sexc septig octing noning /;
927              
928             =head3 ordinal_e2
929              
930             =over 4
931              
932             =item SYNOPSIS
933              
934             ordinal_e2($n, $nn)
935              
936             =item PARAMETERS
937              
938             =over 4
939              
940             =item $n
941              
942             the number.
943              
944             =item $nn
945              
946             word stack.
947              
948             =back
949              
950             =item DESCRIPTION
951              
952             This procedure takes $n (an integer in the range [0 .. 99], not verified) and
953             adds the numbers text translation to $nn (a word stack), on a word by word basis.
954             If $n == 0 nothing is pushed into $nn.
955              
956             =back
957              
958             =cut
959              
960             sub ordinal_e2($$) {
961 20527     20527 1 25168 my ( $n, $nn ) = @_;
962              
963 20527 100       41093 return if $n == 0;
964 20223 100       40014 if ( $n < 13 ) {
965 5163         12322 push @$nn, $ordinal_13[$n];
966 5163         9753 return;
967             }
968 15060         40647 $n =~ /^(.)(.)$/;
969 15060         37216 my $lo = $ordinal_13[$2];
970 15060 100       39943 if ( $1 <= 2 ) {
971 7212 100       28690 my $name = $2
    50          
    100          
972             ? ( $1 == 1 ? 'decimo' : 'vigesimo' )
973             : ( $1 == 1 ? 'décim_' : 'vigésim_' );
974 7212 100       18699 $name =~ s/o$// if $2 == 8; # special case vowels colapsed
975 7212         16484 push @$nn, $name . $lo;
976 7212         14552 return;
977             }
978 7848 100       23965 push @$nn, $lo if $2;
979 7848         28861 push @$nn, $ordinal_dec[$1] . 'gésim_';
980             }
981              
982             =head3 ordinal_e3
983              
984             =over 4
985              
986             =item SYNOPSIS
987              
988             ordinal_e3($n, $nn)
989              
990             =item Parameters
991              
992             =over 4
993              
994             =item $n
995              
996             the number.
997              
998             =item $nn
999              
1000             word stack.
1001              
1002             =back
1003              
1004             =item DESCRIPTION
1005              
1006             This procedure takes $n (an integer in the range [0 .. 999], not verified) and
1007             adds the numbers text translation to $nn (a word stack), on a word by word basis.
1008             If $n == 0 nothing is pushed into $nn.
1009              
1010             =back
1011              
1012             =cut
1013              
1014             sub ordinal_e3($$) {
1015 20635     20635 1 28127 my ( $n, $nn ) = @_;
1016              
1017 20635 100       37876 return if $n == 0;
1018 20527         37454 ordinal_e2( $n % 100, $nn );
1019 20527 100       97103 push @$nn, $ordinal_cen[ int( $n / 100 ) ] . 'entésim_' if $n > 99;
1020             }
1021              
1022             =head3 ordinal_e6
1023              
1024             =over 4
1025              
1026             =item SYNOPSIS
1027              
1028             ordinal_e6($n, $nn, $mag, $un_mil, $postfix)
1029              
1030             =item PARAMETERS
1031              
1032             =over 4
1033              
1034             =item $n
1035              
1036             the number.
1037              
1038             =item $nn
1039              
1040             word stack.
1041              
1042             =item $mag
1043              
1044             magnitude of the number 1 for millions, 2 for billions, etc.
1045              
1046             =back
1047              
1048             =item DESCRIPTION
1049              
1050             This procedure takes $n, and pushes the numbers text translation into $nn,
1051             on a word by word basis, with the proper translated magnitude. If $n == 0
1052             nothing is pushed into $nn.
1053              
1054             =back
1055              
1056             =cut
1057              
1058             sub ordinal_e6($$$) {
1059 21155     21155 1 53811 my ( $n, $nn, $mag ) = @_;
1060              
1061 21155 100       66485 return if $n == 0;
1062 20635 50       42962 push @$nn, $cardinal_megas[$mag] . 'illonésim_' if $mag;
1063 20635         45498 ordinal_e3( $n % 1000, $nn );
1064 20635         41744 my $n3 = int( $n / 1000 );
1065 20635 100       48753 if ($n3) {
1066 18863 100       33080 if ( $n3 > 1 ) {
1067 18723         29614 my $pos = @$nn; # keep pos to adjust number
1068 18723         33811 cardinal_e3( $n3, $nn ); # this is not a typo, its cardinal
1069 18723         54419 $nn->[$pos] .= 'milésim_';
1070             }
1071             else {
1072 140         349 push @$nn, "milésim_";
1073             }
1074             }
1075             }
1076              
1077             =head3 ordinal_simple
1078              
1079             =over 4
1080              
1081             =item SYNOPSIS
1082              
1083             ordinal_simple($n, $exp; $gen)
1084              
1085             =item PARAMETERS
1086              
1087             =over 4
1088              
1089             =item $n
1090              
1091             the number.
1092              
1093             =item $exp
1094              
1095             exponent.
1096              
1097             =item $un_mil
1098              
1099             if true 1000 is translated as "un mil" otherwise "mil"
1100              
1101             =item $gen
1102              
1103             gender of the magnitude (optional defaults to NEUTRAL):
1104             FEMALE for female gender (1 -> primera).
1105             MALE for male gender (1 -> primero).
1106             NEUTRAL for neutral gender (1 -> primer).
1107              
1108             =back
1109              
1110             =item DESCRIPTION
1111              
1112             This function translate the fraction $n to spanish words, adding
1113             gender where needed.
1114              
1115             This procedure just builds a closure with format information, to call
1116             ordinal_e6, and then calls ordinal_generic to do the work.
1117              
1118             =item RETURN VALUE
1119              
1120             Translation of $n to spanish text as a list of words.
1121              
1122             =back
1123              
1124             =cut
1125              
1126             sub ordinal_simple($$;$) {
1127 21397     21397 1 5812594 my ( $n, $exp, $gen ) = @_;
1128              
1129 21397         102065 $n =~ s/^0*//; # eliminar ceros a la izquierda
1130 21397 100       50489 return () unless $n;
1131 21396 100       55767 croak("Fuera de rango") if length($n) + $exp > $MAX_DIGITS;
1132 21395         52261 $n .= "0" x ( $exp % 6 ); # agregar ceros a la derecha
1133 21395         50513 my $mag = int( $exp / 6 );
1134              
1135 21395         31810 my @group = ();
1136 21395 100       59639 if ( $mag == 0 ) {
1137 21155         127986 $n =~ s/(.{1,6})$//x;
1138 21155         56704 ordinal_e6( $1, \@group, $mag++ );
1139             }
1140              
1141 21395         76051 while ( $n =~ s/(.{1,6})$//x ) {
1142 22520 100       73723 if ( $1 == 0 ) {
1143 4940         4909 $mag++;
1144 4940         20838 next;
1145             }
1146 17580         25208 my $words = [];
1147 17580 100       50670 if ( $1 == 1 ) {
1148 540         1009 push @$words, '';
1149             }
1150             else {
1151 17040         36502 cardinal_e6( $1, $words, 0, 0, [] );
1152             }
1153 17580         51246 $words->[0] .= $cardinal_megas[ $mag++ ] . 'illonésim_';
1154 17580         108755 push @group, @$words;
1155             }
1156              
1157 21395 50       42891 unless ($gen) {
1158 0         0 $group[0] =~ s/r_$/r/; # Ajustar neutros en 1er, 3er, etc.
1159 0         0 $gen = MALE;
1160             }
1161 21395         273591 s/_/$gen/g for @group;
1162 21395         137496 reverse @group;
1163             }
1164              
1165             =head2 MISCELANEOUS
1166              
1167             Everithing not fitting elsewere
1168              
1169              
1170             =head3 parse_num
1171              
1172             =over 4
1173              
1174             =item SYNOPSIS
1175              
1176             parse_num($num, $dec, $sep)
1177              
1178             Decomposes the number in its constitutive parts, and returns them in a list:
1179              
1180             use Lingua::ES::Numeros;
1181             ($sgn, $ent, $frc, $exp) = parse_num('123.45e10', '.', '",');
1182              
1183             =item PARAMETERS
1184              
1185             =over 4
1186              
1187             =item $num
1188              
1189             the number to decompose
1190              
1191             =item $dec
1192              
1193             decimal separator (tipically ',' or '.').
1194              
1195             =item $sep
1196              
1197             separator characters ignored by the parser, usually to mark thousands, millions, etc..
1198              
1199             =back
1200              
1201             =item RETURN VALUE
1202              
1203             This function parses a general number and returns a list of 4
1204             elements:
1205              
1206             =over 4
1207              
1208             =item $sgn
1209              
1210             sign of the number: -1 if negative, 1 otherwise
1211              
1212             =item $int
1213              
1214             integer part of the number
1215              
1216             =item $frc
1217              
1218             decimal (fraction) part of the number
1219              
1220             =item $exp
1221              
1222             exponent of the number
1223              
1224             =back
1225              
1226             Croaks if there is a syntax error.
1227              
1228             =back
1229              
1230             =cut
1231              
1232             sub parse_num($$$) {
1233 21180     21180 1 85113 my ( $num, $dec, $sep ) = @_;
1234              
1235             # Eliminar blancos y separadores
1236 21180         125163 $num =~ s/[\s\Q$sep\E]//g;
1237 21180 100       73669 $dec = '\\' . $dec if $dec eq '.';
1238 21180 100       254296 my ( $sgn, $int, $frc, $exp ) = $num =~ /^
1239             ([+-]?) (?= \d | $dec\d ) # signo
1240             (\d*) # parte entera
1241             (?: $dec (\d*) )? # parte decimal
1242             (?: [Ee] ([+-]?\d+) )? # exponente
1243             $/x or croak("Error de sintaxis");
1244              
1245 21178 100       66695 $sgn = $sgn eq '-' ? -1 : 1; # ajustar signo
1246 21178 100 100     262112 return ( $sgn, $int || 0, $frc || 0, $exp ) unless $exp ||= 0;
      100        
      100        
1247              
1248 39   100     83 $int ||= '';
1249 39   100     92 $frc ||= '';
1250              
1251             # reducir la magnitud del exponente
1252 39 100       85 if ( $exp > 0 ) {
1253 15 100       33 if ( $exp > length $frc ) {
1254 4         6 $exp -= length $frc;
1255 4         7 $int .= $frc;
1256 4         7 $frc = '';
1257             }
1258             else {
1259 11         58 $int .= substr( $frc, 0, $exp );
1260 11         19 $frc = substr( $frc, $exp );
1261 11         17 $exp = 0;
1262             }
1263             }
1264             else {
1265 24 100       51 if ( -$exp > length $int ) {
1266 4         5 $exp += length $int;
1267 4         7 $frc = $int . $frc;
1268 4         9 $int = '';
1269             }
1270             else {
1271 20         48 $frc = substr( $int, $exp + length $int ) . $frc;
1272 20         39 $int = substr( $int, 0, $exp + length $int );
1273 20         27 $exp = 0;
1274             }
1275             }
1276 39   100     267 return ( $sgn, $int || 0, $frc || 0, $exp );
      100        
1277             }
1278              
1279             =head3 retval
1280              
1281             =over 4
1282              
1283             =item SYNOPSIS
1284              
1285             $obj->retval($value)
1286              
1287             =item DESCRIPTION
1288              
1289             Utility method to adjust return values, transforms text
1290             following the options: ACENTOS, MAYUSCULAS y HTML.
1291              
1292             Returns the adjusted $value.
1293              
1294             =back
1295              
1296             =cut
1297              
1298             sub retval($$) {
1299 21017     21017 1 34194 my $self = shift;
1300 21017         25561 my $rv = shift;
1301 21017 100       51613 $rv = uc $rv if $self->{MAYUSCULAS};
1302 21017 100       42956 if ( $self->{ACENTOS} ) {
1303 21007 100       48998 if ( $self->{HTML} ) {
1304 6         64 $rv =~ s/([ÁáÉéÍíÓóÚú])/&$1acute;/g;
1305 4     4   38 $rv =~ tr/ÁáÉéÍíÓóÚú/AaEeIiOoUu/;
  4         7  
  4         74  
  6         46  
1306             }
1307             }
1308             else {
1309 10         52 $rv =~ tr/ÁáÉéÍíÓóÚú/AaEeIiOoUu/;
1310             }
1311 21017         73100 return $rv;
1312             }
1313              
1314             1;
1315             __END__