package Lingua::IT::Numbers;
use Regexp::Common qw(number);
use strict;
use warnings;
use overload (
'""' => \&get_string,
'0+' => \&get_number,
'=' => \&clone,
'+' => \&add,
'-' => \&minus,
'*' => \&mult,
'/' => \&div,
fallback => 1);
use Carp qw(carp);
use Exporter;
use vars qw( $VERSION @ISA @EXPORT_OK @EXPORT %EXPORT_TAGS);
use vars qw(
%NUMBER_NAMES
@PART_NAMES
@UNITS_NAMES
@FRACT_NAMES
%OUTPUT_DECIMAL_DELIMITERS
%SIGN_NAMES
%DEFAULT_OPTS
);
require Exporter;
@ISA = qw(Exporter);
$VERSION = '0.06';
@EXPORT = ();
@EXPORT_OK = qw(number_to_it);
%EXPORT_TAGS = (
all => [@EXPORT_OK],
default => [@EXPORT],
);
%SIGN_NAMES = ('-' => 'meno',
'+' => '');
%OUTPUT_DECIMAL_DELIMITERS = (normal => 'virgola',
fract => 'e');
%NUMBER_NAMES = (
0 => 'zero',
1 => 'un',
2 => 'due',
3 => 'tre',
4 => 'quattro',
5 => 'cinque',
6 => 'sei',
7 => 'sette',
8 => 'otto',
9 => 'nove',
10 => 'dieci',
11 => 'undici',
12 => 'dodici',
13 => 'tredici',
14 => 'quattordici',
15 => 'quindici',
16 => 'sedici',
17 => 'diciassette',
18 => 'diciotto',
19 => 'diciannove',
20 => 'venti',
30 => 'trenta',
40 => 'quaranta',
50 => 'cinquanta',
60 => 'sessanta',
70 => 'settanta',
80 => 'ottanta',
90 => 'novanta',
100 => 'cento');
@PART_NAMES = qw(_ mila milioni miliardi);
@UNITS_NAMES = qw(_ mille milione miliardo);
@FRACT_NAMES = qw(decim centesim millesim decimillesim centomillesim
milionesim decimilionesim centomilionesim
miliardesim);
%DEFAULT_OPTS = (
decimal => 0,
decmode => 'normal',
name => "",
);
sub number_to_it {
my ($number,$opts) = @_;
$opts = {} unless defined $opts;
$opts = {%DEFAULT_OPTS,%$opts};
my $parsed = parse_num_string($number);
my @parts = ();
push @parts,$SIGN_NAMES{$parsed->{sign}};
my $intpart = convert_to_string($parsed->{intpart});
my $one = $NUMBER_NAMES{1};
$intpart =~ s/($one)$/$1o/;
push @parts,$intpart;
if ($opts->{name}) {
my $name = ! ref($opts->{name}) ? $opts->{name} :
($intpart eq $NUMBER_NAMES{1} ? $opts->{name}[0] : $opts->{name}[1]);
push @parts,$name;
}
if ($parsed->{fracpart} || $opts->{decimal}) {
push @parts,$OUTPUT_DECIMAL_DELIMITERS{$opts->{decmode}};
if ($opts->{decimal}) {
if (length($parsed->{fracpart}) < $opts->{decimal}) {
$parsed->{fracpart} .= "0" x ($opts->{decimal} -
length($parsed->{fracpart}));
}
}
my $fractpart = convert_to_string($parsed->{fracpart});
if ($opts->{decmode} eq 'fract') {
if ($fractpart eq $NUMBER_NAMES{1}) {
push @parts,$fractpart,$FRACT_NAMES[length($parsed->{fracpart}) - 1] . "o";
}
else {
push @parts,$fractpart,$FRACT_NAMES[length($parsed->{fracpart}) - 1] . "i";
}
}
else {
my $one = $NUMBER_NAMES{1};
$fractpart =~ s/($one)$/$1o/;
push @parts,$fractpart;
}
}
my $result = join(" ",@parts);
$result =~ s/^\s*//;
return $result;
}
sub convert_short {
use integer;
my $num = shift; # 1 < num < 1000
my $hundreds = $num / 100;
my $tens = $num % 100;
my @parts = ();
if ($hundreds == 1) {
push @parts,$NUMBER_NAMES{100};
}
elsif ($hundreds > 1) {
push @parts,$NUMBER_NAMES{$hundreds},$NUMBER_NAMES{100};
}
if ($tens == 0) {
#nothing
;
}
elsif ($tens <= 20) {
push @parts,$NUMBER_NAMES{$tens};
}
else {
my $units = $tens % 10;
$tens = $tens - $units;
my $tenstr = $NUMBER_NAMES{$tens};
$tenstr =~ s/.$// if ($units == 1) or ($units == 8);
push @parts,$tenstr;
if ($units >= 1) {
push @parts,$NUMBER_NAMES{$units};
}
}
return join("",@parts);
}
sub convert_to_string {
use integer;
my $number = shift; #$number >= 0 and integer
return $NUMBER_NAMES{0} unless $number =~ m/[1-9]/;
return $NUMBER_NAMES{1} if "$number" eq "1" ;
if (my $r = length($number) % 3) {
$number = "0" x (3 - $r) . $number;
}
my @blocks = ($number =~ m!(\d\d\d)!g);
@blocks = reverse @blocks;
if (@blocks > 4) {
carp "Numbers bigger than 1e10-1 not handled in version $VERSION";
return;
}
my @name_parts = ();
my $firstpart = "";
if ($blocks[0] == 1) {
#nb one of the following blocks is != 0, since the whole number
#is greater than one
$firstpart = $NUMBER_NAMES{1};
}
elsif ($blocks[0] > 1) {
$firstpart = convert_short($blocks[0]);
}
if ($#blocks >= 1 && $blocks[1] == 1) {
$firstpart = $UNITS_NAMES[1] . $firstpart;
}
elsif ($#blocks >= 1 && $blocks[1] > 1) {
$firstpart = convert_short($blocks[1]) . $PART_NAMES[1] . $firstpart;
}
push @name_parts,$firstpart;
foreach my $pos (2..$#blocks) {
next unless $blocks[$pos];
push @name_parts," ";
if ($blocks[$pos] == 1) {
push @name_parts,$NUMBER_NAMES{1} . " " . $UNITS_NAMES[$pos];
}
else {
my $part = convert_short($blocks[$pos]);
push @name_parts,$part. " " . $PART_NAMES[$pos];
}
}
my $tmp = join("",reverse(@name_parts));
$tmp =~ s/^\s*//;
$tmp =~ s/\s*$//;
$tmp =~ s!\s+! !g;
return $tmp;
}
sub parse_num_string {
my $string = shift;
my %parsed = ();
unless ($string =~
$RE{num}{real}{-keep}{-radix => qr/[,.]/}) {
carp("Invalid number format: '$string'");
return undef;
}
if (defined $7) {
carp("Invalid number format: '$string'");
return undef;
}
@parsed{qw(sign intpart fracpart)}
= (($2 ? $2 : '+'),
$4,
defined $6 ? $6 : 0);
$parsed{intpart} =~ s/\.|\s+//g;
return \%parsed;
}
#
# OO Methods
#
sub new {
my $class = shift;
my $number = shift;
my %opts = (%DEFAULT_OPTS,@_);
bless { number => $number,
opts => \%opts}, $class;
}
sub get_string {
my $self = shift;
number_to_it($self->{number},$self->{opts});
}
sub get_number {
my $self = shift;
return $self->{number}
}
sub set_number {
my $self = shift;
$self->{number} = shift;
return $self;
}
sub add {
my $self = shift;
my $num = shift;
$num = UNIVERSAL::isa($num,__PACKAGE__) ? $num->{number} : $num;
my $tmp = $self->{number} + $num;
return bless {number => $tmp,
opts => $self->{opts}},ref($self);
}
sub mult {
my $self = shift;
my $num = shift;
$num = UNIVERSAL::isa($num,__PACKAGE__) ? $num->{number} : $num;
bless {number => $self->{number} * $num,
opts => $self->{opts}},ref($self);
}
sub div {
my $self = shift;
my $num = shift;
$num = UNIVERSAL::isa($num,__PACKAGE__) ? $num->{number} : $num;
my $inverted = shift;
my $tmp =
($inverted) ? $num / $self->{number} : $self->{number} / $num;
return bless {number => $tmp,
opts => $self->{opts}},ref($self);
}
sub minus {
my $self = shift;
my $num = shift;
$num = UNIVERSAL::isa($num,__PACKAGE__) ? $num->{number} : $num;
my $inverted = shift;
my $tmp =
($inverted) ? $num - $self->{number} : $self->{number} - $num;
return bless {number => $tmp,
opts => $self->{opts}},ref($self);
}
sub clone {
my $self = shift;
my $class = ref($self);
bless {%$self},$class;
}
1;
__END__
=head1 NAME
Lingua::IT::Numbers - Converts numeric values into their Italian string equivalents
=head1 SYNOPSIS
# Procedural Style
use Lingua::IT::Numbers qw(number_to_it);
print number_to_it(315);
# prints trecentoquindici
print number_to_it(325.12)
# prints trecentoventicinque virgola dodici
print number_to_it(325.12,decmode => 'fract')
# prints trecentoveticinque e dodici centesimi
# OO Style
use Lingua::IT::Numbers;
my $number = Lingua::IT::Numbers->new( 123 );
print $number->get_string;
print $number->get_ordinate;
=head1 DESCRIPTION
Lingua::IT::Numbers converts arbitrary numbers into human-oriented
Italian text. The interface is sligtly different from that defined
for Lingua::EN::Numbers, for one it can be used in a procedural way,
just like Lingua::FR::Numbers, importing the B<number_to_it> function.
Remark that Lingua::IT::Numbers object, created by the B<new> constructor
described below, are I<Two-face scalars> as described in L<overload>:
when a Lingua::IT::Numbers object is used as a number, then it is a number,
when it is used as a string then it is its Italian representation (see
L</"OVERLOADING">)
=head2 EXPORT
Nothing is exported by default. The following function is exported.
=over
=item B<number_to_it($number,[options])>
Converts a number to its Italian string representation without building
the Lingua::IT::Numbers instance.
$string = number_to_it($number,...);
is equivalent to
$string = do {
my $tmp = Lingua::IT::Numbers->new($number,...);
$tmp->get_string();
};
See L</"OPTIONS"> for avalaible options for B<number_to_it>
=back
=head2 METHODS
The following method compose the OO interface to Lingua::IT::Numbers.
=over
=item B<Lingua::IT::Numbers->new($number,[options])>
Creates and initialize an instance.
=item B<$obj-E<gt>get_number>
Returns the number contained in the instance.
=item B<$obj-E<gt>get_string()>
Returns the representation of the number as a string in Italian.
=item B<$obj-E<gt>set_number($number)>
Changes the number contained in the instance.
=back
=head1 OPTIONS
The representation of numbers by Lingua::IT::Numbers can be influenced by means
of options. Options are given either to the exported funcion B<number_to_it>
or to the constructor b<new> as named parameters. the following options are
defined:
=over
=item B<decimal>
If different from zero is the minimal number of decimal places a number must
have.
=item B<decmode>
Can be either I<normal> or I<fract>. This options selects the method used for writing
the fractional part of a number. Infact, in Italian there are two way to represent
fractional numbers in writing. For 345.27 you can say either "trecentoquarantacinque
virgola ventisette" or "trecentoquarantacinque e ventisette centesimi". The latter is
used mainly for mensurament. Setting the B<decmode> option to I<normal> (its default
value) selects the former method, while setting it to I<fract> selects the latter.
=item B<name>
The value of this option can be either a string or (a reference to) an array
containing two strings. If the option value is a string this is interpolated between
the integer part and the fractional part. If the option value is an array, the first
element is taken to be the singular form while the second is the plural. So that
my $euro = Lingua::IT::Numbers->new(253,name => "euro",
decmode => 'fract',
decimal => 2);
print $euro->get_string(),"\n"
will print 'duecentocinquantatre euro e zero centesimi', while
my $dollar = Lingua::IT::Numbers->new(253,name => [qw(dollaro dollari)],
decmode => 'fract',
decimal => 2);
print $dollar->get_string(),"\n"
will print 'duecentocinquantatre dollari e zero centesimi'.
=back
=head1 OVERLOADING
As stated above, instances of Lingua::IT::Numbers are I<Two-face scalars> like
those described in L<overload>. This means that you can do something like:
my $first = Lingua::IT::Numbers->new(123);
my $second = Lingua::IT::Numbers->new(321);
print $first,' + ',$second,' = ',$first+$second,"\n";
which will print: 'centoventitre + trecentoventuno = quattrocentoquarantaquattro'.
=head1 SEE ALSO
Lingua::*::Numbers, overload.
=head1 BUGS
There is no control on options' values.
=head1 TODO
=over
=item *
Add italian documentation
=item *
Add a package Lingua::IT::Number::Currency for handling monetary values
=item *
Check an italian grammar to verify that what I remember from primary school about
number writing hasn't changed.
=back
=head1 AUTHOR
Leo "TheHobbit" Cacciari, E<lt>hobbit@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2004 by Leo "TheHobbit" Cacciari
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.2 or,
at your option, any later version of Perl 5 you may have available.
=cut