File Coverage

lib/Math/BigInt/Named/English.pm

Criterion	Covered	Total	%
statement	57	57	100.0
branch	29	32	90.6
condition	6	6	100.0
subroutine	7	7	100.0
pod	1	1	100.0
total	100	103	97.0

#!perl

package Math::BigInt::Named::English;

use 5.006001;
use strict;
use warnings;

use Math::BigInt::Named;
our @ISA = qw< Math::BigInt::Named >;

our $VERSION = '0.06';

sub name {
    my $x = shift;
    $x = Math::BigInt -> new($x) unless ref($x);

    my $class = ref($x);

    return '' if $x -> is_nan();

    my $index = 0;

    my $ret = '';
    my $y = $x -> copy();
    my $rem;

    if ($y -> sign() eq '-') {
        $ret = 'minus ';
        $y -> babs();
    }

    if ($y < 1000) {
        return $ret . $class -> _triple($y, 1, 0);
    }

    while (!$y -> is_zero()) {
        ($y, $rem) = $y -> bdiv(1000);
        $ret = $class -> _triple($rem, 0, $index)
          . ' ' . $class -> _triple_name($index, $rem) . ' ' . $ret;
        $index++;
    }
    $ret =~ s/\s+$//;           # trailing spaces
    $ret;
}

my $SMALL = [ qw/
  zero
  one
  two
  three
  four
  five
  six
  seven
  eight
  nine
  ten
  eleven
  twelve
  thirteen
  fourteen
  fifteen
  sixteen
  seventeen
  eighteen
  nineteen
  / ];

my $ZEHN = [ qw /
  ten
  twenty
  thirty
  fourty
  fifty
  sixty
  seventy
  eighty
  ninety
  / ];

my $HUNDERT = [ qw /
  one
  two
  three
  four
  five
  six
  seven
  eight
  nine
  / ];

my $TRIPLE = [ qw /
  mi
  bi
  tri
  quadri
  penti
  hexi
  septi
  octi
  / ];

sub _triple_name {
    my ($self, $index, $number) = @_;

    return '' if $index == 0 || $number -> is_zero();
    return 'thousand' if $index == 1;

    my $postfix = 'llion';
    my $plural = 's';
    if (($index & 1) == 1) {
        $postfix = 'lliard';
    }
    $postfix .= $plural unless $number -> is_one();
    $index -= 2;
    $TRIPLE -> [$index >> 1] . $postfix;
}

sub _triple {
    # return name of a triple (aka >= 0, and <= 1000)
    # input: number     >= 0, < 1000
    #        only       true if triple is the only triple ever ($nr < 1000)
    #       index       0 for last triple, 1 for thousand, 2 for million etc
    my ($self, $number, $only) = @_;

    return '' if $number -> is_zero() && !$only; # 0 => null, but only for one
    return $SMALL -> [$number] if $number < scalar @$SMALL; # known name

    my $hundert = $number / 100;
    my $rem = $number % 100;
    my $rc = '';
    $rc = $HUNDERT -> [$hundert-1] . "hundred" if !$hundert -> is_zero();

    my $concat = '';
    $concat = 'and' if $rc ne '';
    return $rc if $rem -> is_zero();
    return $rc . $concat . $SMALL -> [$rem] if $rem < scalar @$SMALL;

    my $zehn;
    ($zehn, $rem) = $rem -> bdiv(10);

    my $last = '';
    $last = $HUNDERT -> [$rem-1] if !$rem -> is_zero();    # 31, 32..
    $last = $ZEHN -> [$zehn-1] . $last if !$zehn -> is_zero(); # 1, 2, 3..

    $rc . $last;
}

1;

__END__