File Coverage

blib/lib/Lingua/EN/Number/IsOrdinal.pm
Criterion Covered Total %
statement 26 26 100.0
branch 10 10 100.0
condition 8 9 88.8
subroutine 7 7 100.0
pod 1 1 100.0
total 52 53 98.1


line stmt bran cond sub pod time code
1             package Lingua::EN::Number::IsOrdinal;
2             our $AUTHORITY = 'cpan:RKITOVER';
3             $Lingua::EN::Number::IsOrdinal::VERSION = '0.05';
4 1     1   16604 use strict;
  1         1  
  1         23  
5 1     1   3 use warnings;
  1         1  
  1         18  
6 1     1   2 use Exporter 'import';
  1         1  
  1         17  
7 1     1   355 use Lingua::EN::FindNumber 'extract_numbers';
  1         3405  
  1         277  
8              
9             =encoding UTF-8
10              
11             =head1 NAME
12              
13             Lingua::EN::Number::IsOrdinal - detect if English number is ordinal or cardinal
14              
15             =head1 SYNOPSIS
16              
17             use Lingua::EN::Number::IsOrdinal 'is_ordinal';
18              
19             ok is_ordinal('first');
20              
21             ok !is_ordinal('one');
22              
23             ok is_ordinal('2nd');
24              
25             ok !is_ordinal('2');
26              
27             =head1 DESCRIPTION
28              
29             This module will tell you if a number, either in words or as digits, is a
30             cardinal or L
31             number|http://www.ego4u.com/en/cram-up/vocabulary/numbers/ordinal>.
32              
33             This is useful if you e.g. want to distinguish these types of numbers found with
34             L and take different actions.
35              
36             =cut
37              
38             our @EXPORT_OK = qw/is_ordinal/;
39              
40             my $ORDINAL_WORDS_NUMBER_RE = qr/(?:first|second|third|th)\s*$/;
41              
42             my $NUMBER_RE = qr/^\s*(?:[+-]?)(?=\d|\.\d)\d*(?:\.\d*)?(?:[Ee](?:[+-]?\d+))?/;
43              
44             my $CARDINAL_NUMBER_RE = qr/$NUMBER_RE\s*$/;
45              
46             my $ORDINAL_NUMBER_RE = qr/$NUMBER_RE(?:st|nd|rd|th)\s*$/;
47              
48             =head1 FUNCTIONS
49              
50             =head2 is_ordinal
51              
52             Takes a number as English words or digits (with or without ordinal suffix) and
53             returns C<1> for ordinal numbers and C for cardinal numbers.
54              
55             Checks that the whole parameter is a number using L or
56             a regex in the case of digits, and if it isn't will throw a C
57             exception.
58              
59             This function can be optionally imported.
60              
61             =cut
62              
63 19     19 1 5658 sub is_ordinal { __PACKAGE__->_is_ordinal(@_) }
64              
65             =head1 METHODS
66              
67             =head2 _is_ordinal
68              
69             Method version of L, this is where the function is actually
70             implemented. Can be overloaded in a subclass.
71              
72             =cut
73              
74             sub _is_ordinal {
75 19     19   20 my ($self, $num) = @_;
76              
77 19 100       28 die "not a number" unless $self->_is_number($num);
78              
79 18 100       117 if ($num =~ $ORDINAL_NUMBER_RE) {
    100          
    100          
80 3         5 return 1;
81             }
82             elsif ($num =~ $CARDINAL_NUMBER_RE) {
83 7         13 return undef;
84             }
85             elsif ($num =~ $ORDINAL_WORDS_NUMBER_RE) {
86 4         7 return 1;
87             }
88              
89 4         8 return undef; # cardinal words-number
90             }
91              
92             =head2 _is_number
93              
94             Returns C<1> if the passed in string is a word-number as detected by
95             L or is a cardinal or ordinal number made of digits and
96             (for ordinal numbers) a suffix. Otherwise returns C. Can be overloaded in
97             a subclass.
98              
99             =cut
100              
101             sub _is_number {
102 19     19   14 my ($self, $text) = @_;
103 19         87 s/^\s+//, s/\s+$// for $text;
104            
105 19         34 my @nums = extract_numbers $text;
106              
107 19 100 66     383 if ((@nums == 1 && $nums[0] eq $text)
      100        
      100        
108             || $text =~ $ORDINAL_NUMBER_RE || $text =~ $CARDINAL_NUMBER_RE) {
109              
110 18         39 return 1;
111             }
112              
113 1         14 return undef;
114             }
115              
116             =head1 SEE ALSO
117              
118             =over 4
119              
120             =item * L
121              
122             =item * L
123              
124             =item * L
125              
126             =back
127              
128             =head1 AUTHOR
129              
130             Rafael Kitover
131              
132             =head1 LICENSE
133              
134             Copyright 2013-2015 by Rafael Kitover
135              
136             This library is free software; you can redistribute it and/or modify it under
137             the same terms as Perl itself.
138              
139             =cut
140              
141             1;