File Coverage

blib/lib/Lingua/FRA/Word2Num.pm
Criterion Covered Total %
statement 26 26 100.0
branch n/a
condition 2 2 100.0
subroutine 7 7 100.0
pod 2 2 100.0
total 37 37 100.0


line stmt bran cond sub pod time code
1             # For Emacs: -*- mode:cperl; mode:folding; coding:utf-8; -*-
2              
3             package Lingua::FRA::Word2Num;
4             # ABSTRACT: Word 2 number conversion in FRA.
5              
6             # {{{ use block
7              
8 1     1   25436 use 5.10.1;
  1         4  
  1         49  
9              
10 1     1   6 use strict;
  1         1  
  1         42  
11 1     1   6 use warnings;
  1         11  
  1         30  
12              
13 1     1   4 use base qw(Exporter);
  1         2  
  1         176  
14              
15 1     1   2090 use Parse::RecDescent;
  1         60095  
  1         7  
16              
17             # }}}
18             # {{{ variable declarations
19              
20             our $VERSION = 0.1257;
21             our $INFO = {
22             rev => '$Rev: 808 $',
23             };
24              
25             our @EXPORT_OK = qw(cardinal2num w2n);
26             my $parser = fr_numerals();
27              
28             # }}}
29              
30             # {{{ w2n convert number to text
31             #
32             sub w2n {
33 4   100 4 1 65628 my $input = shift // return;
34              
35 3         13 $input =~ s/quatre-vingt/qvingt/g; # Grant unique identifiers
36 3         10 $input =~ s/dix-sept/dis/g;
37 3         10 $input =~ s/dix-huit/dih/g;
38 3         9 $input =~ s/dix-neuf/din/g;
39              
40 3         9 $input =~ s/ et //g; # Does not affect the number
41              
42 3         10 $input =~ s/millions/million/g; # Million in plural does not affect the number
43              
44 3         7 $input =~ s/,//g; # remove trash
45 3         7 $input =~ s/-//g;
46              
47 3         35 return $parser->numeral($input);
48             }
49             # }}}
50             # {{{ fr_numerals create parser for numerals
51             sub fr_numerals {
52 1     1 1 5 return Parse::RecDescent->new(q{
53             numeral: millions { return $item[1]; } # root parse. go from maximum to minimum value
54             | millenium { return $item[1]; }
55             | century { return $item[1]; }
56             | decade { return $item[1]; }
57             | { return undef; }
58              
59             number: 'zéro' { $return = 0; } # try to find a word from 0 to 19
60             | 'un' { $return = 1; }
61             | 'deux' { $return = 2; }
62             | 'trois' { $return = 3; }
63             | 'quatre' { $return = 4; }
64             | 'cinq' { $return = 5; }
65             | 'six' { $return = 6; }
66             | 'sept' { $return = 7; }
67             | 'huit' { $return = 8; }
68             | 'neuf' { $return = 9; }
69             | 'dix' { $return = 10; }
70             | 'onze' { $return = 11; }
71             | 'douze' { $return = 12; }
72             | 'treize' { $return = 13; }
73             | 'quatorze' { $return = 14; }
74             | 'quinze' { $return = 15; }
75             | 'seize' { $return = 16; }
76             | 'dis' { $return = 17; }
77             | 'dih' { $return = 18; }
78             | 'din' { $return = 19; }
79              
80             tens: 'vingt' { $return = 20; } # try to find a word that representates
81             | 'trente' { $return = 30; } # values 20,30,..,90
82             | 'quarante' { $return = 40; }
83             | 'cinquante' { $return = 50; }
84             | 'soixante' { $return = 60; }
85             | 'qvingt' { $return = 80; }
86              
87             decade: tens(?) number(?) # try to find words that represents values
88             { $return = -1; # from 0 to 99
89             for (@item) {
90             if (ref $_ && defined $$_[0]) {
91             $return += $$_[0] if ($return != -1); # -1 is the non-zero identifier, since
92             $return = $$_[0] if ($return == -1); # the result could be zero
93             }
94             }
95             $return = undef if($return == -1);
96             }
97              
98             century: number(?) 'cent' decade(?) # try to find words that represents values
99             { $return = 0; # from 100 to 999
100             for (@item) {
101             if (ref $_ && defined $$_[0]) {
102             $return += $$_[0];
103             } elsif ($_ eq "cent") {
104             $return = ($return>0) ? $return * 100 : 100;
105             }
106             }
107             $return = undef if(!$return);
108             }
109              
110             millenium: century(?) decade(?) 'mille' century(?) decade(?) # try to find words that represents values
111             { $return = 0; # from 1.000 to 999.999
112             for (@item) {
113             if (ref $_ && defined $$_[0]) {
114             $return += $$_[0];
115             } elsif ($_ eq "mille") {
116             $return = ($return>0) ? $return * 1000 : 1000;
117             }
118             }
119             $return = undef if(!$return);
120             }
121              
122             millions: millenium(?) century(?) decade(?) # try to find words that represents values
123             'million' # from 1.000.000 to 999.999.999.999
124             millenium(?) century(?) decade(?)
125             { $return = 0;
126             for (@item) {
127             if (ref $_ && defined $$_[0]) {
128             $return += $$_[0];
129             } elsif ($_ eq "million" && $return<1000000 ) {
130             $return = ($return>0) ? $return * 1000000 : 1000000;
131             }
132             }
133             $return = undef if(!$return);
134             }
135             });
136             }
137             # }}}
138              
139             1;
140              
141             __END__