File Coverage

blib/lib/Lingua/CES/Num2Word.pm
Criterion Covered Total %
statement 56 62 90.3
branch 27 36 75.0
condition 13 27 48.1
subroutine 8 8 100.0
pod 1 1 100.0
total 105 134 78.3


line stmt bran cond sub pod time code
1             # For Emacs: -*- mode:cperl; mode:folding; coding:utf-8; -*-
2              
3             package Lingua::CES::Num2Word;
4             # ABSTRACT: Number 2 word conversion in CES.
5              
6             # {{{ use block
7              
8 1     1   37261 use 5.10.1;
  1         6  
  1         50  
9              
10 1     1   6 use strict;
  1         2  
  1         48  
11 1     1   6 use warnings;
  1         6  
  1         29  
12 1     1   5 use utf8;
  1         2  
  1         8  
13              
14 1     1   31 use Carp;
  1         2  
  1         103  
15 1     1   931 use Perl6::Export::Attrs;
  1         12458  
  1         8  
16              
17             # }}}
18             # {{{ BEGIN
19              
20             our $VERSION = 0.1106;
21             our $REVISION = '$Rev: 1106 $';
22              
23             # }}}
24             # {{{ variables
25              
26             my %token1 = qw( 0 nula 1 jedna 2 dva
27             3 tři 4 čtyři 5 pět
28             6 šest 7 sedm 8 osm
29             9 devět 10 deset 11 jedenáct
30             12 dvanáct 13 třináct 14 čtrnáct
31             15 patnáct 16 šestnáct 17 sedmnáct
32             18 osmnáct 19 devatenáct
33             );
34             my %token2 = qw( 20 dvacet 30 třicet 40 čtyřicet
35             50 padesát 60 šedesát 70 sedmdesát
36             80 osmdesát 90 devadesát
37             );
38             my %token3 = ( 100, 'sto', 200, 'dvě stě', 300, 'tři sta',
39             400, 'čtyři sta', 500, 'pět set', 600, 'šest set',
40             700, 'sedm set', 800, 'osm set', 900, 'devět set'
41             );
42              
43             # }}}
44              
45             # {{{ num2ces_cardinal number to string conversion
46              
47             sub num2ces_cardinal :Export {
48 34     34 1 5296 my $result = '';
49 34         46 my $number = shift;
50              
51 34 100 33     370 croak 'You should specify a number from interval [0, 999_999_999]'
      33        
      66        
52             if !defined $number
53             || $number !~ m{\A\d+\z}xms
54             || $number < 0
55             || $number > 999_999_999;
56              
57 33         41 my $reminder = 0;
58              
59 33 100       82 if ($number < 20) {
    100          
    100          
    100          
    50          
60 13         29 $result = $token1{$number};
61             }
62             elsif ($number < 100) {
63 8         10 $reminder = $number % 10;
64 8 100       14 if ($reminder == 0) {
65 1         3 $result = $token2{$number};
66             }
67             else {
68 7         45 $result = $token2{$number - $reminder}.' '.num2ces_cardinal($reminder);
69             }
70             }
71             elsif ($number < 1_000) {
72 8         12 $reminder = $number % 100;
73 8 100       15 if ($reminder != 0) {
74 7         24 $result = $token3{$number - $reminder}.' '.num2ces_cardinal($reminder);
75             }
76             else {
77 1         3 $result = $token3{$number};
78             }
79             }
80             elsif ($number < 1_000_000) {
81 2         3 $reminder = $number % 1_000;
82 2 50       21 my $tmp1 = ($reminder != 0) ? ' '.num2ces_cardinal($reminder) : '';
83 2         7 my $tmp2 = substr($number, 0, length($number)-3);
84 2         6 my $tmp3 = $tmp2 % 100;
85 2         4 my $tmp4 = $tmp2 % 10;
86              
87 2 50 33     10 if ($tmp3 < 9 || $tmp3 > 20) {
88 2 50 33     18 if ($tmp4 == 1 && $tmp2 == 1) {
    50 66        
    100          
89 0         0 $tmp2 = 'tisíc';
90             }
91             elsif ($tmp4 == 1) {
92 0         0 $tmp2 = num2ces_cardinal($tmp2 - $tmp4).' jeden tisíc';
93             }
94             elsif($tmp4 > 1 && $tmp4 < 5) {
95 1         4 $tmp2 = num2ces_cardinal($tmp2).' tisíce';
96             }
97             else {
98 1         2 $tmp2 = num2ces_cardinal($tmp2).' tisíc';
99             }
100             }
101             else {
102 0         0 $tmp2 = num2ces_cardinal($tmp2).' tisíc';
103             }
104 2         5 $result = $tmp2.$tmp1;
105             }
106             elsif ($number < 1_000_000_000) {
107 2         4 $reminder = $number % 1_000_000;
108 2 50       7 my $tmp1 = ($reminder != 0) ? ' '.num2ces_cardinal($reminder) : '';
109 2         6 my $tmp2 = substr($number, 0, length($number)-6);
110 2         4 my $tmp3 = $tmp2 % 100;
111 2         3 my $tmp4 = $tmp2 % 10;
112              
113 2 50 66     11 if ($tmp3 < 9 || $tmp3 > 20) {
114 2 50 33     19 if ($tmp4 == 1 && $tmp2 == 1) {
    50 66        
    100          
115 0         0 $tmp2 = 'milion';
116             }
117             elsif ($tmp4 == 1) {
118 0         0 $tmp2 = num2ces_cardinal($tmp2 - $tmp4).' jeden milion';
119             }
120             elsif($tmp4 > 1 && $tmp4 < 5) {
121 1         3 $tmp2 = num2ces_cardinal($tmp2).' miliony';
122             }
123             else {
124 1         4 $tmp2 = num2ces_cardinal($tmp2).' milionů';
125             }
126             }
127             else {
128 0         0 $tmp2 = num2ces_cardinal($tmp2).' milionů';
129             }
130              
131 2         5 $result = $tmp2.$tmp1;
132             }
133              
134 33         83 return $result;
135 1     1   799 }
  1         3  
  1         5  
136              
137             # }}}
138              
139             1;
140              
141             __END__