File Coverage

blib/lib/Lingua/ITA/Numbers.pm

Criterion	Covered	Total	%
statement	95	142	66.9
branch	30	62	48.3
condition	10	15	66.6
subroutine	15	22	68.1
pod	13	13	100.0
total	163	254	64.1

# For Emacs: -*- mode:cperl; mode:folding -*-

package Lingua::ITA::Numbers;
# ABSTRACT: Number 2 Word conversion in ITA.

# {{{ use block

use 5.10.1;

use strict;
use warnings;

use overload (
  '""' => \&get_string,
  '0+' => \&get_number,
  '='  => \&clone,
  '+'  => \&add,
  '-'  => \&minus,
  '*'  => \&mult,
  '/'  => \&div,
  fallback => 1);

use Carp qw(carp);
use Perl6::Export::Attrs;

# }}}
# {{{ variables declaration

our $VERSION = 0.0682;

our %SIGN_NAMES           = ('-' => 'meno',
                             '+'  => '');

our %OUTPUT_DECIMAL_DELIMITERS = (normal => 'virgola',
                                  fract => 'e');

our %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');

our @PART_NAMES    = qw(_ mila milioni miliardi);
our @UNITS_NAMES    = qw(_ mille milione miliardo);
our @FRACT_NAMES = qw(decim centesim millesim decimillesim centomillesim
                      milionesim decimilionesim centomilionesim
                      miliardesim);

our %DEFAULT_OPTS = (
                     decimal => 0,
                     decmode => 'normal',
                     name => "",
                    );

# }}}
# {{{ number_to_it

sub number_to_it :Export {
  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;
}

# }}}
# {{{ convert_short

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);
}

# }}}
# {{{ convert_to_string

sub convert_to_string {
  use integer;
  my $number = shift; #$number >= 0 and integer
  return $NUMBER_NAMES{0} if !$number || $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;
}

# }}}
# {{{ parse_num_string

sub parse_num_string {
  my $string = shift;

  return { intpart  => $string,
           sign     => '+',
           fracpart => 0,
  };
}

# }}}

# OO Methods
# {{{ new
sub new {
    my $class  = shift;
    my $number = shift;
    my @a = @_;
    my %opts = (%DEFAULT_OPTS,@a);
    return bless { number => $number,
                   opts   => \%opts}, $class;
}

# }}}
# {{{ get_string

sub get_string {
    my $self = shift;
    return number_to_it($self->{number},$self->{opts});
}

# }}}
# {{{ get_number

sub get_number {
  my $self = shift;
  return $self->{number}
}

# }}}
# {{{ set_number

sub set_number {
  my $self = shift;
  $self->{number} = shift;
  return $self;
}

# }}}
# {{{ add

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);
}

# }}}
# {{{ mult

sub mult {
  my $self = shift;
  my $num = shift;
  $num = UNIVERSAL::isa($num,__PACKAGE__) ? $num->{number} : $num;
  return bless {number => $self->{number} * $num,
                opts => $self->{opts}},ref($self);
}

# }}}
# {{{ div

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);
}

# }}}
# {{{ minus

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);
}

# }}}
# {{{ clone

sub clone {
  my $self = shift;
  my $class = ref($self);
  return bless {%$self},$class;
}

# }}}

1;
__END__