File Coverage

blib/lib/Lingua/EN/FindNumber.pm
Criterion Covered Total %
statement 23 23 100.0
branch 1 2 50.0
condition n/a
subroutine 7 7 100.0
pod 2 2 100.0
total 33 34 97.0


line stmt bran cond sub pod time code
1             package Lingua::EN::FindNumber;
2             $Lingua::EN::FindNumber::VERSION = '1.32';
3 1     1   753 use 5.006;
  1         3  
4 1     1   5 use strict;
  1         2  
  1         20  
5 1     1   13 use warnings;
  1         2  
  1         40  
6              
7 1     1   5 use base 'Exporter';
  1         2  
  1         106  
8             our @EXPORT = qw( extract_numbers $number_re numify );
9              
10 1     1   807 use Lingua::EN::Words2Nums;
  1         2694  
  1         1049  
11              
12             # This is from Lingua::EN::Words2Nums, after being thrown through
13             # Regex::PreSuf
14             my $numbers =
15             qr/((?:b(?:akers?dozen|illi(?:ard|on))|centillion|d(?:ecilli(?:ard|on)|ozen|u(?:o(?:decilli(?:ard|on)|vigintillion)|vigintillion))|e(?:ight(?:een|ieth|[yh])?|leven(?:ty(?:first|one))?|s)|f(?:i(?:ft(?:een|ieth|[yh])|rst|ve)|o(?:rt(?:ieth|y)|ur(?:t(?:ieth|[yh]))?))|g(?:oogol(?:plex)?|ross)|hundred|mi(?:l(?:ion|li(?:ard|on))|nus)|n(?:aught|egative|in(?:et(?:ieth|y)|t(?:een|[yh])|e)|o(?:nilli(?:ard|on)|ught|vem(?:dec|vigint)illion))|o(?:ct(?:illi(?:ard|on)|o(?:dec|vigint)illion)|ne)|qu(?:a(?:drilli(?:ard|on)|ttuor(?:decilli(?:ard|on)|vigintillion))|in(?:decilli(?:ard|on)|tilli(?:ard|on)|vigintillion))|s(?:core|e(?:cond|pt(?:en(?:dec|vigint)illion|illi(?:ard|on))|ven(?:t(?:ieth|y))?|x(?:decillion|tilli(?:ard|on)|vigintillion))|ix(?:t(?:ieth|y))?)|t(?:ee?n|h(?:ir(?:t(?:een|ieth|y)|d)|ousand|ree)|r(?:e(?:decilli(?:ard|on)|vigintillion)|i(?:gintillion|lli(?:ard|on)))|w(?:e(?:l(?:fth|ve)|nt(?:ieth|y))|o)|h)|un(?:decilli(?:ard|on)|vigintillion)|vigintillion|zero|s))/i;
16              
17             my $ok_words = qr/\b(and|a|of)\b/;
18             my $ok_things = qr/[^A-Za-z0-9.]/;
19             our $number_re = qr/\b(($numbers($ok_words|$ok_things)*)+)\b/i;
20              
21             sub extract_numbers {
22 1     1 1 3 my $text = shift;
23 1         2 my @numbers;
24 1         30 push @numbers, $1 while $text =~ /$number_re/g;
25 1         8 s/\s+$// for @numbers;
26 1         5 return @numbers;
27             }
28              
29             sub numify {
30 1     1 1 727 my $text = shift;
31 1 50       18 $text =~ s/$number_re/words2nums($1). ($1 =~ m{(\s+)$} ? $1 :"")/eg;
  2         652  
32 1         45 return $text;
33             }
34              
35             1;
36             __END__