File Coverage

blib/lib/Lingua/NLD/Num2Word.pm
Criterion Covered Total %
statement 44 63 69.8
branch 10 34 29.4
condition 9 33 27.2
subroutine 9 11 81.8
pod 3 3 100.0
total 75 144 52.0


line stmt bran cond sub pod time code
1             # For Emacs: -*- mode:cperl; eval: (folding-mode 1); coding:utf-8 -*-
2              
3             package Lingua::NLD::Num2Word;
4             # ABSTRACT: Number to word conversion in Dutch
5              
6 1     1   101359 use 5.16.0;
  1         3  
7 1     1   5 use utf8;
  1         1  
  1         28  
8 1     1   24 use warnings;
  1         2  
  1         75  
9              
10             # {{{ use block
11              
12 1     1   5 use Carp;
  1         2  
  1         72  
13 1     1   696 use Readonly;
  1         3378  
  1         61  
14 1     1   582 use Export::Attrs;
  1         9641  
  1         10  
15              
16             # }}}
17             # {{{ var block
18              
19             my Readonly::Scalar $COPY = 'Copyright (c) PetaMem, s.r.o. 2015-present';
20             our $VERSION = '0.2603300';
21              
22             # }}}
23              
24             # {{{ num2nld_cardinal convert number to text
25              
26             sub num2nld_cardinal :Export {
27 7     7 1 240315 my $positive = shift;
28              
29 7 50 33     82 croak 'You should specify a number from interval [0, 999_999_999]'
      33        
      33        
30             if !defined $positive
31             || $positive !~ m{\A\d+\z}xms
32             || $positive < 0
33             || $positive > 999_999_999;
34              
35 7         44 my @tokens1 = qw(nul een twee drie vier vijf zes zeven acht negen tien
36             elf twaalf dertien veertien vijftien zestien zeventien achtien negentien);
37 7         23 my @tokens2 = qw(twintig dertig veertig vijftig zestig zeventig tachtig negentig honderd);
38              
39 7 50 33     28 return $tokens1[$positive] if ($positive >= 0 && $positive < 20); # 0 .. 19
40              
41 7         19 my $out; # string for return value construction
42             my $one_idx; # index for tokens1 array
43 7         0 my $remain; # remainder
44              
45 7 100 66     46 if ($positive > 19 && $positive < 101) { # 20 .. 100
    100 66        
    50 33        
    0 0        
46 3         9 $one_idx = int ($positive / 10);
47 3         23 $remain = $positive % 10;
48              
49 3 50       11 $out = "$tokens1[$remain]en" if ($remain);
50 3         26 $out .= $tokens2[$one_idx - 2];
51             }
52             elsif ($positive > 100 && $positive < 1000) { # 101 .. 999
53 3         8 $one_idx = int ($positive / 100);
54 3         6 $remain = $positive % 100;
55              
56 3         9 $out = "$tokens1[$one_idx]honderd";
57 3 50       18 $out .= $remain ? num2nld_cardinal($remain) : '';
58             }
59             elsif ($positive > 999 && $positive < 1_000_000) { # 1000 .. 999_999
60 1         5 $one_idx = int ($positive / 1000);
61 1         3 $remain = $positive % 1000;
62              
63 1         4 $out = num2nld_cardinal($one_idx) . 'duizend ';
64 1 50       4 $out .= $remain ? num2nld_cardinal($remain) : '';
65             }
66             elsif ( $positive > 999_999
67             && $positive < 1_000_000_000) { # 1_000_000 .. 999_999_999
68 0         0 $one_idx = int ($positive / 1000000);
69 0         0 $remain = $positive % 1000000;
70              
71 0         0 $out = num2nld_cardinal($one_idx) . " miljoen";
72 0 0       0 $out .= $remain ? ' ' . num2nld_cardinal($remain) : '';
73             }
74              
75 7         35 return $out;
76 1     1   607 }
  1         6  
  1         9  
77              
78             # }}}
79              
80             # {{{ num2nld_ordinal convert number to ordinal text
81              
82             sub num2nld_ordinal :Export {
83 0     0 1   my $number = shift;
84              
85 0 0 0       croak 'You should specify a number from interval [0, 999_999_999]'
      0        
      0        
86             if !defined $number
87             || $number !~ m{\A\d+\z}xms
88             || $number < 0
89             || $number > 999_999_999;
90              
91             # Irregular ordinals
92 0 0         return 'nulde' if $number == 0;
93 0 0         return 'eerste' if $number == 1;
94 0 0         return 'tweede' if $number == 2;
95 0 0         return 'derde' if $number == 3;
96              
97 0           my $cardinal = num2nld_cardinal($number);
98              
99             # Numbers 1-19 and compounds ending in 1-19: add "de"
100             # Numbers >= 20 that are round tens/hundreds/etc: add "ste"
101             # Rule: 2-19 get "de", 20+ get "ste", compounds follow last element
102              
103             # Determine the suffix: "de" for 2-19, "ste" for >= 20
104             # For compound numbers, it depends on the last component
105 0           my $last_part = $number;
106 0 0         if ($number >= 20) {
107 0           $last_part = $number % 10; # units digit
108 0 0         if ($last_part == 0) {
109             # Round number, use "ste"
110 0           return $cardinal . 'ste';
111             }
112             # compound: the ordinal is based on the whole cardinal + suffix
113             # For compounds with units 1-19: use "ste" (since total >= 20)
114 0           return $cardinal . 'ste';
115             }
116              
117             # 4-19: cardinal + "de"
118 0           return $cardinal . 'de';
119 1     1   455 }
  1         1  
  1         6  
120              
121             # }}}
122              
123             # {{{ capabilities declare supported features
124              
125             sub capabilities {
126             return {
127 0     0 1   cardinal => 1,
128             ordinal => 1,
129             };
130             }
131              
132             # }}}
133             1;
134              
135             __END__