File Coverage

blib/lib/Lingua/GLE/Word2Num.pm
Criterion Covered Total %
statement 28 29 96.5
branch 2 2 100.0
condition 4 4 100.0
subroutine 8 9 88.8
pod 2 3 66.6
total 44 47 93.6


line stmt bran cond sub pod time code
1             # For Emacs: -*- mode:cperl; eval: (folding-mode 1); coding:utf-8; -*-
2              
3             package Lingua::GLE::Word2Num;
4             # ABSTRACT: Word to number conversion in Irish (Gaeilge)
5              
6 1     1   173538 use 5.16.0;
  1         6  
7 1     1   9 use utf8;
  1         2  
  1         20  
8 1     1   45 use warnings;
  1         2  
  1         95  
9              
10             # {{{ use block
11              
12 1     1   931 use Export::Attrs;
  1         16153  
  1         8  
13              
14 1     1   1653 use Parse::RecDescent;
  1         64270  
  1         14  
15             # }}}
16             # {{{ variable declarations
17             our $VERSION = '0.2603300';
18              
19             my $parser = gle_numerals();
20              
21             # }}}
22              
23             # {{{ w2n convert text to number
24             #
25             sub w2n :Export {
26 16   100 16 1 516917 my $input = shift // return;
27              
28             # Normalise whitespace
29 15         153 $input =~ s/\s+/ /g;
30 15         63 $input =~ s/^\s+//;
31 15         106 $input =~ s/\s+$//;
32              
33             # Remove optional "is" conjunction (alternative compound form)
34 15         50 $input =~ s/\bis\b//g;
35 15         80 $input =~ s/\s+/ /g;
36 15         49 $input =~ s/^\s+//;
37 15         67 $input =~ s/\s+$//;
38              
39 15 100       70 return 0 if $input eq 'náid';
40              
41 14   100     208 return $parser->numeral($input) || undef;
42 1     1   392 }
  1         4  
  1         14  
43             # }}}
44             # {{{ gle_numerals create parser for numerals
45             #
46             sub gle_numerals {
47 1     1 1 11 return Parse::RecDescent->new(q{
48             numeral:
49             numeral: million { return $item[1]; }
50             | millenium { return $item[1]; }
51             | century { return $item[1]; }
52             | decade { return $item[1]; }
53             | { return undef; }
54              
55             number: 'a haon' { $return = 1; }
56             | 'a dó' { $return = 2; }
57             | 'a trí' { $return = 3; }
58             | 'a ceathair' { $return = 4; }
59             | 'a cúig' { $return = 5; }
60             | 'a sé' { $return = 6; }
61             | 'a seacht' { $return = 7; }
62             | 'a hocht' { $return = 8; }
63             | 'a naoi' { $return = 9; }
64             | 'a deich' { $return = 10; }
65              
66             teen: 'a dó dhéag' { $return = 12; }
67             | 'a haon déag' { $return = 11; }
68             | 'a trí déag' { $return = 13; }
69             | 'a ceathair déag' { $return = 14; }
70             | 'a cúig déag' { $return = 15; }
71             | 'a sé déag' { $return = 16; }
72             | 'a seacht déag' { $return = 17; }
73             | 'a hocht déag' { $return = 18; }
74             | 'a naoi déag' { $return = 19; }
75              
76             tens: 'fiche' { $return = 20; }
77             | 'tríocha' { $return = 30; }
78             | 'daichead' { $return = 40; }
79             | 'caoga' { $return = 50; }
80             | 'seasca' { $return = 60; }
81             | 'seachtó' { $return = 70; }
82             | 'ochtó' { $return = 80; }
83             | 'nócha' { $return = 90; }
84              
85             decade: teen # 11-19 first (longer match)
86             { $return = $item[1]; }
87             | tens number(?) # 20-99
88             { $return = 0;
89             $return += $item[1];
90             $return += ${$item[2]}[0] if ref $item[2] && defined ${$item[2]}[0];
91             }
92             | number # 1-10
93             { $return = $item[1]; }
94              
95             hundreds: 'céad' { $return = 100; }
96              
97             century: number(?) hundreds decade(?) # 100-999
98             { $return = 0;
99             my $mult = (ref $item[1] && defined ${$item[1]}[0]) ? ${$item[1]}[0] : 1;
100             $return = $mult * 100;
101             $return += ${$item[3]}[0] if ref $item[3] && defined ${$item[3]}[0];
102             }
103              
104             millenium: century(?) decade(?) 'míle' century(?) decade(?)
105             { $return = 0;
106             for (@item) {
107             if (ref $_ && defined $$_[0]) {
108             $return += $$_[0];
109             } elsif (defined $_ && $_ eq 'míle') {
110             $return = ($return > 0) ? $return * 1000 : 1000;
111             }
112             }
113             }
114              
115             million: century(?) decade(?)
116             'milliún'
117             millenium(?) century(?) decade(?)
118             { $return = 0;
119             for (@item) {
120             if (ref $_ && defined $$_[0]) {
121             $return += $$_[0];
122             } elsif (defined $_ && $_ eq 'milliún') {
123             $return = ($return > 0) ? $return * 1000000 : 1000000;
124             }
125             }
126             }
127              
128             });
129             }
130             # }}}
131              
132             # {{{ capabilities declare supported features
133              
134             sub capabilities {
135             return {
136 0     0 0   cardinal => 1,
137             ordinal => 0,
138             };
139             }
140              
141             # }}}
142              
143             1;
144              
145             __END__