Lingua-ES-Numeros-0.09/0000755000175100017510000000000011606367137013334 5ustar jreyjreyLingua-ES-Numeros-0.09/README0000644000175100017510000000231010707452353014204 0ustar jreyjreyLingua-ES-Numeros version 0.02 ============================== NAME Lingua::ES::Numeros - Translates numbers to spanish text SYNOPSIS use Lingua::ES::Numeros $obj = new Lingua::ES::Numeros ('MAYUSCULAS' => 1) print $obj->Cardinal(124856), "\n"; print $obj->Real(124856.531), "\n"; $obj->{GENERO} = 'a'; print $obj->Ordinal(124856), "\n"; DESCRIPTION Lingua::ES::Numeros converts arbitrary numbers into human-oriented Spanish text. This module supports the translation of cardinal, ordinal and, real numbers, the module handles integer numbers up to vigintillions (that's 1e120), since Perl does not handle such numbers natively, numbers are kept as text strings because processing does not justify using bigint. INSTALLATION To install this module type the following: perl Makefile.PL make make test make install DEPENDENCIES This module requires Perl 5.6 and Carp COPYRIGHT AND LICENCE Copyright (C) 2001-2007 by Jose Rey This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.6 or, at your option, any later version of Perl 5 you may have available. Lingua-ES-Numeros-0.09/t/0000755000175100017510000000000011606367136013576 5ustar jreyjreyLingua-ES-Numeros-0.09/t/t01_init.t0000644000175100017510000001604711606366666015431 0ustar jreyjrey# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl Lingua-ES-Numbers.t' ######################### # change 'tests => 1' to 'tests => last_test_to_print'; use utf8; use strict; use warnings; use Test::More tests => 85; BEGIN { use_ok('Lingua::ES::Numeros') } ######################### sub accesors { my $obj = Lingua::ES::Numeros->new(); is( $obj->acentos, 1, "accesor acentos" ); is( $obj->mayusculas, 0, "accesor mayusculas" ); is( $obj->unmil, 1, "accesor unmil" ); is( $obj->html, 0, "accesor html" ); is( $obj->decimal, '.', "accesor decimal" ); is( $obj->separadores, '_', "accesor separadores" ); is( $obj->genero, Lingua::ES::Numeros::MALE, "accesor genero" ); is( $obj->positivo, '', "accesor positivo" ); is( $obj->negativo, 'menos', "accesor negativo" ); is( $obj->formato, 'con %02d ctms.', "accesor formato" ); is( $obj->accents, $obj->acentos, "accesor accents" ); is( $obj->uppercase, $obj->mayusculas, "accesor uppercase" ); is( $obj->separators, $obj->separadores, "accesor separators" ); is( $obj->gender, $obj->genero, "accesor gender" ); is( $obj->positive, $obj->positivo, "accesor positive" ); is( $obj->negative, $obj->negativo, "accesor negative" ); is( $obj->format, $obj->formato, "accesor format" ); is( $obj->acentos(0), $obj, "accesor acentos" ); is( $obj->mayusculas(1), $obj, "accesor mayusculas" ); is( $obj->unmil(0), $obj, "accesor unmil" ); is( $obj->html(1), $obj, "accesor html" ); is( $obj->decimal(","), $obj, "accesor decimal" ); is( $obj->separadores("*"), $obj, "accesor separadores" ); is( $obj->genero(Lingua::ES::Numeros::FEMALE), $obj, "accesor genero" ); is( $obj->positivo('mas'), $obj, "accesor positivo" ); is( $obj->negativo('negativo'), $obj, "accesor negativo" ); is( $obj->formato('.'), $obj, "accesor formato" ); is( $obj->acentos, 0, "accesor acentos" ); is( $obj->mayusculas, 1, "accesor mayusculas" ); is( $obj->unmil, 0, "accesor unmil" ); is( $obj->html, 1, "accesor html" ); is( $obj->decimal, ',', "accesor decimal" ); is( $obj->separadores, '*', "accesor separadores" ); is( $obj->genero, Lingua::ES::Numeros::FEMALE, "accesor genero" ); is( $obj->positivo, 'mas', "accesor positivo" ); is( $obj->negativo, 'negativo', "accesor negativo" ); is( $obj->formato, '.', "accesor formato" ); is( $obj->accents, 0, "accesor accents" ); is( $obj->uppercase, 1, "accesor uppercase" ); is( $obj->separators, '*', "accesor separators" ); is( $obj->gender, Lingua::ES::Numeros::FEMALE, "accesor gender" ); is( $obj->positive, 'mas', "accesor positive" ); is( $obj->negative, 'negativo', "accesor negative" ); is( $obj->format, '.', "accesor format" ); } sub parser { my $num; my ( $s, $i, $f, $e ); $num = join( "_", split( "", 9 x 9 ) ); ( $s, $i, $f, $e ) = Lingua::ES::Numeros::parse_num( $num, ".", "_" ); ok( ( $s == 1 and $i == 999999999 and $f == 0 and $e == 0 ), "parse_num 1" ); ( $s, $i, $f, $e ) = Lingua::ES::Numeros::parse_num( "-$num", ".", "_" ); ok( ( $s == -1 and $i == 999999999 and $f == 0 and $e == 0 ), "parse_num 2" ); ( $s, $i, $f, $e ) = Lingua::ES::Numeros::parse_num( "${num}e-6", ".", "_" ); ok( ( $s == 1 and $i == 999 and $f == 999999 and $e == 0 ), "parse_num 3" ); ( $s, $i, $f, $e ) = Lingua::ES::Numeros::parse_num( "${num}e-9", ".", "_" ); ok( ( $s == 1 and $i == 0 and $f == 999999999 and $e == 0 ), "parse_num 4" ); ( $s, $i, $f, $e ) = Lingua::ES::Numeros::parse_num( "${num}e-18", ".", "_" ); ok( ( $s == 1 and $i == 0 and $f == 999999999 and $e == -9 ), "parse_num 5" ); ( $s, $i, $f, $e ) = Lingua::ES::Numeros::parse_num( "${num}e+6", ".", "_" ); ok( ( $s == 1 and $i == 999999999 and $f == 0 and $e == 6 ), "parse_num 6" ); my $n = join( "_", split( "", 9 x 6 ) ); $n .= "." . $n; for my $num ( $n, "+$n", "-$n" ) { my $st = $num =~ /^-/ ? -1 : 1; ( $s, $i, $f, $e ) = Lingua::ES::Numeros::parse_num( $num, ".", "_" ); ok( ( $s == $st and $i == 999999 and $f == 999999 and $e == 0 ), "parse_num A" ); for my $xe (qw/ e0 e+0 e-0 /) { ( $s, $i, $f, $e ) = Lingua::ES::Numeros::parse_num( "${num}$xe", ".", "_" ); ok( ( $s == $st and $i == 999999 and $f == 999999 and $e == 0 ), "parse_num B" ); } ( $s, $i, $f, $e ) = Lingua::ES::Numeros::parse_num( "${num}e-3", ".", "_" ); ok( ( $s == $st and $i == 999 and $f == 999999999 and $e == 0 ), "parse_num C" ); ( $s, $i, $f, $e ) = Lingua::ES::Numeros::parse_num( "${num}e-6", ".", "_" ); ok( ( $s == $st and $i == 0 and $f eq "999999999999" and $e == 0 ), "parse_num D" ); ( $s, $i, $f, $e ) = Lingua::ES::Numeros::parse_num( "${num}e-9", ".", "_" ); ok( ( $s == $st and $i == 0 and $f eq "999999999999" and $e == -3 ), "parse_num E" ); ( $s, $i, $f, $e ) = Lingua::ES::Numeros::parse_num( "${num}e+3", ".", "_" ); ok( ( $s == $st and $i == 999999999 and $f == 999 and $e == 0 ), "parse_num F" ); ( $s, $i, $f, $e ) = Lingua::ES::Numeros::parse_num( "${num}e+6", ".", "_" ); ok( ( $s == $st and $i == "999999999999" and $f eq 0 and $e == 0 ), "parse_num G" ); ( $s, $i, $f, $e ) = Lingua::ES::Numeros::parse_num( "${num}e+9", ".", "_" ); ok( ( $s == $st and $i == "999999999999" and $f eq 0 and $e == 3 ), "parse_num H" ); } } sub simple_tests { my $obj = Lingua::ES::Numeros->new(); # Check for proper XHTML entity names, testscase for bug #69323 # thanks to "Eduardo Tubert" $obj->acentos(1); ok($obj->cardinal(16016) eq "dieciséis mil dieciséis", "Lowercase text with accents"); $obj->mayusculas( 1 ); ok($obj->cardinal(16016) eq "DIECISÉIS MIL DIECISÉIS", "Uppercase text with accents"); $obj->mayusculas( 0 ); $obj->html(1); ok($obj->cardinal(16016) eq "dieciséis mil dieciséis", "Lowercase XHTML"); $obj->mayusculas( 1 ); ok($obj->cardinal(16016) eq "DIECISÉIS MIL DIECISÉIS", "Uppercase XHTML"); $obj->mayusculas( 0 ); } accesors; parser; simple_tests; Lingua-ES-Numeros-0.09/t/OrdinalsTest.pm0000644000175100017510000001016111251043710016527 0ustar jreyjreypackage OrdinalsTest; use utf8; use strict; use warnings; use Lingua::ES::Numeros; #use CardinalsTest; require "t/CardinalsTest.pm"; ######################### sub init { my $self = shift; my $cardinal = shift; my %t_ordinal = ( 0 => '', 1 => 'primer_', 2 => 'segund_', 3 => 'tercer_', 4 => 'cuart_', 5 => 'quint_', 6 => 'sext_', 7 => 'séptim_', 8 => 'octav_', 9 => 'noven_', 10 => 'décim_', 11 => 'undécim_', 12 => 'duodécim_', 13 => 'decimotercer_', 14 => 'decimocuart_', 15 => 'decimoquint_', 16 => 'decimosext_', 17 => 'decimoséptim_', 18 => 'decimoctav_', 19 => 'decimonoven_', 20 => 'vigésim_', 21 => 'vigesimoprimer_', 22 => 'vigesimosegund_', 23 => 'vigesimotercer_', 24 => 'vigesimocuart_', 25 => 'vigesimoquint_', 26 => 'vigesimosext_', 27 => 'vigesimoséptim_', 28 => 'vigesimoctav_', 29 => 'vigesimonoven_', 30 => 'trigésim_', 31 => 'trigésim_ primer_', 32 => 'trigésim_ segund_', 33 => 'trigésim_ tercer_', 34 => 'trigésim_ cuart_', 35 => 'trigésim_ quint_', 36 => 'trigésim_ sext_', 37 => 'trigésim_ séptim_', 38 => 'trigésim_ octav_', 39 => 'trigésim_ noven_', 40 => 'cuadragésim_', 41 => 'cuadragésim_ primer_', 42 => 'cuadragésim_ segund_', 95 => 'nonagésim_ quint_', 96 => 'nonagésim_ sext_', 97 => 'nonagésim_ séptim_', 98 => 'nonagésim_ octav_', 99 => 'nonagésim_ noven_' ); my @numeros = sort { $a <=> $b } keys %t_ordinal; my $i = 100; for my $c (qw/ c duoc tric cuadring quing sexc septig octing noning /) { for my $j (@numeros) { $t_ordinal{ $i + $j } = $c . "entésim_ " . $t_ordinal{$j}; } $t_ordinal{$i} = $c . "entésim_"; $i += 100; } for my $m (@numeros) { next unless $m; for my $c (@numeros) { for my $j ( 0, 100, 200, 900 ) { my $m1 = $m + $j; my $c1 = $c + $j; my $name = ( $m1 == 1 ? '' : $cardinal->get($m1) ) . "milésim_ " . $t_ordinal{$c1}; $name =~ s/\s+$//; $t_ordinal{ $m1 * 1000 + $c1 } = $name; } } } for my $num ( 1 .. 5, 19 .. 24, 38 .. 42, 996 .. 999 ) { my $numg = $num; my $nums = ( $num == 1 ? '' : $cardinal->get($num) ); my $numb = $t_ordinal{$num}; my $k = $num * 1000 + $num; my $kg = $k; my $ks = $cardinal->get($k); my $kb = $t_ordinal{$k}; $ks =~ s/^un mil\b/mil/; for my $m ( CardinalsTest::llones() ) { $numg = sprintf( "%s%06d", $numg, $num ); $numb = $nums . "${m}illonésim_ " . $numb; $t_ordinal{$numg} = $numb; $kg = sprintf( "%s%06d", $kg, $k ); $kb = $ks . "${m}illonésim_ " . $kb; $t_ordinal{$kg} = $kb; } } $t_ordinal{100000} = "cienmilésim_"; $i = 6; for my $m ( CardinalsTest::llones() ) { $t_ordinal{ "1" . ( "0" x $i ) } = "${m}illonésim_"; $t_ordinal{ "1" . ( "0" x ( $i + 1 ) ) } = "diez${m}illonésim_"; $t_ordinal{ "1" . ( "0" x ( $i + 2 ) ) } = "cien${m}illonésim_"; $t_ordinal{ "1" . ( "0" x ( $i + 3 ) ) } = "mil${m}illonésim_"; $t_ordinal{ "1" . ( "0" x ( $i + 4 ) ) } = "diez mil${m}illonésim_"; $t_ordinal{ "1" . ( "0" x ( $i + 5 ) ) } = "cien mil${m}illonésim_"; $t_ordinal{ "2" . ( "0" x $i ) } = "dos${m}illonésim_"; $i += 6; } bless \%t_ordinal, ref $self || $self; } sub get { my ( $self, $num, $exp, $gen ) = @_; $exp = 0 unless defined $exp; $gen = 'o' unless defined $gen; $num .= "0" x $exp; die("Unexistent number") unless exists $self->{$num}; my $rv = $self->{$num}; $rv =~ s/_/$gen/g; $rv; } 1; Lingua-ES-Numeros-0.09/t/CardinalsTest.pm0000644000175100017510000001266211251043710016664 0ustar jreyjreypackage CardinalsTest; use utf8; use strict; use warnings; use Lingua::ES::Numeros; ######################### my @llones = qw/ m b tr cuatr quint sext sept oct non dec undec dudec tredec cuatordec quindec sexdec sepdec octodec novendec vigint /; sub llones { if ( @_ == 1 ) { return '' if 0; return $llones[shift]; } else { return @llones; } } sub init { my %t_cardinal = ( 0 => '', 1 => 'un', 2 => 'dos', 3 => 'tres', 4 => 'cuatro', 5 => 'cinco', 6 => 'seis', 7 => 'siete', 8 => 'ocho', 9 => 'nueve', 10 => 'diez', 11 => 'once', 12 => 'doce', 13 => 'trece', 14 => 'catorce', 15 => 'quince', 16 => 'dieciséis', 17 => 'diecisiete', 18 => 'dieciocho', 19 => 'diecinueve', 20 => 'veinte', 21 => 'veintiun', 22 => 'veintidós', 23 => 'veintitrés', 24 => 'veinticuatro', 25 => 'veinticinco', 26 => 'veintiséis', 27 => 'veintisiete', 28 => 'veintiocho', 29 => 'veintinueve', 30 => 'treinta', 31 => 'treinta y un', 32 => 'treinta y dos', 33 => 'treinta y tres', 34 => 'treinta y cuatro', 35 => 'treinta y cinco', 36 => 'treinta y seis', 37 => 'treinta y siete', 38 => 'treinta y ocho', 39 => 'treinta y nueve', 40 => 'cuarenta', 41 => 'cuarenta y un', 42 => 'cuarenta y dos', 95 => 'noventa y cinco', 96 => 'noventa y seis', 97 => 'noventa y siete', 98 => 'noventa y ocho', 99 => 'noventa y nueve' ); my @cientos = qw/ ciento doscientos trescientos cuatrocientos quinientos seiscientos setecientos ochocientos novecientos /; my @numeros = sort { $a <=> $b } keys %t_cardinal; my $i = 100; for my $c (@cientos) { for my $j (@numeros) { $t_cardinal{ $i + $j } = $c . " " . $t_cardinal{$j}; } $t_cardinal{$i} = $c; $i += 100; } $t_cardinal{100} = "cien"; for my $m (@numeros) { next unless $m; for my $c (@numeros) { for my $j ( 0, 100, 200, 900 ) { my $m1 = $m + $j; my $c1 = $c + $j; my $name = $t_cardinal{$m1} . " mil " . $t_cardinal{$c1}; $name =~ s/\s+$//; $t_cardinal{ $m1 * 1000 + $c1 } = $name; $t_cardinal{ "z" . ( $m1 * 1000 + $c1 ) } = substr( $name, 3 ) if $m1 == 1; } } } for my $num ( 1 .. 5, 19 .. 24, 38 .. 42, 996 .. 999 ) { my $numg = $num; my $nums = $t_cardinal{$num}; my $numb = $nums; my $k = $num * 1000 + $num; my $kg = $k; my $ks = $t_cardinal{$k}; my $kb = $ks; for my $m ( llones() ) { $numg = sprintf( "%s%06d", $numg, $num ); $numb = $nums . ( $num == 1 ? " ${m}illón " : " ${m}illones " ) . $numb; $t_cardinal{$numg} = $numb; $kg = sprintf( "%s%06d", $kg, $k ); $kb = $ks . " ${m}illones " . $kb; $t_cardinal{$kg} = $kb; } } $t_cardinal{100000} = "cien mil"; $i = 6; for my $m ( llones() ) { $t_cardinal{ "1" . ( "0" x $i ) } = "un ${m}illón"; $t_cardinal{ "1" . ( "0" x ( $i + 1 ) ) } = "diez ${m}illones"; $t_cardinal{ "1" . ( "0" x ( $i + 2 ) ) } = "cien ${m}illones"; $t_cardinal{ "1" . ( "0" x ( $i + 3 ) ) } = "un mil ${m}illones"; $t_cardinal{ "z1" . ( "0" x ( $i + 3 ) ) } = "mil ${m}illones"; $t_cardinal{ "1" . ( "0" x ( $i + 4 ) ) } = "diez mil ${m}illones"; $t_cardinal{ "1" . ( "0" x ( $i + 5 ) ) } = "cien mil ${m}illones"; $t_cardinal{ "2" . ( "0" x $i ) } = "dos ${m}illones"; $i += 6; } bless \%t_cardinal; } sub get { my ( $self, $num, $exp, $gen, $un_mil ) = @_; $exp = 0 unless defined $exp; $gen = '' unless defined $gen; $num .= "0" x $exp; die("Unexistent number") unless exists $self->{$num}; my $rv = $self->{$num}; $rv = $self->{"z$num"} if $un_mil and exists $self->{"z$num"}; $rv .= $gen if $rv =~ /un$/; $rv; } ################################################################### my %t_fraccion; { my $num = "1"; for my $f (qw/ décim centésim milésim diezmilésim cienmilésim /) { $t_fraccion{$num} = "un " . $f; $num = "0" . $num; } for my $ll ( llones() ) { $t_fraccion{$num} = "un " . $ll . "illonésim"; $num = "0" . $num; for my $f (qw/ diez cien mil diezmil cienmil /) { $t_fraccion{$num} = "un " . $f . $ll . "illonésim"; $num = "0" . $num; } } } sub t_fraccion { my $genre = ""; while ( my ( $k, $v ) = each %t_fraccion ) { my $t = join( " ", Lingua::ES::Numeros::fraccion_simple( $k, 0, 1, $genre ) ); is( $t, $v, "t_fraccion_2" ); $t = join( " ", Lingua::ES::Numeros::fraccion_simple( $k, 0, 0, $genre ) ); is( $t, $v, "t_fraccion_2" ); } for ( my $i = 0; $i < 125; $i++ ) { my $k = ( 0 x $i ) . 1; my $t = join( " ", Lingua::ES::Numeros::fraccion_simple( 1, -$i, 0, $genre ) ); my $v = join( " ", Lingua::ES::Numeros::fraccion_simple( $k, 0, 0, $genre ) ); is( $t, $v, "t_fraccion_2" ); } } 1; Lingua-ES-Numeros-0.09/t/t03_fractions.t0000644000175100017510000000460011251043710016422 0ustar jreyjrey# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl Lingua-ES-Numbers.t' ######################### # change 'tests => 1' to 'tests => last_test_to_print'; use utf8; #use lib '/home/opr/W/Projects/Numeros/Lingua-ES-Numbers/lib/'; use Test::More tests => 499; BEGIN { use_ok('Lingua::ES::Numeros') } ######################### require "t/CardinalsTest.pm"; #my $cardinal = CardinalsTest->init; my %t_fraccion; { my $num = "1"; for my $f (qw/ décim centésim milésim diezmilésim cienmilésim /) { $t_fraccion{$num} = "un " . $f; $num = "0" . $num; } for my $ll ( CardinalsTest::llones() ) { $t_fraccion{$num} = "un " . $ll . "illonésim"; $num = "0" . $num; for my $f (qw/ diez cien mil diezmil cienmil /) { $t_fraccion{$num} = "un " . $f . $ll . "illonésim"; $num = "0" . $num; } } } sub t_fraccion { my $genre = ""; while ( my ( $k, $v ) = each %t_fraccion ) { my $t = join( " ", Lingua::ES::Numeros::fraccion_simple( $k, 0, 1, $genre ) ); is( $t, $v, "t_fraccion_simple" ); $t = join( " ", Lingua::ES::Numeros::fraccion_simple( $k, 0, 0, $genre ) ); is( $t, $v, "t_fraccion_simple" ); } for ( my $i = 0; $i < 125; $i++ ) { my $k = ( 0 x $i ) . 1; my $t = join( " ", Lingua::ES::Numeros::fraccion_simple( 1, -$i, 0, $genre ) ); my $v = join( " ", Lingua::ES::Numeros::fraccion_simple( $k, 0, 0, $genre ) ); is( $t, $v, "t_fraccion_exp" ); if ( length $k > 8 ) { $t = join( " ", Lingua::ES::Numeros::fraccion_simple( "00000001", -$i + 7, 0, $genre ) ); $v = join( " ", Lingua::ES::Numeros::fraccion_simple( substr( $k, 7 ), -7, 0, $genre ) ); is( $t, $v, "t_fraccion_exp2" ); } } for my $i ( 125, 126 ) { my $k = ( 0 x $i ) . 1; eval { Lingua::ES::Numeros::fraccion_simple( 1, -$i, 0, $genre ) }; ok( $@ =~ /^Fuera de rango/, "t_fraccion_range" ); eval { Lingua::ES::Numeros::fraccion_simple( $k, 0, 0, $genre ) }; ok( $@ =~ /^Fuera de rango/, "t_fraccion_range" ); eval { Lingua::ES::Numeros::fraccion_simple( substr( $k, 7 ), -7, 0, $genre ) }; ok( $@ =~ /^Fuera de rango/, "t_fraccion_range" ); } } t_fraccion; Lingua-ES-Numeros-0.09/t/t02_cardinals.t0000644000175100017510000001676211606362344016420 0ustar jreyjrey# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl Lingua-ES-Numbers.t' ######################### # change 'tests => 1' to 'tests => last_test_to_print'; use utf8; #use lib '/home/opr/W/Projects/Numeros/Lingua-ES-Numbers/lib/'; use Test::More tests => 21835; BEGIN { use_ok('Lingua::ES::Numeros') } ######################### require "t/CardinalsTest.pm"; my $cardinal = CardinalsTest->init; cardinal_test_all($cardinal); sub cardinal_iterate_all { my $self = shift; while ( my ( $k, $v ) = each %$self ) { if ( $k =~ /^z/ ) { my $t = join( " ", Lingua::ES::Numeros::cardinal_simple( substr( $k, 1 ), 0, 0 ) ); is( $t, $v, "t_cardinal_2" ); } else { my $t = join( " ", Lingua::ES::Numeros::cardinal_simple( $k, 0, 1 ) ); is( $t, $v, "t_cardinal_2" ); } } } sub cardinal_iterate_exp { my $self = shift; for ( my $i = 0; $i < 126; $i++ ) { my $k = 1 . ( 0 x $i ); my $t = join( " ", Lingua::ES::Numeros::cardinal_simple( 1, $i, 0 ) ); my $v = join( " ", Lingua::ES::Numeros::cardinal_simple( $k, 0, 0 ) ); is( $t, $v, "t_cardinal_2" ); if ( $k % 6 == 3 ) { $v = $self->get("z$k"); is( $t, $v, "t_cardinal_2" ); } $t = join( " ", Lingua::ES::Numeros::cardinal_simple( 1, $i, 1 ) ); $v = join( " ", Lingua::ES::Numeros::cardinal_simple( $k, 0, 1 ) ); is( $t, $v, "t_cardinal_2" ); $v = $self->get($k); is( $t, $v, "t_cardinal_2" ); } } sub cardinal_iterate_obj { my $self = shift; my $obj = Lingua::ES::Numeros->new( GENERO => 'a' ); for my $i ( 0 .. 99 ) { my $n = sprintf("%02d", $i); $t = $obj->real("11.$n"); is( $t, "once con $n ctms.", "t_real_2" ); } while ( my ( $k, $v ) = each %$self ) { next if $k =~ /^z/; my $t = $obj->cardinal($k); $v =~ s/un$/una/g; if ( $v =~ s/(.*(?:illones|llón))?(.+)// ) { my ($hi, $lo) = ($1 || '', $2); $lo =~ s/cientos/cientas/g; $v = $hi . $lo; } $v = 'cero' if $v eq ''; is( $t, $v, "t_cardinal_2" ); } } sub xml_uc($) { my $t = uc shift; $t =~ s/ACUTE;/acute;/g; return $t; } sub cardinal_test_real { my $self = shift; my $obj = Lingua::ES::Numeros->new( SEXO => 'a' ); $obj->{'FORMATO'} = "CON %s"; my $t = $obj->real("124.345"); is( $t, "ciento veinticuatro CON trescientas cuarenta y cinco milésimas", "t_real_2" ); $obj->{'MAYUSCULAS'} = 1; $t = $obj->real("122.345"); is( $t, uc "ciento veintidós CON trescientas cuarenta y cinco milésimas", "t_real_2" ); $obj->{'HTML'} = 1; $obj->{'DECIMAL'} = ","; $t = $obj->real("122,345"); is( $t, xml_uc "ciento veintidós CON trescientas cuarenta y cinco milésimas", "t_real_2" ); $obj->{'MAYUSCULAS'} = 0; $t = $obj->real("122,345"); is( $t, "ciento veintidós CON trescientas cuarenta y cinco milésimas", "t_real_2" ); eval { $t = $obj->real("122.345") }; ok( $@ =~ /^Error de sintaxis/, "Real error de sintaxis" ); $obj->{'DECIMAL'} = "."; $obj->{'HTML'} = 0; $obj->{'MAYUSCULAS'} = 1; $obj->{'ACENTOS'} = 0; $obj->{'POSITIVO'} = "positivo"; $t = $obj->real("124.345"); is( $t, uc "positivo ciento veinticuatro CON trescientas cuarenta y cinco milesimas", "t_real_2" ); $obj->{'MAYUSCULAS'} = 0; $t = $obj->real("-0.124345e3"); is( $t, "menos ciento veinticuatro CON trescientas cuarenta y cinco milesimas", "t_real_2" ); $t = $obj->real("-124345e-3"); is( $t, "menos ciento veinticuatro CON trescientas cuarenta y cinco milesimas", "t_real_2" ); $t = $obj->real("-0.224345e3"); is( $t, "menos doscientas veinticuatro CON trescientas cuarenta y cinco milesimas", "t_real_2" ); $t = $obj->real("-224345e-3"); is( $t, "menos doscientas veinticuatro CON trescientas cuarenta y cinco milesimas", "t_real_2" ); $obj = Lingua::ES::Numeros->new( GENERO => 'o' ); $obj->{'FORMATO'} = "CON %s"; $t = $obj->real("124.345"); is( $t, "ciento veinticuatro CON trescientos cuarenta y cinco milésimos", "t_real_2" ); $obj->{'MAYUSCULAS'} = 1; $t = $obj->real("122.345"); is( $t, xml_uc "ciento veintidós CON trescientos cuarenta y cinco milésimos", "t_real_2" ); $obj->{'HTML'} = 1; $obj->{'DECIMAL'} = ","; $t = $obj->real("122,345"); is( $t, xml_uc "ciento veintidós CON trescientos cuarenta y cinco milésimos", "t_real_2" ); $obj->{'MAYUSCULAS'} = 0; $t = $obj->real("122,345"); is( $t, "ciento veintidós CON trescientos cuarenta y cinco milésimos", "t_real_2" ); eval { $t = $obj->real("122.345") }; ok( $@ =~ /^Error de sintaxis/, "Real error de sintaxis" ); $obj->{'DECIMAL'} = "."; $obj->{'HTML'} = 0; $obj->{'MAYUSCULAS'} = 1; $obj->{'ACENTOS'} = 0; $obj->{'POSITIVO'} = "positivo"; $t = $obj->real("124.345"); is( $t, uc "positivo ciento veinticuatro CON trescientos cuarenta y cinco milesimos", "t_real_2" ); $obj->{'MAYUSCULAS'} = 0; $t = $obj->real("-0.124345e3"); is( $t, "menos ciento veinticuatro CON trescientos cuarenta y cinco milesimos", "t_real_2" ); $t = $obj->real("-124345e-3"); is( $t, "menos ciento veinticuatro CON trescientos cuarenta y cinco milesimos", "t_real_2" ); $t = $obj->real("-0.224345e3"); is( $t, "menos doscientos veinticuatro CON trescientos cuarenta y cinco milesimos", "t_real_2" ); $t = $obj->real("-224345e-3"); is( $t, "menos doscientos veinticuatro CON trescientos cuarenta y cinco milesimos", "t_real_2" ); $obj = $obj->new( GENERO => 'o' ); $obj->{'FORMATO'} = "CON %2d"; $t = $obj->real("-0.124345e3"); is( $t, "menos ciento veinticuatro CON 34", "t_real_2" ); $t = $obj->real("-124345e-3"); is( $t, "menos ciento veinticuatro CON 34", "t_real_2" ); $obj->{'FORMATO'} = ""; $t = $obj->real("-124345e-3"); is( $t, "menos ciento veinticuatro", "t_real_2" ); } sub cardinal_test_all { my $self = shift; cardinal_iterate_all $self; cardinal_iterate_exp $self; cardinal_iterate_obj $self; cardinal_test_real $self; } my %t_fraccion; { my $num = "1"; for my $f (qw/ décim centésim milésim diezmilésim cienmilésim /) { $t_fraccion{$num} = "un " . $f; $num = "0" . $num; } for my $ll ( CardinalsTest::llones() ) { $t_fraccion{$num} = "un " . $ll . "illonésim"; $num = "0" . $num; for my $f (qw/ diez cien mil diezmil cienmil /) { $t_fraccion{$num} = "un " . $f . $ll . "illonésim"; $num = "0" . $num; } } } sub t_fraccion { my $genre = ""; while ( my ( $k, $v ) = each %t_fraccion ) { my $t = join( " ", Lingua::ES::Numeros::fraccion_simple( $k, 0, 1, $genre ) ); is( $t, $v, "t_fraccion_2" ); $t = join( " ", Lingua::ES::Numeros::fraccion_simple( $k, 0, 0, $genre ) ); is( $t, $v, "t_fraccion_2" ); } for ( my $i = 0; $i < 125; $i++ ) { my $k = ( 0 x $i ) . 1; my $t = join( " ", Lingua::ES::Numeros::fraccion_simple( 1, -$i, 0, $genre ) ); my $v = join( " ", Lingua::ES::Numeros::fraccion_simple( $k, 0, 0, $genre ) ); is( $t, $v, "t_fraccion_2" ); } } t_fraccion; Lingua-ES-Numeros-0.09/t/t04_ordinals.t0000644000175100017510000000515311321013553016252 0ustar jreyjrey# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl Lingua-ES-Numbers.t' ######################### # change 'tests => 1' to 'tests => last_test_to_print'; use utf8; #use lib '/home/opr/W/Projects/Numeros/Lingua-ES-Numbers/lib/'; use Test::More tests => 31719; BEGIN { use_ok('Lingua::ES::Numeros') } ######################### require "t/CardinalsTest.pm"; my $cardinal = CardinalsTest->init; require "t/OrdinalsTest.pm"; my $ordinal = OrdinalsTest->init($cardinal); ordinal_test_all($ordinal); sub ordinal_iterate_all { my $self = shift; while ( my ( $k, $v ) = each %$self ) { my $t = join( " ", Lingua::ES::Numeros::ordinal_simple( $k, 0, '_' ) ); #$DB::single = 1 if $t ne $v; #$t = join(" ", Lingua::ES::Numeros::ordinal_simple($k, 0, '_')); is( $t, $v, "t_ordinal_2" ); } } sub ordinal_iterate_exp { my $self = shift; for ( my $i = 0; $i < 126; $i++ ) { my $k = 1 . ( 0 x $i ); my $t = join( " ", Lingua::ES::Numeros::ordinal_simple( 1, $i, '_' ) ); my $v = join( " ", Lingua::ES::Numeros::ordinal_simple( $k, 0, '_' ) ); is( $t, $v, "t_ordinal_2" ); if ( $k % 6 == 3 ) { $v = $self->get("z$k"); is( $t, $v, "t_ordinal_2" ); } $t = join( " ", Lingua::ES::Numeros::ordinal_simple( 1, $i, '_' ) ); $v = join( " ", Lingua::ES::Numeros::ordinal_simple( $k, 0, '_' ) ); is( $t, $v, "t_ordinal_2" ); $v = $self->get( $k, 0, "_" ); is( $t, $v, "t_ordinal_2" ); } } sub ordinal_iterate_obj { my $self = shift; my $obj = Lingua::ES::Numeros->new( GENERO => 'a' ); while ( my ( $k, $v ) = each %$self ) { next if $k =~ /^0*$/; # don't take ordinal of 0 my $t = $obj->ordinal($k); isnt( $t, $v, "t_ordinal_2" ); $v =~ s/_/a/g; is( $t, $v, "t_ordinal_2" ); } eval { $obj->ordinal( 1 x 126 ) }; ok( !$@, "Ordinal in range" ); eval { $obj->ordinal( 1 x 127 ) }; ok( $@ =~ /^Fuera de rango/, "Ordinal out of range" ); eval { $obj->ordinal(-1) }; ok( $@ =~ /^Ordinal negativo/, "Negative ordinal" ); # FIXME: some way to check carp ? eval { $obj->ordinal(-0) }; ok( !$@, "Ordinal -0" ); eval { $obj->ordinal(0) }; ok( !$@, "Ordinal 0" ); ok( $obj->ordinal(3.1416) eq "tercera", "Ordinal PI" ); ok( $obj->ordinal(1) eq "primera", "Ordinal 1a" ); } sub ordinal_test_all { my $self = shift; ordinal_iterate_all $self; ordinal_iterate_exp $self; ordinal_iterate_obj $self; } Lingua-ES-Numeros-0.09/Makefile.PL0000644000175100017510000000071711251043710015273 0ustar jreyjreyuse 5.006000; use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( NAME => 'Lingua::ES::Numeros', VERSION_FROM => 'lib/Lingua/ES/Numeros.pm', # finds $VERSION PREREQ_PM => {Carp => 0}, ABSTRACT_FROM => 'lib/Lingua/ES/Numeros.pm', # retrieve abstract from module AUTHOR => 'Jose Rey ', ); Lingua-ES-Numeros-0.09/META.yml0000644000175100017510000000104311606367137014603 0ustar jreyjrey--- #YAML:1.0 name: Lingua-ES-Numeros version: 0.09 abstract: Translates numbers to spanish text author: - Jose Rey license: unknown distribution_type: module configure_requires: ExtUtils::MakeMaker: 0 build_requires: ExtUtils::MakeMaker: 0 requires: Carp: 0 no_index: directory: - t - inc generated_by: ExtUtils::MakeMaker version 6.55_02 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 Lingua-ES-Numeros-0.09/MANIFEST0000644000175100017510000000036310707502165014460 0ustar jreyjreyChanges lib/Lingua/ES/Numeros.pm Makefile.PL MANIFEST README t/CardinalsTest.pm t/OrdinalsTest.pm t/t01_init.t t/t02_cardinals.t t/t03_fractions.t t/t04_ordinals.t META.yml Module meta-data (added by MakeMaker) Lingua-ES-Numeros-0.09/lib/0000755000175100017510000000000011606367136014101 5ustar jreyjreyLingua-ES-Numeros-0.09/lib/Lingua/0000755000175100017510000000000011606367136015320 5ustar jreyjreyLingua-ES-Numeros-0.09/lib/Lingua/ES/0000755000175100017510000000000011606367136015627 5ustar jreyjreyLingua-ES-Numeros-0.09/lib/Lingua/ES/Numeros.pm0000644000175100017510000006703111606363501017614 0ustar jreyjrey =head1 NAME Lingua::ES::Numeros - Translates numbers to spanish text =head1 SYNOPSIS use Lingua::ES::Numeros ":constants"; my $obj = new Lingua::ES::Numeros ('MAYUSCULAS' => 1); print $obj->cardinal(124856), "\n"; print $obj->real(124856.531), "\n"; $obj->{GENERO} = FEMALE; print $obj->ordinal(124856), "\n"; =head1 DESCRIPTION This module supports the translation of cardinal, ordinal and, real numbers, the module handles integer numbers up to vigintillions (that's 1e120), since Perl does not handle such numbers natively, numbers are kept as text strings because processing does not justify using bigint. Currently Lingua::ES::Numeros handles numbers up to 1e127-1 (999999 vigintillions). =cut ####################################################################### # Jose Luis Rey Barreira (C) 2001-2009 ####################################################################### package Lingua::ES::Numeros; use 5.006; use utf8; use strict; use warnings; use Carp; use base qw( Exporter ); our $VERSION = '0.09'; our @EXPORT = qw( ); our @EXPORT_OK = qw( MALE FEMALE NEUTRAL MASCULINO FEMENINO NEUTRO ); our %EXPORT_TAGS = ( constants => [qw(MALE FEMALE NEUTRAL MASCULINO FEMENINO NEUTRO)] ); # Perl 5.6 fails with this #use constant { # MALE => 'o', # FEMALE => 'a', # NEUTRAL => '' }; use constant MALE => 'o'; use constant FEMALE => 'a'; use constant NEUTRAL => ''; use constant MASCULINO => 'o'; use constant FEMENINO => 'a'; use constant NEUTRO => ''; use fields qw/ ACENTOS MAYUSCULAS UNMIL HTML DECIMAL SEPARADORES GENERO POSITIVO NEGATIVO FORMATO /; =head1 METHODS =head2 CONSTRUCTOR: new To create a new Lingua::ES::Numeros, use the B class method. This method can receive as parameters any of the above mentioned fields. Examples: use Lingua::ES::Numeros ':constants'; # Use the fields' default values $obj = new Lingua::ES::Numeros; # Specifies the values of some of them $obj = Lingua::ES::Numeros->new( ACENTOS => 0, MAYUSCULAS => 1, GENERO => FEMALE, DECIMAL => ',', SEPARADORES=> '"_' ); =over 4 =item DECIMAL Specifies the character string that will be used to separate the integer from the fractional part of the number to convert. The default value for DECIMAL is '.' =item SEPARADORES Character string including all of the format characters used when representing a number. All of the characters in this string will be ignored by the parser when analyzing the number. The default value for SEPARADORES is '_' =item ACENTOS Affects the way in which the generated string for the translated numbers is given; if it is false, the textual representation will not have any accented characters. The default value for this field is true (with accents). =item MAYUSCULAS If this is a true value, the textual representation of the number will be an uppercase character string. The default value for this field is false (lowercase). =item HTML If this is a true value, the textual representation of the number will be a HTML-valid string character (accents will be represented by their respective HTML entities). The default value is 0 (text). =item GENERO The gender of the numbers can be MALE, FEMALE or NEUTRAL, respectively for femenine, masculine or neutral numbers. The default value is MALE. The following table shows the efect of GENDER on translation of Cardinal and Ordinal numbers: +---+---------------------+-----------------------------+ | N | CARDINAL | ORDINAL | | u +------+------+-------+---------+---------+---------+ | m | MALE |FEMALE|NEUTRAL| MALE | FEMALE | NEUTRAL | +---+------+------+-------+---------+---------+---------+ | 1 | uno | una | un | primero | primera | primer | | 2 | dos | dos | dos | segundo | segunda | segundo | | 3 | tres | tres | tres | tercero | tercera | tercer | +---+------+------+-------+---------+---------+---------+ The constants MALE, FEMALE and NEUTRAL and their spanish counterparts MASCULINO, FEMENINO and NEUTRO, may be imported with the tag ":constants" on module use. =item SEXO Deprecated option only for backward compatibility, use GENERO instead. =item UNMIL This field affects only the translation of cardinal numbers. When it is a true value, the number 1000 is translated to 'un mil' (one thousand), otherwise it is translated to the more colloquial 'mil' (thousand). The default value is 1. =item NEGATIVO Contains the character string with the text to which the negative sign (-) will be translated with. Defaults to 'menos'. For example: default translation of -5 will yield "menos cinco". =item POSITIVO Contains the character string with the text to which the positive sign will be translated with. Defaults to ''. For example: default translation of 5 will yield "cinco". =item FORMATO A character string specifying how the decimals of a real number are to be translated. Its default value is 'con %2d ctms.' (see the B method) =back =head3 Aliases All the options have the following english aliases. English Option name -------------------------- ACCENTS ACENTOS UPPERCASE MAYUSCULAS SEPARATORS SEPARADORES GENDER GENERO POSITIVE POSITIVO NEGATIVE NEGATIVO FORMAT FORMATO =cut my %opt_alias = qw( ACCENTS ACENTOS UPPERCASE MAYUSCULAS SEPARATORS SEPARADORES GENDER GENERO POSITIVE POSITIVO NEGATIVE NEGATIVO FORMAT FORMATO ); my %new_defaults = ( ACENTOS => 1, MAYUSCULAS => 0, UNMIL => 1, HTML => 0, DECIMAL => '.', SEPARADORES => '_', GENERO => MALE, POSITIVO => '', NEGATIVO => 'menos', FORMATO => 'con %02d ctms.', ); sub new { my $self = shift; unless ( ref $self ) { $self = fields::new($self); } #%$self = (%new_defaults, @_); { # Compatibility conversion of SEXO into GENERO my %opts = ( %new_defaults, @_ ); if ( $opts{'SEXO'} ) { $opts{'GENERO'} = $opts{'SEXO'}; delete $opts{'SEXO'}; } %$self = %opts } return $self; } =head2 cardinal SYNOPSIS: $text = $obj->cardinal($num) =head3 Parameters =over 4 =item $num the number. =back =head3 Description Translates a cardinal number ($num) to spanish text, translation is performed according to the following object ($obj) settings: DECIMAL, SEPARADORES, SEXO, ACENTOS, MAYUSCULAS, POSITIVO and NEGATIVO. This method ignores any fraction part of the number ($num). =head3 Return Value Textual representation of the number as a string =cut sub cardinal_str($) { my $self = shift; my $num = shift; my ( $sgn, $ent, $frc, $exp ) = parse_num( $num, $self->{'DECIMAL'}, $self->{'SEPARADORES'} ); my @words = cardinal_simple( $ent, $exp, $self->{'UNMIL'}, $self->{'GENERO'} ); if (@words) { unshift @words, $self->{'NEGATIVO'} if $sgn < 0 and $self->{'NEGATIVO'}; unshift @words, $self->{'POSITIVO'} if $sgn > 0 and $self->{'POSITIVO'}; return join( " ", @words ); } else { 'cero'; } } sub cardinal($) { my $self = shift; $self->retval($self->cardinal_str(shift)); } =head2 real SYNOPSIS: $text = real($n; $genf, $genm) Translates the real number ($n) to spanish text. The optional $genf and $genm parameters are used to specify gender of the fraction part and fraction part magnitude in that order. If $genf is missing it will default to the GENDER option, and $genm will default to the $genf's value. This translation is affected by the options: DECIMAL, SEPARADORES, GENDER, ACENTOS, MAYUSCULAS, POSITIVO, NEGATIVO and FORMATO. =head3 Fraction format (FORMATO) FORMAT option is a formatting string like printf, it is used to format the fractional part before appending it to the integer part. It has the following format specifiers: =over 4 =item %Ns Formats the fractional part as text with precisión of N digits, for example: number '124.345' formated with string 'CON %s.' will yield the text 'ciento veinticuatro CON trescientas cuarenta y cinco milEsimas', and formatted with string 'CON %2s.' will yield 'ciento veinticuatro CON treinta y cuatro centEsimas'. =item %Nd Formats the fractional part as a number (no translation), with precision of N digits, veri similar to sprintf's %d format, for example: number '124.045' formated with 'CON %2d ctms.' will yield: 'ciento veinticuatro CON 04 ctms.' =back =cut sub real($;$$) { my $self = shift; my ( $num, $genf, $genm ) = @_; my ( $sgn, $ent, $frc, $exp ) = parse_num( $num, $self->{'DECIMAL'}, $self->{'SEPARADORES'} ); my $gen = $self->{'GENERO'}; $genf = $gen unless defined $genf; $genm = $genf unless defined $genm; # Convertir la parte entera ajustando el sexo #my @words = cardinal_simple($ent, $exp, $self->{'UNMIL'}, $gen); # Traducir la parte decimal de acuerdo al formato for ( $self->{'FORMATO'} ) { /%([0-9]*)s/ && do { # Textual, se traduce según el genero $frc = substr( '0' x $exp . $frc, 0, $1 ) if $1; $frc = join( " ", fraccion_simple( $frc, $exp, $self->{'UNMIL'}, $genf, $genm ) ); $frc = $frc ? sprintf( $self->{'FORMATO'}, $frc ) : ''; last; }; /%([0-9]*)d/ && do { # Numérico, se da formato a los dígitos $frc = substr( '0' x $exp . $frc . '0' x $1, 0, $1 ); $frc = sprintf( $self->{'FORMATO'}, $frc ); last; }; do { # Sin formato, se ignoran los decimales $frc = ''; last; }; } if ($ent) { $ent = $self->cardinal_str( ( $sgn < 0 ? '-' : '+' ) . $ent ); } else { $ent = 'cero'; } $ent .= ' ' . $frc if $ent and $frc; return $self->retval($ent); } =head2 ordinal SYNOPSIS: $text = $obj->ordinal($num) =head3 Parameters =over 4 =item $num the number. =back =head3 Description Translates an ordinal number ($num) to spanish text, translation is performed according to the following object ($obj) settings: DECIMAL, SEPARADORES, GENERO, ACENTOS, MAYUSCULAS, POSITIVO and NEGATIVO. This method croacks if $num <= 0 and carps if $num has a fractional part. =head3 Return Value Textual representation of the number as a string =cut sub ordinal($) { my $self = shift; my $num = shift; my ( $sgn, $ent, $frc, $exp ) = parse_num( $num, $self->{'DECIMAL'}, $self->{'SEPARADORES'} ); croak "Ordinal negativo" if $sgn < 0; carp "Ordinal con decimales" if $frc; if ( $ent =~ /^0*$/ ) { carp "Ordinal cero"; return ''; } my $text = join( " ", ordinal_simple( $ent, $exp, $self->{'GENERO'} ) ); return $self->retval($text); } =head2 Accessors Each of the options has a setter/getter with the name of the option in lowercase, all the accessors have the following sintax: =head3 Getters $obj->name_of_option() Returns the current value of the option. =head3 Setters $obj->name_of_option( $value ) Sets the option to $value and returns $obj =head3 List of accessors $obj->accents $obj->acentos $obj->uppercase $obj->mayusculas $obj->unmil $obj->html $obj->decimal $obj->separators $obj->separadores $obj->gender $obj->genero $obj->positive $obj->positivo $obj->negative $obj->negativo $obj->format $obj->formato =cut { # Build the accessors my %names = ( ( map { $_ => $_ } keys %new_defaults ), %opt_alias ); while ( my ( $opt, $alias ) = each %names ) { $opt = lc $opt; no strict 'refs'; *$opt = sub { my $self = shift; return $self->{$alias} unless @_; $self->{$alias} = shift; return $self; } } } =head1 INTERNALS Functions in this secction are generally not used, but are docummented here for completeness. This is not part of the module's API and is subject to change. =head2 CARDINAL SUPPORT Construction of cardinal numbers =cut ##################################################################### # # Soporte para números CARDINALES # #################################################################### my @cardinal_30 = qw/ cero un dos tres cuatro cinco seis siete ocho nueve diez once doce trece catorce quince dieciséis diecisiete dieciocho diecinueve veinte veintiun veintidós veintitrés veinticuatro veinticinco veintiséis veintisiete veintiocho veintinueve /; my @cardinal_dec = qw/ 0 1 2 treinta cuarenta cincuenta sesenta setenta ochenta noventa /; my @cardinal_centenas = ( "", qw/ ciento doscientos trescientos cuatrocientos quinientos seiscientos setecientos ochocientos novecientos / ); my @cardinal_megas = ( "", qw/ m b tr cuatr quint sext sept oct non dec undec dudec tredec cuatordec quindec sexdec sepdec octodec novendec vigint / ); my $MAX_DIGITS = 6 * @cardinal_megas; =head3 cardinal_e2 =over 4 =item SYNOPSIS cardinal_e2($n, $nn) =item PARAMETERS =over 4 =item $n the number. =item $nn word stack. =back =item DESCRIPTION This procedure takes $n (an integer in the range [0 .. 99], not verified) and adds the numbers text translation to $nn (a word stack), on a word by word basis. If $n == 0 nothing is pushed into $nn. =back =cut sub cardinal_e2($$) { my ( $n, $nn ) = @_; return if $n == 0; do { push @$nn, $cardinal_30[$n]; return } if $n < 30; $n =~ /^(.)(.)$/; push @$nn, $cardinal_30[$2], "y" if $2; push @$nn, $cardinal_dec[$1]; } =head3 cardinal_e3 =over 4 =item SYNOPSIS cardinal_e3($n, $nn) =item PARAMETERS =over 4 =item $n the number. =item $nn word stack. =back =item DESCRIPTION This procedure takes $n (an integer in the range [0 .. 99], not verified) and adds the numbers text translation to $nn (a word stack), on a word by word basis. If $n == 0 nothing is pushed into $nn. =back =cut sub cardinal_e3($$) { my ( $n, $nn ) = @_; return if $n == 0; $n == 100 and do { push @$nn, "cien"; return }; cardinal_e2( $n % 100, $nn ); $n >= 100 and push @$nn, $cardinal_centenas[ int( $n / 100 ) ]; } =head3 cardinal_e6 =over 4 =item SYNOPSIS cardinal_e6($n, $nn, $mag, $un_mil, $postfix) =item PARAMETERS =over 4 =item $n the number. =item $nn word stack. =item $mag magnitude of the number 1 for millions, 2 for billions, etc. =item $un_mil if true 1000 is translated as "un mil" otherwise "mil" =item $postfix array representing plural & singular magnitude of the number, in this order. =back =item DESCRIPTION This procedure takes $n, and pushes the numbers text translation into $nn, on a word by word basis, with the proper translated magnitude. If $n == 0 nothing is pushed into $nn. =back =cut sub cardinal_e6($$$$$) { my ( $n, $nn, $mag, $un_mil, $postfix ) = @_; return if $n == 0; push @$nn, $cardinal_megas[$mag] . $postfix->[ $n == 1 ] if $mag; cardinal_e3( $n % 1000, $nn ); my $n3 = int( $n / 1000 ); if ($n3) { push @$nn, "mil"; cardinal_e3( $n3, $nn ) if $n3 != 1 or $un_mil; } } =head3 cardinal_generic =over 4 =item SYNOPSIS cardinal_generic($n, $exp, $fmag, $gen) =item PARAMETERS =over 4 =item $n the number. =item $exp exponent. =item $fmag closure to format the 6 digits groups. =item $gen gender of the magnitude (optional defaults to NEUTRAL): FEMALE for female gender (1 -> una). MALE for male gender (1 -> uno). NEUTRAL for neutral gender (1 -> un). =back =item DESCRIPTION This function translate the natural number $n to spanish words, adding gender where needed. =item RETURN VALUE Translation of $n to spanish text as a list of words. =back =cut sub cardinal_generic($$$$) { my ( $n, $exp, $fmag, $gen ) = @_; $n =~ s/^0*//; # eliminar ceros a la izquierda return () unless $n; croak("Fuera de rango") if length($n) + $exp > $MAX_DIGITS; $n .= "0" x ( $exp % 6 ); # agregar ceros a la derecha my $mag = int( $exp / 6 ); my @group = (); # Translate the lower 6 digits for female numbers if ($gen eq FEMALE) { $n =~ s/(.{1,6})$//x; $fmag->( $1, \@group, $mag++ ); s/cientos$/cientas/g for @group; } $fmag->( $1, \@group, $mag++ ) while $n =~ s/(.{1,6})$//x; $group[0] .= $gen if $group[0] =~ /un$/; reverse @group; } =head3 cardinal_simple =over 4 =item SYNOPSIS cardinal_simple($n, $exp, $un_mil; $gen) =item PARAMETERS =over 4 =item $n the number. =item $exp exponent. =item $un_mil if true 1000 is translated as "un mil" otherwise "mil" =item $gen gender of the magnitude (optional defaults to NEUTRAL): FEMALE for female gender (1 -> una). MALE for male gender (1 -> uno). NEUTRAL for neutral gender (1 -> un). =back =item DESCRIPTION This function translate the natural number $n to spanish words, adding gender where needed. This procedure just builds a closure with format information, to call cardinal_e6, and then calls cardinal_generic to do the work. =item RETURN VALUE Translation of $n to spanish text as a list of words. =back =cut sub cardinal_simple($$$;$) { my ( $n, $exp, $un_mil, $gen ) = @_; $un_mil = $un_mil ? 1 : 0; $gen = NEUTRAL unless $gen; my $format = sub { cardinal_e6( $_[0], $_[1], $_[2], $un_mil, [ 'illones', 'illón' ] ); }; cardinal_generic( $n, $exp, $format, $gen ); } =head3 fraccion_mag_prefix =over 4 =item SYNOPSIS fraccion_mag_prefix($mag, $gp) =item PARAMETERS =over 4 =item $n the number. =item $exp exponent. =item $mag magnitude of the number 1 for millionths, 2 for billionths, etc. =item $gp gender and plural of the number, is the concatenation of gender and plural gender must be one of FEMALE, MALE or NEUTRAL, and plural must be '' for singular and 's' for plural. Note that NEUTRAL + plural is a nonsense. =item $ngen gender of the number (same values as $gen). =back =item DESCRIPTION This function returns the name of the magnitude of a fraction, $mag is the number of decimal digits. For example 0.001 has $mag == 3 and translates to "milesimos" if $gp is (MALE . 's'). =item RETURN VALUE Translation of $n to spanish text as a string. =back =cut sub fraccion_mag_prefix($$) { my ( $mag, $gp ) = @_; return "" unless $mag; return "décim" . $gp if $mag == 1; return "centésim" . $gp if $mag == 2; my $format = sub { cardinal_e6( $_[0], $_[1], $_[2], 0, [ 'illon', 'illon' ] ); }; my @name = cardinal_generic( 1, $mag, $format, "" ); shift @name unless $mag % 6; join( "", @name, "ésim", $gp ); } =head3 fraccion_simple =over 4 =item SYNOPSIS fraccion_simple($n, $exp, $un_mil, $gen; $ngen) =item PARAMETERS =over 4 =item $n the number. =item $exp exponent. =item $un_mil if true 1000 is translated as "un mil" otherwise "mil" =item $gen gender of the magnitude (optional defaults to NEUTRAL): FEMALE for female gender (1 -> primera). MALE for male gender (1 -> primero). NEUTRAL for neutral gender (1 -> primer). =item $ngen gender of the number (same values as $gen). =back =item DESCRIPTION This function translate the fraction $n to spanish words, adding gender where needed. This procedure just builds a closure with format information, to call cardinal_e6, and then calls cardinal_generic to do the work. =item RETURN VALUE Translation of $n to spanish text as a list of words. =back =cut sub fraccion_simple($$$$;$) { my ( $n, $exp, $un_mil, $gen, $ngen ) = @_; $n =~ s/0*$//; # eliminar 0 a la derecha return () if $n == 0; $ngen = $gen unless defined $ngen; $exp = -$exp + length $n; # adjust exponent croak("Fuera de rango") if $exp > $MAX_DIGITS; $gen .= "s" unless $n =~ /^0*1$/; ( cardinal_simple( $n, 0, $un_mil, $ngen ), fraccion_mag_prefix( $exp, $gen ) ); } =head2 ORDINAL SUPPORT Construction of ordinal numbers =cut ##################################################################### # # Soporte para números ORDINALES # #################################################################### my @ordinal_13 = ( '', qw/ primer_ segund_ tercer_ cuart_ quint_ sext_ séptim_ octav_ noven_ décim_ undécim_ duodécim_ / ); my @ordinal_dec = qw/ 0 1 vi tri cuadra quicua sexa septua octo nona /; my @ordinal_cen = qw/ 0 c duoc tric cuadring quing sexc septig octing noning /; =head3 ordinal_e2 =over 4 =item SYNOPSIS ordinal_e2($n, $nn) =item PARAMETERS =over 4 =item $n the number. =item $nn word stack. =back =item DESCRIPTION This procedure takes $n (an integer in the range [0 .. 99], not verified) and adds the numbers text translation to $nn (a word stack), on a word by word basis. If $n == 0 nothing is pushed into $nn. =back =cut sub ordinal_e2($$) { my ( $n, $nn ) = @_; return if $n == 0; if ( $n < 13 ) { push @$nn, $ordinal_13[$n]; return; } $n =~ /^(.)(.)$/; my $lo = $ordinal_13[$2]; if ( $1 <= 2 ) { my $name = $2 ? ( $1 == 1 ? 'decimo' : 'vigesimo' ) : ( $1 == 1 ? 'décim_' : 'vigésim_' ); $name =~ s/o$// if $2 == 8; # special case vowels colapsed push @$nn, $name . $lo; return; } push @$nn, $lo if $2; push @$nn, $ordinal_dec[$1] . 'gésim_'; } =head3 ordinal_e3 =over 4 =item SYNOPSIS ordinal_e3($n, $nn) =item Parameters =over 4 =item $n the number. =item $nn word stack. =back =item DESCRIPTION This procedure takes $n (an integer in the range [0 .. 999], not verified) and adds the numbers text translation to $nn (a word stack), on a word by word basis. If $n == 0 nothing is pushed into $nn. =back =cut sub ordinal_e3($$) { my ( $n, $nn ) = @_; return if $n == 0; ordinal_e2( $n % 100, $nn ); push @$nn, $ordinal_cen[ int( $n / 100 ) ] . 'entésim_' if $n > 99; } =head3 ordinal_e6 =over 4 =item SYNOPSIS ordinal_e6($n, $nn, $mag, $un_mil, $postfix) =item PARAMETERS =over 4 =item $n the number. =item $nn word stack. =item $mag magnitude of the number 1 for millions, 2 for billions, etc. =back =item DESCRIPTION This procedure takes $n, and pushes the numbers text translation into $nn, on a word by word basis, with the proper translated magnitude. If $n == 0 nothing is pushed into $nn. =back =cut sub ordinal_e6($$$) { my ( $n, $nn, $mag ) = @_; return if $n == 0; push @$nn, $cardinal_megas[$mag] . 'illonésim_' if $mag; ordinal_e3( $n % 1000, $nn ); my $n3 = int( $n / 1000 ); if ($n3) { if ( $n3 > 1 ) { my $pos = @$nn; # keep pos to adjust number cardinal_e3( $n3, $nn ); # this is not a typo, its cardinal $nn->[$pos] .= 'milésim_'; } else { push @$nn, "milésim_"; } } } =head3 ordinal_simple =over 4 =item SYNOPSIS ordinal_simple($n, $exp; $gen) =item PARAMETERS =over 4 =item $n the number. =item $exp exponent. =item $un_mil if true 1000 is translated as "un mil" otherwise "mil" =item $gen gender of the magnitude (optional defaults to NEUTRAL): FEMALE for female gender (1 -> primera). MALE for male gender (1 -> primero). NEUTRAL for neutral gender (1 -> primer). =back =item DESCRIPTION This function translate the fraction $n to spanish words, adding gender where needed. This procedure just builds a closure with format information, to call ordinal_e6, and then calls ordinal_generic to do the work. =item RETURN VALUE Translation of $n to spanish text as a list of words. =back =cut sub ordinal_simple($$;$) { my ( $n, $exp, $gen ) = @_; $n =~ s/^0*//; # eliminar ceros a la izquierda return () unless $n; croak("Fuera de rango") if length($n) + $exp > $MAX_DIGITS; $n .= "0" x ( $exp % 6 ); # agregar ceros a la derecha my $mag = int( $exp / 6 ); my @group = (); if ( $mag == 0 ) { $n =~ s/(.{1,6})$//x; ordinal_e6( $1, \@group, $mag++ ); } while ( $n =~ s/(.{1,6})$//x ) { if ( $1 == 0 ) { $mag++; next; } my $words = []; if ( $1 == 1 ) { push @$words, ''; } else { cardinal_e6( $1, $words, 0, 0, [] ); } $words->[0] .= $cardinal_megas[ $mag++ ] . 'illonésim_'; push @group, @$words; } unless ($gen) { $group[0] =~ s/r_$/r/; # Ajustar neutros en 1er, 3er, etc. $gen = MALE; } s/_/$gen/g for @group; reverse @group; } =head2 MISCELANEOUS Everithing not fitting elsewere =head3 parse_num =over 4 =item SYNOPSIS parse_num($num, $dec, $sep) Decomposes the number in its constitutive parts, and returns them in a list: use Lingua::ES::Numeros; ($sgn, $ent, $frc, $exp) = parse_num('123.45e10', '.', '",'); =item PARAMETERS =over 4 =item $num the number to decompose =item $dec decimal separator (tipically ',' or '.'). =item $sep separator characters ignored by the parser, usually to mark thousands, millions, etc.. =back =item RETURN VALUE This function parses a general number and returns a list of 4 elements: =over 4 =item $sgn sign of the number: -1 if negative, 1 otherwise =item $int integer part of the number =item $frc decimal (fraction) part of the number =item $exp exponent of the number =back Croaks if there is a syntax error. =back =cut sub parse_num($$$) { my ( $num, $dec, $sep ) = @_; # Eliminar blancos y separadores $num =~ s/[\s\Q$sep\E]//g; $dec = '\\' . $dec if $dec eq '.'; my ( $sgn, $int, $frc, $exp ) = $num =~ /^ ([+-]?) (?= \d | $dec\d ) # signo (\d*) # parte entera (?: $dec (\d*) )? # parte decimal (?: [Ee] ([+-]?\d+) )? # exponente $/x or croak("Error de sintaxis"); $sgn = $sgn eq '-' ? -1 : 1; # ajustar signo return ( $sgn, $int || 0, $frc || 0, $exp ) unless $exp ||= 0; $int ||= ''; $frc ||= ''; # reducir la magnitud del exponente if ( $exp > 0 ) { if ( $exp > length $frc ) { $exp -= length $frc; $int .= $frc; $frc = ''; } else { $int .= substr( $frc, 0, $exp ); $frc = substr( $frc, $exp ); $exp = 0; } } else { if ( -$exp > length $int ) { $exp += length $int; $frc = $int . $frc; $int = ''; } else { $frc = substr( $int, $exp + length $int ) . $frc; $int = substr( $int, 0, $exp + length $int ); $exp = 0; } } return ( $sgn, $int || 0, $frc || 0, $exp ); } =head3 retval =over 4 =item SYNOPSIS $obj->retval($value) =item DESCRIPTION Utility method to adjust return values, transforms text following the options: ACENTOS, MAYUSCULAS y HTML. Returns the adjusted $value. =back =cut sub retval($$) { my $self = shift; my $rv = shift; $rv = uc $rv if $self->{MAYUSCULAS}; if ( $self->{ACENTOS} ) { if ( $self->{HTML} ) { $rv =~ s/([ÁáÉéÍíÓóÚú])/&$1acute;/g; $rv =~ tr/ÁáÉéÍíÓóÚú/AaEeIiOoUu/; } } else { $rv =~ tr/ÁáÉéÍíÓóÚú/AaEeIiOoUu/; } return $rv; } 1; __END__ =head1 DEPENDENCIES Perl 5.006, Exporter, Carp =head1 SEE ALSO http://roble.pntic.mec.es/~msanto1/ortografia/numeros.htm =head1 AUTHOR Jose Rey, Ejrey@cpan.orgE =head1 COPYRIGHT AND LICENSE Copyright (C) 2001-2009 by Jose Rey This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut Lingua-ES-Numeros-0.09/Changes0000644000175100017510000000207611606366437014636 0ustar jreyjreyRevision history for Perl extension Lingua::ES::Numeros. 0.09 dom jul 10 13:25:46 VET 2011 - Fix HTML entities names when MAYUSCULAS=>1 as reported via RT #69323 by Eduardo Tubert - New test cases for HTML entity names - Split cardinal method to use cardinal_str. Fixes a bug found after fixing entity names. 0.08 Wed Mar 3 11:43:08 VET 2010 - Create tag :constants to import genre constants - Documentation and examples fixes 0.07 Wed Jan 6 00:14:36 VET 2010 - Corrected fractional formating bug in real() thanks to Joaquin Ferrero - Corrected female hundreths under one million 0.06 Sun Sep 6 18:58:32 VET 2009 - Correct spelling for 2 from dós to dos - Reformat source code: perltidy -pbp -l=99 0.05 Tue Oct 23 19:32:11 VET 2007 - small bug fixes 0.04 Tue Oct 23 15:49:18 VET 2007 - original version; created by h2xs 1.23 with options -AX --skip-exporter --use-new-tests -n Lingua::ES::Numeros - New API - Docs in english 0.01 Sun Sep 16 19:18:07 VET 2001 - alpha version