File Coverage

blib/lib/Lingua/EU/Numbers.pm

Criterion	Covered	Total	%
statement	87	88	98.8
branch	48	56	85.7
condition	43	54	79.6
subroutine	7	7	100.0
pod	2	4	50.0
total	187	209	89.4

package Lingua::EU::Numbers;

use strict;
use Carp;
use vars qw(
  @EXPORT @EXPORT_OK @ISA $VERSION
  %num2alpha
);
require Exporter;

@ISA     = qw(Exporter);
$VERSION = '0.03';
@EXPORT  = qw(
  &cardinal2alpha
  &ordinal2alpha
);
@EXPORT_OK = qw(
  %num2alpha
);

# The Bask numeral system is vigesimal (base 20). So far, going to
# 999_999_999_999.

%num2alpha = (
    0          => 'zero',
    1          => 'bat',
    2          => 'bi',
    3          => 'hiru',
    4          => 'lau',
    5          => 'bost',
    6          => 'sei',
    7          => 'zazpi',
    8          => 'zortzi',
    9          => 'bederatzi',
    10         => 'hamar',
    11         => 'hamaika',
    12         => 'hamabi',
    13         => 'hamahiru',
    14         => 'hamalau',
    15         => 'hamabost',
    16         => 'hamasei',
    17         => 'hamazazpi',
    18         => 'hemezortzi',
    19         => 'hemeretzi',
    20         => 'hogei',
    40         => 'berrogei',
    60         => 'hirurogei',
    80         => 'laurogei',
    100        => 'ehun',
    200        => 'berrehun',
    300        => 'hirurehun',
    400        => 'laurehun',
    500        => 'bostehun',
    600        => 'seiehun',
    700        => 'zazpiehun',
    800        => 'zortziehun',
    900        => 'bederatziehun',
    1000       => 'mila',
    1000000    => 'milioi bat',
    1000000000 => 'mila milioi'
);

#Names for quantifiers, every block of 3 digits
#(thousands, millions, billions)
my %block2alpha = (
    block1 => 'mila',
    block2 => 'milioi',
    block3 => 'mila milioi'
);


#This function accepts an integer (scalar) as a parameter and
#returns a string (array), which is its Bask cardinal equivalent.
#
sub cardinal2alpha {
    return undef unless defined $_[0];
    my $orig_num = shift;
    my @result   = ();
    my ( $thousands, $hundreds, $tens, $units );
    my $num = $orig_num;

    #Input validation
    unless ( $num =~ /^\d+$/ ) {
        carp "Entry $num not valid. Should be numeric characters only";
        return undef;
    }

    if ( $num > 999_999_999_999 or $num < 0 ) {
        carp "Entry $num not valid. Number should be an integer between 0 and 999,999,999,999";
        return undef;
    }

    #Handling special cases
    return $num2alpha{0} if $num == 0;
    return $num2alpha{$num} if $num2alpha{$num};

    my $len = length($num);

    #Main logic: cutting number by block of 3 digits
    while ( $len > 3 ) {

        $num = reverse($num);

        #Dealing with the part off the block(s) of three
        my $extra_digits = substr( $num, int( ( $len - 1 ) / 3 ) * 3 );
        $extra_digits = reverse($extra_digits);
        push ( @result, triple_digit_handling($extra_digits) )
          unless $extra_digits == 1;

        #Adding name for the quantifier
        my $quantif = 'block' . ( int( ( $len - 1 ) / 3 ) );
        push ( @result, $block2alpha{$quantif} ) unless $num =~ /000$/;

        #Special case for 1 million: adding the term for "one"
        push ( @result, $num2alpha{1} ) if $len == 7 && $extra_digits == 1;

        #Adding "eta" after millions (except when there's no thousand)
        my $whats_left = substr( reverse($num), length($extra_digits) );
        if ( ( $len <= 8 and $len >= 7 )
            && $whats_left != 0
            && ( reverse($num) !~ /^[^0]000/ ) )
        {
            push ( @result, "eta" );
        }

        #Adding 'eta' for hundreds, except when there are tens and/or units
        if ( length($num) <= 6 ) {
            ( $units, $tens, $hundreds, $thousands, my @rest ) =
              split ( //, reverse($orig_num) );

            if (   ( $hundreds  != 0 && $tens == 0 && $units == 0 )
                || ( $hundreds  == 0 && ( $tens || $units ) ) && $num !~ /^0/
                || ( $thousands == 0 && $hundreds == 0 && ( $tens || $units ) )
              )
            {
                push ( @result, "eta" );
            }
        }

        #Dealing with the remaining digits
        $num = reverse($num);
        $num = substr( $num, length($extra_digits) );
        $len = length($num);

    }    #end while len > 3

    if ( $len <= 3 ) {
        push ( @result, triple_digit_handling($num) );
        return "@result";
    }
}


#This function takes an integer (scalar) as a parameter, which is
#a 3-digit number or less, and returns a string (array), which is
#its Bask equivalent.
#
sub triple_digit_handling {
    my $num    = shift;
    my @result = ();
    my ( $hundreds, $tens, $units, @tens_n_units );

    #Handling exceptional cases
    return undef if $num > 999 || $num < 0;
    return if $num == 0;
    return $num2alpha{$num} if $num2alpha{$num};

    my $len = length($num);

    #Handling 2-digit numbers
    if ( $len == 2 ) {
        ( $tens, $units ) = split ( //, sprintf( "%02d", $num ) );
        @result = double_digit_handling( $tens, $units );
        return @result;
    }

    #Handling 3-digit numbers
    if ( $len == 3 ) {
        ( $hundreds, $tens, $units ) = split ( //, sprintf( "%03d", $num ) );
        unless ( $hundreds == 0 ) {
            $hundreds *= 100;
            push ( @result, $num2alpha{$hundreds} );
            push ( @result, "eta" ) if $tens || $units;
        }

        @tens_n_units = double_digit_handling( $tens, $units );
        push ( @result, @tens_n_units );
        return @result;
    }

}


#This function takes two integers (scalars) as parameters (tens and units)
#and returns a string (array), which is their Bask equivalent.
#
sub double_digit_handling {
    my $diz  = shift;
    my $unit = shift;
    my $num  = "$diz$unit";
    my @result;

    #Handling exceptional cases
    return if $num == 0;

    return $num2alpha{$num} if $num2alpha{$num};

    return $num2alpha{$unit} unless $diz;

    #Dealing with base 20
    if ( $diz =~ /[3579]/ ) {
        $diz -= 1;
        $unit += 10;
    }
    $diz = $diz * 10;

    if ($unit) { push ( @result, "$num2alpha{$diz}ta" ); }
    else { push ( @result, $num2alpha{$diz} ); }
    push ( @result, $num2alpha{$unit} );

    return @result;
}


#This function accepts an integer (scalar) as a parameter and
#returns a string (array), which is its Bask ordinal equivalent.
#
sub ordinal2alpha {
    return undef unless defined $_[0];
    my $num = shift;
    my @result;

    #Handling special cases
    return undef unless $num =~ /^\d+$/;
    return undef if ( $num < 0 || $num > 999_999_999_999 );
    return "lehenengo" if $num == 1;

    push ( @result, join ( '', cardinal2alpha($num), "garren" ) );
    return "@result";
}

1;
__END__