File Coverage

blib/lib/Lingua/POL/Word2Num.pm
Criterion Covered Total %
statement 26 26 100.0
branch n/a
condition 2 2 100.0
subroutine 9 9 100.0
pod 2 2 100.0
total 39 39 100.0


line stmt bran cond sub pod time code
1             # For Emacs: -*- mode:cperl; mode:folding -*-
2              
3             package Lingua::POL::Word2Num;
4             # ABSTRACT: Word 2 number conversion in POL.
5              
6             # {{{ use block
7              
8 1     1   26686 use 5.10.1;
  1         4  
  1         37  
9              
10 1     1   5 use strict;
  1         2  
  1         35  
11 1     1   4 use warnings;
  1         10  
  1         25  
12              
13 1     1   831 use Encode qw(decode_utf8);
  1         14709  
  1         90  
14 1     1   681 use Perl6::Export::Attrs;
  1         12701  
  1         7  
15 1     1   2021 use Parse::RecDescent;
  1         75650  
  1         8  
16              
17             # }}}
18             # {{{ var block
19              
20             our $VERSION = 0.0682;
21             my $COPY = 'Copyright (C) PetaMem, s.r.o. 2003-present';
22             my $parser = pl_numerals();
23              
24             # }}}
25              
26             # {{{ w2n convert number to text
27              
28             sub w2n :Export {
29 3   100 3 1 103635 my $input = shift // return;
30              
31 2         10 $input =~ s/tysišce/tysišc/g; # Remove trick chars that don't affect the parsing (gender related)
32              
33 2         7 $input .= " "; # Grant end space, since we identify similar words by specifying the space
34              
35 2         28 return $parser->numeral($input);
36 1     1   135 }
  1         2  
  1         10  
37              
38             # }}}
39             # {{{ pl_numerals create parser for numerals
40              
41             sub pl_numerals {
42 1     1 1 14 return Parse::RecDescent->new(decode_utf8(q[
43             numeral:
44             numeral: million { return $item[1]; } # root parse. go from maximum to minimum value
45             | millenium { return $item[1]; }
46             | century { return $item[1]; }
47             | decade { return $item[1]; }
48             | { return undef; }
49              
50             number: "dziewiętnaście " { $return = 19; } # try to find a word from 0 to 19
51             | "osiemnaście " { $return = 18; }
52             | "siedemnaście " { $return = 17; }
53             | "szesnaście " { $return = 16; }
54             | "piętnaście " { $return = 15; }
55             | "czternaście " { $return = 14; }
56             | "trzynaście " { $return = 13; }
57             | "dwanaście " { $return = 12; }
58             | "jedenaście " { $return = 11; }
59             | "dziesięć " { $return = 10; }
60             | "dziewięć " { $return = 9; }
61             | "osiem " { $return = 8; }
62             | "siedem " { $return = 7; }
63             | "sześć " { $return = 6; }
64             | "pięć " { $return = 5; }
65             | "cztery " { $return = 4; }
66             | "trzy " { $return = 3; }
67             | "dwa " { $return = 2; }
68             | "jeden " { $return = 1; }
69             | "zero " { $return = 0; }
70              
71             tens: "dwadzieścia" { $return = 20; } # try to find a word that representates
72             | "trzydzieści" { $return = 30; } # values 20,30,..,90
73             | "czerdzieści" { $return = 40; }
74             | "pięćdziesiąt" { $return = 50; }
75             | "sześćdziesiąt" { $return = 60; }
76             | "siedemdziesiąt" { $return = 70; }
77             | "osiemdziesiąt" { $return = 80; }
78             | "dziewięćdziesiąt" { $return = 90; }
79              
80             hundreds: "sto" { $return = 100; }
81             | "dwieśccie" { $return = 200; }
82             | "trzysta" { $return = 300; }
83             | "czterysta" { $return = 400; }
84             | "pięćset" { $return = 500; }
85             | "sześćset" { $return = 600; }
86             | "siedemset" { $return = 700; }
87             | "osiemset" { $return = 800; }
88             | "dziewięćset" { $return = 900; }
89              
90             decade: tens(?) number(?) # try to find words that represents values
91             { $return = 0; # from 0 to 99
92             for (@item) {
93             $return += $$_[0] if (ref $_ && defined $$_[0]);
94             }
95             }
96              
97             century: number(?) hundreds(?) decade(?) # try to find words that represents values
98             { $return = 0; # from 100 to 999
99             for (@item) {
100             $return += $$_[0] if (ref $_ && defined $$_[0]);
101             }
102             }
103              
104             millenium: century(?) decade(?) 'tysiąc' century(?) decade(?) # try to find words that represents values
105             { $return = 0; # from 1.000 to 999.999
106             for (@item) {
107             if (ref $_ && defined $$_[0]) {
108             $return += $$_[0];
109             } elsif ($_ eq "tysiąc") {
110             $return = ($return>0) ? $return * 1000 : 1000;
111             }
112             }
113             }
114              
115             million: millenium(?) century(?) decade(?) # try to find words that represents values
116             'milion' # from 1.000.000 to 999.999.999
117             millenium(?) century(?) decade(?)
118             { $return = 0;
119             for (@item) {
120             if (ref $_ && defined $$_[0]) {
121             $return += $$_[0];
122             } elsif ($_ eq "milion") {
123             $return = ($return>0) ? $return * 1000000 : 1000000;
124             }
125             }
126             }
127             ]));
128             }
129              
130             # }}}
131              
132             1;
133              
134             __END__