File Coverage

blib/lib/Math/BigInt/Named/German.pm

Criterion	Covered	Total	%
statement	63	63	100.0
branch	36	40	90.0
condition	6	6	100.0
subroutine	7	7	100.0
pod	1	1	100.0
total	113	117	96.5

# -*- mode: perl; -*-

package Math::BigInt::Named::German;

use 5.006001;
use strict;
use warnings;

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

our $VERSION = '0.08';

sub name
  {
  # output the name of the number
  my ($x) = shift;
  $x = Math::BigInt->new($x) unless ref($x);

  my $self = 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 . $self->_triple($y,1,0);
    }
  while (!$y->is_zero())
    {
    ($y,$rem) = $y->bdiv(1000);
    $ret = $self->_triple($rem,0,$index)
          .' ' . $self->_triple_name($index,$rem) . ' ' . $ret;
    $index++;
    }
  $ret =~ s/\s+$//;	# trailing spaces
  $ret;
  }

my $SMALL = [ qw/
  null
  eins
  zwei
  drei
  vier
  fuenf
  sechs
  sieben
  acht
  neun
  zehn
  oelf
  zwoelf
  dreizehn
  vierzehn
  fuenfzehn
  sechzehn
  siebzehn
  achtzehn
  neunzehn
  / ];

my $ZEHN = [ qw /
  zehn
  zwanzig
  dreissig
  vierzig
  fuenfzig
  sechzig
  siebzig
  achtzig
  neunzig
  / ];

my $HUNDERT = [ qw /
  ein
  zwei
  drei
  vier
  fuenf
  sechs
  sieben
  acht
  neun
  / ];

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 'tausend' if $index == 1;

  my $postfix = 'llion'; my $plural = 'en';
  if ($index & 1 == 1)
    {
    $postfix = 'lliarde'; $plural = 'n';
    }
  $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 tausend, 2 for million etc
  my ($self,$number,$only,$index) = @_;

  # eins, ein hundert, ein tausend, eine million
  # zwei, zwei hundert, zwei tausend, zwei million

  my $eins = 'ein';
  $eins = 'eins' if $index == 0;
  $eins = 'eine' if $index > 2;

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

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

  my $concat = ''; $concat = 'und' 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);

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

  $rc;
  }

1;

__END__