r3718 - in /packages/liblingua-es-numeros-perl: ./ branches/
branches/upstream/ branches/upstream/current/
branches/upstream/current/debian/ tags/
gwolf at users.alioth.debian.org
gwolf at users.alioth.debian.org
Wed Sep 13 18:57:48 UTC 2006
Author: gwolf
Date: Wed Sep 13 18:57:48 2006
New Revision: 3718
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=3718
Log:
[svn-inject] Installing original source of liblingua-es-numeros-perl
Added:
packages/liblingua-es-numeros-perl/
packages/liblingua-es-numeros-perl/branches/
packages/liblingua-es-numeros-perl/branches/upstream/
packages/liblingua-es-numeros-perl/branches/upstream/current/
packages/liblingua-es-numeros-perl/branches/upstream/current/Changes
packages/liblingua-es-numeros-perl/branches/upstream/current/MANIFEST
packages/liblingua-es-numeros-perl/branches/upstream/current/Makefile.PL
packages/liblingua-es-numeros-perl/branches/upstream/current/Numeros.pm
packages/liblingua-es-numeros-perl/branches/upstream/current/README
packages/liblingua-es-numeros-perl/branches/upstream/current/debian/
packages/liblingua-es-numeros-perl/branches/upstream/current/debian/changelog
packages/liblingua-es-numeros-perl/branches/upstream/current/debian/compat
packages/liblingua-es-numeros-perl/branches/upstream/current/debian/control
packages/liblingua-es-numeros-perl/branches/upstream/current/debian/copyright
packages/liblingua-es-numeros-perl/branches/upstream/current/debian/rules (with props)
packages/liblingua-es-numeros-perl/branches/upstream/current/test.pl
packages/liblingua-es-numeros-perl/tags/
Added: packages/liblingua-es-numeros-perl/branches/upstream/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/packages/liblingua-es-numeros-perl/branches/upstream/current/Changes?rev=3718&op=file
==============================================================================
--- packages/liblingua-es-numeros-perl/branches/upstream/current/Changes (added)
+++ packages/liblingua-es-numeros-perl/branches/upstream/current/Changes Wed Sep 13 18:57:48 2006
@@ -1,0 +1,5 @@
+Revision history for Perl extension Lingua::ES::Numeros.
+
+0.01 Sun Sep 16 10:51:55 2001
+ - original version; created by h2xs 1.19
+
Added: packages/liblingua-es-numeros-perl/branches/upstream/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/packages/liblingua-es-numeros-perl/branches/upstream/current/MANIFEST?rev=3718&op=file
==============================================================================
--- packages/liblingua-es-numeros-perl/branches/upstream/current/MANIFEST (added)
+++ packages/liblingua-es-numeros-perl/branches/upstream/current/MANIFEST Wed Sep 13 18:57:48 2006
@@ -1,0 +1,6 @@
+Changes
+MANIFEST
+Makefile.PL
+Numeros.pm
+README
+test.pl
Added: packages/liblingua-es-numeros-perl/branches/upstream/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/packages/liblingua-es-numeros-perl/branches/upstream/current/Makefile.PL?rev=3718&op=file
==============================================================================
--- packages/liblingua-es-numeros-perl/branches/upstream/current/Makefile.PL (added)
+++ packages/liblingua-es-numeros-perl/branches/upstream/current/Makefile.PL Wed Sep 13 18:57:48 2006
@@ -1,0 +1,12 @@
+use ExtUtils::MakeMaker;
+BEGIN { require 5.0 }
+
+WriteMakefile(
+ 'NAME' => 'Lingua::ES::Numeros',
+ 'VERSION_FROM' => "Numeros.pm",
+ 'ABSTRACT' => 'Convierte números cardinales en texto castellano',
+ 'AUTHOR' => 'Jose Rey (jrey at mercared.com)',
+ 'PM' => {
+ 'Numeros.pm' => '${INST_LIBDIR}/Numeros.pm'
+ }
+);
Added: packages/liblingua-es-numeros-perl/branches/upstream/current/Numeros.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/liblingua-es-numeros-perl/branches/upstream/current/Numeros.pm?rev=3718&op=file
==============================================================================
--- packages/liblingua-es-numeros-perl/branches/upstream/current/Numeros.pm (added)
+++ packages/liblingua-es-numeros-perl/branches/upstream/current/Numeros.pm Wed Sep 13 18:57:48 2006
@@ -1,0 +1,772 @@
+=head1 NAME
+
+Lingua::ES::Numeros - Convierte números a texto en Español (Castellano)
+
+=head1 SYNOPSIS
+
+ use Lingua::ES::Numeros
+
+ $obj = new Lingua::ES::Numeros ('MAYUSCULAS' => 1)
+ print $obj->Cardinal(124856), "\n";
+ print $obj->Real(124856.531), "\n";
+ $obj->{SEXO} = 'a';
+ print $obj->Ordinal(124856), "\n";
+
+=head1 REQUIERE
+
+Perl 5.004, Exporter, Carp
+
+=head1 DESCRIPTION
+
+Lingua::ES::Numeros convierte números de precisión arbitraria en su
+representación textual en castellano. Tiene soporte para la
+representación de cardinales, ordinales y reales. Como los números
+manejados tienen mayor rango que el manejo númeríco nativo de Perl,
+estos se manejan como cadenas de caracteres, permitiendo así el
+crecimiento ilimitado del sistema de conversión.
+
+=cut
+
+#######################################################################
+# Jose Luis Rey Barreira (C) 2001
+# Código bajo licencia GPL ver http://www.gnu.org
+#######################################################################
+
+package Lingua::ES::Numeros;
+
+require 5.004;
+require Exporter;
+ at ISA = qw(Exporter);
+
+use strict;
+use Carp;
+
+use vars qw {
+ $VERSION
+ @EXPORT
+ @EXPORT_OK
+ %EXPORT_TAGS
+};
+
+BEGIN {
+ $VERSION = '0.01';
+
+ @EXPORT = qw{ cardinal real ordinal };
+ @EXPORT_OK = qw{ parse_num };
+ %EXPORT_TAGS = (
+ 'all' => [ @EXPORT, @EXPORT_OK ],
+ 'default' => [ @EXPORT ],
+ );
+};
+
+
+#####################################################################
+#
+# Soporte para números CARDINALES
+#
+####################################################################
+
+my @hasta30 = 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 @decenas = qw {
+ treinta cuarenta cincuenta
+ sesenta setenta ochenta noventa
+ };
+
+my @centenas = (
+ "", "ciento", "doscientos", "trescientos",
+ "cuatrocientos", "quinientos", "seiscientos",
+ "setecientos", "ochocientos", "novecientos"
+ );
+
+my @Llones = (
+ "", "m", "b", "tr", "cuatr", "quint",
+ "sext", "sept", "oct", "non", "dec",
+ "undec", "dudec", "tredec", "cuatordec",
+ "quindec", "sexdec", "sepdec", "octodec",
+ "novendec", "vigint"
+ );
+
+sub hasta100($) {
+ my $n = shift;
+
+ return "" if $n == 0;
+ return $hasta30[$n] if $n < 30;
+ $n =~ /(.)(.)$/;
+ return $decenas[$1-3] unless $2;
+ return $decenas[$1-3] . " y " .$hasta30[$2];
+}
+
+sub hasta1k($) {
+ my $n = shift;
+
+ return "" if $n == 0;
+ return "cien" if $n == 100;
+ my $c = $centenas[int($n / 100)];
+ my $d = hasta100($n % 100);
+ return $c . ($c and $d ? ' ' : '') . $d;
+}
+
+sub hasta1M($$) {
+ my ($n, $un_mil) = @_;
+
+ return "" if $n == 0;
+ my $h = int($n / 1000);
+ $h = $h==1
+ ? $un_mil
+ ? 'un mil'
+ : 'mil'
+ : $h
+ ? hasta1k($h) . ' mil'
+ : '';
+ my $l = hasta1k($n % 1000);
+ return $h . ($h and $l ? ' ' : '') . $l;
+}
+
+sub enteroAtexto($$$) {
+ my ($n, $exp, $un_mil) = @_;
+
+ my @grupo;
+ my $buf = '';
+
+ $n =~ s/^0*//; # eliminar ceros a la izquierda
+ while ($exp > 6) {
+ push @grupo, 0;
+ $exp -= 6;
+ }
+ $n .= '0' x $exp;
+ while ($n =~ s/(......)$//) {
+ push @grupo, $1;
+ }
+ push @grupo, $n;
+ croak 'Número fuera de rango' if @grupo > @Llones;
+ for (my $i=$#grupo; $i>0; $i--) {
+ my $g = $grupo[$i];
+ next if $g == 0;
+ $buf .= ($buf ? ' ' : '') . hasta1M($g, $un_mil) . ' ' .
+ $Llones[$i] . ($g==1 ? 'illón' : 'illones');
+ }
+ if ($grupo[0] > 0) {
+ $buf .= ' ' if $buf;
+ $buf .= hasta1M($grupo[0], $un_mil);
+ }
+ return $buf;
+}
+
+sub fracAtexto($$$$) {
+ my ($n, $exp, $un_mil, $sex) = @_;
+
+ $n =~ s/0*$//; # eliminar 0 a la derecha
+ my $ll = -$exp + length $n; # total de dígitos en $n
+ my $mm = $ll - 6*@Llones; # digitos fuera de precisión
+ croak 'Número fuera de precisión' if length($n) <= $mm;
+ $n = substr($n, 0, length($n)-$mm); # eliminar dígitos sobrantes
+ return '' unless $n =~ /[1-9]/;
+
+ $ll -= $mm if $mm > 0; # tomar en cuenta los dígitos sobrantes
+ $mm = $ll % 6; # 1->décimas, 2->centésimas, etc.
+ $ll = int( $ll / 6 ); # 1->millonésimas, 3->trillonésimas, etc.
+ if ($ll) {
+ $ll = enteroAtexto('1', $mm, 0) . ' ' . $Llones[$ll] . 'illonés';
+ $ll =~ s/^un\s*//; # evitar el 'un ' en 'un millonésimas'
+ } else {
+ for ($mm) {
+ /1/ && do { $ll = "déc"; last };
+ /2/ && do { $ll = "centés"; last };
+ $ll = enteroAtexto('1', $mm, 0) . "és";
+ }
+ }
+ # Traducir el número, ajustar su sexo
+ $mm = enteroAtexto($n, 0, $un_mil);
+ if ($sex eq 'a') {
+ $mm =~ s/un$/una/;
+ } else {
+ $sex = 'o';
+ }
+ # Ajustar el sexo de la magnitud (milésimas, etc)
+ $mm .= ' ' . $ll . "im$sex";
+ $mm .= 's' if $n !~ /^0*1$/; # plural si es > 1
+ return $mm;
+}
+
+
+#####################################################################
+#
+# Soporte para números ORDINALES
+#
+####################################################################
+
+my @hasta20vo = qw{
+ x primer_ segund_ tercer_ cuart_ quint_ sext_
+ séptim_ octav_ noven_ décim_ undécim_ duodécim_
+ };
+
+my @decimos = qw {
+ vi tri cuadra quicua sexa septua octo nona
+ };
+
+my @centesimos = qw {
+ c duoc tric cuadring quing sexc septig octing noning
+ };
+
+sub hasta100vo($)
+{
+ $_ = shift;
+ return $hasta20vo[$_] if $_ < 13;
+ /(.)(.)/;
+ return 'decim_' . $hasta20vo[$2] if $1 == 1;
+ return $decimos[$1 - 2] . 'gésim_' . ($2 ? ' ' . $hasta20vo[$2] : "");
+}
+
+sub hasta1Kvo($)
+{
+ my $n = shift;
+
+ return "" if $n == 0;
+ my $c = int($n / 100);
+ $c = $c==0
+ ? ''
+ : $centesimos[$c - 1] . 'entésim_';
+ my $d = hasta100vo($n % 100);
+ return $c . ($c and $d ? ' ' : '') . $d;
+}
+
+sub hasta1Mvo($)
+{
+ my $n = shift;
+
+ return "" if $n == 0;
+ my $h = int($n / 1000);
+ $h = $h<=1
+ ? $h==0
+ ? ''
+ : 'milésim_'
+ : hasta1k($h) . 'milésim_';
+ my $l = hasta1Kvo($n % 1000);
+ return $h . ($h and $l ? ' ' : '') . $l;
+}
+
+
+#####################################################################
+#
+# Métodos de Clase
+#
+####################################################################
+
+=head1 MÉTODOS DE CLASE
+
+=over 4
+
+=item parse_num($num, $dec, $sep)
+
+Descompone el número en sus diferentes partes y retorna una lista con
+las mismas, por ejemplo:
+
+ use Linugua::ES::Numeros qw( :All );
+ ($sgn, $ent, $frc, $exp) = parse_num('123.45e10', '.', '",');
+
+=head2 Parámetros
+
+=over 4
+
+=item $num
+
+El número a traducir
+
+=item $dec
+
+El separador de decimales.
+
+=item $sep
+
+Los caracteres separadores de miles, millones, etc.
+
+=back
+
+=head2 Valores de retorno
+
+=over 4
+
+=item $sgn
+
+Signo, puede ser -1 si está presente el signo negativo, 1 si está
+presente el signo negativo y 0 si no hay signo presente.
+
+=item $ent
+
+Parte entera del número, solo los dígitos más significativos (ver $exp)
+
+=item $frc
+
+Parte fraccional del número, solo los dígitos menos significativos (ver
+$exp)
+
+=item $exp
+
+Exponente del número, si es > 0, dicta el número de ceros que sigue a la parte entera, si es < 0, dicta el número de ceros que están entre el punto decimal y la parte fraccional.
+
+=back
+
+Este método no se exporta implicitamente, asi que debe ser importado
+con cualquiera de las siguientes sintaxis:
+
+ use Lingua::ES::Numeros qw(parse_num);
+ use Lingua::ES::Numeros qw(:All);
+
+=back
+
+=cut
+
+sub parse_num($$$)
+{
+ $_ = shift;
+ my ($dec, $sep) = @_;
+
+ my ($sgn, $int, $frc, $exp);
+
+ # Eliminar blancos y separadores
+ s/[\s\Q$sep\E]//g;
+ $dec = '\\' . $dec;
+ if (/^([+-]?)(?=\d|$dec\d)(\d*)($dec(\d*))?([Ee]([+-]?\d+))?$/) {
+ ($sgn, $int, $frc, $exp) = ( $1, $2, $4, $6 );
+ $sgn = defined $sgn
+ ? $sgn = $sgn eq '-' ? -1 : 1
+ : 0;
+ $exp = 0 unless defined $exp;
+ }
+ else {
+ croak "Número ilegal";
+ }
+ return ($sgn, $int, $frc, $exp) if $exp == 0;
+
+ # Correr el punto décimal tantas posciones como sea posible
+ 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, $frc, $exp);
+}
+
+=head1 CAMPOS
+
+El objeto contiene los siguientes campos que alteran la conversión.
+
+=over 4
+
+=item DECIMAL
+
+Especifíca la cadena de caracteres que se utilizará para separar la
+parte entera de la parte fraccional del número a convertir. El valor
+por defecto de DECIMAL es '.'
+
+=item SEPARADORES
+
+Cadena de caracteres que contiene todos los caracteres de formato del
+número. Todos los caracteres de esta cadena serán ignorados por el
+parser que descompone el número. El valor por defecto de SEPARADORES es
+',"_'
+
+=item ACENTOS
+
+Afecta la ortografía de los números traducidos, si es falso la
+representación textual de los números no tendrá acentos, el valor
+predeterminado de este campo es 1 (con acentos). Esté campo puede ser
+de mucha utilidad si el conjunto de caracteres utilizado no es el
+Latin1, ya que los acentos dependen de él en esta versión (ver
+PROBLEMAS).
+
+=item MAYUSCULAS
+
+Si es cierto, la representación textual del número será una cadena de
+caracteres en mayúsculas, el valor predeterminado de este campo es 0 (en
+minúsculas)
+
+=item HTML
+
+Si es cierto, la representación textual del número será una cadena de
+caracteres en HTML (los acentos estarán representados por las
+respectivas entidades HTML). El valor predeterminado es 0 (texto).
+
+=item SEXO
+
+El sexo de los números, puede ser: 'a', 'o' o '', para números en
+femenino, masculino o neutro respectivamente. El valor por defecto
+de este campo es 'o'.
+
+ +---+--------------------+-----------------------------+
+ |Nú | CARDINALES | ORDINALES |
+ |me +------+------+------+---------+---------+---------+
+ |ro | 'o' | 'a' | '' | 'o' | 'a' | '' |
+ +---+------+------+------+---------+---------+---------+
+ | 1 | uno | una | un | primero | primera | primer |
+ | 2 | dos | dos | dos | segundo | segunda | segundo |
+ | 3 | tres | tres | tres | tercero | tercera | tercer |
+ +---+------+------+------+---------+---------+---------+
+
+=item UNMIL
+
+Este campo solo afecta la traduccion de cardinales y cuando es cierto,
+el número 1000 se traduce como 'un mil', de otro modo se traduce
+simplemente 'mil'. El valor por defecto de UNMIL es 1.
+
+=item NEGATIVO
+
+La cadena de caracteres que contiene el nombre con el que se traducirá
+el signo negativo (-), por defecto vale 'menos'.
+
+=item POSITIVO
+
+La cadena de caracteres que contiene el nombre con el que se traducirá
+el signo positivo (+), por defecto vale ''. Esta cadena sólo es añadida
+al número en presencia del signo '+', de otro modo no se agrega aunque
+el número se asume positivo.
+
+=item FORMATO
+
+Una cadena de caracteres que especifíca como se deben traducir los
+decimales de un número real. Su valor por defecto es 'con %02d ctms.'
+(ver el método B<real>).
+
+=back
+
+=cut
+
+my $objvars = {
+ 'ACENTOS' => 1,
+ 'MAYUSCULAS' => 2,
+ 'UNMIL' => 3,
+ 'HTML' => 4,
+ 'DECIMAL' => 5,
+ 'SEPARADORES' => 6,
+ 'SEXO' => 7,
+ 'NEGATIVO' => 8,
+ 'POSITIVO' => 9,
+ 'FORMATO' => 10
+ };
+
+=head1 CONSTRUCTOR
+
+Para construir un objeto Lingua::ES::Numeros, se utiliza el método de
+clase B<new>, este método puede recibir como parámetro cualesquiera de
+los campos mencionados en la sección anterior.
+
+Ejemplos:
+
+ use Lingua::ES::Numeros;
+
+ # usa los valores predeterminados de los campos
+ $obj = new Lingua::ES::Numeros;
+
+ # especifíca los valores de algunos campos
+ $obj = Lingua::ES::Numeros::->new( 'ACENTOS' => 0,
+ 'MAYUSCULAS' => 1,
+ 'SEXO' => 'a',
+ 'DECIMAL' => ',',
+ 'SEPARADORES'=> '"_' );
+
+=cut
+
+sub new {
+ my $self = [ $objvars, 1, 0, 1, 0, '.', ',', 'o',
+ 'menos', '', 'con %02d ctms.' ];
+ bless $self, shift;
+ while (@_) {
+ my $i = shift;
+ $self->{$i} = shift;
+ }
+ return $self;
+}
+
+
+#####################################################################
+#
+# Métodos del Objeto
+#
+####################################################################
+
+sub retval($$)
+{
+# Rutina de utilidad que retorna el valor textual adecuado, según los
+# valores de los campos ACENTOS, MAYUSCULAS y HTML.
+#
+# Esta rutina por ahora no hace uso de locale ni utf8 y por lo tanto el
+# módulo solo funciona en máquinas que utilicen el set de caracteres
+# Latin1 (ISO-8859-1). Esto puede cambiar proximamente.
+#
+ my $self = shift;
+ $_ = shift;
+ if ($self->{ACENTOS}) {
+ tr/a-záéíóú/A-ZÁÉÍÓÚ/ if $self->{MAYUSCULAS};
+ if ( $self->{HTML} ) {
+ s/([ÁÉÍÓÚáéíóú])/&$1acute;/g;
+ tr/ÁÉÍÓÚáéíóú/AEIOUaeiou/;
+ }
+ }
+ else {
+ tr/áéíóú/aeiou/;
+ return uc $_ if $self->{MAYUSCULAS};
+ }
+ return $_;
+}
+
+=head1 MÉTODOS DEL OBJETO
+
+=over 4
+
+=item $n = cardinal($n)
+
+Convierte el número $n, como un número cardinal a castellano.
+
+La conversión esta afectada por los campos: DECIMAL, SEPARADORES,
+SEXO, ACENTOS, MAYUSCULAS, POSITIVO y NEGATIVO.
+
+Esta conversión ignora la parte fraccional del número, si la tiene.
+
+=cut
+
+sub cardinal($) {
+ my $self = shift;
+ my ($sgn, $ent, $frc, $exp)= parse_num(shift, $self->{DECIMAL}, $self->{SEPARADORES});
+# $ent = enteroAtexto($ent . '0' x $exp, $self->{UNMIL});
+ $ent = enteroAtexto($ent, $exp, $self->{UNMIL});
+ my $sex = $self->{SEXO};
+ $ent =~ s/un$/un$sex/ if $sex;
+ if ($ent) {
+ my $s = '';
+ $s = $self->{NEGATIVO} if $sgn < 0;
+ $s = $self->{POSITIVO} if $sgn > 0;
+ $s .= ' ' if $s;
+ $ent = $s . $ent;
+ $ent =~ tr/áéíóú/aeiou/ unless $self->{ACENTOS};
+ }
+ else {
+ $ent = 'cero';
+ }
+ return retval( $self, $ent);
+}
+
+=item $n = real($n [, $fsexo])
+
+Convierte el número $n, como un número real a castellano.
+
+El parámetro opcional $fsexo se utiliza para especificas un sexo diferente para
+la parte decimal, recibe los mismos valores que se le pueden asignar al campo
+SESO, pero el sexo neutro equivale a masculino en la parte fraccional, si es
+omitido se usará el valor del campo SEXO.
+
+La conversión esta afectada por los campos: DECIMAL, SEPARADORES,
+SEXO, ACENTOS, MAYUSCULAS, POSITIVO y NEGATIVO.
+
+=head2 Formato de la parte fraccional (FORMATO)
+
+Además esta conversión utiliza el campo FORMATO para dirigir la
+conversión de la parte fraccional del número real. Este campo es un
+formato estilo sprintf que solo tiene una especificación de
+formato precedida por '%'. Además las dos únicas especificaciones
+válidas por ahora son:
+
+=over 4
+
+=item %s
+
+Incluye la representación textual de la parte fraccional dentro del
+formato. Por ejemplo, convertir '123.345' con formato 'más %s.' resultará
+en el número: CIENTO VEINTITRÉS Y TRECIENTOS CUARENTA MÁS CINCO MILÉSIMAS.
+
+=item %Nd
+
+Incluye la representación numérica de la parte fraccional, donde N es
+una especificación del formato '%d' de sprintf. Por ejemplo, convertir
+'123.345' con formato ' con %02d ctms.' producirá: CIENTO VEINTITRÉS Y
+TRECIENTOS CUARENTA CON 34 CTMS.
+
+=back
+
+=cut
+
+sub real($;$) {
+ my $self = shift;
+ my ($sgn, $ent, $frc, $exp)= parse_num(shift, $self->{DECIMAL}, $self->{SEPARADORES});
+ my $fsex = shift; # sexo de la parte decimal (opcional)
+
+ # Convertir la parte entera ajustando el sexo
+ my $sex = $self->{SEXO};
+# $ent = enteroAtexto($ent . '0' x $exp, $self->{UNMIL});
+ $ent = enteroAtexto($ent, $exp, $self->{UNMIL});
+ $ent =~ s/un$/un$sex/ if $sex;
+
+ # Traducir la parte decimal de acuerdo al formato
+ for ($self->{FORMATO}) {
+ /%s/ && do {
+ # Textual, se traduce según el sexo
+ $fsex = $sex unless defined $fsex;
+ $frc = fracAtexto($frc, $exp, $self->{UNMIL}, $fsex);
+ $frc = $frc ? sprintf($self->{FORMATO}, $frc) : '';
+ last;
+ };
+ /%([0-9]*)/ && do {
+ # Numérico, se da formato a los dígitos
+ $frc = substr('0' x $exp . $frc, 0, $1);
+ $frc = sprintf($self->{FORMATO}, $frc);
+ last;
+ };
+ do {
+ # Sin formato, se ignoran los decimales
+ $frc = '';
+ last;
+ };
+ }
+ if ($ent) {
+ my $s = '';
+ $s = $self->{NEGATIVO} if $sgn < 0;
+ $s = $self->{POSITIVO} if $sgn > 0;
+ $s .= ' ' if $s;
+ $ent = $s . $ent;
+ }
+ else {
+ $ent = 'cero';
+ }
+ $ent .= ' ' . $frc if $ent and $frc;
+ return retval($self, $ent);
+}
+
+=item $n = ordinal($n)
+
+Convierte el número $n, como un número ordinal a castellano.
+
+La conversión esta afectada por los campos: DECIMAL, SEPARADORES,
+SEXO, ACENTOS y MAYUSCULAS.
+
+Presenta advertencias si el número es negativo y/o si no es un natural >
+0.
+
+=cut
+
+sub ordinal($) {
+ my $self = shift;
+ my ($sgn, $ent, $frc, $exp)= parse_num(shift, $self->{DECIMAL}, $self->{SEPARADORES});
+
+ croak "Ordinal negativo" if $sgn < 0;
+ croak "Ordinal con decimales" if $frc;
+ if ($ent =~ /^0*$/) {
+ carp "Ordinal cero";
+ return '';
+ }
+
+ my @grupo;
+
+ $ent .= '0' x $exp;
+ while ($ent =~ s/(......)$//) {
+ push @grupo, $1;
+ }
+ push @grupo, $ent;
+ $ent = '';
+ for (my $i=$#grupo; $i>0; $i--) {
+ my $g = $grupo[$i];
+ next if $g == 0;
+ $ent .= ($ent ? ' ' : '') . hasta1M($g,0) . ' ' .
+ $Llones[$i] . 'illonésim_';
+ }
+ if ($grupo[0] > 0) {
+ $ent .= ' ' if $ent;
+ $ent .= hasta1Mvo($grupo[0]);
+ }
+ my $sex = $self->{SEXO};
+ $ent =~ s/r_$/r/ unless $sex; # Ajustar neutros en 1er, 3er, etc.
+ $sex = 'o' unless $sex;
+ $ent =~ s/_/$sex/g;
+ return retval($self, $ent);
+}
+
+1;
+
+__END__
+
+=back
+
+=head1 DIAGNÓSTICOS
+
+=over 4
+
+=item Número ilegal.
+
+El número tiene un error sintáctico.
+
+=item Número fuera de rango.
+
+La parte entera del número es demasiado grande. Por el momento solo se
+aceptan números de hasta 10**126 - 1, pues no se cual es la
+representación textual de números >= 10**126. Cualquier ayuda o
+corrección será bien recibida.
+
+=item Número fuera de precisión.
+
+La parte fraccional del número es menor que 10**-126 y no se puede
+traducir por los motivos antes mencionados.
+
+=item Ordinal negativo
+
+El número a convertir en ordinal es negativo.
+
+=item Ordinal con decimales
+
+El número a convertir en ordinal tiene decimales.
+
+=back
+
+=head1 AUTOR
+
+José Luis Rey Barreira <jrey at mercared.com>
+
+=head1 PROBLEMAS
+
+La conversión a mayúsculas se está haciendo actualmente mediante una
+transliteración para poder convertir los caracteres acentuados. El
+problema es que esto no funcionará si el conjunto de caracteres en uso
+es distinto al ISO 8859-1 (Latin1) o al ISO 8859-15.
+
+Las alternativas a este problema serían: la utilización de Perl 5.6 o
+superior con 'utf8', pero restringo el uso del módulo a una gran
+cantidad de usuarios que todavía usan Perl 5.00x, por otra parte podría
+utilizar locales, pero no se si estos funcionan exactamente igual en
+Unix, Windows, BeOS, etc. así que creo que la transliteración es
+adecuada por ahora.
+
+=head1 LICENCIA
+
+Este código es propiedad intelectual de José Rey y se distribuye según
+los términos de la Licencia Pública General del proyecto GNU, cuya letra
+y explicación se pueden encontrar en inglés en la página
+http://www.gnu.org/licenses/licenses.html y de la que cual hay una
+traducción al castellano en
+http://lucas.hispalinux.es/Otros/gples/gples.html
+
+=cut
+
Added: packages/liblingua-es-numeros-perl/branches/upstream/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/packages/liblingua-es-numeros-perl/branches/upstream/current/README?rev=3718&op=file
==============================================================================
--- packages/liblingua-es-numeros-perl/branches/upstream/current/README (added)
+++ packages/liblingua-es-numeros-perl/branches/upstream/current/README Wed Sep 13 18:57:48 2006
@@ -1,0 +1,8 @@
+Este es el módulo Lingua::ES::Numeros, que convierte números a su
+representación textual en castellano.
+
+Este módulo esta siendo probado y probablemente contiene errores, las
+correcciones son bienvenidas.
+
+José Luis Rey Barreira
+jrey at linuxsis.net
Added: packages/liblingua-es-numeros-perl/branches/upstream/current/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/packages/liblingua-es-numeros-perl/branches/upstream/current/debian/changelog?rev=3718&op=file
==============================================================================
--- packages/liblingua-es-numeros-perl/branches/upstream/current/debian/changelog (added)
+++ packages/liblingua-es-numeros-perl/branches/upstream/current/debian/changelog Wed Sep 13 18:57:48 2006
@@ -1,0 +1,6 @@
+liblingua-es-numeros-perl (0.01-1) unstable; urgency=low
+
+ * Initial Release.
+
+ -- David Moreno Garza <damog at debian.org> Sun, 12 Mar 2006 18:10:31 -0400
+
Added: packages/liblingua-es-numeros-perl/branches/upstream/current/debian/compat
URL: http://svn.debian.org/wsvn/pkg-perl/packages/liblingua-es-numeros-perl/branches/upstream/current/debian/compat?rev=3718&op=file
==============================================================================
--- packages/liblingua-es-numeros-perl/branches/upstream/current/debian/compat (added)
+++ packages/liblingua-es-numeros-perl/branches/upstream/current/debian/compat Wed Sep 13 18:57:48 2006
@@ -1,0 +1,1 @@
+4
Added: packages/liblingua-es-numeros-perl/branches/upstream/current/debian/control
URL: http://svn.debian.org/wsvn/pkg-perl/packages/liblingua-es-numeros-perl/branches/upstream/current/debian/control?rev=3718&op=file
==============================================================================
--- packages/liblingua-es-numeros-perl/branches/upstream/current/debian/control (added)
+++ packages/liblingua-es-numeros-perl/branches/upstream/current/debian/control Wed Sep 13 18:57:48 2006
@@ -1,0 +1,17 @@
+Source: liblingua-es-numeros-perl
+Section: perl
+Priority: optional
+Build-Depends: debhelper (>= 4.0.2)
+Build-Depends-Indep: perl (>= 5.8.0-7)
+Maintainer: David Moreno Garza <damog at debian.org>
+Standards-Version: 3.6.2
+
+Package: liblingua-es-numeros-perl
+Architecture: all
+Depends: ${perl:Depends}, ${misc:Depends}
+Description: Converts numbers to Spanish text
+ Arbitrary precision number converter to its textual representation
+ in Spanish. Supports cardinals, ordinals and reals. As managed
+ numbers are widely longer than Perl's native number management,
+ these are handled as character strings, allowing unlimited growth
+ on the conversion system.
Added: packages/liblingua-es-numeros-perl/branches/upstream/current/debian/copyright
URL: http://svn.debian.org/wsvn/pkg-perl/packages/liblingua-es-numeros-perl/branches/upstream/current/debian/copyright?rev=3718&op=file
==============================================================================
--- packages/liblingua-es-numeros-perl/branches/upstream/current/debian/copyright (added)
+++ packages/liblingua-es-numeros-perl/branches/upstream/current/debian/copyright Wed Sep 13 18:57:48 2006
@@ -1,0 +1,14 @@
+This is the debian package for the Lingua::ES::Numeros module.
+It was created by David Moreno Garza <damog at debian.org> using dh-make-perl.
+
+Copyright:
+
+Upstream Author: José Rey <jreylinuxsis.net>
+
+License:
+
+You are free to distribute this software under the terms of the GNU
+General Public License. On Debian systems, the complete text of the GNU
+General Public License can be found in the file
+`/usr/share/common-licenses/GPL'.
+
Added: packages/liblingua-es-numeros-perl/branches/upstream/current/debian/rules
URL: http://svn.debian.org/wsvn/pkg-perl/packages/liblingua-es-numeros-perl/branches/upstream/current/debian/rules?rev=3718&op=file
==============================================================================
--- packages/liblingua-es-numeros-perl/branches/upstream/current/debian/rules (added)
+++ packages/liblingua-es-numeros-perl/branches/upstream/current/debian/rules Wed Sep 13 18:57:48 2006
@@ -1,0 +1,83 @@
+#!/usr/bin/make -f
+# This debian/rules file is provided as a template for normal perl
+# packages. It was created by Marc Brockschmidt <marc at dch-faq.de> for
+# the Debian Perl Group (http://pkg-perl.alioth.debian.org/) but may
+# be used freely wherever it is useful.
+
+# Uncomment this to turn on verbose mode.
+export DH_VERBOSE=1
+
+# If set to a true value then MakeMaker's prompt function will
+# always return the default without waiting for user input.
+export PERL_MM_USE_DEFAULT=1
+
+PACKAGE=$(shell dh_listpackages)
+
+ifndef PERL
+PERL = /usr/bin/perl
+endif
+
+TMP =$(CURDIR)/debian/$(PACKAGE)
+
+build: build-stamp
+build-stamp:
+ dh_testdir
+
+ # Add commands to compile the package here
+ $(PERL) Makefile.PL INSTALLDIRS=vendor
+ $(MAKE) OPTIMIZE="-Wall -O2 -g"
+
+ touch build-stamp
+
+clean:
+ dh_testdir
+ dh_testroot
+
+ # Add commands to clean up after the build process here
+ [ ! -f Makefile ] || $(MAKE) realclean
+
+ dh_clean build-stamp install-stamp
+
+install: build install-stamp
+install-stamp:
+ dh_testdir
+ dh_testroot
+ dh_clean -k
+
+ # Add commands to install the package into debian/$PACKAGE_NAME here
+ $(MAKE) test
+ $(MAKE) install DESTDIR=$(TMP) PREFIX=/usr
+
+ # As this is a architecture independent package, we are not
+ # supposed to install stuff to /usr/lib. MakeMaker creates
+ # the dirs, we delete them from the deb:
+ rmdir --ignore-fail-on-non-empty --parents $(TMP)/usr/lib/perl5
+
+ touch install-stamp
+
+binary-arch:
+# We have nothing to do by default.
+
+binary-indep: build install
+ dh_testdir
+ dh_testroot
+# dh_installcron
+# dh_installmenu
+# dh_installexamples
+ dh_installdocs README
+ dh_installchangelogs Changes
+ dh_perl
+ dh_link
+ dh_strip
+ dh_compress
+ dh_fixperms
+ dh_installdeb
+ dh_gencontrol
+ dh_md5sums
+ dh_builddeb
+
+source diff:
+ @echo >&2 'source and diff are obsolete - use dpkg-source -b'; false
+
+binary: binary-indep binary-arch
+.PHONY: build clean binary-indep binary-arch binary
Propchange: packages/liblingua-es-numeros-perl/branches/upstream/current/debian/rules
------------------------------------------------------------------------------
svn:executable =
Added: packages/liblingua-es-numeros-perl/branches/upstream/current/test.pl
URL: http://svn.debian.org/wsvn/pkg-perl/packages/liblingua-es-numeros-perl/branches/upstream/current/test.pl?rev=3718&op=file
==============================================================================
--- packages/liblingua-es-numeros-perl/branches/upstream/current/test.pl (added)
+++ packages/liblingua-es-numeros-perl/branches/upstream/current/test.pl Wed Sep 13 18:57:48 2006
@@ -1,0 +1,42 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+######################### We start with some black magic to print on failure.
+
+# Change 1..1 below to 1..last_test_to_print .
+# (It may become useful if the test is moved to ./t subdirectory.)
+
+BEGIN { $| = 1; print "1..5\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use Lingua::ES::Numeros;
+$loaded = 1;
+print "ok 1\n";
+
+######################### End of black magic.
+
+# Insert your test code below (better if it prints "ok 13"
+# (correspondingly "not ok 13") depending on the success of chunk 13
+# of the test code):
+
+$obj = Lingua::ES::Numeros::new;
+
+$l = $obj->cardinal(1001);
+$t1 = "un mil uno";
+print scalar($l ne $t1 ? "not " : ""), "ok 2\n";
+
+$l = $obj->ordinal(1001);
+$t1 = "milésimo primero";
+print scalar($l ne $t1 ? "not " : ""), "ok 3\n";
+
+$obj->{UNMIL} = 0;
+$obj->{SEXO} = 'a';
+$obj->{FORMATO} = 'con %s';
+$l = $obj->real(1001001.001);
+$t1 = "un millón mil una con una milésima";
+print scalar($l ne $t1 ? "not " : ""), "ok 4\n";
+
+$obj->{MAYUSCULAS} = 1;
+$l = $obj->real(1001001.001);
+$t1 = "UN MILLÓN MIL UNA CON UNA MILÉSIMA";
+print scalar($l ne $t1 ? "not " : ""), "ok 5\n";
+
More information about the Pkg-perl-cvs-commits
mailing list