File Coverage

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   7555 use 5.006001;
  3         21  
6 3     3   19 use strict;
  3         6  
  3         69  
7 3     3   14 use warnings;
  3         6  
  3         107  
8              
9 3     3   335 use Math::BigInt::Named;
  3         6  
  3         26  
10             our @ISA = qw< Math::BigInt::Named >;
11              
12             our $VERSION = '0.06';
13              
14             sub name
15             {
16             # output the name of the number
17 51     51 1 9910 my ($x) = shift;
18 51 50       130 $x = Math::BigInt->new($x) unless ref($x);
19              
20 51         71 my $self = ref($x);
21              
22 51 50       131 return '' if $x->is_nan();
23              
24 51         299 my $index = 0;
25              
26 51         70 my $ret = '';
27 51         118 my $y = $x->copy(); my $rem;
  51         1013  
28 51 100       121 if ($y->sign() eq '-')
29             {
30 1         7 $ret = 'minus ';
31 1         14 $y->babs();
32             }
33 51 100       367 if ($y < 1000)
34             {
35 44         4752 return $ret . $self->_triple($y,1,0);
36             }
37 7         891 while (!$y->is_zero())
38             {
39 14         189 ($y,$rem) = $y->bdiv(1000);
40 14         3226 $ret = $self->_triple($rem,0,$index)
41             .' ' . $self->_triple_name($index,$rem) . ' ' . $ret;
42 14         33 $index++;
43             }
44 7         114 $ret =~ s/\s+$//; # trailing spaces
45 7         44 $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   829 my ($self,$index,$number) = @_;
109              
110 49 100 100     176 return '' if $index == 0 || $number->is_zero();
111 40 100       576 return 'tausend' if $index == 1;
112              
113 32         49 my $postfix = 'llion'; my $plural = 'en';
  32         33  
114 32 100       57 if ($index & 1 == 1)
115             {
116 16         18 $postfix = 'lliarde'; $plural = 'n';
  16         17  
117             }
118 32 100       61 $postfix .= $plural unless $number->is_one();
119 32         375 $index -= 2;
120 32         123 $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   111 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         74 my $eins = 'ein';
135 58 100       117 $eins = 'eins' if $index == 0;
136 58 50       108 $eins = 'eine' if $index > 2;
137              
138 58 100 100     116 return '' if $number->is_zero() && !$only; # 0 => null, but only for one
139 57 100       731 return $eins if $number->is_one();
140 47 100       613 return $SMALL->[$number] if $number < scalar @$SMALL; # known name
141              
142 27         2848 my $hundert = $number / 100;
143 27         5819 my $rem = $number % 100;
144 27         4854 my $rc = '';
145 27 100       59 $rc = "$HUNDERT->[$hundert-1]hundert" if !$hundert->is_zero();
146              
147 27 100       4029 my $concat = ''; $concat = 'und' if $rc ne '';
  27         62  
148 27 100       52 return $rc if $rem->is_zero();
149 18 100       210 return $rc . $concat . $SMALL->[$rem] if $rem < scalar @$SMALL;
150              
151 15         1560 my $zehn; ($zehn,$rem) = $rem->bdiv(10);
  15         38  
152              
153 15 100       3353 $rc .= $concat . $HUNDERT->[$rem-1] if !$rem->is_zero(); # 31, 32..
154 15 100       3161 $concat = ''; $concat = 'und' if $rc ne '';
  15         78  
155 15 50       35 $rc .= $concat . $ZEHN->[$zehn-1] if !$zehn->is_zero(); # 1,2,3..
156              
157 15         3508 $rc;
158             }
159              
160             1;
161              
162             __END__