line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Lingua::Any::Numbers; |
2
|
4
|
|
|
4
|
|
179110
|
use strict; |
|
4
|
|
|
|
|
8
|
|
|
4
|
|
|
|
|
183
|
|
3
|
4
|
|
|
4
|
|
24
|
use warnings; |
|
4
|
|
|
|
|
10
|
|
|
4
|
|
|
|
|
170
|
|
4
|
4
|
|
|
4
|
|
24
|
use vars qw( $VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS ); |
|
4
|
|
|
|
|
14
|
|
|
4
|
|
|
|
|
913
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
$VERSION = '0.45'; |
7
|
|
|
|
|
|
|
|
8
|
4
|
|
|
|
|
21
|
use subs qw( |
9
|
|
|
|
|
|
|
to_string |
10
|
|
|
|
|
|
|
num2str |
11
|
|
|
|
|
|
|
number_to_string |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
to_ordinal |
14
|
|
|
|
|
|
|
num2ord |
15
|
|
|
|
|
|
|
number_to_ordinal |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
available |
18
|
|
|
|
|
|
|
available_langs |
19
|
|
|
|
|
|
|
available_languages |
20
|
4
|
|
|
4
|
|
5696
|
); |
|
4
|
|
|
|
|
130
|
|
21
|
|
|
|
|
|
|
|
22
|
4
|
|
|
4
|
|
476
|
use constant LCLASS => 0; |
|
4
|
|
|
|
|
8
|
|
|
4
|
|
|
|
|
463
|
|
23
|
4
|
|
|
|
|
178
|
use constant RE_LEGACY_PERL => qr{ |
24
|
|
|
|
|
|
|
Perl \s+ (.+?) \s+ required |
25
|
|
|
|
|
|
|
--this \s+ is \s+ only \s+ (.+?), |
26
|
|
|
|
|
|
|
\s+ stopped |
27
|
4
|
|
|
4
|
|
298
|
}xmsi; |
|
4
|
|
|
|
|
8
|
|
28
|
4
|
|
|
4
|
|
24
|
use File::Spec; |
|
4
|
|
|
|
|
8
|
|
|
4
|
|
|
|
|
114
|
|
29
|
4
|
|
|
4
|
|
22
|
use base qw( Exporter ); |
|
4
|
|
|
|
|
5
|
|
|
4
|
|
|
|
|
469
|
|
30
|
4
|
|
|
4
|
|
23
|
use Carp qw(croak); |
|
4
|
|
|
|
|
8
|
|
|
4
|
|
|
|
|
593
|
|
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
BEGIN { |
33
|
4
|
|
|
4
|
|
191
|
*num2str = *number_to_string = \&to_string; |
34
|
4
|
|
|
|
|
17
|
*num2ord = *number_to_ordinal = \&to_ordinal; |
35
|
4
|
|
|
|
|
13
|
*available_langs = *available_languages = \&available; |
36
|
|
|
|
|
|
|
|
37
|
4
|
|
|
|
|
9
|
@EXPORT = (); |
38
|
4
|
|
|
|
|
25336
|
@EXPORT_OK = qw( |
39
|
|
|
|
|
|
|
to_string number_to_string num2str |
40
|
|
|
|
|
|
|
to_ordinal number_to_ordinal num2ord |
41
|
|
|
|
|
|
|
available available_langs available_languages |
42
|
|
|
|
|
|
|
language_handler |
43
|
|
|
|
|
|
|
); |
44
|
|
|
|
|
|
|
} |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
%EXPORT_TAGS = ( |
47
|
|
|
|
|
|
|
all => [ @EXPORT_OK ], |
48
|
|
|
|
|
|
|
standard => [ qw/ available to_string to_ordinal / ], |
49
|
|
|
|
|
|
|
standard2 => [ qw/ available_languages to_string to_ordinal / ], |
50
|
|
|
|
|
|
|
long => [ qw/ available_languages number_to_string number_to_ordinal / ], |
51
|
|
|
|
|
|
|
); |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
@EXPORT_TAGS{ qw/ std std2 / } = @EXPORT_TAGS{ qw/ standard standard2 / }; |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
my %LMAP; |
56
|
|
|
|
|
|
|
my $DEFAULT = 'EN'; |
57
|
|
|
|
|
|
|
my $USE_LOCALE = 0; |
58
|
|
|
|
|
|
|
# blacklist non-language modules |
59
|
|
|
|
|
|
|
my %NOT_LANG = map { $_ => 1 } qw( |
60
|
|
|
|
|
|
|
Any |
61
|
|
|
|
|
|
|
Base |
62
|
|
|
|
|
|
|
Conlang |
63
|
|
|
|
|
|
|
Slavic |
64
|
|
|
|
|
|
|
); |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
_probe(); # fetch/examine/compile all available modules |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
sub import { |
69
|
4
|
|
|
4
|
|
53
|
my($class, @args) = @_; |
70
|
4
|
|
|
|
|
11
|
my @exports; |
71
|
|
|
|
|
|
|
|
72
|
4
|
|
|
|
|
111
|
foreach my $thing ( @args ) { |
73
|
8
|
100
|
|
|
|
28
|
if ( lc $thing eq '+locale' ) { $USE_LOCALE = 1; next; } |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
7
|
|
74
|
6
|
50
|
|
|
|
57
|
if ( lc $thing eq '-locale' ) { $USE_LOCALE = 0; next; } |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
75
|
6
|
|
|
|
|
17
|
push @exports, $thing; |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
|
78
|
4
|
|
|
|
|
4512
|
return $class->export_to_level( 1, $class, @exports ); |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
sub to_string { |
82
|
42
|
|
|
42
|
|
15672
|
my @args = @_; |
83
|
42
|
|
|
|
|
153
|
return _to( string => @args ) |
84
|
|
|
|
|
|
|
} |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
sub to_ordinal { |
87
|
42
|
|
|
42
|
|
69334
|
my @args = @_; |
88
|
42
|
|
|
|
|
136
|
return _to( ordinal => @args ) |
89
|
|
|
|
|
|
|
} |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
sub available { |
92
|
2
|
|
|
2
|
|
824
|
my @ids = sort keys %LMAP; |
93
|
2
|
|
|
|
|
68
|
return @ids; |
94
|
|
|
|
|
|
|
} |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
sub language_handler { |
97
|
46
|
|
50
|
46
|
1
|
782
|
my $lang = shift || return; |
98
|
46
|
|
50
|
|
|
221
|
my $h = $LMAP{ uc $lang } || return; |
99
|
46
|
|
|
|
|
280
|
return $h->{class}; |
100
|
|
|
|
|
|
|
} |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
# -- PRIVATE -- # |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
sub _to { |
105
|
84
|
|
33
|
84
|
|
476
|
my $type = shift || croak 'No type specified'; |
106
|
84
|
|
|
|
|
254
|
my $n = shift; |
107
|
84
|
|
66
|
|
|
304
|
my $lang = shift || _get_lang(); |
108
|
84
|
|
|
|
|
1300
|
$lang = uc $lang; |
109
|
84
|
100
|
|
|
|
446
|
$lang = _get_lang($lang) if $lang eq 'LOCALE'; |
110
|
84
|
50
|
66
|
|
|
1821
|
if ( ($lang eq 'LOCALE' || $USE_LOCALE) && ! exists $LMAP{ $lang } ) { |
|
|
|
66
|
|
|
|
|
111
|
0
|
|
|
|
|
0
|
_w("Locale language ($lang) is not available. " |
112
|
|
|
|
|
|
|
."Falling back to default language ($DEFAULT)"); |
113
|
0
|
|
|
|
|
0
|
$lang = $DEFAULT; # prevent die()ing from an absent driver |
114
|
|
|
|
|
|
|
} |
115
|
84
|
|
33
|
|
|
271
|
my $struct = $LMAP{ $lang } || croak "Language ($lang) is not available"; |
116
|
84
|
|
|
|
|
419
|
return $struct->{ $type }->( $n ); |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
sub _get_lang { |
120
|
8
|
|
|
8
|
|
11
|
my $lang; |
121
|
8
|
|
|
|
|
11
|
my $locale = shift; |
122
|
8
|
50
|
66
|
|
|
54
|
$lang = _get_lang_from_locale() if $locale || $USE_LOCALE; |
123
|
8
|
50
|
|
|
|
25
|
$lang = $DEFAULT if ! $lang; |
124
|
8
|
|
|
|
|
34
|
return uc $lang; |
125
|
|
|
|
|
|
|
} |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
sub _get_lang_from_locale { |
128
|
8
|
|
|
8
|
|
2421
|
require I18N::LangTags::Detect; |
129
|
8
|
|
|
|
|
11849
|
my @user_wants = I18N::LangTags::Detect::detect(); |
130
|
8
|
|
50
|
|
|
1300
|
my $lang = $user_wants[0] || return; |
131
|
0
|
|
|
|
|
0
|
($lang,undef) = split m{\-}xms, $lang; # tr-tr |
132
|
0
|
|
|
|
|
0
|
return $lang; |
133
|
|
|
|
|
|
|
} |
134
|
|
|
|
|
|
|
|
135
|
0
|
|
0
|
0
|
|
0
|
sub _is_silent { return defined &SILENT && SILENT() } |
136
|
|
|
|
|
|
|
|
137
|
18
|
|
|
18
|
|
143
|
sub _dummy_ordinal { return shift } |
138
|
0
|
|
|
0
|
|
0
|
sub _dummy_string { return shift } |
139
|
|
|
|
|
|
|
sub _dummy_oo { |
140
|
24
|
|
|
24
|
|
47
|
my $class = shift; |
141
|
24
|
|
|
|
|
105
|
my $type = shift; |
142
|
|
|
|
|
|
|
return $type && ! $class->can('parse') |
143
|
6
|
|
|
6
|
|
51
|
? sub { $class->new->$type( shift ) } |
144
|
6
|
|
|
6
|
|
44
|
: sub { $class->new->parse( shift ) } |
145
|
24
|
100
|
66
|
|
|
499
|
; |
146
|
|
|
|
|
|
|
} |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
sub _probe { |
149
|
4
|
|
|
4
|
|
353
|
my @compile; |
150
|
4
|
|
|
|
|
16
|
foreach my $module ( _probe_inc() ) { |
151
|
80
|
|
|
|
|
386
|
my $class = $module->[LCLASS]; |
152
|
|
|
|
|
|
|
|
153
|
80
|
|
|
|
|
550
|
(my $inc = $class) =~ s{::}{/}xmsg; |
154
|
80
|
|
|
|
|
234
|
$inc .= q{.pm}; |
155
|
|
|
|
|
|
|
|
156
|
80
|
50
|
|
|
|
309
|
if ( ! $INC{ $inc } ) { |
157
|
80
|
|
|
|
|
1568
|
my $file = File::Spec->catfile( split m{::}xms, $class ) . '.pm'; |
158
|
|
|
|
|
|
|
eval { |
159
|
80
|
|
|
|
|
258547
|
require $file; |
160
|
80
|
|
|
|
|
1423334
|
$class->import; |
161
|
80
|
|
|
|
|
966
|
1; |
162
|
80
|
50
|
|
|
|
241
|
} or do { |
163
|
|
|
|
|
|
|
# some modules need attention |
164
|
0
|
|
|
|
|
0
|
_probe_error($@, $class); |
165
|
0
|
|
|
|
|
0
|
next; |
166
|
|
|
|
|
|
|
}; |
167
|
80
|
|
|
|
|
312
|
$INC{ $inc } = $INC{ $file }; |
168
|
|
|
|
|
|
|
} |
169
|
|
|
|
|
|
|
|
170
|
80
|
|
|
|
|
443
|
push @compile, $module; |
171
|
|
|
|
|
|
|
} |
172
|
4
|
|
|
|
|
37
|
_compile( \@compile ); |
173
|
4
|
|
|
|
|
54
|
return 1; |
174
|
|
|
|
|
|
|
} |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
sub _probe_error { |
177
|
0
|
|
|
0
|
|
0
|
my($e, $class) = @_; |
178
|
0
|
0
|
|
|
|
0
|
if ( $e =~ RE_LEGACY_PERL ) { # JA -> 5.6.2 |
179
|
0
|
|
|
|
|
0
|
return _w( _eprobe( $class, $1, $2 ) ); |
180
|
|
|
|
|
|
|
} |
181
|
0
|
|
|
|
|
0
|
croak("An error occurred while including sub modules: $e"); |
182
|
|
|
|
|
|
|
} |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
sub _probe_inc { |
185
|
4
|
|
|
4
|
|
7369
|
require Symbol; |
186
|
4
|
|
|
|
|
8385
|
my @classes; |
187
|
4
|
|
|
|
|
24
|
foreach my $inc ( @INC ) { |
188
|
46
|
|
|
|
|
504
|
my $path = File::Spec->catfile( $inc, 'Lingua' ); |
189
|
46
|
100
|
|
|
|
3034
|
next if ! -d $path; |
190
|
12
|
|
|
|
|
47
|
my $DIRH = Symbol::gensym(); |
191
|
12
|
50
|
|
|
|
1495
|
opendir $DIRH, $path or croak "opendir($path): $!"; |
192
|
12
|
|
|
|
|
423
|
while ( my $dir = readdir $DIRH ) { |
193
|
120
|
100
|
100
|
|
|
944
|
next if $dir =~ m{ \A [.] }xms || $NOT_LANG{ $dir }; |
194
|
76
|
50
|
|
|
|
516
|
($dir) = $dir =~ m{([a-z0-9_]+)}xmsi or next; # untaint |
195
|
76
|
|
|
|
|
179
|
my @rs = _probe_exists($path, $dir); |
196
|
76
|
50
|
|
|
|
170
|
next if ! @rs; # bogus |
197
|
76
|
|
|
|
|
126
|
foreach my $e ( @rs ) { |
198
|
80
|
|
|
|
|
96
|
my($file, $type) = @{ $e }; |
|
80
|
|
|
|
|
155
|
|
199
|
80
|
|
|
|
|
2660
|
push @classes, [ join(q{::}, 'Lingua', $dir, $type), $file, $dir ]; |
200
|
|
|
|
|
|
|
} |
201
|
|
|
|
|
|
|
} |
202
|
12
|
|
|
|
|
243
|
closedir $DIRH; |
203
|
|
|
|
|
|
|
} |
204
|
|
|
|
|
|
|
|
205
|
4
|
|
|
|
|
28
|
return @classes; |
206
|
|
|
|
|
|
|
} |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
sub _probe_exists { |
209
|
76
|
|
|
76
|
|
118
|
my($path, $dir) = @_; |
210
|
76
|
|
|
|
|
88
|
my @results; |
211
|
76
|
|
|
|
|
127
|
foreach my $possibility ( qw[ Numbers Num2Word Nums2Words Numeros Nums2Ords ] ) { |
212
|
380
|
|
|
|
|
3712
|
my $file = File::Spec->catfile( $path, $dir, $possibility . '.pm' ); |
213
|
380
|
100
|
66
|
|
|
225054
|
next if ! -e $file || -d _; |
214
|
80
|
|
|
|
|
306
|
push @results, [ $file, $possibility ]; |
215
|
|
|
|
|
|
|
} |
216
|
76
|
|
|
|
|
253
|
return @results; |
217
|
|
|
|
|
|
|
} |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
sub _w { |
220
|
0
|
0
|
|
0
|
|
0
|
return _is_silent() ? 1 : do { warn "@_\n"; 1 }; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
221
|
|
|
|
|
|
|
} |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
sub _eprobe { |
224
|
0
|
|
|
0
|
|
0
|
my @args = @_; |
225
|
0
|
0
|
|
|
|
0
|
my $tmp = @args > 2 ? q{%s requires a newer (%s) perl binary. You have %s} |
226
|
|
|
|
|
|
|
: q{%s requires a newer perl binary. You have %s} |
227
|
|
|
|
|
|
|
; |
228
|
0
|
|
|
|
|
0
|
return sprintf $tmp, @args; |
229
|
|
|
|
|
|
|
} |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
sub _merge_into_numbers { |
232
|
4
|
|
|
4
|
|
12
|
my($id, $lang ) = @_; |
233
|
4
|
|
|
|
|
17
|
my $e = delete $lang->{ $id }; |
234
|
4
|
|
|
|
|
7
|
my %test = map { @{ $_ } } @{ $e }; |
|
8
|
|
|
|
|
13
|
|
|
8
|
|
|
|
|
45
|
|
|
4
|
|
|
|
|
11
|
|
235
|
4
|
|
|
|
|
18
|
my $words = delete $test{'Lingua::' . $id . '::Nums2Words' }; |
236
|
4
|
|
|
|
|
15
|
my $ords = delete $test{'Lingua::' . $id . '::Nums2Ords' }; |
237
|
4
|
|
|
|
|
13
|
my $numbers = delete $test{'Lingua::' . $id . '::Numbers' }; |
238
|
|
|
|
|
|
|
|
239
|
4
|
50
|
33
|
|
|
37
|
if ( ! $numbers && ( $ords || $words ) ) { |
|
|
|
33
|
|
|
|
|
240
|
4
|
|
|
|
|
28
|
my $file = sprintf 'Lingua/%s/Numbers.pm', $id; |
241
|
4
|
|
|
|
|
13
|
my $c = sprintf 'Lingua::%s::Numbers', $id; |
242
|
4
|
|
50
|
|
|
38
|
$INC{ $file } ||= 'Fake placeholder module'; |
243
|
4
|
|
|
|
|
16
|
my $n = $c . '::num2' . lc $id; |
244
|
4
|
|
|
|
|
11
|
my $v = $c . '::VERSION'; |
245
|
4
|
|
|
|
|
12
|
my $o = $n . '_ordinal'; |
246
|
4
|
|
|
|
|
12
|
my $f = $c . '::_faked_by_lingua_any_numbers'; |
247
|
4
|
|
|
|
|
13
|
my $card = 'Lingua::' . $id . '::Nums2Words::num2word'; |
248
|
4
|
|
|
|
|
13
|
my $ord = 'Lingua::' . $id . '::Nums2Ords::num2ord'; |
249
|
4
|
|
|
|
|
17
|
$lang->{ $id } = [ $c, $INC{ $file } ]; |
250
|
|
|
|
|
|
|
|
251
|
4
|
|
|
4
|
|
56
|
no strict qw( refs ); ## no critic (ProhibitProlongedStrictureOverride) |
|
4
|
|
|
|
|
11
|
|
|
4
|
|
|
|
|
4895
|
|
252
|
4
|
50
|
33
|
|
|
84
|
*{ $n } = \&{ $card } if $words && ! $c->can('num2tr'); |
|
4
|
|
|
|
|
47
|
|
|
4
|
|
|
|
|
22
|
|
253
|
4
|
50
|
33
|
|
|
112
|
*{ $o } = \&{ $ord } if $ords && ! $c->can('num2ord'); |
|
4
|
|
|
|
|
23
|
|
|
4
|
|
|
|
|
22
|
|
254
|
4
|
50
|
|
0
|
|
43
|
*{ $v } = sub { $VERSION } if ! $c->can('VERSION'); |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
255
|
4
|
|
|
2
|
|
40
|
*{ $f } = sub { return { words => $words, ords => $ords } }; |
|
4
|
|
|
|
|
38
|
|
|
2
|
|
|
|
|
754
|
|
256
|
|
|
|
|
|
|
|
257
|
4
|
|
|
|
|
21
|
return; |
258
|
|
|
|
|
|
|
} |
259
|
|
|
|
|
|
|
|
260
|
0
|
|
|
|
|
0
|
$lang->{ $id } = $e; # restore |
261
|
|
|
|
|
|
|
|
262
|
0
|
|
|
|
|
0
|
return; |
263
|
|
|
|
|
|
|
} |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
sub _compile { |
266
|
4
|
|
|
4
|
|
15
|
my $classes = shift; |
267
|
4
|
|
|
|
|
9
|
my %lang; |
268
|
4
|
|
|
|
|
76
|
foreach my $e ( @{ $classes } ) { |
|
4
|
|
|
|
|
15
|
|
269
|
80
|
|
|
|
|
84
|
my($class, $file, $id) = @{ $e }; |
|
80
|
|
|
|
|
188
|
|
270
|
80
|
100
|
|
|
|
405
|
$lang{ $id } = [] if ! defined $lang{ $id }; |
271
|
80
|
|
|
|
|
98
|
push @{ $lang{ $id } }, [ $class, $file ]; |
|
80
|
|
|
|
|
262
|
|
272
|
|
|
|
|
|
|
} |
273
|
|
|
|
|
|
|
|
274
|
4
|
|
|
|
|
29
|
foreach my $id ( keys %lang ) { |
275
|
76
|
100
|
|
|
|
176
|
if ( $id eq 'PT' ) { |
276
|
4
|
|
|
|
|
32
|
_merge_into_numbers( $id, \%lang ); |
277
|
4
|
|
|
|
|
12
|
next; |
278
|
|
|
|
|
|
|
} |
279
|
72
|
|
|
|
|
78
|
my @choices = @{ $lang{ $id } }; |
|
72
|
|
|
|
|
235
|
|
280
|
72
|
|
|
|
|
88
|
my $numbers; |
281
|
72
|
|
|
|
|
136
|
foreach my $c ( @choices ) { |
282
|
72
|
|
|
|
|
73
|
my($class, $file) = @{ $c }; |
|
72
|
|
|
|
|
119
|
|
283
|
72
|
100
|
|
|
|
342
|
$numbers = $c if $class =~ m{::Numbers\z}xms; |
284
|
|
|
|
|
|
|
} |
285
|
72
|
100
|
|
|
|
259
|
$lang{ $id } = $numbers ? [ @{ $numbers} ] : shift @choices; |
|
52
|
|
|
|
|
189
|
|
286
|
|
|
|
|
|
|
} |
287
|
|
|
|
|
|
|
|
288
|
4
|
|
|
|
|
24
|
foreach my $l ( keys %lang ) { |
289
|
76
|
|
|
|
|
128
|
my $e = $lang{ $l }; |
290
|
76
|
|
|
|
|
109
|
my $c = $e->[0]; |
291
|
76
|
|
|
|
|
147
|
$LMAP{ uc $l } = { |
292
|
|
|
|
|
|
|
string => _test_cardinal($c, $l), |
293
|
|
|
|
|
|
|
ordinal => _test_ordinal( $c, $l), |
294
|
|
|
|
|
|
|
class => $c, |
295
|
|
|
|
|
|
|
}; |
296
|
|
|
|
|
|
|
} |
297
|
|
|
|
|
|
|
|
298
|
4
|
|
|
|
|
39
|
return; |
299
|
|
|
|
|
|
|
} |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
sub _test_cardinal { |
302
|
76
|
|
|
76
|
|
120
|
my($c, $l) = @_; |
303
|
76
|
|
|
|
|
128
|
$l = lc $l; |
304
|
4
|
|
|
4
|
|
30
|
no strict qw(refs); |
|
4
|
|
|
|
|
8
|
|
|
4
|
|
|
|
|
8148
|
|
305
|
76
|
|
|
|
|
78
|
my %s = %{ "${c}::" }; |
|
76
|
|
|
|
|
2491
|
|
306
|
76
|
|
|
|
|
245
|
my $n = $s{new}; |
307
|
|
|
|
|
|
|
return |
308
|
24
|
|
|
|
|
262
|
$s{"num2${l}"} ? \&{"${c}::num2${l}" } |
|
16
|
|
|
|
|
176
|
|
309
|
4
|
|
|
|
|
41
|
: $s{"number_to_${l}"} ? \&{"${c}::number_to_${l}" } |
310
|
0
|
|
|
|
|
0
|
: $s{'nums2words'} ? \&{"${c}::nums2words" } |
311
|
4
|
|
|
|
|
39
|
: $s{'num2word'} ? \&{"${c}::num2word" } |
312
|
8
|
|
|
|
|
61
|
: $s{cardinal2alpha} ? \&{"${c}::cardinal2alpha" } |
313
|
|
|
|
|
|
|
: $s{cardinal} && $n ? _dummy_oo( $c, 'cardinal' ) |
314
|
|
|
|
|
|
|
: $s{parse} ? _dummy_oo( $c ) |
315
|
|
|
|
|
|
|
: $s{"num2${l}_cardinal"}? $n ? _dummy_oo( $c, "num2${l}_cardinal" ) |
316
|
76
|
100
|
66
|
|
|
465
|
: \&{"${c}::num2${l}_cardinal" } |
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
317
|
|
|
|
|
|
|
: \&_dummy_string |
318
|
|
|
|
|
|
|
; |
319
|
|
|
|
|
|
|
} |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
sub _test_ordinal { |
322
|
76
|
|
|
76
|
|
145
|
my($c, $l) = @_; |
323
|
76
|
|
|
|
|
119
|
$l = lc $l; |
324
|
4
|
|
|
4
|
|
35
|
no strict qw(refs); |
|
4
|
|
|
|
|
27
|
|
|
4
|
|
|
|
|
1329
|
|
325
|
76
|
|
|
|
|
82
|
my %s = %{ "${c}::" }; |
|
76
|
|
|
|
|
1130
|
|
326
|
76
|
|
100
|
|
|
333
|
my $n = $s{new} && ! _like_en( $c ); |
327
|
|
|
|
|
|
|
return |
328
|
8
|
|
|
|
|
91
|
$s{"ordinate_to_${l}"} ? \&{"${c}::ordinate_to_${l}"} |
|
4
|
|
|
|
|
51
|
|
329
|
24
|
|
|
|
|
306
|
: $s{ordinal2alpha} ? \&{"${c}::ordinal2alpha" } |
330
|
|
|
|
|
|
|
: $s{ordinal} && $n ? _dummy_oo( $c, 'ordinal' ) |
331
|
|
|
|
|
|
|
: $s{"num2${l}_ordinal"} ? $n ? _dummy_oo( $c, "num2${l}_ordinal" ) |
332
|
76
|
50
|
100
|
|
|
774
|
: \&{ "${c}::num2${l}_ordinal" } |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
333
|
|
|
|
|
|
|
: \&_dummy_ordinal |
334
|
|
|
|
|
|
|
; |
335
|
|
|
|
|
|
|
} |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
sub _like_en { |
338
|
36
|
|
|
36
|
|
52
|
my $c = shift; |
339
|
36
|
|
66
|
|
|
798
|
my $rv = $c->isa('Lingua::EN::Numbers') |
340
|
|
|
|
|
|
|
|| $c->isa('Lingua::JA::Numbers') |
341
|
|
|
|
|
|
|
|| $c->isa('Lingua::TR::Numbers') |
342
|
|
|
|
|
|
|
; |
343
|
36
|
|
|
|
|
134
|
return $rv; |
344
|
|
|
|
|
|
|
} |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
1; |
347
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
__END__ |