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


line stmt bran cond sub pod time code
1             #!perl
2              
3             package Math::BigInt::Named::German;
4              
5 3     3   7260 use 5.006001;
  3         17  
6 3     3   19 use strict;
  3         5  
  3         64  
7 3     3   15 use warnings;
  3         5  
  3         90  
8              
9 3     3   312 use Math::BigInt::Named;
  3         7  
  3         27  
10             our @ISA = qw< Math::BigInt::Named >;
11              
12             our $VERSION = '0.07';
13              
14             sub name
15             {
16             # output the name of the number
17 51     51 1 9918 my ($x) = shift;
18 51 50       123 $x = Math::BigInt->new($x) unless ref($x);
19              
20 51         69 my $self = ref($x);
21              
22 51 50       117 return '' if $x->is_nan();
23              
24 51         285 my $index = 0;
25              
26 51         57 my $ret = '';
27 51         97 my $y = $x->copy(); my $rem;
  51         934  
28 51 100       134 if ($y->sign() eq '-')
29             {
30 1         7 $ret = 'minus ';
31 1         10 $y->babs();
32             }
33 51 100       345 if ($y < 1000)
34             {
35 44         4711 return $ret . $self->_triple($y,1,0);
36             }
37 7         878 while (!$y->is_zero())
38             {
39 14         173 ($y,$rem) = $y->bdiv(1000);
40 14         3105 $ret = $self->_triple($rem,0,$index)
41             .' ' . $self->_triple_name($index,$rem) . ' ' . $ret;
42 14         31 $index++;
43             }
44 7         110 $ret =~ s/\s+$//; # trailing spaces
45 7         39 $ret;
46             }
47              
48             my $SMALL = [ qw/
49             null
50             eins
51             zwei
52             drei
53             vier
54             fuenf
55             sechs
56             sieben
57             acht
58             neun
59             zehn
60             oelf
61             zwoelf
62             dreizehn
63             vierzehn
64             fuenfzehn
65             sechzehn
66             siebzehn
67             achtzehn
68             neunzehn
69             / ];
70              
71             my $ZEHN = [ qw /
72             zehn
73             zwanzig
74             dreissig
75             vierzig
76             fuenfzig
77             sechzig
78             siebzig
79             achtzig
80             neunzig
81             / ];
82              
83             my $HUNDERT = [ qw /
84             ein
85             zwei
86             drei
87             vier
88             fuenf
89             sechs
90             sieben
91             acht
92             neun
93             / ];
94              
95             my $TRIPLE = [ qw /
96             mi
97             bi
98             tri
99             quadri
100             penti
101             hexi
102             septi
103             octi
104             / ];
105              
106             sub _triple_name
107             {
108 49     49   650 my ($self,$index,$number) = @_;
109              
110 49 100 100     171 return '' if $index == 0 || $number->is_zero();
111 40 100       626 return 'tausend' if $index == 1;
112              
113 32         40 my $postfix = 'llion'; my $plural = 'en';
  32         38  
114 32 100       57 if ($index & 1 == 1)
115             {
116 16         17 $postfix = 'lliarde'; $plural = 'n';
  16         18  
117             }
118 32 100       58 $postfix .= $plural unless $number->is_one();
119 32         369 $index -= 2;
120 32         131 $TRIPLE->[$index >> 1] . $postfix;
121             }
122              
123             sub _triple
124             {
125             # return name of a triple (aka >= 0, and <= 1000)
126             # input: number >= 0, < 1000)
127             # only true if triple is the only triple ever ($nr < 1000)
128             # index 0 for last triple, 1 for tausend, 2 for million etc
129 58     58   103 my ($self,$number,$only,$index) = @_;
130              
131             # eins, ein hundert, ein tausend, eine million
132             # zwei, zwei hundert, zwei tausend, zwei million
133              
134 58         73 my $eins = 'ein';
135 58 100       109 $eins = 'eins' if $index == 0;
136 58 50       97 $eins = 'eine' if $index > 2;
137              
138 58 100 100     119 return '' if $number->is_zero() && !$only; # 0 => null, but only for one
139 57 100       697 return $eins if $number->is_one();
140 47 100       569 return $SMALL->[$number] if $number < scalar @$SMALL; # known name
141              
142 27         2788 my $hundert = $number / 100;
143 27         5560 my $rem = $number % 100;
144 27         4735 my $rc = '';
145 27 100       49 $rc = "$HUNDERT->[$hundert-1]hundert" if !$hundert->is_zero();
146              
147 27 100       3848 my $concat = ''; $concat = 'und' if $rc ne '';
  27         57  
148 27 100       53 return $rc if $rem->is_zero();
149 18 100       246 return $rc . $concat . $SMALL->[$rem] if $rem < scalar @$SMALL;
150              
151 15         1534 my $zehn; ($zehn,$rem) = $rem->bdiv(10);
  15         38  
152              
153 15 100       3269 $rc .= $concat . $HUNDERT->[$rem-1] if !$rem->is_zero(); # 31, 32..
154 15 100       3074 $concat = ''; $concat = 'und' if $rc ne '';
  15         38  
155 15 50       30 $rc .= $concat . $ZEHN->[$zehn-1] if !$zehn->is_zero(); # 1,2,3..
156              
157 15         3398 $rc;
158             }
159              
160             1;
161              
162             __END__