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