line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Locale::CLDR; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
=encoding utf8 |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
=head1 NAME |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
Locale::CLDR - A Module to create locale objects with localisation data from the CLDR |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
=head1 VERSION |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
Version 0.26.6 |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
=head1 SYNOPSIS |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
This module provides a locale object you can use to localise your output. |
16
|
|
|
|
|
|
|
The localisation data comes from the Unicode Common Locale Data Repository. |
17
|
|
|
|
|
|
|
Most of this code can be used with Perl version 5.10 or above. There are a |
18
|
|
|
|
|
|
|
few parts of the code that require version 5.18 or above. |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
=head1 USAGE |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
my $locale = Locale::CLDR->new('en_US'); |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
or |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
my $locale = Locale::CLDR->new(language_id => 'en', territory_id => 'us'); |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
A full locale identifier is |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
C<language>_C<script>_C<territory>_C<variant>_u_C<extension name>_C<extension value> |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
my $locale = Locale::CLDR->new('en_latn_US_SCOUSE_u_nu_traditional'); |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
or |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
my $locale = Locale::CLDR->new(language_id => 'en', script_id => 'latn', territory_id => 'US', variant => 'SCOUSE', extensions => { nu => 'traditional' } ); |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
=cut |
39
|
|
|
|
|
|
|
|
40
|
20
|
|
|
20
|
|
436206
|
use v5.10; |
|
20
|
|
|
|
|
62
|
|
|
20
|
|
|
|
|
814
|
|
41
|
20
|
|
|
20
|
|
8906
|
use version; |
|
20
|
|
|
|
|
31797
|
|
|
20
|
|
|
|
|
98
|
|
42
|
|
|
|
|
|
|
our $VERSION = version->declare('v0.26.6'); |
43
|
|
|
|
|
|
|
|
44
|
20
|
|
|
20
|
|
11919
|
use open ':encoding(utf8)'; |
|
20
|
|
|
|
|
21662
|
|
|
20
|
|
|
|
|
100
|
|
45
|
20
|
|
|
20
|
|
202915
|
use utf8; |
|
20
|
|
|
|
|
44
|
|
|
20
|
|
|
|
|
127
|
|
46
|
20
|
|
|
20
|
|
1147
|
use if $^V ge v5.12.0, feature => 'unicode_strings'; |
|
20
|
|
|
|
|
32
|
|
|
20
|
|
|
|
|
964
|
|
47
|
|
|
|
|
|
|
|
48
|
20
|
|
|
20
|
|
6186
|
use Moose; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
use MooseX::ClassAttribute; |
50
|
|
|
|
|
|
|
with 'Locale::CLDR::ValidCodes', 'Locale::CLDR::EraBoundries', 'Locale::CLDR::WeekData', |
51
|
|
|
|
|
|
|
'Locale::CLDR::MeasurementSystem', 'Locale::CLDR::LikelySubtags', 'Locale::CLDR::NumberingSystems', |
52
|
|
|
|
|
|
|
'Locale::CLDR::NumberFormatter', 'Locale::CLDR::TerritoryContainment', 'Locale::CLDR::CalendarPreferences', |
53
|
|
|
|
|
|
|
'Locale::CLDR::Currencies', 'Locale::CLDR::Plurals'; |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
use Class::Load; |
56
|
|
|
|
|
|
|
use namespace::autoclean; |
57
|
|
|
|
|
|
|
use List::Util qw(first); |
58
|
|
|
|
|
|
|
use Class::MOP; |
59
|
|
|
|
|
|
|
use DateTime::Locale; |
60
|
|
|
|
|
|
|
use Unicode::Normalize(); |
61
|
|
|
|
|
|
|
#use Locale::CLDR::Collator(); |
62
|
|
|
|
|
|
|
use File::Spec(); |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
# Backwards compatibility |
65
|
|
|
|
|
|
|
BEGIN { |
66
|
|
|
|
|
|
|
if (defined &CORE::fc) { #v5.16 |
67
|
|
|
|
|
|
|
*fc = \&CORE::fc; |
68
|
|
|
|
|
|
|
} |
69
|
|
|
|
|
|
|
else { |
70
|
|
|
|
|
|
|
# We only use fc() with code that expects Perl v5.18 or above |
71
|
|
|
|
|
|
|
*fc = sub {}; |
72
|
|
|
|
|
|
|
} |
73
|
|
|
|
|
|
|
} |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
=head1 ATTRIBUTES |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
These can be passed into the constructor and all are optional. |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
=over 4 |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
=item language_id |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
A valid language or language alias id, such as C<en> |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
=cut |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
has 'language_id' => ( |
88
|
|
|
|
|
|
|
is => 'ro', |
89
|
|
|
|
|
|
|
isa => 'Str', |
90
|
|
|
|
|
|
|
required => 1, |
91
|
|
|
|
|
|
|
); |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
# language aliases |
94
|
|
|
|
|
|
|
around 'language_id' => sub { |
95
|
|
|
|
|
|
|
my ($orig, $self) = @_; |
96
|
|
|
|
|
|
|
my $value = $self->$orig; |
97
|
|
|
|
|
|
|
return $self->language_aliases->{$value} // $value; |
98
|
|
|
|
|
|
|
}; |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
=item script_id |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
A valid script id, such as C<latn> or C<Ctcl>. The code will pick a likely script |
103
|
|
|
|
|
|
|
depending on the given language if non is provided. |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
=cut |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
has 'script_id' => ( |
108
|
|
|
|
|
|
|
is => 'ro', |
109
|
|
|
|
|
|
|
isa => 'Str', |
110
|
|
|
|
|
|
|
default => '', |
111
|
|
|
|
|
|
|
predicate => 'has_script', |
112
|
|
|
|
|
|
|
); |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
=item territory_id |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
A valid territory id or territory alias such as C<GB> |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
=cut |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
has 'territory_id' => ( |
121
|
|
|
|
|
|
|
is => 'ro', |
122
|
|
|
|
|
|
|
isa => 'Str', |
123
|
|
|
|
|
|
|
default => '', |
124
|
|
|
|
|
|
|
predicate => 'has_territory', |
125
|
|
|
|
|
|
|
); |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
# territory aliases |
128
|
|
|
|
|
|
|
around 'territory_id' => sub { |
129
|
|
|
|
|
|
|
my ($orig, $self) = @_; |
130
|
|
|
|
|
|
|
my $value = $self->$orig; |
131
|
|
|
|
|
|
|
return $value if defined $value; |
132
|
|
|
|
|
|
|
my $alias = $self->territory_aliases->{$value}; |
133
|
|
|
|
|
|
|
return (split /\s+/, $alias)[0]; |
134
|
|
|
|
|
|
|
}; |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
=item variant_id |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
A valid variant id. The code currently ignores this |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
=cut |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
has 'variant_id' => ( |
143
|
|
|
|
|
|
|
is => 'ro', |
144
|
|
|
|
|
|
|
isa => 'Str', |
145
|
|
|
|
|
|
|
default => '', |
146
|
|
|
|
|
|
|
predicate => 'has_variant', |
147
|
|
|
|
|
|
|
); |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
=item extensions |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
A Hashref of extension names and values. You can use this to override |
152
|
|
|
|
|
|
|
the locales number formatting and calendar by passing in the Unicode |
153
|
|
|
|
|
|
|
extension names or aliases as keys and the extension value as the hash |
154
|
|
|
|
|
|
|
value. |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
Currently supported extensions are |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
=over 8 |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
=item nu |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
=item numbers |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
The number type can be one of |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
=over 12 |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
=item arab |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
Arabic-Indic Digits |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
=item arabext |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
Extended Arabic-Indic Digits |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
=item armn |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
Armenian Numerals |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
=item armnlow |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
Armenian Lowercase Numerals |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
=item bali |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
Balinese Digits |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
=item beng |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
Bengali Digits |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
=item brah |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
Brahmi Digits |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
=item cakm |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
Chakma Digits |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
=item cham |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
Cham Digits |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
=item deva |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
Devanagari Digits |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
=item ethi |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
Ethiopic Numerals |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
=item finance |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
Financial Numerals |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
=item fullwide |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
Full Width Digits |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
=item geor |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
Georgian Numerals |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
=item grek |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
Greek Numerals |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
=item greklow |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
Greek Lowercase Numerals |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
=item gujr |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
Gujarati Digits |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
=item guru |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
Gurmukhi Digits |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
=item hanidays |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
Chinese Calendar Day-of-Month Numerals |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
=item hanidec |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
Chinese Decimal Numerals |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
=item hans |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
Simplified Chinese Numerals |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
=item hansfin |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
Simplified Chinese Financial Numerals |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
=item hant |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
Traditional Chinese Numerals |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
=item hantfin |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
Traditional Chinese Financial Numerals |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
=item hebr |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
Hebrew Numerals |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
=item java |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
Javanese Digits |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
=item jpan |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
Japanese Numerals |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
=item jpanfin |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
Japanese Financial Numerals |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
=item kali |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
Kayah Li Digits |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
=item khmr |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
Khmer Digits |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
=item knda |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
Kannada Digits |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
=item lana |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
Tai Tham Hora Digits |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
=item lanatham |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
Tai Tham Tham Digits |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
=item laoo |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
Lao Digits |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
=item latn |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
Western Digits |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
=item lepc |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
Lepcha Digits |
311
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
=item limb |
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
Limbu Digits |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
=item mlym |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
Malayalam Digits |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
=item mong |
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
Mongolian Digits |
323
|
|
|
|
|
|
|
|
324
|
|
|
|
|
|
|
=item mtei |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
Meetei Mayek Digits |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
=item mymr |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
Myanmar Digits |
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
=item mymrshan |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
Myanmar Shan Digits |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
=item native |
337
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
Native Digits |
339
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
=item nkoo |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
N'Ko Digits |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
=item olck |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
Ol Chiki Digits |
347
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
=item orya |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
Oriya Digits |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
=item osma |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
Osmanya Digits |
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
=item roman |
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
Roman Numerals |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
=item romanlow |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
Roman Lowercase Numerals |
363
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
=item saur |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
Saurashtra Digits |
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
=item shrd |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
Sharada Digits |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
=item sora |
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
Sora Sompeng Digits |
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
=item sund |
377
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
Sundanese Digits |
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
=item takr |
381
|
|
|
|
|
|
|
|
382
|
|
|
|
|
|
|
Takri Digits |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
=item talu |
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
New Tai Lue Digits |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
=item taml |
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
Traditional Tamil Numerals |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
=item tamldec |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
Tamil Digits |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
=item telu |
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
Telugu Digits |
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
=item thai |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
Thai Digits |
403
|
|
|
|
|
|
|
|
404
|
|
|
|
|
|
|
=item tibt |
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
Tibetan Digits |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
=item traditional |
409
|
|
|
|
|
|
|
|
410
|
|
|
|
|
|
|
Traditional Numerals |
411
|
|
|
|
|
|
|
|
412
|
|
|
|
|
|
|
=item vaii |
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
Vai Digits |
415
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
=back |
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
=item ca |
419
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
=item calendar |
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
You can use this to override a locales default calendar. Valid values are |
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
=over 12 |
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
=item buddhist |
427
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
Buddhist Calendar |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
=item chinese |
431
|
|
|
|
|
|
|
|
432
|
|
|
|
|
|
|
Chinese Calendar |
433
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
=item coptic |
435
|
|
|
|
|
|
|
|
436
|
|
|
|
|
|
|
Coptic Calendar |
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
=item dangi |
439
|
|
|
|
|
|
|
|
440
|
|
|
|
|
|
|
Dangi Calendar |
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
=item ethiopic |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
Ethiopic Calendar |
445
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
=item ethiopic-amete-alem |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
Ethiopic Amete Alem Calendar |
449
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
=item gregorian |
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
Gregorian Calendar |
453
|
|
|
|
|
|
|
|
454
|
|
|
|
|
|
|
=item hebrew |
455
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
Hebrew Calendar |
457
|
|
|
|
|
|
|
|
458
|
|
|
|
|
|
|
=item indian |
459
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
Indian National Calendar |
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
=item islamic |
463
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
Islamic Calendar |
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
=item islamic-civil |
467
|
|
|
|
|
|
|
|
468
|
|
|
|
|
|
|
Islamic Calendar (tabular, civil epoch) |
469
|
|
|
|
|
|
|
|
470
|
|
|
|
|
|
|
=item islamic-rgsa |
471
|
|
|
|
|
|
|
|
472
|
|
|
|
|
|
|
Islamic Calendar (Saudi Arabia, sighting) |
473
|
|
|
|
|
|
|
|
474
|
|
|
|
|
|
|
=item islamic-tbla |
475
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
Islamic Calendar (tabular, astronomical epoch) |
477
|
|
|
|
|
|
|
|
478
|
|
|
|
|
|
|
=item islamic-umalqura |
479
|
|
|
|
|
|
|
|
480
|
|
|
|
|
|
|
Islamic Calendar (Umm al-Qura) |
481
|
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
=item iso8601 |
483
|
|
|
|
|
|
|
|
484
|
|
|
|
|
|
|
ISO-8601 Calendar |
485
|
|
|
|
|
|
|
|
486
|
|
|
|
|
|
|
=item japanese |
487
|
|
|
|
|
|
|
|
488
|
|
|
|
|
|
|
Japanese Calendar |
489
|
|
|
|
|
|
|
|
490
|
|
|
|
|
|
|
=item persian |
491
|
|
|
|
|
|
|
|
492
|
|
|
|
|
|
|
Persian Calendar |
493
|
|
|
|
|
|
|
|
494
|
|
|
|
|
|
|
=item roc |
495
|
|
|
|
|
|
|
|
496
|
|
|
|
|
|
|
Minguo Calendar |
497
|
|
|
|
|
|
|
|
498
|
|
|
|
|
|
|
=back |
499
|
|
|
|
|
|
|
|
500
|
|
|
|
|
|
|
=back |
501
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
=cut |
503
|
|
|
|
|
|
|
|
504
|
|
|
|
|
|
|
has 'extensions' => ( |
505
|
|
|
|
|
|
|
is => 'ro', |
506
|
|
|
|
|
|
|
isa => 'Undef|HashRef', |
507
|
|
|
|
|
|
|
default => undef, |
508
|
|
|
|
|
|
|
writer => '_set_extensions', |
509
|
|
|
|
|
|
|
); |
510
|
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
=back |
512
|
|
|
|
|
|
|
|
513
|
|
|
|
|
|
|
=head1 Methods |
514
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
The following methods can be called on the locale object |
516
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
=over 4 |
518
|
|
|
|
|
|
|
|
519
|
|
|
|
|
|
|
=item id() |
520
|
|
|
|
|
|
|
|
521
|
|
|
|
|
|
|
The local identifier. This is what you get if you attempt to |
522
|
|
|
|
|
|
|
stringify a locale object. |
523
|
|
|
|
|
|
|
|
524
|
|
|
|
|
|
|
=item likely_language() |
525
|
|
|
|
|
|
|
|
526
|
|
|
|
|
|
|
Given a locale with no language passed in or with the explicit language |
527
|
|
|
|
|
|
|
code of C<und>, this method attempts to use the script and territory |
528
|
|
|
|
|
|
|
data to guess the locale's language. |
529
|
|
|
|
|
|
|
|
530
|
|
|
|
|
|
|
=cut |
531
|
|
|
|
|
|
|
|
532
|
|
|
|
|
|
|
has 'likely_language' => ( |
533
|
|
|
|
|
|
|
is => 'ro', |
534
|
|
|
|
|
|
|
isa => 'Str', |
535
|
|
|
|
|
|
|
init_arg => undef, |
536
|
|
|
|
|
|
|
lazy => 1, |
537
|
|
|
|
|
|
|
builder => '_build_likely_language', |
538
|
|
|
|
|
|
|
); |
539
|
|
|
|
|
|
|
|
540
|
|
|
|
|
|
|
sub _build_likely_language { |
541
|
|
|
|
|
|
|
my $self = shift; |
542
|
|
|
|
|
|
|
|
543
|
|
|
|
|
|
|
my $language = $self->language(); |
544
|
|
|
|
|
|
|
|
545
|
|
|
|
|
|
|
return $language unless $language eq 'und'; |
546
|
|
|
|
|
|
|
|
547
|
|
|
|
|
|
|
return $self->likely_subtag->language; |
548
|
|
|
|
|
|
|
} |
549
|
|
|
|
|
|
|
|
550
|
|
|
|
|
|
|
=item likely_script() |
551
|
|
|
|
|
|
|
|
552
|
|
|
|
|
|
|
Given a locale with no script passed in this method attempts to use the |
553
|
|
|
|
|
|
|
language and territory data to guess the locale's script. |
554
|
|
|
|
|
|
|
|
555
|
|
|
|
|
|
|
=cut |
556
|
|
|
|
|
|
|
|
557
|
|
|
|
|
|
|
has 'likely_script' => ( |
558
|
|
|
|
|
|
|
is => 'ro', |
559
|
|
|
|
|
|
|
isa => 'Str', |
560
|
|
|
|
|
|
|
init_arg => undef, |
561
|
|
|
|
|
|
|
lazy => 1, |
562
|
|
|
|
|
|
|
builder => '_build_likely_script', |
563
|
|
|
|
|
|
|
); |
564
|
|
|
|
|
|
|
|
565
|
|
|
|
|
|
|
sub _build_likely_script { |
566
|
|
|
|
|
|
|
my $self = shift; |
567
|
|
|
|
|
|
|
|
568
|
|
|
|
|
|
|
my $script = $self->script(); |
569
|
|
|
|
|
|
|
|
570
|
|
|
|
|
|
|
return $script if $script; |
571
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
return $self->likely_subtag->script || ''; |
573
|
|
|
|
|
|
|
} |
574
|
|
|
|
|
|
|
|
575
|
|
|
|
|
|
|
=item likely_territory() |
576
|
|
|
|
|
|
|
|
577
|
|
|
|
|
|
|
Given a locale with no territory passed in this method attempts to use the |
578
|
|
|
|
|
|
|
language and script data to guess the locale's territory. |
579
|
|
|
|
|
|
|
|
580
|
|
|
|
|
|
|
=back |
581
|
|
|
|
|
|
|
|
582
|
|
|
|
|
|
|
=cut |
583
|
|
|
|
|
|
|
|
584
|
|
|
|
|
|
|
has 'likely_territory' => ( |
585
|
|
|
|
|
|
|
is => 'ro', |
586
|
|
|
|
|
|
|
isa => 'Str', |
587
|
|
|
|
|
|
|
init_arg => undef, |
588
|
|
|
|
|
|
|
lazy => 1, |
589
|
|
|
|
|
|
|
builder => '_build_likely_territory', |
590
|
|
|
|
|
|
|
); |
591
|
|
|
|
|
|
|
|
592
|
|
|
|
|
|
|
sub _build_likely_territory { |
593
|
|
|
|
|
|
|
my $self = shift; |
594
|
|
|
|
|
|
|
|
595
|
|
|
|
|
|
|
my $territory = $self->territory(); |
596
|
|
|
|
|
|
|
|
597
|
|
|
|
|
|
|
return $territory if $territory; |
598
|
|
|
|
|
|
|
|
599
|
|
|
|
|
|
|
return $self->likely_subtag->territory || ''; |
600
|
|
|
|
|
|
|
} |
601
|
|
|
|
|
|
|
|
602
|
|
|
|
|
|
|
has 'module' => ( |
603
|
|
|
|
|
|
|
is => 'ro', |
604
|
|
|
|
|
|
|
isa => 'Object', |
605
|
|
|
|
|
|
|
init_arg => undef, |
606
|
|
|
|
|
|
|
lazy => 1, |
607
|
|
|
|
|
|
|
builder => '_build_module', |
608
|
|
|
|
|
|
|
); |
609
|
|
|
|
|
|
|
|
610
|
|
|
|
|
|
|
sub _build_module { |
611
|
|
|
|
|
|
|
# Create the new path |
612
|
|
|
|
|
|
|
my $self = shift; |
613
|
|
|
|
|
|
|
|
614
|
|
|
|
|
|
|
my @path = map { ucfirst lc } |
615
|
|
|
|
|
|
|
map { $_ ? $_ : 'Any' } ( |
616
|
|
|
|
|
|
|
$self->language_id, |
617
|
|
|
|
|
|
|
$self->script_id, |
618
|
|
|
|
|
|
|
$self->territory_id, |
619
|
|
|
|
|
|
|
); |
620
|
|
|
|
|
|
|
|
621
|
|
|
|
|
|
|
my @likely_path = |
622
|
|
|
|
|
|
|
map { ucfirst lc } ( |
623
|
|
|
|
|
|
|
$self->has_likely_subtag ? $self->likely_subtag->language_id : 'Any', |
624
|
|
|
|
|
|
|
$self->has_likely_subtag ? $self->likely_subtag->script_id : 'Any', |
625
|
|
|
|
|
|
|
$self->has_likely_subtag ? $self->likely_subtag->territory_id : 'Any', |
626
|
|
|
|
|
|
|
); |
627
|
|
|
|
|
|
|
|
628
|
|
|
|
|
|
|
for (my $i = 0; $i < @path; $i++) { |
629
|
|
|
|
|
|
|
$likely_path[$i] = $path[$i] unless $path[$i] eq 'und' or $path[$i] eq 'Any'; |
630
|
|
|
|
|
|
|
} |
631
|
|
|
|
|
|
|
|
632
|
|
|
|
|
|
|
# Note the order we push these onto the stack is important |
633
|
|
|
|
|
|
|
@path = join '::', @likely_path; |
634
|
|
|
|
|
|
|
push @path, join '::', $likely_path[0], 'Any', $likely_path[2]; |
635
|
|
|
|
|
|
|
push @path, join '::', @likely_path[0 .. 1]; |
636
|
|
|
|
|
|
|
push @path, join '::', $likely_path[0]; |
637
|
|
|
|
|
|
|
|
638
|
|
|
|
|
|
|
# Now we go through the path loading each module |
639
|
|
|
|
|
|
|
# And calling new on it. |
640
|
|
|
|
|
|
|
my $module; |
641
|
|
|
|
|
|
|
foreach my $module_name (@path) { |
642
|
|
|
|
|
|
|
$module_name = "Locale::CLDR::Locales::$module_name"; |
643
|
|
|
|
|
|
|
eval { Class::Load::load_class($module_name); }; |
644
|
|
|
|
|
|
|
next if $@; |
645
|
|
|
|
|
|
|
$module = $module_name->new; |
646
|
|
|
|
|
|
|
last; |
647
|
|
|
|
|
|
|
} |
648
|
|
|
|
|
|
|
|
649
|
|
|
|
|
|
|
# If we only have the root module then we have a problem as |
650
|
|
|
|
|
|
|
# none of the language specific data is in the root. So we |
651
|
|
|
|
|
|
|
# fall back to the en module |
652
|
|
|
|
|
|
|
|
653
|
|
|
|
|
|
|
if ( ref $module eq 'Locale::CLDR::Locales::Root') { |
654
|
|
|
|
|
|
|
Class::Load::load_class('Locale::CLDR::Locales::En'); |
655
|
|
|
|
|
|
|
$module = Locale::CLDR::Locales::En->new |
656
|
|
|
|
|
|
|
} |
657
|
|
|
|
|
|
|
|
658
|
|
|
|
|
|
|
return $module; |
659
|
|
|
|
|
|
|
} |
660
|
|
|
|
|
|
|
|
661
|
|
|
|
|
|
|
class_has 'method_cache' => ( |
662
|
|
|
|
|
|
|
is => 'rw', |
663
|
|
|
|
|
|
|
isa => 'HashRef[HashRef[ArrayRef[Object]]]', |
664
|
|
|
|
|
|
|
init_arg => undef, |
665
|
|
|
|
|
|
|
default => sub { return {}}, |
666
|
|
|
|
|
|
|
); |
667
|
|
|
|
|
|
|
|
668
|
|
|
|
|
|
|
has 'break_grapheme_cluster' => ( |
669
|
|
|
|
|
|
|
is => 'ro', |
670
|
|
|
|
|
|
|
isa => 'ArrayRef', |
671
|
|
|
|
|
|
|
init_arg => undef(), |
672
|
|
|
|
|
|
|
lazy => 1, |
673
|
|
|
|
|
|
|
default => sub {shift->_build_break('GraphemeClusterBreak')}, |
674
|
|
|
|
|
|
|
); |
675
|
|
|
|
|
|
|
|
676
|
|
|
|
|
|
|
has 'break_word' => ( |
677
|
|
|
|
|
|
|
is => 'ro', |
678
|
|
|
|
|
|
|
isa => 'ArrayRef', |
679
|
|
|
|
|
|
|
init_arg => undef(), |
680
|
|
|
|
|
|
|
lazy => 1, |
681
|
|
|
|
|
|
|
default => sub {shift->_build_break('WordBreak')}, |
682
|
|
|
|
|
|
|
); |
683
|
|
|
|
|
|
|
|
684
|
|
|
|
|
|
|
has 'break_line' => ( |
685
|
|
|
|
|
|
|
is => 'ro', |
686
|
|
|
|
|
|
|
isa => 'ArrayRef', |
687
|
|
|
|
|
|
|
init_arg => undef(), |
688
|
|
|
|
|
|
|
lazy => 1, |
689
|
|
|
|
|
|
|
default => sub {shift->_build_break('LineBreak')}, |
690
|
|
|
|
|
|
|
); |
691
|
|
|
|
|
|
|
|
692
|
|
|
|
|
|
|
has 'break_sentence' => ( |
693
|
|
|
|
|
|
|
is => 'ro', |
694
|
|
|
|
|
|
|
isa => 'ArrayRef', |
695
|
|
|
|
|
|
|
init_arg => undef(), |
696
|
|
|
|
|
|
|
lazy => 1, |
697
|
|
|
|
|
|
|
default => sub {shift->_build_break('SentenceBreak')}, |
698
|
|
|
|
|
|
|
); |
699
|
|
|
|
|
|
|
|
700
|
|
|
|
|
|
|
=head2 Meta Data |
701
|
|
|
|
|
|
|
|
702
|
|
|
|
|
|
|
The following methods return, in English, the names if the various |
703
|
|
|
|
|
|
|
id's passed into the locales constructor. I.e. if you passed |
704
|
|
|
|
|
|
|
C<language =E<gt> 'fr'> to the constructor you would get back C<French> |
705
|
|
|
|
|
|
|
for the language. |
706
|
|
|
|
|
|
|
|
707
|
|
|
|
|
|
|
=over 4 |
708
|
|
|
|
|
|
|
|
709
|
|
|
|
|
|
|
=item name |
710
|
|
|
|
|
|
|
|
711
|
|
|
|
|
|
|
The locale's name. This is usually built up out of the language, |
712
|
|
|
|
|
|
|
script, territory and variant of the locale |
713
|
|
|
|
|
|
|
|
714
|
|
|
|
|
|
|
=item language |
715
|
|
|
|
|
|
|
|
716
|
|
|
|
|
|
|
The name of the locale's language |
717
|
|
|
|
|
|
|
|
718
|
|
|
|
|
|
|
=item script |
719
|
|
|
|
|
|
|
|
720
|
|
|
|
|
|
|
The name of the locale's script |
721
|
|
|
|
|
|
|
|
722
|
|
|
|
|
|
|
=item territory |
723
|
|
|
|
|
|
|
|
724
|
|
|
|
|
|
|
The name of the locale's territory |
725
|
|
|
|
|
|
|
|
726
|
|
|
|
|
|
|
=item variant |
727
|
|
|
|
|
|
|
|
728
|
|
|
|
|
|
|
The name of the locale's variant |
729
|
|
|
|
|
|
|
|
730
|
|
|
|
|
|
|
=back |
731
|
|
|
|
|
|
|
|
732
|
|
|
|
|
|
|
=head2 Native Meta Data |
733
|
|
|
|
|
|
|
|
734
|
|
|
|
|
|
|
Like Meta Data above this provides the names of the various id's |
735
|
|
|
|
|
|
|
passed into the locale's constructor. However in this case the |
736
|
|
|
|
|
|
|
names are formatted to match the locale. I.e. if you passed |
737
|
|
|
|
|
|
|
C<language =E<gt> 'fr'> to the constructor you would get back |
738
|
|
|
|
|
|
|
C<français> for the language. |
739
|
|
|
|
|
|
|
|
740
|
|
|
|
|
|
|
=over 4 |
741
|
|
|
|
|
|
|
|
742
|
|
|
|
|
|
|
=item native_name |
743
|
|
|
|
|
|
|
|
744
|
|
|
|
|
|
|
The locale's name. This is usually built up out of the language, |
745
|
|
|
|
|
|
|
script, territory and variant of the locale. Returned in the locale's |
746
|
|
|
|
|
|
|
language and script |
747
|
|
|
|
|
|
|
|
748
|
|
|
|
|
|
|
=item native_language |
749
|
|
|
|
|
|
|
|
750
|
|
|
|
|
|
|
The name of the locale's language in the locale's language and script. |
751
|
|
|
|
|
|
|
|
752
|
|
|
|
|
|
|
=item native_script |
753
|
|
|
|
|
|
|
|
754
|
|
|
|
|
|
|
The name of the locale's script in the locale's language and script. |
755
|
|
|
|
|
|
|
|
756
|
|
|
|
|
|
|
=item native_territory |
757
|
|
|
|
|
|
|
|
758
|
|
|
|
|
|
|
The name of the locale's territory in the locale's language and script. |
759
|
|
|
|
|
|
|
|
760
|
|
|
|
|
|
|
=item native_variant |
761
|
|
|
|
|
|
|
|
762
|
|
|
|
|
|
|
The name of the locale's variant in the locale's language and script. |
763
|
|
|
|
|
|
|
|
764
|
|
|
|
|
|
|
=back |
765
|
|
|
|
|
|
|
|
766
|
|
|
|
|
|
|
=cut |
767
|
|
|
|
|
|
|
|
768
|
|
|
|
|
|
|
foreach my $property (qw( name language script territory variant)) { |
769
|
|
|
|
|
|
|
has $property => ( |
770
|
|
|
|
|
|
|
is => 'ro', |
771
|
|
|
|
|
|
|
isa => 'Str', |
772
|
|
|
|
|
|
|
init_arg => undef, |
773
|
|
|
|
|
|
|
lazy => 1, |
774
|
|
|
|
|
|
|
builder => "_build_$property", |
775
|
|
|
|
|
|
|
); |
776
|
|
|
|
|
|
|
|
777
|
|
|
|
|
|
|
no strict 'refs'; |
778
|
|
|
|
|
|
|
*{"native_$property"} = sub { |
779
|
|
|
|
|
|
|
my ($self, $for) = @_; |
780
|
|
|
|
|
|
|
|
781
|
|
|
|
|
|
|
$for //= $self; |
782
|
|
|
|
|
|
|
my $build = "_build_native_$property"; |
783
|
|
|
|
|
|
|
return $self->$build($for); |
784
|
|
|
|
|
|
|
}; |
785
|
|
|
|
|
|
|
} |
786
|
|
|
|
|
|
|
|
787
|
|
|
|
|
|
|
=head2 Calenders |
788
|
|
|
|
|
|
|
|
789
|
|
|
|
|
|
|
The Calendar data is built to hook into L<DateTime::Locale> so that |
790
|
|
|
|
|
|
|
all Locale::CLDR objects can be used as replacements for DateTime::Locale's |
791
|
|
|
|
|
|
|
locale data. To use, say, the French data do |
792
|
|
|
|
|
|
|
|
793
|
|
|
|
|
|
|
my $french_locale = Locale::CLDR->new('fr_FR'); |
794
|
|
|
|
|
|
|
my $french_dt = DateTime->now(locale => $french_locale); |
795
|
|
|
|
|
|
|
say "French month : ", $french_dt->month_name; # prints out the current month in French |
796
|
|
|
|
|
|
|
|
797
|
|
|
|
|
|
|
=over 4 |
798
|
|
|
|
|
|
|
|
799
|
|
|
|
|
|
|
=item month_format_wide |
800
|
|
|
|
|
|
|
|
801
|
|
|
|
|
|
|
=item month_format_abbreviated |
802
|
|
|
|
|
|
|
|
803
|
|
|
|
|
|
|
=item month_format_narrow |
804
|
|
|
|
|
|
|
|
805
|
|
|
|
|
|
|
=item month_stand_alone_wide |
806
|
|
|
|
|
|
|
|
807
|
|
|
|
|
|
|
=item month_stand_alone_abbreviated |
808
|
|
|
|
|
|
|
|
809
|
|
|
|
|
|
|
=item month_stand_alone_narrow |
810
|
|
|
|
|
|
|
|
811
|
|
|
|
|
|
|
All the above return an arrayref of month names in the requested style. |
812
|
|
|
|
|
|
|
|
813
|
|
|
|
|
|
|
=item day_format_wide |
814
|
|
|
|
|
|
|
|
815
|
|
|
|
|
|
|
=item day_format_abbreviated |
816
|
|
|
|
|
|
|
|
817
|
|
|
|
|
|
|
=item day_format_narrow |
818
|
|
|
|
|
|
|
|
819
|
|
|
|
|
|
|
=item day_stand_alone_wide |
820
|
|
|
|
|
|
|
|
821
|
|
|
|
|
|
|
=item day_stand_alone_abbreviated |
822
|
|
|
|
|
|
|
|
823
|
|
|
|
|
|
|
=item day_stand_alone_narrow |
824
|
|
|
|
|
|
|
|
825
|
|
|
|
|
|
|
All the above return an array ref of day names in the requested style. |
826
|
|
|
|
|
|
|
|
827
|
|
|
|
|
|
|
=item quarter_format_wide |
828
|
|
|
|
|
|
|
|
829
|
|
|
|
|
|
|
=item quarter_format_abbreviated |
830
|
|
|
|
|
|
|
|
831
|
|
|
|
|
|
|
=item quarter_format_narrow |
832
|
|
|
|
|
|
|
|
833
|
|
|
|
|
|
|
=item quarter_stand_alone_wide |
834
|
|
|
|
|
|
|
|
835
|
|
|
|
|
|
|
=item quarter_stand_alone_abbreviated |
836
|
|
|
|
|
|
|
|
837
|
|
|
|
|
|
|
=item quarter_stand_alone_narrow |
838
|
|
|
|
|
|
|
|
839
|
|
|
|
|
|
|
All the above return an arrayref of quarter names in the requested style. |
840
|
|
|
|
|
|
|
|
841
|
|
|
|
|
|
|
=item am_pm_wide |
842
|
|
|
|
|
|
|
|
843
|
|
|
|
|
|
|
=item am_pm_abbreviated |
844
|
|
|
|
|
|
|
|
845
|
|
|
|
|
|
|
=item am_pm_narrow |
846
|
|
|
|
|
|
|
|
847
|
|
|
|
|
|
|
All the above return the date period name for AM and PM |
848
|
|
|
|
|
|
|
in the requested style |
849
|
|
|
|
|
|
|
|
850
|
|
|
|
|
|
|
=item era_wide |
851
|
|
|
|
|
|
|
|
852
|
|
|
|
|
|
|
=item era_abbreviated |
853
|
|
|
|
|
|
|
|
854
|
|
|
|
|
|
|
=item era_narrow |
855
|
|
|
|
|
|
|
|
856
|
|
|
|
|
|
|
All the above return an array ref of era names. Note that these |
857
|
|
|
|
|
|
|
return the first two eras which is what you normally want for |
858
|
|
|
|
|
|
|
BC and AD etc. but won't work correctly for Japanese calendars. |
859
|
|
|
|
|
|
|
|
860
|
|
|
|
|
|
|
=back |
861
|
|
|
|
|
|
|
|
862
|
|
|
|
|
|
|
=cut |
863
|
|
|
|
|
|
|
|
864
|
|
|
|
|
|
|
foreach my $property (qw( |
865
|
|
|
|
|
|
|
month_format_wide month_format_abbreviated month_format_narrow |
866
|
|
|
|
|
|
|
month_stand_alone_wide month_stand_alone_abbreviated month_stand_alone_narrow |
867
|
|
|
|
|
|
|
day_format_wide day_format_abbreviated day_format_narrow |
868
|
|
|
|
|
|
|
day_stand_alone_wide day_stand_alone_abbreviated day_stand_alone_narrow |
869
|
|
|
|
|
|
|
quarter_format_wide quarter_format_abbreviated quarter_format_narrow |
870
|
|
|
|
|
|
|
quarter_stand_alone_wide quarter_stand_alone_abbreviated quarter_stand_alone_narrow |
871
|
|
|
|
|
|
|
am_pm_wide am_pm_abbreviated am_pm_narrow |
872
|
|
|
|
|
|
|
era_wide era_abbreviated era_narrow |
873
|
|
|
|
|
|
|
era_format_wide era_format_abbreviated era_format_narrow |
874
|
|
|
|
|
|
|
era_stand_alone_wide era_stand_alone_abbreviated era_stand_alone_narrow |
875
|
|
|
|
|
|
|
)) { |
876
|
|
|
|
|
|
|
has $property => ( |
877
|
|
|
|
|
|
|
is => 'ro', |
878
|
|
|
|
|
|
|
isa => 'ArrayRef', |
879
|
|
|
|
|
|
|
init_arg => undef, |
880
|
|
|
|
|
|
|
lazy => 1, |
881
|
|
|
|
|
|
|
builder => "_build_$property", |
882
|
|
|
|
|
|
|
clearer => "_clear_$property", |
883
|
|
|
|
|
|
|
); |
884
|
|
|
|
|
|
|
} |
885
|
|
|
|
|
|
|
|
886
|
|
|
|
|
|
|
=pod |
887
|
|
|
|
|
|
|
|
888
|
|
|
|
|
|
|
The next set of methods are not used by DateTime::Locale but CLDR provide |
889
|
|
|
|
|
|
|
the data and you might want it |
890
|
|
|
|
|
|
|
|
891
|
|
|
|
|
|
|
=over 4 |
892
|
|
|
|
|
|
|
|
893
|
|
|
|
|
|
|
=item am_pm_format_wide |
894
|
|
|
|
|
|
|
|
895
|
|
|
|
|
|
|
=item am_pm_format_abbreviated |
896
|
|
|
|
|
|
|
|
897
|
|
|
|
|
|
|
=item am_pm_format_narrow |
898
|
|
|
|
|
|
|
|
899
|
|
|
|
|
|
|
=item am_pm_stand_alone_wide |
900
|
|
|
|
|
|
|
|
901
|
|
|
|
|
|
|
=item am_pm_stand_alone_abbreviated |
902
|
|
|
|
|
|
|
|
903
|
|
|
|
|
|
|
=item am_pm_stand_alone_narrow |
904
|
|
|
|
|
|
|
|
905
|
|
|
|
|
|
|
All the above return a hashref keyed on date period |
906
|
|
|
|
|
|
|
with the value being the value for that date period |
907
|
|
|
|
|
|
|
|
908
|
|
|
|
|
|
|
=item era_format_wide |
909
|
|
|
|
|
|
|
|
910
|
|
|
|
|
|
|
=item era_format_abbreviated |
911
|
|
|
|
|
|
|
|
912
|
|
|
|
|
|
|
=item era_format_narrow |
913
|
|
|
|
|
|
|
|
914
|
|
|
|
|
|
|
=item era_stand_alone_wide |
915
|
|
|
|
|
|
|
|
916
|
|
|
|
|
|
|
=item era_stand_alone_abbreviated |
917
|
|
|
|
|
|
|
|
918
|
|
|
|
|
|
|
=item era_stand_alone_narrow |
919
|
|
|
|
|
|
|
|
920
|
|
|
|
|
|
|
All the above return an array ref with I<all> the era data for the |
921
|
|
|
|
|
|
|
locale formatted to the requested width |
922
|
|
|
|
|
|
|
|
923
|
|
|
|
|
|
|
=cut |
924
|
|
|
|
|
|
|
|
925
|
|
|
|
|
|
|
foreach my $property (qw( |
926
|
|
|
|
|
|
|
am_pm_format_wide am_pm_format_abbreviated am_pm_format_narrow |
927
|
|
|
|
|
|
|
am_pm_stand_alone_wide am_pm_stand_alone_abbreviated am_pm_stand_alone_narrow |
928
|
|
|
|
|
|
|
)) { |
929
|
|
|
|
|
|
|
has $property => ( |
930
|
|
|
|
|
|
|
is => 'ro', |
931
|
|
|
|
|
|
|
isa => 'HashRef', |
932
|
|
|
|
|
|
|
init_arg => undef, |
933
|
|
|
|
|
|
|
lazy => 1, |
934
|
|
|
|
|
|
|
builder => "_build_$property", |
935
|
|
|
|
|
|
|
clearer => "_clear_$property", |
936
|
|
|
|
|
|
|
); |
937
|
|
|
|
|
|
|
} |
938
|
|
|
|
|
|
|
|
939
|
|
|
|
|
|
|
=item date_format_full |
940
|
|
|
|
|
|
|
|
941
|
|
|
|
|
|
|
=item date_format_long |
942
|
|
|
|
|
|
|
|
943
|
|
|
|
|
|
|
=item date_format_medium |
944
|
|
|
|
|
|
|
|
945
|
|
|
|
|
|
|
=item date_format_short |
946
|
|
|
|
|
|
|
|
947
|
|
|
|
|
|
|
=item time_format_full |
948
|
|
|
|
|
|
|
|
949
|
|
|
|
|
|
|
=item time_format_long |
950
|
|
|
|
|
|
|
|
951
|
|
|
|
|
|
|
=item time_format_medium |
952
|
|
|
|
|
|
|
|
953
|
|
|
|
|
|
|
=item time_format_short |
954
|
|
|
|
|
|
|
|
955
|
|
|
|
|
|
|
=item datetime_format_full |
956
|
|
|
|
|
|
|
|
957
|
|
|
|
|
|
|
=item datetime_format_long |
958
|
|
|
|
|
|
|
|
959
|
|
|
|
|
|
|
=item datetime_format_medium |
960
|
|
|
|
|
|
|
|
961
|
|
|
|
|
|
|
=item datetime_format_short |
962
|
|
|
|
|
|
|
|
963
|
|
|
|
|
|
|
All the above return the CLDR I<date format pattern> for the given |
964
|
|
|
|
|
|
|
element and width |
965
|
|
|
|
|
|
|
|
966
|
|
|
|
|
|
|
=cut |
967
|
|
|
|
|
|
|
|
968
|
|
|
|
|
|
|
foreach my $property (qw( |
969
|
|
|
|
|
|
|
id |
970
|
|
|
|
|
|
|
date_format_full date_format_long |
971
|
|
|
|
|
|
|
date_format_medium date_format_short |
972
|
|
|
|
|
|
|
time_format_full time_format_long |
973
|
|
|
|
|
|
|
time_format_medium time_format_short |
974
|
|
|
|
|
|
|
datetime_format_full datetime_format_long |
975
|
|
|
|
|
|
|
datetime_format_medium datetime_format_short |
976
|
|
|
|
|
|
|
)) { |
977
|
|
|
|
|
|
|
has $property => ( |
978
|
|
|
|
|
|
|
is => 'ro', |
979
|
|
|
|
|
|
|
isa => 'Str', |
980
|
|
|
|
|
|
|
init_arg => undef, |
981
|
|
|
|
|
|
|
lazy => 1, |
982
|
|
|
|
|
|
|
builder => "_build_$property", |
983
|
|
|
|
|
|
|
clearer => "_clear_$property", |
984
|
|
|
|
|
|
|
); |
985
|
|
|
|
|
|
|
} |
986
|
|
|
|
|
|
|
|
987
|
|
|
|
|
|
|
has '_available_formats' => ( |
988
|
|
|
|
|
|
|
traits => ['Array'], |
989
|
|
|
|
|
|
|
is => 'ro', |
990
|
|
|
|
|
|
|
isa => 'ArrayRef', |
991
|
|
|
|
|
|
|
init_arg => undef, |
992
|
|
|
|
|
|
|
lazy => 1, |
993
|
|
|
|
|
|
|
builder => "_build_available_formats", |
994
|
|
|
|
|
|
|
clearer => "_clear_available_formats", |
995
|
|
|
|
|
|
|
handles => { |
996
|
|
|
|
|
|
|
available_formats => 'elements', |
997
|
|
|
|
|
|
|
}, |
998
|
|
|
|
|
|
|
); |
999
|
|
|
|
|
|
|
|
1000
|
|
|
|
|
|
|
has 'format_data' => ( |
1001
|
|
|
|
|
|
|
is => 'ro', |
1002
|
|
|
|
|
|
|
isa => 'HashRef', |
1003
|
|
|
|
|
|
|
init_arg => undef, |
1004
|
|
|
|
|
|
|
lazy => 1, |
1005
|
|
|
|
|
|
|
builder => "_build_format_data", |
1006
|
|
|
|
|
|
|
clearer => "_clear_format_data", |
1007
|
|
|
|
|
|
|
); |
1008
|
|
|
|
|
|
|
|
1009
|
|
|
|
|
|
|
# default_calendar |
1010
|
|
|
|
|
|
|
foreach my $property (qw( |
1011
|
|
|
|
|
|
|
default_date_format_length default_time_format_length |
1012
|
|
|
|
|
|
|
)) { |
1013
|
|
|
|
|
|
|
has $property => ( |
1014
|
|
|
|
|
|
|
is => 'ro', |
1015
|
|
|
|
|
|
|
isa => 'Str', |
1016
|
|
|
|
|
|
|
init_arg => undef, |
1017
|
|
|
|
|
|
|
lazy => 1, |
1018
|
|
|
|
|
|
|
builder => "_build_$property", |
1019
|
|
|
|
|
|
|
writer => "set_$property" |
1020
|
|
|
|
|
|
|
); |
1021
|
|
|
|
|
|
|
} |
1022
|
|
|
|
|
|
|
|
1023
|
|
|
|
|
|
|
=item prefers_24_hour_time() |
1024
|
|
|
|
|
|
|
|
1025
|
|
|
|
|
|
|
Returns a boolean value, true if the locale has a preference |
1026
|
|
|
|
|
|
|
for 24 hour time over 12 hour |
1027
|
|
|
|
|
|
|
|
1028
|
|
|
|
|
|
|
=cut |
1029
|
|
|
|
|
|
|
|
1030
|
|
|
|
|
|
|
has 'prefers_24_hour_time' => ( |
1031
|
|
|
|
|
|
|
is => 'ro', |
1032
|
|
|
|
|
|
|
isa => 'Bool', |
1033
|
|
|
|
|
|
|
init_arg => undef, |
1034
|
|
|
|
|
|
|
lazy => 1, |
1035
|
|
|
|
|
|
|
builder => "_build_prefers_24_hour_time", |
1036
|
|
|
|
|
|
|
); |
1037
|
|
|
|
|
|
|
|
1038
|
|
|
|
|
|
|
=item first_day_of_week() |
1039
|
|
|
|
|
|
|
|
1040
|
|
|
|
|
|
|
Returns the numeric representation of the first day of the week |
1041
|
|
|
|
|
|
|
With 0 = Saturday |
1042
|
|
|
|
|
|
|
|
1043
|
|
|
|
|
|
|
=item get_day_period($time) |
1044
|
|
|
|
|
|
|
|
1045
|
|
|
|
|
|
|
This method will calculate the correct |
1046
|
|
|
|
|
|
|
period for a given time and return the period name in |
1047
|
|
|
|
|
|
|
the locale's language and script |
1048
|
|
|
|
|
|
|
|
1049
|
|
|
|
|
|
|
=item format_for($date_time_format) |
1050
|
|
|
|
|
|
|
|
1051
|
|
|
|
|
|
|
This method takes a CLDR date time format and returns |
1052
|
|
|
|
|
|
|
the localised version of the format. |
1053
|
|
|
|
|
|
|
|
1054
|
|
|
|
|
|
|
=cut |
1055
|
|
|
|
|
|
|
|
1056
|
|
|
|
|
|
|
has 'first_day_of_week' => ( |
1057
|
|
|
|
|
|
|
is => 'ro', |
1058
|
|
|
|
|
|
|
isa => 'Int', |
1059
|
|
|
|
|
|
|
init_arg => undef, |
1060
|
|
|
|
|
|
|
lazy => 1, |
1061
|
|
|
|
|
|
|
builder => "_build_first_day_of_week", |
1062
|
|
|
|
|
|
|
); |
1063
|
|
|
|
|
|
|
|
1064
|
|
|
|
|
|
|
has 'likely_subtag' => ( |
1065
|
|
|
|
|
|
|
is => 'ro', |
1066
|
|
|
|
|
|
|
isa => __PACKAGE__, |
1067
|
|
|
|
|
|
|
init_arg => undef, |
1068
|
|
|
|
|
|
|
writer => '_set_likely_subtag', |
1069
|
|
|
|
|
|
|
predicate => 'has_likely_subtag', |
1070
|
|
|
|
|
|
|
); |
1071
|
|
|
|
|
|
|
|
1072
|
|
|
|
|
|
|
sub _build_break { |
1073
|
|
|
|
|
|
|
my ($self, $what) = @_; |
1074
|
|
|
|
|
|
|
|
1075
|
|
|
|
|
|
|
my $vars = $self->_build_break_vars($what); |
1076
|
|
|
|
|
|
|
my $rules = $self->_build_break_rules($vars, $what); |
1077
|
|
|
|
|
|
|
return $rules; |
1078
|
|
|
|
|
|
|
} |
1079
|
|
|
|
|
|
|
|
1080
|
|
|
|
|
|
|
sub _build_break_vars { |
1081
|
|
|
|
|
|
|
my ($self, $what) = @_; |
1082
|
|
|
|
|
|
|
|
1083
|
|
|
|
|
|
|
my $name = "${what}_variables"; |
1084
|
|
|
|
|
|
|
my @bundles = $self->_find_bundle($name); |
1085
|
|
|
|
|
|
|
my @vars; |
1086
|
|
|
|
|
|
|
foreach my $bundle (reverse @bundles) { |
1087
|
|
|
|
|
|
|
push @vars, @{$bundle->$name}; |
1088
|
|
|
|
|
|
|
} |
1089
|
|
|
|
|
|
|
|
1090
|
|
|
|
|
|
|
my %vars = (); |
1091
|
|
|
|
|
|
|
while (my ($name, $value) = (shift @vars, shift @vars)) { |
1092
|
|
|
|
|
|
|
last unless defined $name; |
1093
|
|
|
|
|
|
|
if (! defined $value) { |
1094
|
|
|
|
|
|
|
delete $vars{$name}; |
1095
|
|
|
|
|
|
|
next; |
1096
|
|
|
|
|
|
|
} |
1097
|
|
|
|
|
|
|
|
1098
|
|
|
|
|
|
|
$value =~ s{ ( \$ \p{ID_START} \p{ID_CONTINUE}* ) }{$vars{$1}}msxeg; |
1099
|
|
|
|
|
|
|
$vars{$name} = $value; |
1100
|
|
|
|
|
|
|
} |
1101
|
|
|
|
|
|
|
|
1102
|
|
|
|
|
|
|
return \%vars; |
1103
|
|
|
|
|
|
|
} |
1104
|
|
|
|
|
|
|
|
1105
|
|
|
|
|
|
|
sub _build_break_rules { |
1106
|
|
|
|
|
|
|
my ($self, $vars, $what) = @_; |
1107
|
|
|
|
|
|
|
|
1108
|
|
|
|
|
|
|
my $name = "${what}_rules"; |
1109
|
|
|
|
|
|
|
my @bundles = $self->_find_bundle($name); |
1110
|
|
|
|
|
|
|
|
1111
|
|
|
|
|
|
|
my %rules; |
1112
|
|
|
|
|
|
|
foreach my $bundle (reverse @bundles) { |
1113
|
|
|
|
|
|
|
%rules = (%rules, %{$bundle->$name}); |
1114
|
|
|
|
|
|
|
} |
1115
|
|
|
|
|
|
|
|
1116
|
|
|
|
|
|
|
my @rules; |
1117
|
|
|
|
|
|
|
foreach my $rule_number ( sort { $a <=> $b } keys %rules ) { |
1118
|
|
|
|
|
|
|
# Test for deleted rules |
1119
|
|
|
|
|
|
|
next unless defined $rules{$rule_number}; |
1120
|
|
|
|
|
|
|
|
1121
|
|
|
|
|
|
|
$rules{$rule_number} =~ s{ ( \$ \p{ID_START} \p{ID_CONTINUE}* ) }{$vars->{$1}}msxeg; |
1122
|
|
|
|
|
|
|
my ($first, $opp, $second) = split /(Ã|÷)/, $rules{$rule_number}; |
1123
|
|
|
|
|
|
|
|
1124
|
|
|
|
|
|
|
foreach my $operand ($first, $second) { |
1125
|
|
|
|
|
|
|
if ($operand =~ m{ \S }msx) { |
1126
|
|
|
|
|
|
|
$operand = _unicode_to_perl($operand); |
1127
|
|
|
|
|
|
|
} |
1128
|
|
|
|
|
|
|
else { |
1129
|
|
|
|
|
|
|
$operand = '.'; |
1130
|
|
|
|
|
|
|
} |
1131
|
|
|
|
|
|
|
} |
1132
|
|
|
|
|
|
|
|
1133
|
|
|
|
|
|
|
no warnings 'deprecated'; |
1134
|
|
|
|
|
|
|
push @rules, [qr{$first}msx, qr{$second}msx, ($opp eq 'Ã' ? 1 : 0)]; |
1135
|
|
|
|
|
|
|
} |
1136
|
|
|
|
|
|
|
|
1137
|
|
|
|
|
|
|
push @rules, [ '.', '.', 0 ]; |
1138
|
|
|
|
|
|
|
|
1139
|
|
|
|
|
|
|
return \@rules; |
1140
|
|
|
|
|
|
|
} |
1141
|
|
|
|
|
|
|
|
1142
|
|
|
|
|
|
|
sub BUILDARGS { |
1143
|
|
|
|
|
|
|
my $self = shift; |
1144
|
|
|
|
|
|
|
my %args; |
1145
|
|
|
|
|
|
|
|
1146
|
|
|
|
|
|
|
# Used for arguments when we call new from our own code |
1147
|
|
|
|
|
|
|
my %internal_args = (); |
1148
|
|
|
|
|
|
|
if (@_ > 1 && ref $_[-1] eq 'HASH') { |
1149
|
|
|
|
|
|
|
%internal_args = %{pop @_}; |
1150
|
|
|
|
|
|
|
} |
1151
|
|
|
|
|
|
|
|
1152
|
|
|
|
|
|
|
if (1 == @_ && ! ref $_[0]) { |
1153
|
|
|
|
|
|
|
my ($language, $script, $territory, $variant, $extensions) |
1154
|
|
|
|
|
|
|
= $_[0]=~/^ |
1155
|
|
|
|
|
|
|
([a-zA-Z]+) |
1156
|
|
|
|
|
|
|
(?:[-_]([a-zA-Z]{4}))? |
1157
|
|
|
|
|
|
|
(?:[-_]([a-zA-Z]{2,3}))? |
1158
|
|
|
|
|
|
|
(?:[-_]([a-zA-Z0-9]+))? |
1159
|
|
|
|
|
|
|
(?:[-_]u[_-](.+))? |
1160
|
|
|
|
|
|
|
$/x; |
1161
|
|
|
|
|
|
|
|
1162
|
|
|
|
|
|
|
foreach ($language, $script, $territory, $variant) { |
1163
|
|
|
|
|
|
|
$_ = '' unless defined $_; |
1164
|
|
|
|
|
|
|
} |
1165
|
|
|
|
|
|
|
|
1166
|
|
|
|
|
|
|
%args = ( |
1167
|
|
|
|
|
|
|
language_id => $language, |
1168
|
|
|
|
|
|
|
script_id => $script, |
1169
|
|
|
|
|
|
|
territory_id => $territory, |
1170
|
|
|
|
|
|
|
variant_id => $variant, |
1171
|
|
|
|
|
|
|
extensions => $extensions, |
1172
|
|
|
|
|
|
|
); |
1173
|
|
|
|
|
|
|
} |
1174
|
|
|
|
|
|
|
|
1175
|
|
|
|
|
|
|
if (! keys %args ) { |
1176
|
|
|
|
|
|
|
%args = ref $_[0] |
1177
|
|
|
|
|
|
|
? %{$_[0]} |
1178
|
|
|
|
|
|
|
: @_ |
1179
|
|
|
|
|
|
|
} |
1180
|
|
|
|
|
|
|
|
1181
|
|
|
|
|
|
|
# Split up the extensions |
1182
|
|
|
|
|
|
|
if ( defined $args{extensions} && ! ref $args{extensions} ) { |
1183
|
|
|
|
|
|
|
$args{extensions} = { |
1184
|
|
|
|
|
|
|
map {lc} |
1185
|
|
|
|
|
|
|
split /[_-]/, $args{extensions} |
1186
|
|
|
|
|
|
|
}; |
1187
|
|
|
|
|
|
|
} |
1188
|
|
|
|
|
|
|
|
1189
|
|
|
|
|
|
|
# Fix casing of args |
1190
|
|
|
|
|
|
|
$args{language_id} = lc $args{language_id} if defined $args{language_id}; |
1191
|
|
|
|
|
|
|
$args{script_id} = ucfirst lc $args{script_id} if defined $args{script_id}; |
1192
|
|
|
|
|
|
|
$args{territory_id} = uc $args{territory_id} if defined $args{territory_id}; |
1193
|
|
|
|
|
|
|
$args{variant_id} = uc $args{variant_id} if defined $args{variant_id}; |
1194
|
|
|
|
|
|
|
|
1195
|
|
|
|
|
|
|
# Set up undefined language |
1196
|
|
|
|
|
|
|
$args{language_id} //= 'und'; |
1197
|
|
|
|
|
|
|
|
1198
|
|
|
|
|
|
|
$self->SUPER::BUILDARGS(%args, %internal_args); |
1199
|
|
|
|
|
|
|
} |
1200
|
|
|
|
|
|
|
|
1201
|
|
|
|
|
|
|
sub BUILD { |
1202
|
|
|
|
|
|
|
my ($self, $args) = @_; |
1203
|
|
|
|
|
|
|
|
1204
|
|
|
|
|
|
|
# Check that the args are valid |
1205
|
|
|
|
|
|
|
# also check for aliases |
1206
|
|
|
|
|
|
|
$args->{language_id} = $self->language_aliases->{$args->{language_id}} |
1207
|
|
|
|
|
|
|
// $args->{language_id}; |
1208
|
|
|
|
|
|
|
|
1209
|
|
|
|
|
|
|
die "Invalid language" if $args->{language_id} |
1210
|
|
|
|
|
|
|
&& ! first { $args->{language_id} eq $_ } $self->valid_languages; |
1211
|
|
|
|
|
|
|
|
1212
|
|
|
|
|
|
|
die "Invalid script" if $args->{script_id} |
1213
|
|
|
|
|
|
|
&& ! first { ucfirst lc $args->{script_id} eq $_ } $self->valid_scripts; |
1214
|
|
|
|
|
|
|
|
1215
|
|
|
|
|
|
|
die "Invalid territory" if $args->{territory_id} |
1216
|
|
|
|
|
|
|
&& ( ! ( first { uc $args->{territory_id} eq $_ } $self->valid_territories ) |
1217
|
|
|
|
|
|
|
&& ( ! $self->territory_aliases->{$self->{territory_id}} ) |
1218
|
|
|
|
|
|
|
); |
1219
|
|
|
|
|
|
|
|
1220
|
|
|
|
|
|
|
die "Invalid variant" if $args->{variant_id} |
1221
|
|
|
|
|
|
|
&& ( ! ( first { uc $args->{variant_id} eq $_ } $self->valid_variants ) |
1222
|
|
|
|
|
|
|
&& ( ! $self->variant_aliases->{lc $self->{variant_id}} ) |
1223
|
|
|
|
|
|
|
); |
1224
|
|
|
|
|
|
|
|
1225
|
|
|
|
|
|
|
if ($args->{extensions}) { |
1226
|
|
|
|
|
|
|
my %valid_keys = $self->valid_keys; |
1227
|
|
|
|
|
|
|
my %key_aliases = $self->key_names; |
1228
|
|
|
|
|
|
|
my @keys = keys %{$args->{extensions}}; |
1229
|
|
|
|
|
|
|
|
1230
|
|
|
|
|
|
|
foreach my $key ( @keys ) { |
1231
|
|
|
|
|
|
|
my $canonical_key = $key_aliases{$key} if exists $key_aliases{$key}; |
1232
|
|
|
|
|
|
|
$canonical_key //= $key; |
1233
|
|
|
|
|
|
|
if ($canonical_key ne $key) { |
1234
|
|
|
|
|
|
|
$args->{extensions}{$canonical_key} = delete $args->{extensions}{$key}; |
1235
|
|
|
|
|
|
|
} |
1236
|
|
|
|
|
|
|
|
1237
|
|
|
|
|
|
|
$key = $canonical_key; |
1238
|
|
|
|
|
|
|
die "Invalid extension name" unless exists $valid_keys{$key}; |
1239
|
|
|
|
|
|
|
die "Invalid extension value" unless |
1240
|
|
|
|
|
|
|
first { $_ eq $args->{extensions}{$key} } @{$valid_keys{$key}}; |
1241
|
|
|
|
|
|
|
|
1242
|
|
|
|
|
|
|
$self->_set_extensions($args->{extensions}) |
1243
|
|
|
|
|
|
|
} |
1244
|
|
|
|
|
|
|
} |
1245
|
|
|
|
|
|
|
|
1246
|
|
|
|
|
|
|
# Check for variant aliases |
1247
|
|
|
|
|
|
|
if ($args->{variant_id} && (my $variant_alias = $self->variant_aliases->{lc $self->variant_id})) { |
1248
|
|
|
|
|
|
|
delete $args->{variant_id}; |
1249
|
|
|
|
|
|
|
my ($what) = keys %{$variant_alias}; |
1250
|
|
|
|
|
|
|
my ($value) = values %{$variant_alias}; |
1251
|
|
|
|
|
|
|
$args->{$what} = $value; |
1252
|
|
|
|
|
|
|
} |
1253
|
|
|
|
|
|
|
|
1254
|
|
|
|
|
|
|
# Now set up the module |
1255
|
|
|
|
|
|
|
$self->_build_module; |
1256
|
|
|
|
|
|
|
} |
1257
|
|
|
|
|
|
|
|
1258
|
|
|
|
|
|
|
after 'BUILD' => sub { |
1259
|
|
|
|
|
|
|
|
1260
|
|
|
|
|
|
|
my $self = shift; |
1261
|
|
|
|
|
|
|
|
1262
|
|
|
|
|
|
|
# Fix up likely sub tags |
1263
|
|
|
|
|
|
|
|
1264
|
|
|
|
|
|
|
my $likely_subtags = $self->likely_subtags; |
1265
|
|
|
|
|
|
|
my $likely_subtag; |
1266
|
|
|
|
|
|
|
my ($language_id, $script_id, $territory_id) = ($self->language_id, $self->script_id, $self->territory_id); |
1267
|
|
|
|
|
|
|
|
1268
|
|
|
|
|
|
|
unless ($language_id ne 'und' && $script_id && $territory_id ) { |
1269
|
|
|
|
|
|
|
$likely_subtag = $likely_subtags->{join '_', grep { length() } ($language_id, $script_id, $territory_id)}; |
1270
|
|
|
|
|
|
|
|
1271
|
|
|
|
|
|
|
if (! $likely_subtag ) { |
1272
|
|
|
|
|
|
|
$likely_subtag = $likely_subtags->{join '_', $language_id, $territory_id}; |
1273
|
|
|
|
|
|
|
} |
1274
|
|
|
|
|
|
|
|
1275
|
|
|
|
|
|
|
if (! $likely_subtag ) { |
1276
|
|
|
|
|
|
|
$likely_subtag = $likely_subtags->{join '_', $language_id, $script_id}; |
1277
|
|
|
|
|
|
|
} |
1278
|
|
|
|
|
|
|
|
1279
|
|
|
|
|
|
|
if (! $likely_subtag ) { |
1280
|
|
|
|
|
|
|
$likely_subtag = $likely_subtags->{$language_id}; |
1281
|
|
|
|
|
|
|
} |
1282
|
|
|
|
|
|
|
|
1283
|
|
|
|
|
|
|
if (! $likely_subtag ) { |
1284
|
|
|
|
|
|
|
$likely_subtag = $likely_subtags->{join '_', 'und', $script_id}; |
1285
|
|
|
|
|
|
|
} |
1286
|
|
|
|
|
|
|
} |
1287
|
|
|
|
|
|
|
|
1288
|
|
|
|
|
|
|
my ($likely_language_id, $likely_script_id, $likely_territory_id); |
1289
|
|
|
|
|
|
|
if ($likely_subtag) { |
1290
|
|
|
|
|
|
|
($likely_language_id, $likely_script_id, $likely_territory_id) = split /_/, $likely_subtag; |
1291
|
|
|
|
|
|
|
$likely_language_id = $language_id unless $language_id eq 'und'; |
1292
|
|
|
|
|
|
|
$likely_script_id = $script_id if length $script_id; |
1293
|
|
|
|
|
|
|
$likely_territory_id = $territory_id if length $territory_id; |
1294
|
|
|
|
|
|
|
$self->_set_likely_subtag(__PACKAGE__->new(join '_',$likely_language_id, $likely_script_id, $likely_territory_id)); |
1295
|
|
|
|
|
|
|
} |
1296
|
|
|
|
|
|
|
|
1297
|
|
|
|
|
|
|
# Fix up extension overrides |
1298
|
|
|
|
|
|
|
my $extensions = $self->extensions; |
1299
|
|
|
|
|
|
|
if (exists $extensions->{ca}) { |
1300
|
|
|
|
|
|
|
$self->_set_default_ca(($territory_id // $likely_territory_id) => $extensions->{ca}); |
1301
|
|
|
|
|
|
|
} |
1302
|
|
|
|
|
|
|
|
1303
|
|
|
|
|
|
|
if (exists $extensions->{nu}) { |
1304
|
|
|
|
|
|
|
$self->_clear_default_nu; |
1305
|
|
|
|
|
|
|
$self->_set_default_nu($extensions->{nu}); |
1306
|
|
|
|
|
|
|
} |
1307
|
|
|
|
|
|
|
}; |
1308
|
|
|
|
|
|
|
|
1309
|
|
|
|
|
|
|
use overload |
1310
|
|
|
|
|
|
|
'bool' => sub { 1 }, |
1311
|
|
|
|
|
|
|
'""' => sub {shift->id}; |
1312
|
|
|
|
|
|
|
|
1313
|
|
|
|
|
|
|
sub _build_id { |
1314
|
|
|
|
|
|
|
my $self = shift; |
1315
|
|
|
|
|
|
|
my $string = lc $self->language_id; |
1316
|
|
|
|
|
|
|
|
1317
|
|
|
|
|
|
|
if ($self->script_id) { |
1318
|
|
|
|
|
|
|
$string.= '_' . ucfirst lc $self->script_id; |
1319
|
|
|
|
|
|
|
} |
1320
|
|
|
|
|
|
|
|
1321
|
|
|
|
|
|
|
if ($self->territory_id) { |
1322
|
|
|
|
|
|
|
$string.= '_' . uc $self->territory_id; |
1323
|
|
|
|
|
|
|
} |
1324
|
|
|
|
|
|
|
|
1325
|
|
|
|
|
|
|
if ($self->variant_id) { |
1326
|
|
|
|
|
|
|
$string.= '_' . uc $self->variant_id; |
1327
|
|
|
|
|
|
|
} |
1328
|
|
|
|
|
|
|
|
1329
|
|
|
|
|
|
|
if (defined $self->extensions) { |
1330
|
|
|
|
|
|
|
$string.= '_u'; |
1331
|
|
|
|
|
|
|
foreach my $key (sort keys %{$self->extensions}) { |
1332
|
|
|
|
|
|
|
my $value = $self->extensions->{$key}; |
1333
|
|
|
|
|
|
|
$string .= "_${key}_$value"; |
1334
|
|
|
|
|
|
|
} |
1335
|
|
|
|
|
|
|
$string =~ s/_u$//; |
1336
|
|
|
|
|
|
|
} |
1337
|
|
|
|
|
|
|
|
1338
|
|
|
|
|
|
|
return $string; |
1339
|
|
|
|
|
|
|
} |
1340
|
|
|
|
|
|
|
|
1341
|
|
|
|
|
|
|
sub _get_english { |
1342
|
|
|
|
|
|
|
my $self = shift; |
1343
|
|
|
|
|
|
|
my $english; |
1344
|
|
|
|
|
|
|
if ($self->language_id eq 'en') { |
1345
|
|
|
|
|
|
|
$english = $self; |
1346
|
|
|
|
|
|
|
} |
1347
|
|
|
|
|
|
|
else { |
1348
|
|
|
|
|
|
|
$english = Locale::CLDR->new('en_Latn_US'); |
1349
|
|
|
|
|
|
|
} |
1350
|
|
|
|
|
|
|
|
1351
|
|
|
|
|
|
|
return $english; |
1352
|
|
|
|
|
|
|
} |
1353
|
|
|
|
|
|
|
|
1354
|
|
|
|
|
|
|
sub _build_name { |
1355
|
|
|
|
|
|
|
my $self = shift; |
1356
|
|
|
|
|
|
|
|
1357
|
|
|
|
|
|
|
return $self->_get_english->native_name($self); |
1358
|
|
|
|
|
|
|
} |
1359
|
|
|
|
|
|
|
|
1360
|
|
|
|
|
|
|
sub _build_native_name { |
1361
|
|
|
|
|
|
|
my ($self, $for) = @_; |
1362
|
|
|
|
|
|
|
|
1363
|
|
|
|
|
|
|
return $self->locale_name($for); |
1364
|
|
|
|
|
|
|
} |
1365
|
|
|
|
|
|
|
|
1366
|
|
|
|
|
|
|
sub _build_language { |
1367
|
|
|
|
|
|
|
my $self = shift; |
1368
|
|
|
|
|
|
|
|
1369
|
|
|
|
|
|
|
return $self->_get_english->native_language($self); |
1370
|
|
|
|
|
|
|
} |
1371
|
|
|
|
|
|
|
|
1372
|
|
|
|
|
|
|
sub _build_native_language { |
1373
|
|
|
|
|
|
|
my ($self, $for) = @_; |
1374
|
|
|
|
|
|
|
|
1375
|
|
|
|
|
|
|
return $self->language_name($for) // ''; |
1376
|
|
|
|
|
|
|
} |
1377
|
|
|
|
|
|
|
|
1378
|
|
|
|
|
|
|
sub _build_script { |
1379
|
|
|
|
|
|
|
my $self = shift; |
1380
|
|
|
|
|
|
|
|
1381
|
|
|
|
|
|
|
return $self->_get_english->native_script($self); |
1382
|
|
|
|
|
|
|
} |
1383
|
|
|
|
|
|
|
|
1384
|
|
|
|
|
|
|
sub _build_native_script { |
1385
|
|
|
|
|
|
|
my ($self, $for) = @_; |
1386
|
|
|
|
|
|
|
|
1387
|
|
|
|
|
|
|
return $self->script_name($for); |
1388
|
|
|
|
|
|
|
} |
1389
|
|
|
|
|
|
|
|
1390
|
|
|
|
|
|
|
sub _build_territory { |
1391
|
|
|
|
|
|
|
my $self = shift; |
1392
|
|
|
|
|
|
|
|
1393
|
|
|
|
|
|
|
return $self->_get_english->native_territory($self); |
1394
|
|
|
|
|
|
|
} |
1395
|
|
|
|
|
|
|
|
1396
|
|
|
|
|
|
|
sub _build_native_territory { |
1397
|
|
|
|
|
|
|
my ($self, $for) = @_; |
1398
|
|
|
|
|
|
|
|
1399
|
|
|
|
|
|
|
return $self->territory_name($for); |
1400
|
|
|
|
|
|
|
} |
1401
|
|
|
|
|
|
|
|
1402
|
|
|
|
|
|
|
sub _build_variant { |
1403
|
|
|
|
|
|
|
my $self = shift; |
1404
|
|
|
|
|
|
|
|
1405
|
|
|
|
|
|
|
return $self->_get_english->native_variant($self); |
1406
|
|
|
|
|
|
|
} |
1407
|
|
|
|
|
|
|
|
1408
|
|
|
|
|
|
|
sub _build_native_variant { |
1409
|
|
|
|
|
|
|
my ($self, $for) = @_; |
1410
|
|
|
|
|
|
|
|
1411
|
|
|
|
|
|
|
return $self->variant_name($for); |
1412
|
|
|
|
|
|
|
} |
1413
|
|
|
|
|
|
|
|
1414
|
|
|
|
|
|
|
# Method to locate the resource bundle with the required data |
1415
|
|
|
|
|
|
|
sub _find_bundle { |
1416
|
|
|
|
|
|
|
my ($self, $method_name) = @_; |
1417
|
|
|
|
|
|
|
my $id = $self->has_likely_subtag() |
1418
|
|
|
|
|
|
|
? $self->likely_subtag()->id() |
1419
|
|
|
|
|
|
|
: $self->id(); |
1420
|
|
|
|
|
|
|
|
1421
|
|
|
|
|
|
|
|
1422
|
|
|
|
|
|
|
if ($self->method_cache->{$id}{$method_name}) { |
1423
|
|
|
|
|
|
|
return wantarray |
1424
|
|
|
|
|
|
|
? @{$self->method_cache->{$id}{$method_name}} |
1425
|
|
|
|
|
|
|
: $self->method_cache->{$id}{$method_name}[0]; |
1426
|
|
|
|
|
|
|
} |
1427
|
|
|
|
|
|
|
|
1428
|
|
|
|
|
|
|
foreach my $module ($self->module->meta->linearized_isa) { |
1429
|
|
|
|
|
|
|
last if $module eq 'Moose::Object'; |
1430
|
|
|
|
|
|
|
if ($module->meta->has_method($method_name)) { |
1431
|
|
|
|
|
|
|
push @{$self->method_cache->{$id}{$method_name}}, $module->new; |
1432
|
|
|
|
|
|
|
} |
1433
|
|
|
|
|
|
|
} |
1434
|
|
|
|
|
|
|
|
1435
|
|
|
|
|
|
|
return unless $self->method_cache->{$id}{$method_name}; |
1436
|
|
|
|
|
|
|
return wantarray |
1437
|
|
|
|
|
|
|
? @{$self->method_cache->{$id}{$method_name}} |
1438
|
|
|
|
|
|
|
: $self->method_cache->{$id}{$method_name}[0]; |
1439
|
|
|
|
|
|
|
} |
1440
|
|
|
|
|
|
|
|
1441
|
|
|
|
|
|
|
=back |
1442
|
|
|
|
|
|
|
|
1443
|
|
|
|
|
|
|
=head2 Names |
1444
|
|
|
|
|
|
|
|
1445
|
|
|
|
|
|
|
These methods allow you to pass in a locale, either by C<id> or as a |
1446
|
|
|
|
|
|
|
Locale::CLDR object and return an name formatted in the locale of $self. |
1447
|
|
|
|
|
|
|
If you don't pass in a locale then it will use $self. |
1448
|
|
|
|
|
|
|
|
1449
|
|
|
|
|
|
|
=over 4 |
1450
|
|
|
|
|
|
|
|
1451
|
|
|
|
|
|
|
=item locale_name($name) |
1452
|
|
|
|
|
|
|
|
1453
|
|
|
|
|
|
|
Returns the given locale name in the current locale's format. The name can be |
1454
|
|
|
|
|
|
|
a locale id or a locale object or non existent. If a name is not passed in |
1455
|
|
|
|
|
|
|
then the name of the current locale is returned. |
1456
|
|
|
|
|
|
|
|
1457
|
|
|
|
|
|
|
=cut |
1458
|
|
|
|
|
|
|
|
1459
|
|
|
|
|
|
|
sub locale_name { |
1460
|
|
|
|
|
|
|
my ($self, $name) = @_; |
1461
|
|
|
|
|
|
|
$name //= $self; |
1462
|
|
|
|
|
|
|
|
1463
|
|
|
|
|
|
|
my $code = ref $name |
1464
|
|
|
|
|
|
|
? join ( '_', $name->language_id, $name->territory_id ? $name->territory_id : () ) |
1465
|
|
|
|
|
|
|
: $name; |
1466
|
|
|
|
|
|
|
|
1467
|
|
|
|
|
|
|
my @bundles = $self->_find_bundle('display_name_language'); |
1468
|
|
|
|
|
|
|
|
1469
|
|
|
|
|
|
|
foreach my $bundle (@bundles) { |
1470
|
|
|
|
|
|
|
my $display_name = $bundle->display_name_language->($code); |
1471
|
|
|
|
|
|
|
return $display_name if defined $display_name; |
1472
|
|
|
|
|
|
|
} |
1473
|
|
|
|
|
|
|
|
1474
|
|
|
|
|
|
|
# $name can be a string or a Locale::CLDR::Locales::* |
1475
|
|
|
|
|
|
|
if (! ref $name) { |
1476
|
|
|
|
|
|
|
$name = Locale::CLDR->new($name); |
1477
|
|
|
|
|
|
|
} |
1478
|
|
|
|
|
|
|
|
1479
|
|
|
|
|
|
|
# Now we have to process each individual element |
1480
|
|
|
|
|
|
|
# to pass to the display name pattern |
1481
|
|
|
|
|
|
|
my $language = $self->language_name($name); |
1482
|
|
|
|
|
|
|
my $script = $self->script_name($name); |
1483
|
|
|
|
|
|
|
my $territory = $self->territory_name($name); |
1484
|
|
|
|
|
|
|
my $variant = $self->variant_name($name); |
1485
|
|
|
|
|
|
|
|
1486
|
|
|
|
|
|
|
my $bundle = $self->_find_bundle('display_name_pattern'); |
1487
|
|
|
|
|
|
|
return $bundle |
1488
|
|
|
|
|
|
|
->display_name_pattern($language, $territory, $script, $variant); |
1489
|
|
|
|
|
|
|
} |
1490
|
|
|
|
|
|
|
|
1491
|
|
|
|
|
|
|
=item language_name($language) |
1492
|
|
|
|
|
|
|
|
1493
|
|
|
|
|
|
|
Returns the language name in the current locale's format. The name can be |
1494
|
|
|
|
|
|
|
a locale language id or a locale object or non existent. If a name is not |
1495
|
|
|
|
|
|
|
passed in then the language name of the current locale is returned. |
1496
|
|
|
|
|
|
|
|
1497
|
|
|
|
|
|
|
=cut |
1498
|
|
|
|
|
|
|
|
1499
|
|
|
|
|
|
|
sub language_name { |
1500
|
|
|
|
|
|
|
my ($self, $name) = @_; |
1501
|
|
|
|
|
|
|
|
1502
|
|
|
|
|
|
|
$name //= $self; |
1503
|
|
|
|
|
|
|
|
1504
|
|
|
|
|
|
|
my $code = ref $name ? $name->language_id : eval { Locale::CLDR->new(language_id => $name)->language_id }; |
1505
|
|
|
|
|
|
|
|
1506
|
|
|
|
|
|
|
my $language = undef; |
1507
|
|
|
|
|
|
|
my @bundles = $self->_find_bundle('display_name_language'); |
1508
|
|
|
|
|
|
|
if ($code) { |
1509
|
|
|
|
|
|
|
foreach my $bundle (@bundles) { |
1510
|
|
|
|
|
|
|
my $display_name = $bundle->display_name_language->($code); |
1511
|
|
|
|
|
|
|
if (defined $display_name) { |
1512
|
|
|
|
|
|
|
$language = $display_name; |
1513
|
|
|
|
|
|
|
last; |
1514
|
|
|
|
|
|
|
} |
1515
|
|
|
|
|
|
|
} |
1516
|
|
|
|
|
|
|
} |
1517
|
|
|
|
|
|
|
# If we don't have a display name for the language we try again |
1518
|
|
|
|
|
|
|
# with the und tag |
1519
|
|
|
|
|
|
|
if (! defined $language ) { |
1520
|
|
|
|
|
|
|
foreach my $bundle (@bundles) { |
1521
|
|
|
|
|
|
|
my $display_name = $bundle->display_name_language->('und'); |
1522
|
|
|
|
|
|
|
if (defined $display_name) { |
1523
|
|
|
|
|
|
|
$language = $display_name; |
1524
|
|
|
|
|
|
|
last; |
1525
|
|
|
|
|
|
|
} |
1526
|
|
|
|
|
|
|
} |
1527
|
|
|
|
|
|
|
} |
1528
|
|
|
|
|
|
|
|
1529
|
|
|
|
|
|
|
return $language; |
1530
|
|
|
|
|
|
|
} |
1531
|
|
|
|
|
|
|
|
1532
|
|
|
|
|
|
|
=item all_languages() |
1533
|
|
|
|
|
|
|
|
1534
|
|
|
|
|
|
|
Returns a hash ref keyed on language id of all the languages the system |
1535
|
|
|
|
|
|
|
knows about. The values are the language names for the corresponding id's |
1536
|
|
|
|
|
|
|
|
1537
|
|
|
|
|
|
|
=cut |
1538
|
|
|
|
|
|
|
|
1539
|
|
|
|
|
|
|
sub all_languages { |
1540
|
|
|
|
|
|
|
my $self = shift; |
1541
|
|
|
|
|
|
|
|
1542
|
|
|
|
|
|
|
my @bundles = $self->_find_bundle('display_name_language'); |
1543
|
|
|
|
|
|
|
my %languages; |
1544
|
|
|
|
|
|
|
foreach my $bundle (@bundles) { |
1545
|
|
|
|
|
|
|
my $languages = $bundle->display_name_language->(); |
1546
|
|
|
|
|
|
|
|
1547
|
|
|
|
|
|
|
# Remove existing languages |
1548
|
|
|
|
|
|
|
delete @{$languages}{keys %languages}; |
1549
|
|
|
|
|
|
|
|
1550
|
|
|
|
|
|
|
# Assign new ones to the hash |
1551
|
|
|
|
|
|
|
@languages{keys %$languages} = values %$languages; |
1552
|
|
|
|
|
|
|
} |
1553
|
|
|
|
|
|
|
|
1554
|
|
|
|
|
|
|
return \%languages; |
1555
|
|
|
|
|
|
|
} |
1556
|
|
|
|
|
|
|
|
1557
|
|
|
|
|
|
|
=item script_name($script) |
1558
|
|
|
|
|
|
|
|
1559
|
|
|
|
|
|
|
Returns the script name in the current locale's format. The script can be |
1560
|
|
|
|
|
|
|
a locale script id or a locale object or non existent. If a script is not |
1561
|
|
|
|
|
|
|
passed in then the script name of the current locale is returned. |
1562
|
|
|
|
|
|
|
|
1563
|
|
|
|
|
|
|
=cut |
1564
|
|
|
|
|
|
|
|
1565
|
|
|
|
|
|
|
sub script_name { |
1566
|
|
|
|
|
|
|
my ($self, $name) = @_; |
1567
|
|
|
|
|
|
|
$name //= $self; |
1568
|
|
|
|
|
|
|
|
1569
|
|
|
|
|
|
|
if (! ref $name ) { |
1570
|
|
|
|
|
|
|
$name = eval {__PACKAGE__->new(script_id => $name)}; |
1571
|
|
|
|
|
|
|
} |
1572
|
|
|
|
|
|
|
|
1573
|
|
|
|
|
|
|
if ( ref $name && ! $name->script_id ) { |
1574
|
|
|
|
|
|
|
return ''; |
1575
|
|
|
|
|
|
|
} |
1576
|
|
|
|
|
|
|
|
1577
|
|
|
|
|
|
|
my $script = undef; |
1578
|
|
|
|
|
|
|
my @bundles = $self->_find_bundle('display_name_script'); |
1579
|
|
|
|
|
|
|
if ($name) { |
1580
|
|
|
|
|
|
|
foreach my $bundle (@bundles) { |
1581
|
|
|
|
|
|
|
$script = $bundle->display_name_script->($name->script_id); |
1582
|
|
|
|
|
|
|
if (defined $script) { |
1583
|
|
|
|
|
|
|
last; |
1584
|
|
|
|
|
|
|
} |
1585
|
|
|
|
|
|
|
} |
1586
|
|
|
|
|
|
|
} |
1587
|
|
|
|
|
|
|
|
1588
|
|
|
|
|
|
|
if (! $script) { |
1589
|
|
|
|
|
|
|
foreach my $bundle (@bundles) { |
1590
|
|
|
|
|
|
|
$script = $bundle->display_name_script->('Zzzz'); |
1591
|
|
|
|
|
|
|
if (defined $script) { |
1592
|
|
|
|
|
|
|
last; |
1593
|
|
|
|
|
|
|
} |
1594
|
|
|
|
|
|
|
} |
1595
|
|
|
|
|
|
|
} |
1596
|
|
|
|
|
|
|
|
1597
|
|
|
|
|
|
|
return $script; |
1598
|
|
|
|
|
|
|
} |
1599
|
|
|
|
|
|
|
|
1600
|
|
|
|
|
|
|
=item all_scripts() |
1601
|
|
|
|
|
|
|
|
1602
|
|
|
|
|
|
|
Returns a hash ref keyed on script id of all the scripts the system |
1603
|
|
|
|
|
|
|
knows about. The values are the script names for the corresponding id's |
1604
|
|
|
|
|
|
|
|
1605
|
|
|
|
|
|
|
=cut |
1606
|
|
|
|
|
|
|
|
1607
|
|
|
|
|
|
|
sub all_scripts { |
1608
|
|
|
|
|
|
|
my $self = shift; |
1609
|
|
|
|
|
|
|
|
1610
|
|
|
|
|
|
|
my @bundles = $self->_find_bundle('display_name_script'); |
1611
|
|
|
|
|
|
|
my %scripts; |
1612
|
|
|
|
|
|
|
foreach my $bundle (@bundles) { |
1613
|
|
|
|
|
|
|
my $scripts = $bundle->display_name_script->(); |
1614
|
|
|
|
|
|
|
|
1615
|
|
|
|
|
|
|
# Remove existing scripts |
1616
|
|
|
|
|
|
|
delete @{$scripts}{keys %scripts}; |
1617
|
|
|
|
|
|
|
|
1618
|
|
|
|
|
|
|
# Assign new ones to the hash |
1619
|
|
|
|
|
|
|
@scripts{keys %$scripts} = values %$scripts; |
1620
|
|
|
|
|
|
|
} |
1621
|
|
|
|
|
|
|
|
1622
|
|
|
|
|
|
|
return \%scripts; |
1623
|
|
|
|
|
|
|
} |
1624
|
|
|
|
|
|
|
|
1625
|
|
|
|
|
|
|
=item territory_name($territory) |
1626
|
|
|
|
|
|
|
|
1627
|
|
|
|
|
|
|
Returns the territory name in the current locale's format. The territory can be |
1628
|
|
|
|
|
|
|
a locale territory id or a locale object or non existent. If a territory is not |
1629
|
|
|
|
|
|
|
passed in then the territory name of the current locale is returned. |
1630
|
|
|
|
|
|
|
|
1631
|
|
|
|
|
|
|
=cut |
1632
|
|
|
|
|
|
|
|
1633
|
|
|
|
|
|
|
sub territory_name { |
1634
|
|
|
|
|
|
|
my ($self, $name) = @_; |
1635
|
|
|
|
|
|
|
$name //= $self; |
1636
|
|
|
|
|
|
|
|
1637
|
|
|
|
|
|
|
if (! ref $name ) { |
1638
|
|
|
|
|
|
|
$name = eval { __PACKAGE__->new(language_id => 'und', territory_id => $name); }; |
1639
|
|
|
|
|
|
|
} |
1640
|
|
|
|
|
|
|
|
1641
|
|
|
|
|
|
|
if ( ref $name && ! $name->territory_id) { |
1642
|
|
|
|
|
|
|
return ''; |
1643
|
|
|
|
|
|
|
} |
1644
|
|
|
|
|
|
|
|
1645
|
|
|
|
|
|
|
my $territory = undef; |
1646
|
|
|
|
|
|
|
my @bundles = $self->_find_bundle('display_name_territory'); |
1647
|
|
|
|
|
|
|
if ($name) { |
1648
|
|
|
|
|
|
|
foreach my $bundle (@bundles) { |
1649
|
|
|
|
|
|
|
$territory = $bundle->display_name_territory->{$name->territory_id}; |
1650
|
|
|
|
|
|
|
if (defined $territory) { |
1651
|
|
|
|
|
|
|
last; |
1652
|
|
|
|
|
|
|
} |
1653
|
|
|
|
|
|
|
} |
1654
|
|
|
|
|
|
|
} |
1655
|
|
|
|
|
|
|
|
1656
|
|
|
|
|
|
|
if (! defined $territory) { |
1657
|
|
|
|
|
|
|
foreach my $bundle (@bundles) { |
1658
|
|
|
|
|
|
|
$territory = $bundle->display_name_territory->{'ZZ'}; |
1659
|
|
|
|
|
|
|
if (defined $territory) { |
1660
|
|
|
|
|
|
|
last; |
1661
|
|
|
|
|
|
|
} |
1662
|
|
|
|
|
|
|
} |
1663
|
|
|
|
|
|
|
} |
1664
|
|
|
|
|
|
|
|
1665
|
|
|
|
|
|
|
return $territory; |
1666
|
|
|
|
|
|
|
} |
1667
|
|
|
|
|
|
|
|
1668
|
|
|
|
|
|
|
=item all_territories |
1669
|
|
|
|
|
|
|
|
1670
|
|
|
|
|
|
|
Returns a hash ref keyed on territory id of all the territory the system |
1671
|
|
|
|
|
|
|
knows about. The values are the territory names for the corresponding ids |
1672
|
|
|
|
|
|
|
|
1673
|
|
|
|
|
|
|
=cut |
1674
|
|
|
|
|
|
|
|
1675
|
|
|
|
|
|
|
sub all_territories { |
1676
|
|
|
|
|
|
|
my $self = shift; |
1677
|
|
|
|
|
|
|
|
1678
|
|
|
|
|
|
|
my @bundles = $self->_find_bundle('display_name_territory'); |
1679
|
|
|
|
|
|
|
my %territories; |
1680
|
|
|
|
|
|
|
foreach my $bundle (@bundles) { |
1681
|
|
|
|
|
|
|
my $territories = $bundle->display_name_territory; |
1682
|
|
|
|
|
|
|
|
1683
|
|
|
|
|
|
|
# Remove existing territories |
1684
|
|
|
|
|
|
|
delete @{$territories}{keys %territories}; |
1685
|
|
|
|
|
|
|
|
1686
|
|
|
|
|
|
|
# Assign new ones to the hash |
1687
|
|
|
|
|
|
|
@territories{keys %$territories} = values %$territories; |
1688
|
|
|
|
|
|
|
} |
1689
|
|
|
|
|
|
|
|
1690
|
|
|
|
|
|
|
return \%territories; |
1691
|
|
|
|
|
|
|
} |
1692
|
|
|
|
|
|
|
|
1693
|
|
|
|
|
|
|
=item variant_name($variant) |
1694
|
|
|
|
|
|
|
|
1695
|
|
|
|
|
|
|
Returns the variant name in the current locale's format. The variant can be |
1696
|
|
|
|
|
|
|
a locale variant id or a locale object or non existent. If a variant is not |
1697
|
|
|
|
|
|
|
passed in then the variant name of the current locale is returned. |
1698
|
|
|
|
|
|
|
|
1699
|
|
|
|
|
|
|
=cut |
1700
|
|
|
|
|
|
|
|
1701
|
|
|
|
|
|
|
sub variant_name { |
1702
|
|
|
|
|
|
|
my ($self, $name) = @_; |
1703
|
|
|
|
|
|
|
$name //= $self; |
1704
|
|
|
|
|
|
|
|
1705
|
|
|
|
|
|
|
if (! ref $name ) { |
1706
|
|
|
|
|
|
|
$name = __PACKAGE__->new(language_id=> 'und', variant_id => $name); |
1707
|
|
|
|
|
|
|
} |
1708
|
|
|
|
|
|
|
|
1709
|
|
|
|
|
|
|
return '' unless $name->variant_id; |
1710
|
|
|
|
|
|
|
my $variant = undef; |
1711
|
|
|
|
|
|
|
if ($name->has_variant) { |
1712
|
|
|
|
|
|
|
my @bundles = $self->_find_bundle('display_name_variant'); |
1713
|
|
|
|
|
|
|
foreach my $bundle (@bundles) { |
1714
|
|
|
|
|
|
|
$variant= $bundle->display_name_variant->{$name->variant_id}; |
1715
|
|
|
|
|
|
|
if (defined $variant) { |
1716
|
|
|
|
|
|
|
last; |
1717
|
|
|
|
|
|
|
} |
1718
|
|
|
|
|
|
|
} |
1719
|
|
|
|
|
|
|
} |
1720
|
|
|
|
|
|
|
|
1721
|
|
|
|
|
|
|
return $variant // ''; |
1722
|
|
|
|
|
|
|
} |
1723
|
|
|
|
|
|
|
|
1724
|
|
|
|
|
|
|
=item key_name($key) |
1725
|
|
|
|
|
|
|
|
1726
|
|
|
|
|
|
|
Returns the key name in the current locale's format. The key must be |
1727
|
|
|
|
|
|
|
a locale key id as a string |
1728
|
|
|
|
|
|
|
|
1729
|
|
|
|
|
|
|
=cut |
1730
|
|
|
|
|
|
|
|
1731
|
|
|
|
|
|
|
sub key_name { |
1732
|
|
|
|
|
|
|
my ($self, $key) = @_; |
1733
|
|
|
|
|
|
|
|
1734
|
|
|
|
|
|
|
$key = lc $key; |
1735
|
|
|
|
|
|
|
|
1736
|
|
|
|
|
|
|
my %key_aliases = $self->key_aliases; |
1737
|
|
|
|
|
|
|
my %key_names = $self->key_names; |
1738
|
|
|
|
|
|
|
my %valid_keys = $self->valid_keys; |
1739
|
|
|
|
|
|
|
|
1740
|
|
|
|
|
|
|
my $alias = $key_aliases{$key} // ''; |
1741
|
|
|
|
|
|
|
my $name = $key_names{$key} // ''; |
1742
|
|
|
|
|
|
|
|
1743
|
|
|
|
|
|
|
return '' unless exists $valid_keys{$key} || exists $valid_keys{$alias} || exists $valid_keys{$name}; |
1744
|
|
|
|
|
|
|
my @bundles = $self->_find_bundle('display_name_key'); |
1745
|
|
|
|
|
|
|
foreach my $bundle (@bundles) { |
1746
|
|
|
|
|
|
|
my $return = $bundle->display_name_key->{$key}; |
1747
|
|
|
|
|
|
|
$return //= $bundle->display_name_key->{$alias}; |
1748
|
|
|
|
|
|
|
$return //= $bundle->display_name_key->{$name}; |
1749
|
|
|
|
|
|
|
|
1750
|
|
|
|
|
|
|
return $return if defined $return && length $return; |
1751
|
|
|
|
|
|
|
} |
1752
|
|
|
|
|
|
|
|
1753
|
|
|
|
|
|
|
return ucfirst ($key_names{$name} || $key_names{$alias} || $key_names{$key} || $key); |
1754
|
|
|
|
|
|
|
} |
1755
|
|
|
|
|
|
|
|
1756
|
|
|
|
|
|
|
=item type_name($key, $type) |
1757
|
|
|
|
|
|
|
|
1758
|
|
|
|
|
|
|
Returns the type name in the current locale's format. The key and type must be |
1759
|
|
|
|
|
|
|
a locale key id and type id as a string |
1760
|
|
|
|
|
|
|
|
1761
|
|
|
|
|
|
|
=cut |
1762
|
|
|
|
|
|
|
|
1763
|
|
|
|
|
|
|
sub type_name { |
1764
|
|
|
|
|
|
|
my ($self, $key, $type) = @_; |
1765
|
|
|
|
|
|
|
|
1766
|
|
|
|
|
|
|
$key = lc $key; |
1767
|
|
|
|
|
|
|
$type = lc $type; |
1768
|
|
|
|
|
|
|
|
1769
|
|
|
|
|
|
|
my %key_aliases = $self->key_aliases; |
1770
|
|
|
|
|
|
|
my %valid_keys = $self->valid_keys; |
1771
|
|
|
|
|
|
|
my %key_names = $self->key_names; |
1772
|
|
|
|
|
|
|
|
1773
|
|
|
|
|
|
|
my $alias = $key_aliases{$key} // ''; |
1774
|
|
|
|
|
|
|
my $name = $key_names{$key} // ''; |
1775
|
|
|
|
|
|
|
|
1776
|
|
|
|
|
|
|
return '' unless exists $valid_keys{$key} || $valid_keys{$alias} || $valid_keys{$name}; |
1777
|
|
|
|
|
|
|
return '' unless first { $_ eq $type } @{$valid_keys{$key} || []}, @{$valid_keys{$alias} || []}, @{$valid_keys{$name} || []}; |
1778
|
|
|
|
|
|
|
|
1779
|
|
|
|
|
|
|
my @bundles = $self->_find_bundle('display_name_type'); |
1780
|
|
|
|
|
|
|
foreach my $bundle (@bundles) { |
1781
|
|
|
|
|
|
|
my $types = $bundle->display_name_type->{$key} // $bundle->display_name_type->{$alias} // $bundle->display_name_type->{$name}; |
1782
|
|
|
|
|
|
|
my $type = $types->{$type}; |
1783
|
|
|
|
|
|
|
return $type if defined $type; |
1784
|
|
|
|
|
|
|
} |
1785
|
|
|
|
|
|
|
|
1786
|
|
|
|
|
|
|
return ''; |
1787
|
|
|
|
|
|
|
} |
1788
|
|
|
|
|
|
|
|
1789
|
|
|
|
|
|
|
=item measurement_system_name($measurement_system) |
1790
|
|
|
|
|
|
|
|
1791
|
|
|
|
|
|
|
Returns the measurement system name in the current locale's format. The measurement system must be |
1792
|
|
|
|
|
|
|
a measurement system id as a string |
1793
|
|
|
|
|
|
|
|
1794
|
|
|
|
|
|
|
=cut |
1795
|
|
|
|
|
|
|
|
1796
|
|
|
|
|
|
|
sub measurement_system_name { |
1797
|
|
|
|
|
|
|
my ($self, $name) = @_; |
1798
|
|
|
|
|
|
|
|
1799
|
|
|
|
|
|
|
# Fix case of code |
1800
|
|
|
|
|
|
|
$name = uc $name; |
1801
|
|
|
|
|
|
|
$name = 'metric' if $name eq 'METRIC'; |
1802
|
|
|
|
|
|
|
|
1803
|
|
|
|
|
|
|
my @bundles = $self->_find_bundle('display_name_measurement_system'); |
1804
|
|
|
|
|
|
|
foreach my $bundle (@bundles) { |
1805
|
|
|
|
|
|
|
my $system = $bundle->display_name_measurement_system->{$name}; |
1806
|
|
|
|
|
|
|
return $system if defined $system; |
1807
|
|
|
|
|
|
|
} |
1808
|
|
|
|
|
|
|
|
1809
|
|
|
|
|
|
|
return ''; |
1810
|
|
|
|
|
|
|
} |
1811
|
|
|
|
|
|
|
|
1812
|
|
|
|
|
|
|
=item transform_name($name) |
1813
|
|
|
|
|
|
|
|
1814
|
|
|
|
|
|
|
Returns the transform (transliteration) name in the current locale's format. The transform must be |
1815
|
|
|
|
|
|
|
a transform id as a string |
1816
|
|
|
|
|
|
|
|
1817
|
|
|
|
|
|
|
=cut |
1818
|
|
|
|
|
|
|
|
1819
|
|
|
|
|
|
|
sub transform_name { |
1820
|
|
|
|
|
|
|
my ($self, $name) = @_; |
1821
|
|
|
|
|
|
|
|
1822
|
|
|
|
|
|
|
$name = lc $name; |
1823
|
|
|
|
|
|
|
|
1824
|
|
|
|
|
|
|
my @bundles = $self->_find_bundle('display_name_transform_name'); |
1825
|
|
|
|
|
|
|
foreach my $bundle (@bundles) { |
1826
|
|
|
|
|
|
|
my $key = $bundle->display_name_transform_name->{$name}; |
1827
|
|
|
|
|
|
|
return $key if length $key; |
1828
|
|
|
|
|
|
|
} |
1829
|
|
|
|
|
|
|
|
1830
|
|
|
|
|
|
|
return ''; |
1831
|
|
|
|
|
|
|
} |
1832
|
|
|
|
|
|
|
|
1833
|
|
|
|
|
|
|
=item code_pattern($type, $locale) |
1834
|
|
|
|
|
|
|
|
1835
|
|
|
|
|
|
|
This method formats a language, script or territory name, given as C<$type> |
1836
|
|
|
|
|
|
|
from C<$locale> in a way expected by the current locale. If $locale is |
1837
|
|
|
|
|
|
|
not passed in or is undef() the method uses the current locale. |
1838
|
|
|
|
|
|
|
|
1839
|
|
|
|
|
|
|
=cut |
1840
|
|
|
|
|
|
|
|
1841
|
|
|
|
|
|
|
sub code_pattern { |
1842
|
|
|
|
|
|
|
my ($self, $type, $locale) = @_; |
1843
|
|
|
|
|
|
|
$type = lc $type; |
1844
|
|
|
|
|
|
|
|
1845
|
|
|
|
|
|
|
# If locale is not passed in then we are using ourself |
1846
|
|
|
|
|
|
|
$locale //= $self; |
1847
|
|
|
|
|
|
|
|
1848
|
|
|
|
|
|
|
# If locale is not an object then inflate it |
1849
|
|
|
|
|
|
|
$locale = __PACKAGE__->new($locale) unless blessed $locale; |
1850
|
|
|
|
|
|
|
|
1851
|
|
|
|
|
|
|
return '' unless $type =~ m{ \A (?: language | script | territory ) \z }xms; |
1852
|
|
|
|
|
|
|
|
1853
|
|
|
|
|
|
|
my $method = $type . '_name'; |
1854
|
|
|
|
|
|
|
my $substitute = $self->$method($locale); |
1855
|
|
|
|
|
|
|
|
1856
|
|
|
|
|
|
|
my @bundles = $self->_find_bundle('display_name_code_patterns'); |
1857
|
|
|
|
|
|
|
foreach my $bundle (@bundles) { |
1858
|
|
|
|
|
|
|
my $text = $bundle->display_name_code_patterns->{$type}; |
1859
|
|
|
|
|
|
|
next unless defined $text; |
1860
|
|
|
|
|
|
|
my $match = qr{ \{ 0 \} }xms; |
1861
|
|
|
|
|
|
|
$text=~ s{ $match }{$substitute}gxms; |
1862
|
|
|
|
|
|
|
return $text; |
1863
|
|
|
|
|
|
|
} |
1864
|
|
|
|
|
|
|
|
1865
|
|
|
|
|
|
|
return ''; |
1866
|
|
|
|
|
|
|
} |
1867
|
|
|
|
|
|
|
|
1868
|
|
|
|
|
|
|
=item text_orientation($type) |
1869
|
|
|
|
|
|
|
|
1870
|
|
|
|
|
|
|
Gets the text orientation for the locale. Type must be one of |
1871
|
|
|
|
|
|
|
C<lines> or C<characters> |
1872
|
|
|
|
|
|
|
|
1873
|
|
|
|
|
|
|
=cut |
1874
|
|
|
|
|
|
|
|
1875
|
|
|
|
|
|
|
sub text_orientation { |
1876
|
|
|
|
|
|
|
my $self = shift; |
1877
|
|
|
|
|
|
|
my $type = shift; |
1878
|
|
|
|
|
|
|
|
1879
|
|
|
|
|
|
|
my @bundles = $self->_find_bundle('text_orientation'); |
1880
|
|
|
|
|
|
|
foreach my $bundle (@bundles) { |
1881
|
|
|
|
|
|
|
my $orientation = $bundle->text_orientation; |
1882
|
|
|
|
|
|
|
next unless defined $orientation; |
1883
|
|
|
|
|
|
|
return $orientation->{$type}; |
1884
|
|
|
|
|
|
|
} |
1885
|
|
|
|
|
|
|
|
1886
|
|
|
|
|
|
|
return; |
1887
|
|
|
|
|
|
|
} |
1888
|
|
|
|
|
|
|
|
1889
|
|
|
|
|
|
|
sub _set_casing { |
1890
|
|
|
|
|
|
|
my ($self, $casing, $string) = @_; |
1891
|
|
|
|
|
|
|
|
1892
|
|
|
|
|
|
|
my @words = $self->split_words($string); |
1893
|
|
|
|
|
|
|
|
1894
|
|
|
|
|
|
|
if ($casing eq 'titlecase-firstword') { |
1895
|
|
|
|
|
|
|
# Check to see whether $words[0] is white space or not |
1896
|
|
|
|
|
|
|
my $firstword_location = 0; |
1897
|
|
|
|
|
|
|
if ($words[0] =~ m{ \A \s }msx) { |
1898
|
|
|
|
|
|
|
$firstword_location = 1; |
1899
|
|
|
|
|
|
|
} |
1900
|
|
|
|
|
|
|
|
1901
|
|
|
|
|
|
|
$words[$firstword_location] = ucfirst $words[$firstword_location]; |
1902
|
|
|
|
|
|
|
} |
1903
|
|
|
|
|
|
|
elsif ($casing eq 'titlecase-words') { |
1904
|
|
|
|
|
|
|
@words = map{ ucfirst } @words; |
1905
|
|
|
|
|
|
|
} |
1906
|
|
|
|
|
|
|
elsif ($casing eq 'lowercase-words') { |
1907
|
|
|
|
|
|
|
@words = map{ lc } @words; |
1908
|
|
|
|
|
|
|
} |
1909
|
|
|
|
|
|
|
|
1910
|
|
|
|
|
|
|
return join '', @words; |
1911
|
|
|
|
|
|
|
} |
1912
|
|
|
|
|
|
|
|
1913
|
|
|
|
|
|
|
=back |
1914
|
|
|
|
|
|
|
|
1915
|
|
|
|
|
|
|
=head2 Segmentation |
1916
|
|
|
|
|
|
|
|
1917
|
|
|
|
|
|
|
This group of methods allow you to split a string in various ways |
1918
|
|
|
|
|
|
|
Note you need Perl 5.18 or above for this |
1919
|
|
|
|
|
|
|
|
1920
|
|
|
|
|
|
|
=over 4 |
1921
|
|
|
|
|
|
|
|
1922
|
|
|
|
|
|
|
=item split_grapheme_clusters($string) |
1923
|
|
|
|
|
|
|
|
1924
|
|
|
|
|
|
|
Splits a string on grapheme clusters using the locale's segmentation rules. |
1925
|
|
|
|
|
|
|
Returns a list of grapheme clusters. |
1926
|
|
|
|
|
|
|
|
1927
|
|
|
|
|
|
|
=cut |
1928
|
|
|
|
|
|
|
# Need 5.18 and above |
1929
|
|
|
|
|
|
|
sub _new_perl { |
1930
|
|
|
|
|
|
|
die "You need Perl 5.18 or later for this functionality\n" |
1931
|
|
|
|
|
|
|
if $^V lt v5.18.0; |
1932
|
|
|
|
|
|
|
} |
1933
|
|
|
|
|
|
|
|
1934
|
|
|
|
|
|
|
sub split_grapheme_clusters { |
1935
|
|
|
|
|
|
|
_new_perl(); |
1936
|
|
|
|
|
|
|
|
1937
|
|
|
|
|
|
|
my ($self, $string) = @_; |
1938
|
|
|
|
|
|
|
|
1939
|
|
|
|
|
|
|
my $rules = $self->break_grapheme_cluster; |
1940
|
|
|
|
|
|
|
my @clusters = $self->_split($rules, $string, 1); |
1941
|
|
|
|
|
|
|
|
1942
|
|
|
|
|
|
|
return @clusters; |
1943
|
|
|
|
|
|
|
} |
1944
|
|
|
|
|
|
|
|
1945
|
|
|
|
|
|
|
=item split_words($string) |
1946
|
|
|
|
|
|
|
|
1947
|
|
|
|
|
|
|
Splits a string on word boundaries using the locale's segmentation rules. |
1948
|
|
|
|
|
|
|
Returns a list of words. |
1949
|
|
|
|
|
|
|
|
1950
|
|
|
|
|
|
|
=cut |
1951
|
|
|
|
|
|
|
|
1952
|
|
|
|
|
|
|
sub split_words { |
1953
|
|
|
|
|
|
|
_new_perl(); |
1954
|
|
|
|
|
|
|
|
1955
|
|
|
|
|
|
|
my ($self, $string) = @_; |
1956
|
|
|
|
|
|
|
|
1957
|
|
|
|
|
|
|
my $rules = $self->break_word; |
1958
|
|
|
|
|
|
|
my @words = $self->_split($rules, $string); |
1959
|
|
|
|
|
|
|
|
1960
|
|
|
|
|
|
|
return @words; |
1961
|
|
|
|
|
|
|
} |
1962
|
|
|
|
|
|
|
|
1963
|
|
|
|
|
|
|
=item split_sentences($string) |
1964
|
|
|
|
|
|
|
|
1965
|
|
|
|
|
|
|
Splits a string on on all points where a sentence could |
1966
|
|
|
|
|
|
|
end using the locale's segmentation rules. Returns a list |
1967
|
|
|
|
|
|
|
the end of each list element is the point where a sentence |
1968
|
|
|
|
|
|
|
could end. |
1969
|
|
|
|
|
|
|
|
1970
|
|
|
|
|
|
|
=cut |
1971
|
|
|
|
|
|
|
|
1972
|
|
|
|
|
|
|
sub split_sentences { |
1973
|
|
|
|
|
|
|
_new_perl(); |
1974
|
|
|
|
|
|
|
|
1975
|
|
|
|
|
|
|
my ($self, $string) = @_; |
1976
|
|
|
|
|
|
|
|
1977
|
|
|
|
|
|
|
my $rules = $self->break_sentence; |
1978
|
|
|
|
|
|
|
my @sentences = $self->_split($rules, $string); |
1979
|
|
|
|
|
|
|
|
1980
|
|
|
|
|
|
|
return @sentences; |
1981
|
|
|
|
|
|
|
} |
1982
|
|
|
|
|
|
|
|
1983
|
|
|
|
|
|
|
=item split_lines($string) |
1984
|
|
|
|
|
|
|
|
1985
|
|
|
|
|
|
|
Splits a string on on all points where a line could |
1986
|
|
|
|
|
|
|
end using the locale's segmentation rules. Returns a list |
1987
|
|
|
|
|
|
|
the end of each list element is the point where a line |
1988
|
|
|
|
|
|
|
could end. |
1989
|
|
|
|
|
|
|
|
1990
|
|
|
|
|
|
|
=cut |
1991
|
|
|
|
|
|
|
|
1992
|
|
|
|
|
|
|
sub split_lines { |
1993
|
|
|
|
|
|
|
_new_perl(); |
1994
|
|
|
|
|
|
|
|
1995
|
|
|
|
|
|
|
my ($self, $string) = @_; |
1996
|
|
|
|
|
|
|
|
1997
|
|
|
|
|
|
|
my $rules = $self->break_line; |
1998
|
|
|
|
|
|
|
my @lines = $self->_split($rules, $string); |
1999
|
|
|
|
|
|
|
|
2000
|
|
|
|
|
|
|
return @lines; |
2001
|
|
|
|
|
|
|
} |
2002
|
|
|
|
|
|
|
|
2003
|
|
|
|
|
|
|
sub _split { |
2004
|
|
|
|
|
|
|
my ($self, $rules, $string, $grapheme_split) = @_; |
2005
|
|
|
|
|
|
|
|
2006
|
|
|
|
|
|
|
my @split = (scalar @$rules) x (length($string) - 1); |
2007
|
|
|
|
|
|
|
|
2008
|
|
|
|
|
|
|
pos($string)=0; |
2009
|
|
|
|
|
|
|
# The Unicode Consortium has deprecated LB=Surrogate but the CLDR still |
2010
|
|
|
|
|
|
|
# uses it, at last in this version. |
2011
|
|
|
|
|
|
|
no warnings 'deprecated'; |
2012
|
|
|
|
|
|
|
while (length($string) -1 != pos $string) { |
2013
|
|
|
|
|
|
|
my $rule_number = 0; |
2014
|
|
|
|
|
|
|
my $first; |
2015
|
|
|
|
|
|
|
foreach my $rule (@$rules) { |
2016
|
|
|
|
|
|
|
unless( ($first) = $string =~ m{ |
2017
|
|
|
|
|
|
|
\G |
2018
|
|
|
|
|
|
|
($rule->[0]) |
2019
|
|
|
|
|
|
|
$rule->[1] |
2020
|
|
|
|
|
|
|
}msx) { |
2021
|
|
|
|
|
|
|
$rule_number++; |
2022
|
|
|
|
|
|
|
next; |
2023
|
|
|
|
|
|
|
} |
2024
|
|
|
|
|
|
|
my $location = pos($string) + length($first) -1; |
2025
|
|
|
|
|
|
|
$split[$location] = $rule_number; |
2026
|
|
|
|
|
|
|
|
2027
|
|
|
|
|
|
|
# If the left hand side was part of a grapheme cluster |
2028
|
|
|
|
|
|
|
# we have to jump past the entire cluster |
2029
|
|
|
|
|
|
|
my $length = length $first; |
2030
|
|
|
|
|
|
|
my ($gc) = $string =~ /\G(\X)/; |
2031
|
|
|
|
|
|
|
$length = (! $grapheme_split && length($gc)) > $length ? length($gc) : $length; |
2032
|
|
|
|
|
|
|
pos($string)+= $length; |
2033
|
|
|
|
|
|
|
last; |
2034
|
|
|
|
|
|
|
} |
2035
|
|
|
|
|
|
|
} |
2036
|
|
|
|
|
|
|
|
2037
|
|
|
|
|
|
|
push @$rules,[undef,undef,1]; |
2038
|
|
|
|
|
|
|
@split = map {$rules->[$_][2] ? 1 : 0} @split; |
2039
|
|
|
|
|
|
|
my $count = 0; |
2040
|
|
|
|
|
|
|
my @sections = ('.'); |
2041
|
|
|
|
|
|
|
foreach my $split (@split) { |
2042
|
|
|
|
|
|
|
$count++ unless $split; |
2043
|
|
|
|
|
|
|
$sections[$count] .= '.'; |
2044
|
|
|
|
|
|
|
} |
2045
|
|
|
|
|
|
|
|
2046
|
|
|
|
|
|
|
my $regex = '(' . join(')(', @sections) . ')'; |
2047
|
|
|
|
|
|
|
$regex = qr{ \A $regex \z}msx; |
2048
|
|
|
|
|
|
|
@split = $string =~ $regex; |
2049
|
|
|
|
|
|
|
|
2050
|
|
|
|
|
|
|
return @split; |
2051
|
|
|
|
|
|
|
} |
2052
|
|
|
|
|
|
|
|
2053
|
|
|
|
|
|
|
=back |
2054
|
|
|
|
|
|
|
|
2055
|
|
|
|
|
|
|
=head2 Characters |
2056
|
|
|
|
|
|
|
|
2057
|
|
|
|
|
|
|
=over 4 |
2058
|
|
|
|
|
|
|
|
2059
|
|
|
|
|
|
|
=item is_exemplar_character( $type, $character) |
2060
|
|
|
|
|
|
|
|
2061
|
|
|
|
|
|
|
=item is_exemplar_character($character) |
2062
|
|
|
|
|
|
|
|
2063
|
|
|
|
|
|
|
Tests if the given character is used in the locale. There are |
2064
|
|
|
|
|
|
|
three possible types; C<main>, C<auxiliary> and C<punctuation>. |
2065
|
|
|
|
|
|
|
If no type is given C<main> is assumed. Unless the C<index> type |
2066
|
|
|
|
|
|
|
is given you will have to have a Perl version of 5.18 or above |
2067
|
|
|
|
|
|
|
to use this method |
2068
|
|
|
|
|
|
|
|
2069
|
|
|
|
|
|
|
=cut |
2070
|
|
|
|
|
|
|
|
2071
|
|
|
|
|
|
|
sub is_exemplar_character { |
2072
|
|
|
|
|
|
|
my ($self, @parameters) = @_; |
2073
|
|
|
|
|
|
|
unshift @parameters, 'main' if @parameters == 1; |
2074
|
|
|
|
|
|
|
|
2075
|
|
|
|
|
|
|
_new_perl() unless $parameters[0] eq 'index'; |
2076
|
|
|
|
|
|
|
|
2077
|
|
|
|
|
|
|
my @bundles = $self->_find_bundle('characters'); |
2078
|
|
|
|
|
|
|
foreach my $bundle (@bundles) { |
2079
|
|
|
|
|
|
|
my $characters = $bundle->characters->{lc $parameters[0]}; |
2080
|
|
|
|
|
|
|
next unless defined $characters; |
2081
|
|
|
|
|
|
|
return 1 if fc($parameters[1])=~$characters; |
2082
|
|
|
|
|
|
|
} |
2083
|
|
|
|
|
|
|
|
2084
|
|
|
|
|
|
|
return; |
2085
|
|
|
|
|
|
|
} |
2086
|
|
|
|
|
|
|
|
2087
|
|
|
|
|
|
|
=item index_characters() |
2088
|
|
|
|
|
|
|
|
2089
|
|
|
|
|
|
|
Returns an array ref of characters normally used when creating |
2090
|
|
|
|
|
|
|
an index and ordered appropriately. |
2091
|
|
|
|
|
|
|
|
2092
|
|
|
|
|
|
|
=cut |
2093
|
|
|
|
|
|
|
|
2094
|
|
|
|
|
|
|
sub index_characters { |
2095
|
|
|
|
|
|
|
my $self = shift; |
2096
|
|
|
|
|
|
|
|
2097
|
|
|
|
|
|
|
my @bundles = $self->_find_bundle('characters'); |
2098
|
|
|
|
|
|
|
foreach my $bundle (@bundles) { |
2099
|
|
|
|
|
|
|
my $characters = $bundle->characters->{index}; |
2100
|
|
|
|
|
|
|
next unless defined $characters; |
2101
|
|
|
|
|
|
|
return $characters; |
2102
|
|
|
|
|
|
|
} |
2103
|
|
|
|
|
|
|
return []; |
2104
|
|
|
|
|
|
|
} |
2105
|
|
|
|
|
|
|
|
2106
|
|
|
|
|
|
|
sub _truncated { |
2107
|
|
|
|
|
|
|
my ($self, $type, @params) = @_; |
2108
|
|
|
|
|
|
|
|
2109
|
|
|
|
|
|
|
my @bundles = $self->_find_bundle('ellipsis'); |
2110
|
|
|
|
|
|
|
foreach my $bundle (@bundles) { |
2111
|
|
|
|
|
|
|
my $ellipsis = $bundle->ellipsis->{$type}; |
2112
|
|
|
|
|
|
|
next unless defined $ellipsis; |
2113
|
|
|
|
|
|
|
$ellipsis=~s{ \{ 0 \} }{$params[0]}msx; |
2114
|
|
|
|
|
|
|
$ellipsis=~s{ \{ 1 \} }{$params[1]}msx; |
2115
|
|
|
|
|
|
|
return $ellipsis; |
2116
|
|
|
|
|
|
|
} |
2117
|
|
|
|
|
|
|
} |
2118
|
|
|
|
|
|
|
|
2119
|
|
|
|
|
|
|
=back |
2120
|
|
|
|
|
|
|
|
2121
|
|
|
|
|
|
|
=head2 Truncation |
2122
|
|
|
|
|
|
|
|
2123
|
|
|
|
|
|
|
These methods format a string to show where part of the string has been removed |
2124
|
|
|
|
|
|
|
|
2125
|
|
|
|
|
|
|
=over 4 |
2126
|
|
|
|
|
|
|
|
2127
|
|
|
|
|
|
|
=item truncated_beginning($string) |
2128
|
|
|
|
|
|
|
|
2129
|
|
|
|
|
|
|
Adds the locale specific marking to show that the |
2130
|
|
|
|
|
|
|
string has been truncated at the beginning. |
2131
|
|
|
|
|
|
|
|
2132
|
|
|
|
|
|
|
=cut |
2133
|
|
|
|
|
|
|
|
2134
|
|
|
|
|
|
|
sub truncated_beginning { |
2135
|
|
|
|
|
|
|
shift->_truncated(initial => @_); |
2136
|
|
|
|
|
|
|
} |
2137
|
|
|
|
|
|
|
|
2138
|
|
|
|
|
|
|
=item truncated_between($string, $string) |
2139
|
|
|
|
|
|
|
|
2140
|
|
|
|
|
|
|
Adds the locale specific marking to show that something |
2141
|
|
|
|
|
|
|
has been truncated between the two strings. Returns a |
2142
|
|
|
|
|
|
|
string comprising of the concatenation of the first string, |
2143
|
|
|
|
|
|
|
the mark and the second string |
2144
|
|
|
|
|
|
|
|
2145
|
|
|
|
|
|
|
=cut |
2146
|
|
|
|
|
|
|
|
2147
|
|
|
|
|
|
|
sub truncated_between { |
2148
|
|
|
|
|
|
|
shift->_truncated(medial => @_); |
2149
|
|
|
|
|
|
|
} |
2150
|
|
|
|
|
|
|
|
2151
|
|
|
|
|
|
|
=item truncated_end($string) |
2152
|
|
|
|
|
|
|
|
2153
|
|
|
|
|
|
|
Adds the locale specific marking to show that the |
2154
|
|
|
|
|
|
|
string has been truncated at the end. |
2155
|
|
|
|
|
|
|
|
2156
|
|
|
|
|
|
|
=cut |
2157
|
|
|
|
|
|
|
|
2158
|
|
|
|
|
|
|
sub truncated_end { |
2159
|
|
|
|
|
|
|
shift->_truncated(final => @_); |
2160
|
|
|
|
|
|
|
} |
2161
|
|
|
|
|
|
|
|
2162
|
|
|
|
|
|
|
=item truncated_word_beginning($string) |
2163
|
|
|
|
|
|
|
|
2164
|
|
|
|
|
|
|
Adds the locale specific marking to show that the |
2165
|
|
|
|
|
|
|
string has been truncated at the beginning. This |
2166
|
|
|
|
|
|
|
should be used in preference to C<truncated_beginning> |
2167
|
|
|
|
|
|
|
when the truncation occurs on a word boundary. |
2168
|
|
|
|
|
|
|
|
2169
|
|
|
|
|
|
|
=cut |
2170
|
|
|
|
|
|
|
|
2171
|
|
|
|
|
|
|
sub truncated_word_beginning { |
2172
|
|
|
|
|
|
|
shift->_truncated('word-initial' => @_); |
2173
|
|
|
|
|
|
|
} |
2174
|
|
|
|
|
|
|
|
2175
|
|
|
|
|
|
|
=item truncated_word_between($string, $string) |
2176
|
|
|
|
|
|
|
|
2177
|
|
|
|
|
|
|
Adds the locale specific marking to show that something |
2178
|
|
|
|
|
|
|
has been truncated between the two strings. Returns a |
2179
|
|
|
|
|
|
|
string comprising of the concatenation of the first string, |
2180
|
|
|
|
|
|
|
the mark and the second string. This should be used in |
2181
|
|
|
|
|
|
|
preference to C<truncated_between> when the truncation |
2182
|
|
|
|
|
|
|
occurs on a word boundary. |
2183
|
|
|
|
|
|
|
|
2184
|
|
|
|
|
|
|
=cut |
2185
|
|
|
|
|
|
|
|
2186
|
|
|
|
|
|
|
sub truncated_word_between { |
2187
|
|
|
|
|
|
|
shift->_truncated('word-medial' => @_); |
2188
|
|
|
|
|
|
|
} |
2189
|
|
|
|
|
|
|
|
2190
|
|
|
|
|
|
|
=item truncated_word_end($string) |
2191
|
|
|
|
|
|
|
|
2192
|
|
|
|
|
|
|
Adds the locale specific marking to show that the |
2193
|
|
|
|
|
|
|
string has been truncated at the end. This should be |
2194
|
|
|
|
|
|
|
used in preference to C<truncated_end> when the |
2195
|
|
|
|
|
|
|
truncation occurs on a word boundary. |
2196
|
|
|
|
|
|
|
|
2197
|
|
|
|
|
|
|
=cut |
2198
|
|
|
|
|
|
|
|
2199
|
|
|
|
|
|
|
sub truncated_word_end { |
2200
|
|
|
|
|
|
|
shift->_truncated('word-final' => @_); |
2201
|
|
|
|
|
|
|
} |
2202
|
|
|
|
|
|
|
|
2203
|
|
|
|
|
|
|
=back |
2204
|
|
|
|
|
|
|
|
2205
|
|
|
|
|
|
|
=head2 Quoting |
2206
|
|
|
|
|
|
|
|
2207
|
|
|
|
|
|
|
=over 4 |
2208
|
|
|
|
|
|
|
|
2209
|
|
|
|
|
|
|
=item quote($string) |
2210
|
|
|
|
|
|
|
|
2211
|
|
|
|
|
|
|
Adds the locale's primary quotation marks to the ends of the string. |
2212
|
|
|
|
|
|
|
Also scans the string for paired primary and auxiliary quotation |
2213
|
|
|
|
|
|
|
marks and flips them. |
2214
|
|
|
|
|
|
|
|
2215
|
|
|
|
|
|
|
eg passing C<z âabcâ z> to this method for the C<en_GB> locale |
2216
|
|
|
|
|
|
|
gives C<âz âabcâ zâ> |
2217
|
|
|
|
|
|
|
|
2218
|
|
|
|
|
|
|
=cut |
2219
|
|
|
|
|
|
|
|
2220
|
|
|
|
|
|
|
sub quote { |
2221
|
|
|
|
|
|
|
my ($self, $text) = @_; |
2222
|
|
|
|
|
|
|
|
2223
|
|
|
|
|
|
|
my %quote; |
2224
|
|
|
|
|
|
|
my @bundles = $self->_find_bundle('quote_start'); |
2225
|
|
|
|
|
|
|
foreach my $bundle (@bundles) { |
2226
|
|
|
|
|
|
|
my $quote = $bundle->quote_start; |
2227
|
|
|
|
|
|
|
next unless defined $quote; |
2228
|
|
|
|
|
|
|
$quote{start} = $quote; |
2229
|
|
|
|
|
|
|
last; |
2230
|
|
|
|
|
|
|
} |
2231
|
|
|
|
|
|
|
|
2232
|
|
|
|
|
|
|
@bundles = $self->_find_bundle('quote_end'); |
2233
|
|
|
|
|
|
|
foreach my $bundle (@bundles) { |
2234
|
|
|
|
|
|
|
my $quote = $bundle->quote_end; |
2235
|
|
|
|
|
|
|
next unless defined $quote; |
2236
|
|
|
|
|
|
|
$quote{end} = $quote; |
2237
|
|
|
|
|
|
|
last; |
2238
|
|
|
|
|
|
|
} |
2239
|
|
|
|
|
|
|
|
2240
|
|
|
|
|
|
|
@bundles = $self->_find_bundle('alternate_quote_start'); |
2241
|
|
|
|
|
|
|
foreach my $bundle (@bundles) { |
2242
|
|
|
|
|
|
|
my $quote = $bundle->alternate_quote_start; |
2243
|
|
|
|
|
|
|
next unless defined $quote; |
2244
|
|
|
|
|
|
|
$quote{alternate_start} = $quote; |
2245
|
|
|
|
|
|
|
last; |
2246
|
|
|
|
|
|
|
} |
2247
|
|
|
|
|
|
|
|
2248
|
|
|
|
|
|
|
@bundles = $self->_find_bundle('alternate_quote_end'); |
2249
|
|
|
|
|
|
|
foreach my $bundle (@bundles) { |
2250
|
|
|
|
|
|
|
my $quote = $bundle->alternate_quote_end; |
2251
|
|
|
|
|
|
|
next unless defined $quote; |
2252
|
|
|
|
|
|
|
$quote{alternate_end} = $quote; |
2253
|
|
|
|
|
|
|
last; |
2254
|
|
|
|
|
|
|
} |
2255
|
|
|
|
|
|
|
|
2256
|
|
|
|
|
|
|
# Check to see if we need to switch quotes |
2257
|
|
|
|
|
|
|
foreach (qw( start end alternate_start alternate_end)) { |
2258
|
|
|
|
|
|
|
$quote{$_} //= ''; |
2259
|
|
|
|
|
|
|
} |
2260
|
|
|
|
|
|
|
|
2261
|
|
|
|
|
|
|
my $from = join ' | ', map {quotemeta} @quote{qw( start end alternate_start alternate_end)}; |
2262
|
|
|
|
|
|
|
my %to; |
2263
|
|
|
|
|
|
|
@to{@quote{qw( start end alternate_start alternate_end)}} |
2264
|
|
|
|
|
|
|
= @quote{qw( alternate_start alternate_end start end)}; |
2265
|
|
|
|
|
|
|
|
2266
|
|
|
|
|
|
|
my $outer = index($text, $quote{start}); |
2267
|
|
|
|
|
|
|
my $inner = index($text, $quote{alternate_start}); |
2268
|
|
|
|
|
|
|
|
2269
|
|
|
|
|
|
|
if ($inner == -1 || ($outer > -1 && $inner > -1 && $outer < $inner)) { |
2270
|
|
|
|
|
|
|
$text =~ s{ ( $from ) }{ $to{$1} }msxeg; |
2271
|
|
|
|
|
|
|
} |
2272
|
|
|
|
|
|
|
|
2273
|
|
|
|
|
|
|
return "$quote{start}$text$quote{end}"; |
2274
|
|
|
|
|
|
|
} |
2275
|
|
|
|
|
|
|
|
2276
|
|
|
|
|
|
|
=back |
2277
|
|
|
|
|
|
|
|
2278
|
|
|
|
|
|
|
=head2 Miscellaneous |
2279
|
|
|
|
|
|
|
|
2280
|
|
|
|
|
|
|
=over 4 |
2281
|
|
|
|
|
|
|
|
2282
|
|
|
|
|
|
|
=item more_information() |
2283
|
|
|
|
|
|
|
|
2284
|
|
|
|
|
|
|
The more information string is one that can be displayed |
2285
|
|
|
|
|
|
|
in an interface to indicate that more information is |
2286
|
|
|
|
|
|
|
available. |
2287
|
|
|
|
|
|
|
|
2288
|
|
|
|
|
|
|
=cut |
2289
|
|
|
|
|
|
|
|
2290
|
|
|
|
|
|
|
sub more_information { |
2291
|
|
|
|
|
|
|
my $self = shift; |
2292
|
|
|
|
|
|
|
|
2293
|
|
|
|
|
|
|
my @bundles = $self->_find_bundle('more_information'); |
2294
|
|
|
|
|
|
|
foreach my $bundle (@bundles) { |
2295
|
|
|
|
|
|
|
my $info = $bundle->more_information; |
2296
|
|
|
|
|
|
|
next unless defined $info; |
2297
|
|
|
|
|
|
|
return $info; |
2298
|
|
|
|
|
|
|
} |
2299
|
|
|
|
|
|
|
return ''; |
2300
|
|
|
|
|
|
|
} |
2301
|
|
|
|
|
|
|
|
2302
|
|
|
|
|
|
|
|
2303
|
|
|
|
|
|
|
=item measurement() |
2304
|
|
|
|
|
|
|
|
2305
|
|
|
|
|
|
|
Returns the measurement type for the locale |
2306
|
|
|
|
|
|
|
|
2307
|
|
|
|
|
|
|
=cut |
2308
|
|
|
|
|
|
|
|
2309
|
|
|
|
|
|
|
sub measurement { |
2310
|
|
|
|
|
|
|
my $self = shift; |
2311
|
|
|
|
|
|
|
|
2312
|
|
|
|
|
|
|
my $measurement_data = $self->measurement_system; |
2313
|
|
|
|
|
|
|
my $territory = $self->territory_id // '001'; |
2314
|
|
|
|
|
|
|
|
2315
|
|
|
|
|
|
|
my $data = $measurement_data->{$territory}; |
2316
|
|
|
|
|
|
|
|
2317
|
|
|
|
|
|
|
until (defined $data) { |
2318
|
|
|
|
|
|
|
$territory = $self->territory_contained_by->{$territory}; |
2319
|
|
|
|
|
|
|
$data = $measurement_data->{$territory}; |
2320
|
|
|
|
|
|
|
} |
2321
|
|
|
|
|
|
|
|
2322
|
|
|
|
|
|
|
return $data; |
2323
|
|
|
|
|
|
|
} |
2324
|
|
|
|
|
|
|
|
2325
|
|
|
|
|
|
|
=item paper() |
2326
|
|
|
|
|
|
|
|
2327
|
|
|
|
|
|
|
Returns the paper type for the locale |
2328
|
|
|
|
|
|
|
|
2329
|
|
|
|
|
|
|
=cut |
2330
|
|
|
|
|
|
|
|
2331
|
|
|
|
|
|
|
sub paper { |
2332
|
|
|
|
|
|
|
my $self = shift; |
2333
|
|
|
|
|
|
|
|
2334
|
|
|
|
|
|
|
my $paper_size = $self->paper_size; |
2335
|
|
|
|
|
|
|
my $territory = $self->territory_id // '001'; |
2336
|
|
|
|
|
|
|
|
2337
|
|
|
|
|
|
|
my $data = $paper_size->{$territory}; |
2338
|
|
|
|
|
|
|
|
2339
|
|
|
|
|
|
|
until (defined $data) { |
2340
|
|
|
|
|
|
|
$territory = $self->territory_contained_by->{$territory}; |
2341
|
|
|
|
|
|
|
$data = $paper_size->{$territory}; |
2342
|
|
|
|
|
|
|
} |
2343
|
|
|
|
|
|
|
|
2344
|
|
|
|
|
|
|
return $data; |
2345
|
|
|
|
|
|
|
} |
2346
|
|
|
|
|
|
|
|
2347
|
|
|
|
|
|
|
=back |
2348
|
|
|
|
|
|
|
|
2349
|
|
|
|
|
|
|
=head2 Units |
2350
|
|
|
|
|
|
|
|
2351
|
|
|
|
|
|
|
=over 4 |
2352
|
|
|
|
|
|
|
|
2353
|
|
|
|
|
|
|
=item all_units() |
2354
|
|
|
|
|
|
|
|
2355
|
|
|
|
|
|
|
Returns a list of all the unit identifiers for the locale |
2356
|
|
|
|
|
|
|
|
2357
|
|
|
|
|
|
|
=cut |
2358
|
|
|
|
|
|
|
|
2359
|
|
|
|
|
|
|
sub all_units { |
2360
|
|
|
|
|
|
|
my $self = shift; |
2361
|
|
|
|
|
|
|
my @bundles = $self->_find_bundle('units'); |
2362
|
|
|
|
|
|
|
|
2363
|
|
|
|
|
|
|
my %units; |
2364
|
|
|
|
|
|
|
foreach my $bundle (reverse @bundles) { |
2365
|
|
|
|
|
|
|
%units = %units, $bundle->units; |
2366
|
|
|
|
|
|
|
} |
2367
|
|
|
|
|
|
|
|
2368
|
|
|
|
|
|
|
return keys %units; |
2369
|
|
|
|
|
|
|
} |
2370
|
|
|
|
|
|
|
|
2371
|
|
|
|
|
|
|
=item unit($number, $unit, $width) |
2372
|
|
|
|
|
|
|
|
2373
|
|
|
|
|
|
|
Returns the localised string for the given number and unit formatted for the |
2374
|
|
|
|
|
|
|
required width. The number must not be the localized version of the number. |
2375
|
|
|
|
|
|
|
The returned string will be in the locale's format, including the number. |
2376
|
|
|
|
|
|
|
|
2377
|
|
|
|
|
|
|
=cut |
2378
|
|
|
|
|
|
|
|
2379
|
|
|
|
|
|
|
sub unit { |
2380
|
|
|
|
|
|
|
my ($self, $number, $what, $type) = @_; |
2381
|
|
|
|
|
|
|
$type //= 'long'; |
2382
|
|
|
|
|
|
|
|
2383
|
|
|
|
|
|
|
my $plural = $self->plural($number); |
2384
|
|
|
|
|
|
|
|
2385
|
|
|
|
|
|
|
my @bundles = $self->_find_bundle('units'); |
2386
|
|
|
|
|
|
|
my $format; |
2387
|
|
|
|
|
|
|
foreach my $bundle (@bundles) { |
2388
|
|
|
|
|
|
|
if (exists $bundle->units()->{$type}{$what}{$plural}) { |
2389
|
|
|
|
|
|
|
$format = $bundle->units()->{$type}{$what}{$plural}; |
2390
|
|
|
|
|
|
|
last; |
2391
|
|
|
|
|
|
|
} |
2392
|
|
|
|
|
|
|
|
2393
|
|
|
|
|
|
|
if (exists $bundle->units()->{$type}{$what}{other}) { |
2394
|
|
|
|
|
|
|
$format = $bundle->units()->{$type}{$what}{other}; |
2395
|
|
|
|
|
|
|
last; |
2396
|
|
|
|
|
|
|
} |
2397
|
|
|
|
|
|
|
} |
2398
|
|
|
|
|
|
|
|
2399
|
|
|
|
|
|
|
# Check for aliases |
2400
|
|
|
|
|
|
|
unless ($format) { |
2401
|
|
|
|
|
|
|
my $original_type = $type; |
2402
|
|
|
|
|
|
|
my @aliases = $self->_find_bundle('unit_alias'); |
2403
|
|
|
|
|
|
|
foreach my $alias (@aliases) { |
2404
|
|
|
|
|
|
|
$type = $alias->unit_alias()->{$original_type}; |
2405
|
|
|
|
|
|
|
next unless $type; |
2406
|
|
|
|
|
|
|
foreach my $bundle (@bundles) { |
2407
|
|
|
|
|
|
|
if (exists $bundle->units()->{$type}{$what}{$plural}) { |
2408
|
|
|
|
|
|
|
$format = $bundle->units()->{$type}{$what}{$plural}; |
2409
|
|
|
|
|
|
|
last; |
2410
|
|
|
|
|
|
|
} |
2411
|
|
|
|
|
|
|
|
2412
|
|
|
|
|
|
|
if (exists $bundle->units()->{$type}{$what}{other}) { |
2413
|
|
|
|
|
|
|
$format = $bundle->units()->{$type}{$what}{other}; |
2414
|
|
|
|
|
|
|
last; |
2415
|
|
|
|
|
|
|
} |
2416
|
|
|
|
|
|
|
} |
2417
|
|
|
|
|
|
|
} |
2418
|
|
|
|
|
|
|
$type = $original_type; |
2419
|
|
|
|
|
|
|
} |
2420
|
|
|
|
|
|
|
|
2421
|
|
|
|
|
|
|
# Check for a compound unit that we don't specifically have |
2422
|
|
|
|
|
|
|
if (! $format && (my ($dividend, $divisor) = $what =~ /^(.+)-per-(.+)$/)) { |
2423
|
|
|
|
|
|
|
return $self->_unit_compound($number, $dividend, $divisor, $type); |
2424
|
|
|
|
|
|
|
} |
2425
|
|
|
|
|
|
|
|
2426
|
|
|
|
|
|
|
$number = $self->format_number($number); |
2427
|
|
|
|
|
|
|
return $number unless $format; |
2428
|
|
|
|
|
|
|
|
2429
|
|
|
|
|
|
|
$format =~ s/\{0\}/$number/g; |
2430
|
|
|
|
|
|
|
|
2431
|
|
|
|
|
|
|
return $format; |
2432
|
|
|
|
|
|
|
} |
2433
|
|
|
|
|
|
|
|
2434
|
|
|
|
|
|
|
sub _unit_compound { |
2435
|
|
|
|
|
|
|
my ($self, $number, $dividend_what, $divisor_what, $type) = @_; |
2436
|
|
|
|
|
|
|
|
2437
|
|
|
|
|
|
|
$type //= 'long'; |
2438
|
|
|
|
|
|
|
|
2439
|
|
|
|
|
|
|
my $dividend = $self->unit($number, $dividend_what, $type); |
2440
|
|
|
|
|
|
|
my $divisor = $self->unit(1, $divisor_what, $type); |
2441
|
|
|
|
|
|
|
|
2442
|
|
|
|
|
|
|
my $one = $self->format_number(1); |
2443
|
|
|
|
|
|
|
$divisor =~ s/\s*$one\s*//; |
2444
|
|
|
|
|
|
|
|
2445
|
|
|
|
|
|
|
my @bundles = $self->_find_bundle('units'); |
2446
|
|
|
|
|
|
|
my $format; |
2447
|
|
|
|
|
|
|
foreach my $bundle (@bundles) { |
2448
|
|
|
|
|
|
|
if (exists $bundle->units()->{$type}{per}{1}) { |
2449
|
|
|
|
|
|
|
$format = $bundle->units()->{$type}{per}{1}; |
2450
|
|
|
|
|
|
|
last; |
2451
|
|
|
|
|
|
|
} |
2452
|
|
|
|
|
|
|
} |
2453
|
|
|
|
|
|
|
|
2454
|
|
|
|
|
|
|
# Check for aliases |
2455
|
|
|
|
|
|
|
unless ($format) { |
2456
|
|
|
|
|
|
|
my $original_type = $type; |
2457
|
|
|
|
|
|
|
my @aliases = $self->_find_bundle('unit_alias'); |
2458
|
|
|
|
|
|
|
foreach my $alias (@aliases) { |
2459
|
|
|
|
|
|
|
$type = $alias->unit_alias()->{$original_type}; |
2460
|
|
|
|
|
|
|
foreach my $bundle (@bundles) { |
2461
|
|
|
|
|
|
|
if (exists $bundle->units()->{$type}{per}{1}) { |
2462
|
|
|
|
|
|
|
$format = $bundle->units()->{$type}{per}{1}; |
2463
|
|
|
|
|
|
|
last; |
2464
|
|
|
|
|
|
|
} |
2465
|
|
|
|
|
|
|
} |
2466
|
|
|
|
|
|
|
} |
2467
|
|
|
|
|
|
|
} |
2468
|
|
|
|
|
|
|
|
2469
|
|
|
|
|
|
|
$format =~ s/\{0\}/$dividend/g; |
2470
|
|
|
|
|
|
|
$format =~ s/\{1\}/$divisor/g; |
2471
|
|
|
|
|
|
|
|
2472
|
|
|
|
|
|
|
return $format; |
2473
|
|
|
|
|
|
|
} |
2474
|
|
|
|
|
|
|
|
2475
|
|
|
|
|
|
|
=item duration_unit($format, @data) |
2476
|
|
|
|
|
|
|
|
2477
|
|
|
|
|
|
|
This method formats a duration. The format must be one of |
2478
|
|
|
|
|
|
|
C<hm>, C<hms> or C<ms> corresponding to C<hour minute>, |
2479
|
|
|
|
|
|
|
C<hour minute second> and C<minute second> respectively. |
2480
|
|
|
|
|
|
|
The data must correspond to the given format. |
2481
|
|
|
|
|
|
|
|
2482
|
|
|
|
|
|
|
=cut |
2483
|
|
|
|
|
|
|
|
2484
|
|
|
|
|
|
|
sub duration_unit { |
2485
|
|
|
|
|
|
|
# data in hh,mm; hh,mm,ss or mm,ss |
2486
|
|
|
|
|
|
|
my ($self, $format, @data) = @_; |
2487
|
|
|
|
|
|
|
|
2488
|
|
|
|
|
|
|
my $bundle = $self->_find_bundle('duration_units'); |
2489
|
|
|
|
|
|
|
my $parsed = $bundle->duration_units()->{$format}; |
2490
|
|
|
|
|
|
|
|
2491
|
|
|
|
|
|
|
my $num_format = '#'; |
2492
|
|
|
|
|
|
|
foreach my $entry ( qr/(hh?)/, qr/(mm?)/, qr/(ss?)/) { |
2493
|
|
|
|
|
|
|
$num_format = '00' if $parsed =~ s/$entry/$self->format_number(shift(@data), $num_format)/e; |
2494
|
|
|
|
|
|
|
} |
2495
|
|
|
|
|
|
|
|
2496
|
|
|
|
|
|
|
return $parsed; |
2497
|
|
|
|
|
|
|
} |
2498
|
|
|
|
|
|
|
|
2499
|
|
|
|
|
|
|
=back |
2500
|
|
|
|
|
|
|
|
2501
|
|
|
|
|
|
|
=head2 Yes or No? |
2502
|
|
|
|
|
|
|
|
2503
|
|
|
|
|
|
|
=over 4 |
2504
|
|
|
|
|
|
|
|
2505
|
|
|
|
|
|
|
=item is_yes($string) |
2506
|
|
|
|
|
|
|
|
2507
|
|
|
|
|
|
|
Returns true if the passed in string matches the locale's |
2508
|
|
|
|
|
|
|
idea of a string designating yes. Note that under POSIX |
2509
|
|
|
|
|
|
|
rules unless the locale's word for yes starts with C<Y> |
2510
|
|
|
|
|
|
|
(U+0079) then a single 'y' will also be accepted as yes. |
2511
|
|
|
|
|
|
|
The string will be matched case insensitive. |
2512
|
|
|
|
|
|
|
|
2513
|
|
|
|
|
|
|
=cut |
2514
|
|
|
|
|
|
|
|
2515
|
|
|
|
|
|
|
sub is_yes { |
2516
|
|
|
|
|
|
|
my ($self, $test_str) = @_; |
2517
|
|
|
|
|
|
|
|
2518
|
|
|
|
|
|
|
my $bundle = $self->_find_bundle('yesstr'); |
2519
|
|
|
|
|
|
|
return $test_str =~ $bundle->yesstr ? 1 : 0; |
2520
|
|
|
|
|
|
|
} |
2521
|
|
|
|
|
|
|
|
2522
|
|
|
|
|
|
|
=item is_no($string) |
2523
|
|
|
|
|
|
|
|
2524
|
|
|
|
|
|
|
Returns true if the passed in string matches the locale's |
2525
|
|
|
|
|
|
|
idea of a string designating no. Note that under POSIX |
2526
|
|
|
|
|
|
|
rules unless the locale's word for no starts with C<n> |
2527
|
|
|
|
|
|
|
(U+006E) then a single 'n' will also be accepted as no |
2528
|
|
|
|
|
|
|
The string will be matched case insensitive. |
2529
|
|
|
|
|
|
|
|
2530
|
|
|
|
|
|
|
=cut |
2531
|
|
|
|
|
|
|
|
2532
|
|
|
|
|
|
|
sub is_no { |
2533
|
|
|
|
|
|
|
my ($self, $test_str) = @_; |
2534
|
|
|
|
|
|
|
|
2535
|
|
|
|
|
|
|
my $bundle = $self->_find_bundle('nostr'); |
2536
|
|
|
|
|
|
|
return $test_str =~ $bundle->nostr ? 1 : 0; |
2537
|
|
|
|
|
|
|
} |
2538
|
|
|
|
|
|
|
|
2539
|
|
|
|
|
|
|
=back |
2540
|
|
|
|
|
|
|
|
2541
|
|
|
|
|
|
|
=head2 Transliteration |
2542
|
|
|
|
|
|
|
|
2543
|
|
|
|
|
|
|
This method requires Perl version 5.18 or above to use and for you to have |
2544
|
|
|
|
|
|
|
installed the optional C<Bundle::CLDR::Transformations> |
2545
|
|
|
|
|
|
|
|
2546
|
|
|
|
|
|
|
=over 4 |
2547
|
|
|
|
|
|
|
|
2548
|
|
|
|
|
|
|
=item transform(from => $from, to => $to, variant => $variant, text => $text) |
2549
|
|
|
|
|
|
|
|
2550
|
|
|
|
|
|
|
This method returns the transliterated string of C<text> from script C<from> |
2551
|
|
|
|
|
|
|
to script C<to> using variant C<variant>. If C<from> is not given then the |
2552
|
|
|
|
|
|
|
current locale's script is used. If C<text> is not given then it defaults to an |
2553
|
|
|
|
|
|
|
empty string. The C<variant> is optional. |
2554
|
|
|
|
|
|
|
|
2555
|
|
|
|
|
|
|
=cut |
2556
|
|
|
|
|
|
|
|
2557
|
|
|
|
|
|
|
sub transform { |
2558
|
|
|
|
|
|
|
_new_perl(); |
2559
|
|
|
|
|
|
|
|
2560
|
|
|
|
|
|
|
my ($self, %params) = @_; |
2561
|
|
|
|
|
|
|
|
2562
|
|
|
|
|
|
|
my $from = $params{from} // $self; |
2563
|
|
|
|
|
|
|
my $to = $params{to}; |
2564
|
|
|
|
|
|
|
my $variant = $params{variant} // 'Any'; |
2565
|
|
|
|
|
|
|
my $text = $params{text} // ''; |
2566
|
|
|
|
|
|
|
|
2567
|
|
|
|
|
|
|
($from, $to) = map {ref $_ ? $_->likely_script() : $_} ($from, $to); |
2568
|
|
|
|
|
|
|
$_ = ucfirst(lc $_) foreach ($from, $to, $variant); |
2569
|
|
|
|
|
|
|
|
2570
|
|
|
|
|
|
|
my $package = __PACKAGE__ . "::Transformations::${variant}::${from}::${to}"; |
2571
|
|
|
|
|
|
|
eval { Class::Load::load_class($package); }; |
2572
|
|
|
|
|
|
|
warn $@ if $@; |
2573
|
|
|
|
|
|
|
return $text if $@; # Can't load transform module so return original text |
2574
|
|
|
|
|
|
|
use feature 'state'; |
2575
|
|
|
|
|
|
|
state $transforms; |
2576
|
|
|
|
|
|
|
$transforms->{$variant}{$from}{$to} //= $package->new(); |
2577
|
|
|
|
|
|
|
my $rules = $transforms->{$variant}{$from}{$to}->transforms(); |
2578
|
|
|
|
|
|
|
|
2579
|
|
|
|
|
|
|
# First get the filter rule |
2580
|
|
|
|
|
|
|
my $filter = $rules->[0]; |
2581
|
|
|
|
|
|
|
|
2582
|
|
|
|
|
|
|
# Break up the input on the filter |
2583
|
|
|
|
|
|
|
my @text; |
2584
|
|
|
|
|
|
|
pos($text) = 0; |
2585
|
|
|
|
|
|
|
while (pos($text) < length($text)) { |
2586
|
|
|
|
|
|
|
my $characters = ''; |
2587
|
|
|
|
|
|
|
while (my ($char) = $text =~ /($filter)/) { |
2588
|
|
|
|
|
|
|
$characters .= $char; |
2589
|
|
|
|
|
|
|
pos($text) = pos($text) + length $char; |
2590
|
|
|
|
|
|
|
} |
2591
|
|
|
|
|
|
|
push @text, $characters; |
2592
|
|
|
|
|
|
|
last unless pos($text) < length $text; |
2593
|
|
|
|
|
|
|
|
2594
|
|
|
|
|
|
|
$characters = ''; |
2595
|
|
|
|
|
|
|
while ($text !~ /$filter/) { |
2596
|
|
|
|
|
|
|
my ($char) = $text =~ /\G(\X)/; |
2597
|
|
|
|
|
|
|
$characters .= $char; |
2598
|
|
|
|
|
|
|
pos($text) = pos($text) + length $char; |
2599
|
|
|
|
|
|
|
} |
2600
|
|
|
|
|
|
|
push @text, $characters; |
2601
|
|
|
|
|
|
|
} |
2602
|
|
|
|
|
|
|
|
2603
|
|
|
|
|
|
|
my $to_transform = 1; |
2604
|
|
|
|
|
|
|
|
2605
|
|
|
|
|
|
|
foreach my $characters (@text) { |
2606
|
|
|
|
|
|
|
if ($to_transform) { |
2607
|
|
|
|
|
|
|
foreach my $rule (@$rules[1 .. @$rules -1 ]) { |
2608
|
|
|
|
|
|
|
if ($rule->{type} eq 'transform') { |
2609
|
|
|
|
|
|
|
$characters = $self->_transformation_transform($characters, $rule->{data}, $variant); |
2610
|
|
|
|
|
|
|
} |
2611
|
|
|
|
|
|
|
else { |
2612
|
|
|
|
|
|
|
$characters = $self->_transform_convert($characters, $rule->{data}); |
2613
|
|
|
|
|
|
|
} |
2614
|
|
|
|
|
|
|
} |
2615
|
|
|
|
|
|
|
} |
2616
|
|
|
|
|
|
|
$to_transform = ! $to_transform; |
2617
|
|
|
|
|
|
|
} |
2618
|
|
|
|
|
|
|
|
2619
|
|
|
|
|
|
|
return join '', @text; |
2620
|
|
|
|
|
|
|
} |
2621
|
|
|
|
|
|
|
|
2622
|
|
|
|
|
|
|
sub _transformation_transform { |
2623
|
|
|
|
|
|
|
my ($self, $text, $rules, $variant) = @_; |
2624
|
|
|
|
|
|
|
|
2625
|
|
|
|
|
|
|
foreach my $rule (@$rules) { |
2626
|
|
|
|
|
|
|
for (lc $rule->{to}) { |
2627
|
|
|
|
|
|
|
if ($_ eq 'nfc') { |
2628
|
|
|
|
|
|
|
$text = Unicode::Normalize::NFC($text); |
2629
|
|
|
|
|
|
|
} |
2630
|
|
|
|
|
|
|
elsif($_ eq 'nfd') { |
2631
|
|
|
|
|
|
|
$text = Unicode::Normalize::NFD($text); |
2632
|
|
|
|
|
|
|
} |
2633
|
|
|
|
|
|
|
elsif($_ eq 'nfkd') { |
2634
|
|
|
|
|
|
|
$text = Unicode::Normalize::NFKD($text); |
2635
|
|
|
|
|
|
|
} |
2636
|
|
|
|
|
|
|
elsif($_ eq 'nfkc') { |
2637
|
|
|
|
|
|
|
$text = Unicode::Normalize::NFKC($text); |
2638
|
|
|
|
|
|
|
} |
2639
|
|
|
|
|
|
|
elsif($_ eq 'lower') { |
2640
|
|
|
|
|
|
|
$text = lc($text); |
2641
|
|
|
|
|
|
|
} |
2642
|
|
|
|
|
|
|
elsif($_ eq 'upper') { |
2643
|
|
|
|
|
|
|
$text = uc($text); |
2644
|
|
|
|
|
|
|
} |
2645
|
|
|
|
|
|
|
elsif($_ eq 'title') { |
2646
|
|
|
|
|
|
|
$text =~ s/(\X)/\u$1/g; |
2647
|
|
|
|
|
|
|
} |
2648
|
|
|
|
|
|
|
elsif($_ eq 'null') { |
2649
|
|
|
|
|
|
|
} |
2650
|
|
|
|
|
|
|
elsif($_ eq 'remove') { |
2651
|
|
|
|
|
|
|
$text = ''; |
2652
|
|
|
|
|
|
|
} |
2653
|
|
|
|
|
|
|
else { |
2654
|
|
|
|
|
|
|
$text = $self->transform($text, $variant, $rule->{from}, $rule->to); |
2655
|
|
|
|
|
|
|
} |
2656
|
|
|
|
|
|
|
} |
2657
|
|
|
|
|
|
|
} |
2658
|
|
|
|
|
|
|
return $text; |
2659
|
|
|
|
|
|
|
} |
2660
|
|
|
|
|
|
|
|
2661
|
|
|
|
|
|
|
sub _transform_convert { |
2662
|
|
|
|
|
|
|
my ($self, $text, $rules) = @_; |
2663
|
|
|
|
|
|
|
|
2664
|
|
|
|
|
|
|
pos($text) = 0; # Make sure we start scanning at the beginning of the text |
2665
|
|
|
|
|
|
|
|
2666
|
|
|
|
|
|
|
CHARACTER: while (pos($text) < length($text)) { |
2667
|
|
|
|
|
|
|
foreach my $rule (@$rules) { |
2668
|
|
|
|
|
|
|
next if length $rule->{before} && $text !~ /$rule->{before}\G/; |
2669
|
|
|
|
|
|
|
my $regex = $rule->{replace}; |
2670
|
|
|
|
|
|
|
$regex .= '(' . $rule->{after} . ')' if length $rule->{after}; |
2671
|
|
|
|
|
|
|
my $result = 'q(' . $rule->{result} . ')'; |
2672
|
|
|
|
|
|
|
$result .= '. $1' if length $rule->{after}; |
2673
|
|
|
|
|
|
|
if ($text =~ s/\G$regex/eval $result/e) { |
2674
|
|
|
|
|
|
|
pos($text) += length($rule->{result}) - $rule->{revisit}; |
2675
|
|
|
|
|
|
|
next CHARACTER; |
2676
|
|
|
|
|
|
|
} |
2677
|
|
|
|
|
|
|
} |
2678
|
|
|
|
|
|
|
|
2679
|
|
|
|
|
|
|
pos($text)++; |
2680
|
|
|
|
|
|
|
} |
2681
|
|
|
|
|
|
|
|
2682
|
|
|
|
|
|
|
return $text; |
2683
|
|
|
|
|
|
|
} |
2684
|
|
|
|
|
|
|
|
2685
|
|
|
|
|
|
|
=back |
2686
|
|
|
|
|
|
|
|
2687
|
|
|
|
|
|
|
=head2 Lists |
2688
|
|
|
|
|
|
|
|
2689
|
|
|
|
|
|
|
=over 4 |
2690
|
|
|
|
|
|
|
|
2691
|
|
|
|
|
|
|
=item list(@data) |
2692
|
|
|
|
|
|
|
|
2693
|
|
|
|
|
|
|
Returns C<data> as a string formatted by the locales idea of producing a list |
2694
|
|
|
|
|
|
|
of elements. What is returned can be effected by the locale and the number |
2695
|
|
|
|
|
|
|
of items in C<data>. Note that C<data> can contain 0 or more items. |
2696
|
|
|
|
|
|
|
|
2697
|
|
|
|
|
|
|
=cut |
2698
|
|
|
|
|
|
|
|
2699
|
|
|
|
|
|
|
sub list { |
2700
|
|
|
|
|
|
|
my ($self, @data) = @_; |
2701
|
|
|
|
|
|
|
|
2702
|
|
|
|
|
|
|
# Short circuit on 0 or 1 entries |
2703
|
|
|
|
|
|
|
return '' unless @data; |
2704
|
|
|
|
|
|
|
return $data[0] if 1 == @data; |
2705
|
|
|
|
|
|
|
|
2706
|
|
|
|
|
|
|
my @bundles = $self->_find_bundle('listPatterns'); |
2707
|
|
|
|
|
|
|
|
2708
|
|
|
|
|
|
|
my %list_data; |
2709
|
|
|
|
|
|
|
foreach my $bundle (reverse @bundles) { |
2710
|
|
|
|
|
|
|
my %listPatterns = %{$bundle->listPatterns}; |
2711
|
|
|
|
|
|
|
@list_data{keys %listPatterns} = values %listPatterns; |
2712
|
|
|
|
|
|
|
} |
2713
|
|
|
|
|
|
|
|
2714
|
|
|
|
|
|
|
if (my $pattern = $list_data{scalar @data}) { |
2715
|
|
|
|
|
|
|
$pattern=~s/\{([0-9]+)\}/$data[$1]/eg; |
2716
|
|
|
|
|
|
|
return $pattern; |
2717
|
|
|
|
|
|
|
} |
2718
|
|
|
|
|
|
|
|
2719
|
|
|
|
|
|
|
my ($start, $middle, $end) = @list_data{qw( start middle end )}; |
2720
|
|
|
|
|
|
|
|
2721
|
|
|
|
|
|
|
# First do the end |
2722
|
|
|
|
|
|
|
my $pattern = $end; |
2723
|
|
|
|
|
|
|
$pattern=~s/\{1\}/pop @data/e; |
2724
|
|
|
|
|
|
|
$pattern=~s/\{0\}/pop @data/e; |
2725
|
|
|
|
|
|
|
|
2726
|
|
|
|
|
|
|
# If there is any data left do the middle |
2727
|
|
|
|
|
|
|
while (@data > 1) { |
2728
|
|
|
|
|
|
|
my $current = $pattern; |
2729
|
|
|
|
|
|
|
$pattern = $middle; |
2730
|
|
|
|
|
|
|
$pattern=~s/\{1\}/$current/; |
2731
|
|
|
|
|
|
|
$pattern=~s/\{0\}/pop @data/e; |
2732
|
|
|
|
|
|
|
} |
2733
|
|
|
|
|
|
|
|
2734
|
|
|
|
|
|
|
# Now do the start |
2735
|
|
|
|
|
|
|
my $current = $pattern; |
2736
|
|
|
|
|
|
|
$pattern = $start; |
2737
|
|
|
|
|
|
|
$pattern=~s/\{1\}/$current/; |
2738
|
|
|
|
|
|
|
$pattern=~s/\{0\}/pop @data/e; |
2739
|
|
|
|
|
|
|
|
2740
|
|
|
|
|
|
|
return $pattern; |
2741
|
|
|
|
|
|
|
} |
2742
|
|
|
|
|
|
|
|
2743
|
|
|
|
|
|
|
=back |
2744
|
|
|
|
|
|
|
|
2745
|
|
|
|
|
|
|
=head2 Pluralisation |
2746
|
|
|
|
|
|
|
|
2747
|
|
|
|
|
|
|
=over 4 |
2748
|
|
|
|
|
|
|
|
2749
|
|
|
|
|
|
|
=item plural($number) |
2750
|
|
|
|
|
|
|
|
2751
|
|
|
|
|
|
|
This method takes a number and uses the locale's pluralisation |
2752
|
|
|
|
|
|
|
rules to calculate the type of pluralisation required for |
2753
|
|
|
|
|
|
|
units, currencies and other data that changes depending on |
2754
|
|
|
|
|
|
|
the plural state of the number |
2755
|
|
|
|
|
|
|
|
2756
|
|
|
|
|
|
|
=item plural_range($start, $end) |
2757
|
|
|
|
|
|
|
|
2758
|
|
|
|
|
|
|
This method returns the plural type for the range $start to $end |
2759
|
|
|
|
|
|
|
$start and $end can either be numbers or one of the plural types |
2760
|
|
|
|
|
|
|
C<zero one two few many other> |
2761
|
|
|
|
|
|
|
|
2762
|
|
|
|
|
|
|
=cut |
2763
|
|
|
|
|
|
|
|
2764
|
|
|
|
|
|
|
sub _clear_calendar_data { |
2765
|
|
|
|
|
|
|
my $self = shift; |
2766
|
|
|
|
|
|
|
|
2767
|
|
|
|
|
|
|
foreach my $property (qw( |
2768
|
|
|
|
|
|
|
month_format_wide month_format_abbreviated month_format_narrow |
2769
|
|
|
|
|
|
|
month_stand_alone_wide month_stand_alone_abbreviated |
2770
|
|
|
|
|
|
|
month_stand_alone_narrow day_format_wide day_format_abbreviated |
2771
|
|
|
|
|
|
|
day_format_narrow day_stand_alone_wide day_stand_alone_abreviated |
2772
|
|
|
|
|
|
|
day_stand_alone_narrow quater_format_wide quater_format_abbreviated |
2773
|
|
|
|
|
|
|
quater_format_narrow quater_stand_alone_wide |
2774
|
|
|
|
|
|
|
quater_stand_alone_abreviated quater_stand_alone_narrow |
2775
|
|
|
|
|
|
|
am_pm_wide am_pm_abbreviated am_pm_narrow am_pm_format_wide |
2776
|
|
|
|
|
|
|
am_pm_format_abbreviated am_pm_format_narrow am_pm_stand_alone_wide |
2777
|
|
|
|
|
|
|
am_pm_stand_alone_abbreviated am_pm_stand_alone_narrow era_wide |
2778
|
|
|
|
|
|
|
era_abbreviated era_narrow date_format_full date_format_long date_format_medium |
2779
|
|
|
|
|
|
|
date_format_short time_format_full |
2780
|
|
|
|
|
|
|
time_format_long time_format_medium time_format_short |
2781
|
|
|
|
|
|
|
datetime_format_full datetime_format_long |
2782
|
|
|
|
|
|
|
datetime_format_medium datetime_format_short |
2783
|
|
|
|
|
|
|
available_formats format_data |
2784
|
|
|
|
|
|
|
)) { |
2785
|
|
|
|
|
|
|
my $method = "_clear_$property"; |
2786
|
|
|
|
|
|
|
$self->$method; |
2787
|
|
|
|
|
|
|
} |
2788
|
|
|
|
|
|
|
} |
2789
|
|
|
|
|
|
|
|
2790
|
|
|
|
|
|
|
sub _build_any_month { |
2791
|
|
|
|
|
|
|
my ($self, $type, $width) = @_; |
2792
|
|
|
|
|
|
|
my $default_calendar = $self->default_calendar(); |
2793
|
|
|
|
|
|
|
my @bundles = $self->_find_bundle('calendar_months'); |
2794
|
|
|
|
|
|
|
BUNDLES: { |
2795
|
|
|
|
|
|
|
foreach my $bundle (@bundles) { |
2796
|
|
|
|
|
|
|
my $months = $bundle->calendar_months; |
2797
|
|
|
|
|
|
|
if (exists $months->{$default_calendar}{alias}) { |
2798
|
|
|
|
|
|
|
$default_calendar = $months->{$default_calendar}{alias}; |
2799
|
|
|
|
|
|
|
redo BUNDLES; |
2800
|
|
|
|
|
|
|
} |
2801
|
|
|
|
|
|
|
|
2802
|
|
|
|
|
|
|
if (exists $months->{$default_calendar}{$type}{$width}{alias}) { |
2803
|
|
|
|
|
|
|
($type, $width) = @{$months->{$default_calendar}{$type}{$width}{alias}}{qw(context type)}; |
2804
|
|
|
|
|
|
|
redo BUNDLES; |
2805
|
|
|
|
|
|
|
} |
2806
|
|
|
|
|
|
|
|
2807
|
|
|
|
|
|
|
my $result = $months->{$default_calendar}{$type}{$width}{nonleap}; |
2808
|
|
|
|
|
|
|
return $result if defined $result; |
2809
|
|
|
|
|
|
|
} |
2810
|
|
|
|
|
|
|
} |
2811
|
|
|
|
|
|
|
|
2812
|
|
|
|
|
|
|
return []; |
2813
|
|
|
|
|
|
|
} |
2814
|
|
|
|
|
|
|
|
2815
|
|
|
|
|
|
|
sub _build_month_format_wide { |
2816
|
|
|
|
|
|
|
my $self = shift; |
2817
|
|
|
|
|
|
|
my ($type, $width) = (qw(format wide)); |
2818
|
|
|
|
|
|
|
|
2819
|
|
|
|
|
|
|
return $self->_build_any_month($type, $width); |
2820
|
|
|
|
|
|
|
} |
2821
|
|
|
|
|
|
|
|
2822
|
|
|
|
|
|
|
sub _build_month_format_abbreviated { |
2823
|
|
|
|
|
|
|
my $self = shift; |
2824
|
|
|
|
|
|
|
my ($type, $width) = (qw(format abbreviated)); |
2825
|
|
|
|
|
|
|
|
2826
|
|
|
|
|
|
|
return $self->_build_any_month($type, $width); |
2827
|
|
|
|
|
|
|
} |
2828
|
|
|
|
|
|
|
|
2829
|
|
|
|
|
|
|
sub _build_month_format_narrow { |
2830
|
|
|
|
|
|
|
my $self = shift; |
2831
|
|
|
|
|
|
|
my ($type, $width) = (qw(format narrow)); |
2832
|
|
|
|
|
|
|
|
2833
|
|
|
|
|
|
|
return $self->_build_any_month($type, $width); |
2834
|
|
|
|
|
|
|
} |
2835
|
|
|
|
|
|
|
|
2836
|
|
|
|
|
|
|
sub _build_month_stand_alone_wide { |
2837
|
|
|
|
|
|
|
my $self = shift; |
2838
|
|
|
|
|
|
|
my ($type, $width) = ('stand-alone', 'wide'); |
2839
|
|
|
|
|
|
|
|
2840
|
|
|
|
|
|
|
return $self->_build_any_month($type, $width); |
2841
|
|
|
|
|
|
|
} |
2842
|
|
|
|
|
|
|
|
2843
|
|
|
|
|
|
|
sub _build_month_stand_alone_abbreviated { |
2844
|
|
|
|
|
|
|
my $self = shift; |
2845
|
|
|
|
|
|
|
my ($type, $width) = ('stand-alone', 'abbreviated'); |
2846
|
|
|
|
|
|
|
|
2847
|
|
|
|
|
|
|
return $self->_build_any_month($type, $width); |
2848
|
|
|
|
|
|
|
} |
2849
|
|
|
|
|
|
|
|
2850
|
|
|
|
|
|
|
sub _build_month_stand_alone_narrow { |
2851
|
|
|
|
|
|
|
my $self = shift; |
2852
|
|
|
|
|
|
|
my ($type, $width) = ('stand-alone', 'narrow'); |
2853
|
|
|
|
|
|
|
|
2854
|
|
|
|
|
|
|
return $self->_build_any_month($type, $width); |
2855
|
|
|
|
|
|
|
} |
2856
|
|
|
|
|
|
|
|
2857
|
|
|
|
|
|
|
sub _build_any_day { |
2858
|
|
|
|
|
|
|
my ($self, $type, $width) = @_; |
2859
|
|
|
|
|
|
|
|
2860
|
|
|
|
|
|
|
my $default_calendar = $self->default_calendar(); |
2861
|
|
|
|
|
|
|
|
2862
|
|
|
|
|
|
|
my @bundles = $self->_find_bundle('calendar_days'); |
2863
|
|
|
|
|
|
|
BUNDLES: { |
2864
|
|
|
|
|
|
|
foreach my $bundle (@bundles) { |
2865
|
|
|
|
|
|
|
my $days= $bundle->calendar_days; |
2866
|
|
|
|
|
|
|
|
2867
|
|
|
|
|
|
|
if (exists $days->{$default_calendar}{alias}) { |
2868
|
|
|
|
|
|
|
$default_calendar = $days->{$default_calendar}{alias}; |
2869
|
|
|
|
|
|
|
redo BUNDLES; |
2870
|
|
|
|
|
|
|
} |
2871
|
|
|
|
|
|
|
|
2872
|
|
|
|
|
|
|
if (exists $days->{$default_calendar}{$type}{$width}{alias}) { |
2873
|
|
|
|
|
|
|
($type, $width) = @{$days->{$default_calendar}{$type}{$width}{alias}}{qw(context type)}; |
2874
|
|
|
|
|
|
|
redo BUNDLES; |
2875
|
|
|
|
|
|
|
} |
2876
|
|
|
|
|
|
|
my $result = $days->{$default_calendar}{$type}{$width}; |
2877
|
|
|
|
|
|
|
return [ @{$result}{qw( mon tue wed thu fri sat sun )} ] if keys %$result; |
2878
|
|
|
|
|
|
|
} |
2879
|
|
|
|
|
|
|
} |
2880
|
|
|
|
|
|
|
|
2881
|
|
|
|
|
|
|
return []; |
2882
|
|
|
|
|
|
|
} |
2883
|
|
|
|
|
|
|
|
2884
|
|
|
|
|
|
|
sub _build_day_format_wide { |
2885
|
|
|
|
|
|
|
my $self = shift; |
2886
|
|
|
|
|
|
|
my ($type, $width) = (qw(format wide)); |
2887
|
|
|
|
|
|
|
|
2888
|
|
|
|
|
|
|
return $self->_build_any_day($type, $width); |
2889
|
|
|
|
|
|
|
} |
2890
|
|
|
|
|
|
|
|
2891
|
|
|
|
|
|
|
sub _build_day_format_abbreviated { |
2892
|
|
|
|
|
|
|
my $self = shift; |
2893
|
|
|
|
|
|
|
my ($type, $width) = (qw(format abbreviated)); |
2894
|
|
|
|
|
|
|
|
2895
|
|
|
|
|
|
|
return $self->_build_any_day($type, $width); |
2896
|
|
|
|
|
|
|
} |
2897
|
|
|
|
|
|
|
|
2898
|
|
|
|
|
|
|
sub _build_day_format_narrow { |
2899
|
|
|
|
|
|
|
my $self = shift; |
2900
|
|
|
|
|
|
|
my ($type, $width) = (qw(format narrow)); |
2901
|
|
|
|
|
|
|
|
2902
|
|
|
|
|
|
|
return $self->_build_any_day($type, $width); |
2903
|
|
|
|
|
|
|
} |
2904
|
|
|
|
|
|
|
|
2905
|
|
|
|
|
|
|
sub _build_day_stand_alone_wide { |
2906
|
|
|
|
|
|
|
my $self = shift; |
2907
|
|
|
|
|
|
|
my ($type, $width) = ('stand-alone', 'wide'); |
2908
|
|
|
|
|
|
|
|
2909
|
|
|
|
|
|
|
return $self->_build_any_day($type, $width); |
2910
|
|
|
|
|
|
|
} |
2911
|
|
|
|
|
|
|
|
2912
|
|
|
|
|
|
|
sub _build_day_stand_alone_abbreviated { |
2913
|
|
|
|
|
|
|
my $self = shift; |
2914
|
|
|
|
|
|
|
my ($type, $width) = ('stand-alone', 'abbreviated'); |
2915
|
|
|
|
|
|
|
|
2916
|
|
|
|
|
|
|
return $self->_build_any_day($type, $width); |
2917
|
|
|
|
|
|
|
} |
2918
|
|
|
|
|
|
|
|
2919
|
|
|
|
|
|
|
sub _build_day_stand_alone_narrow { |
2920
|
|
|
|
|
|
|
my $self = shift; |
2921
|
|
|
|
|
|
|
my ($type, $width) = ('stand-alone', 'narrow'); |
2922
|
|
|
|
|
|
|
|
2923
|
|
|
|
|
|
|
return $self->_build_any_day($type, $width); |
2924
|
|
|
|
|
|
|
} |
2925
|
|
|
|
|
|
|
|
2926
|
|
|
|
|
|
|
sub _build_any_quarter { |
2927
|
|
|
|
|
|
|
my ($self, $type, $width) = @_; |
2928
|
|
|
|
|
|
|
|
2929
|
|
|
|
|
|
|
my $default_calendar = $self->default_calendar(); |
2930
|
|
|
|
|
|
|
|
2931
|
|
|
|
|
|
|
my @bundles = $self->_find_bundle('calendar_quarters'); |
2932
|
|
|
|
|
|
|
BUNDLES: { |
2933
|
|
|
|
|
|
|
foreach my $bundle (@bundles) { |
2934
|
|
|
|
|
|
|
my $quarters= $bundle->calendar_quarters; |
2935
|
|
|
|
|
|
|
|
2936
|
|
|
|
|
|
|
if (exists $quarters->{$default_calendar}{alias}) { |
2937
|
|
|
|
|
|
|
$default_calendar = $quarters->{$default_calendar}{alias}; |
2938
|
|
|
|
|
|
|
redo BUNDLES; |
2939
|
|
|
|
|
|
|
} |
2940
|
|
|
|
|
|
|
|
2941
|
|
|
|
|
|
|
if (exists $quarters->{$default_calendar}{$type}{$width}{alias}) { |
2942
|
|
|
|
|
|
|
($type, $width) = @{$quarters->{$default_calendar}{$type}{$width}{alias}}{qw(context type)}; |
2943
|
|
|
|
|
|
|
redo BUNDLES; |
2944
|
|
|
|
|
|
|
} |
2945
|
|
|
|
|
|
|
|
2946
|
|
|
|
|
|
|
my $result = $quarters->{$default_calendar}{$type}{$width}; |
2947
|
|
|
|
|
|
|
return [ @{$result}{qw( 0 1 2 3 )} ] if keys %$result; |
2948
|
|
|
|
|
|
|
} |
2949
|
|
|
|
|
|
|
} |
2950
|
|
|
|
|
|
|
|
2951
|
|
|
|
|
|
|
return []; |
2952
|
|
|
|
|
|
|
} |
2953
|
|
|
|
|
|
|
|
2954
|
|
|
|
|
|
|
sub _build_quarter_format_wide { |
2955
|
|
|
|
|
|
|
my $self = shift; |
2956
|
|
|
|
|
|
|
my ($type, $width) = (qw( format wide )); |
2957
|
|
|
|
|
|
|
|
2958
|
|
|
|
|
|
|
return $self->_build_any_quarter($type, $width); |
2959
|
|
|
|
|
|
|
} |
2960
|
|
|
|
|
|
|
|
2961
|
|
|
|
|
|
|
sub _build_quarter_format_abbreviated { |
2962
|
|
|
|
|
|
|
my $self = shift; |
2963
|
|
|
|
|
|
|
my ($type, $width) = (qw(format abbreviated)); |
2964
|
|
|
|
|
|
|
|
2965
|
|
|
|
|
|
|
return $self->_build_any_quarter($type, $width); |
2966
|
|
|
|
|
|
|
} |
2967
|
|
|
|
|
|
|
|
2968
|
|
|
|
|
|
|
sub _build_quarter_format_narrow { |
2969
|
|
|
|
|
|
|
my $self = shift; |
2970
|
|
|
|
|
|
|
my ($type, $width) = (qw(format narrow)); |
2971
|
|
|
|
|
|
|
|
2972
|
|
|
|
|
|
|
return $self->_build_any_quarter($type, $width); |
2973
|
|
|
|
|
|
|
} |
2974
|
|
|
|
|
|
|
|
2975
|
|
|
|
|
|
|
sub _build_quarter_stand_alone_wide { |
2976
|
|
|
|
|
|
|
my $self = shift; |
2977
|
|
|
|
|
|
|
my ($type, $width) = ('stand-alone', 'wide'); |
2978
|
|
|
|
|
|
|
|
2979
|
|
|
|
|
|
|
return $self->_build_any_quarter($type, $width); |
2980
|
|
|
|
|
|
|
} |
2981
|
|
|
|
|
|
|
|
2982
|
|
|
|
|
|
|
sub _build_quarter_stand_alone_abbreviated { |
2983
|
|
|
|
|
|
|
my $self = shift; |
2984
|
|
|
|
|
|
|
my ($type, $width) = ('stand-alone', 'abbreviated'); |
2985
|
|
|
|
|
|
|
|
2986
|
|
|
|
|
|
|
return $self->_build_any_quarter($type, $width); |
2987
|
|
|
|
|
|
|
} |
2988
|
|
|
|
|
|
|
|
2989
|
|
|
|
|
|
|
sub _build_quarter_stand_alone_narrow { |
2990
|
|
|
|
|
|
|
my $self = shift; |
2991
|
|
|
|
|
|
|
my ($type, $width) = ('stand-alone', 'narrow'); |
2992
|
|
|
|
|
|
|
|
2993
|
|
|
|
|
|
|
return $self->_build_any_quarter($type, $width); |
2994
|
|
|
|
|
|
|
} |
2995
|
|
|
|
|
|
|
|
2996
|
|
|
|
|
|
|
sub get_day_period { |
2997
|
|
|
|
|
|
|
# Time in hhmm |
2998
|
|
|
|
|
|
|
my ($self, $time) = @_; |
2999
|
|
|
|
|
|
|
|
3000
|
|
|
|
|
|
|
my $default_calendar = $self->default_calendar(); |
3001
|
|
|
|
|
|
|
|
3002
|
|
|
|
|
|
|
my $bundle = $self->_find_bundle('day_period_data'); |
3003
|
|
|
|
|
|
|
|
3004
|
|
|
|
|
|
|
my $day_period = $bundle->day_period_data; |
3005
|
|
|
|
|
|
|
$day_period = $self->$day_period($default_calendar, $time); |
3006
|
|
|
|
|
|
|
|
3007
|
|
|
|
|
|
|
my $am_pm = $self->am_pm_format_abbreviated; |
3008
|
|
|
|
|
|
|
|
3009
|
|
|
|
|
|
|
return $am_pm->{$day_period}; |
3010
|
|
|
|
|
|
|
} |
3011
|
|
|
|
|
|
|
|
3012
|
|
|
|
|
|
|
sub _build_any_am_pm { |
3013
|
|
|
|
|
|
|
my ($self, $type, $width) = @_; |
3014
|
|
|
|
|
|
|
|
3015
|
|
|
|
|
|
|
my $default_calendar = $self->default_calendar(); |
3016
|
|
|
|
|
|
|
my @result; |
3017
|
|
|
|
|
|
|
my @bundles = $self->_find_bundle('day_periods'); |
3018
|
|
|
|
|
|
|
my %return; |
3019
|
|
|
|
|
|
|
|
3020
|
|
|
|
|
|
|
BUNDLES: { |
3021
|
|
|
|
|
|
|
foreach my $bundle (@bundles) { |
3022
|
|
|
|
|
|
|
my $am_pm = $bundle->day_periods; |
3023
|
|
|
|
|
|
|
|
3024
|
|
|
|
|
|
|
if (exists $am_pm->{$default_calendar}{alias}) { |
3025
|
|
|
|
|
|
|
$default_calendar = $am_pm->{$default_calendar}{alias}; |
3026
|
|
|
|
|
|
|
redo BUNDLES; |
3027
|
|
|
|
|
|
|
} |
3028
|
|
|
|
|
|
|
|
3029
|
|
|
|
|
|
|
if (exists $am_pm->{$default_calendar}{$type}{alias}) { |
3030
|
|
|
|
|
|
|
$type = $am_pm->{$default_calendar}{$type}{alias}; |
3031
|
|
|
|
|
|
|
redo BUNDLES; |
3032
|
|
|
|
|
|
|
} |
3033
|
|
|
|
|
|
|
|
3034
|
|
|
|
|
|
|
if (exists $am_pm->{$default_calendar}{$type}{$width}{alias}) { |
3035
|
|
|
|
|
|
|
$width = $am_pm->{$default_calendar}{$type}{$width}{alias}; |
3036
|
|
|
|
|
|
|
redo BUNDLES; |
3037
|
|
|
|
|
|
|
} |
3038
|
|
|
|
|
|
|
|
3039
|
|
|
|
|
|
|
my $result = $am_pm->{$default_calendar}{$type}{$width}; |
3040
|
|
|
|
|
|
|
|
3041
|
|
|
|
|
|
|
foreach (keys %$result) { |
3042
|
|
|
|
|
|
|
$return{$_} = $result->{$_} unless exists $return{$_}; |
3043
|
|
|
|
|
|
|
} |
3044
|
|
|
|
|
|
|
} |
3045
|
|
|
|
|
|
|
} |
3046
|
|
|
|
|
|
|
|
3047
|
|
|
|
|
|
|
return \%return; |
3048
|
|
|
|
|
|
|
} |
3049
|
|
|
|
|
|
|
|
3050
|
|
|
|
|
|
|
# The first 3 are to link in with Date::Time::Locale |
3051
|
|
|
|
|
|
|
sub _build_am_pm_wide { |
3052
|
|
|
|
|
|
|
my $self = shift; |
3053
|
|
|
|
|
|
|
my ($type, $width) = (qw( format wide )); |
3054
|
|
|
|
|
|
|
|
3055
|
|
|
|
|
|
|
my $result = $self->_build_any_am_pm($type, $width); |
3056
|
|
|
|
|
|
|
|
3057
|
|
|
|
|
|
|
return [ @$result{qw( am pm )} ]; |
3058
|
|
|
|
|
|
|
} |
3059
|
|
|
|
|
|
|
|
3060
|
|
|
|
|
|
|
sub _build_am_pm_abbreviated { |
3061
|
|
|
|
|
|
|
my $self = shift; |
3062
|
|
|
|
|
|
|
my ($type, $width) = (qw( format abbreviated )); |
3063
|
|
|
|
|
|
|
|
3064
|
|
|
|
|
|
|
my $result = $self->_build_any_am_pm($type, $width); |
3065
|
|
|
|
|
|
|
|
3066
|
|
|
|
|
|
|
return [ @$result{qw( am pm )} ]; |
3067
|
|
|
|
|
|
|
} |
3068
|
|
|
|
|
|
|
|
3069
|
|
|
|
|
|
|
sub _build_am_pm_narrow { |
3070
|
|
|
|
|
|
|
my $self = shift; |
3071
|
|
|
|
|
|
|
my ($type, $width) = (qw( format narrow )); |
3072
|
|
|
|
|
|
|
|
3073
|
|
|
|
|
|
|
my $result = $self->_build_any_am_pm($type, $width); |
3074
|
|
|
|
|
|
|
|
3075
|
|
|
|
|
|
|
return [ @$result{qw( am pm )} ]; |
3076
|
|
|
|
|
|
|
} |
3077
|
|
|
|
|
|
|
|
3078
|
|
|
|
|
|
|
# Now we do the full set of data |
3079
|
|
|
|
|
|
|
sub _build_am_pm_format_wide { |
3080
|
|
|
|
|
|
|
my $self = shift; |
3081
|
|
|
|
|
|
|
my ($type, $width) = (qw( format wide )); |
3082
|
|
|
|
|
|
|
|
3083
|
|
|
|
|
|
|
return $self->_build_any_am_pm($type, $width); |
3084
|
|
|
|
|
|
|
} |
3085
|
|
|
|
|
|
|
|
3086
|
|
|
|
|
|
|
sub _build_am_pm_format_abbreviated { |
3087
|
|
|
|
|
|
|
my $self = shift; |
3088
|
|
|
|
|
|
|
my ($type, $width) = (qw( format abbreviated )); |
3089
|
|
|
|
|
|
|
|
3090
|
|
|
|
|
|
|
return $self->_build_any_am_pm($type, $width); |
3091
|
|
|
|
|
|
|
} |
3092
|
|
|
|
|
|
|
|
3093
|
|
|
|
|
|
|
sub _build_am_pm_format_narrow { |
3094
|
|
|
|
|
|
|
my $self = shift; |
3095
|
|
|
|
|
|
|
my ($type, $width) = (qw( format narrow )); |
3096
|
|
|
|
|
|
|
|
3097
|
|
|
|
|
|
|
return $self->_build_any_am_pm($type, $width); |
3098
|
|
|
|
|
|
|
} |
3099
|
|
|
|
|
|
|
|
3100
|
|
|
|
|
|
|
sub _build_am_pm_stand_alone_wide { |
3101
|
|
|
|
|
|
|
my $self = shift; |
3102
|
|
|
|
|
|
|
my ($type, $width) = ('stand-alone', 'wide'); |
3103
|
|
|
|
|
|
|
|
3104
|
|
|
|
|
|
|
return $self->_build_any_am_pm($type, $width); |
3105
|
|
|
|
|
|
|
} |
3106
|
|
|
|
|
|
|
|
3107
|
|
|
|
|
|
|
sub _build_am_pm_stand_alone_abbreviated { |
3108
|
|
|
|
|
|
|
my $self = shift; |
3109
|
|
|
|
|
|
|
my ($type, $width) = ('stand-alone', 'abbreviated'); |
3110
|
|
|
|
|
|
|
|
3111
|
|
|
|
|
|
|
return $self->_build_any_am_pm($type, $width); |
3112
|
|
|
|
|
|
|
} |
3113
|
|
|
|
|
|
|
|
3114
|
|
|
|
|
|
|
sub _build_am_pm_stand_alone_narrow { |
3115
|
|
|
|
|
|
|
my $self = shift; |
3116
|
|
|
|
|
|
|
my ($type, $width) = ('stand-alone', 'narrow'); |
3117
|
|
|
|
|
|
|
|
3118
|
|
|
|
|
|
|
return $self->_build_any_am_pm($type, $width); |
3119
|
|
|
|
|
|
|
} |
3120
|
|
|
|
|
|
|
|
3121
|
|
|
|
|
|
|
sub _build_any_era { |
3122
|
|
|
|
|
|
|
my ($self, $width) = @_; |
3123
|
|
|
|
|
|
|
|
3124
|
|
|
|
|
|
|
my $default_calendar = $self->default_calendar(); |
3125
|
|
|
|
|
|
|
my @bundles = $self->_find_bundle('eras'); |
3126
|
|
|
|
|
|
|
BUNDLES: { |
3127
|
|
|
|
|
|
|
foreach my $bundle (@bundles) { |
3128
|
|
|
|
|
|
|
my $eras = $bundle->eras; |
3129
|
|
|
|
|
|
|
|
3130
|
|
|
|
|
|
|
if (exists $eras->{$default_calendar}{alias}) { |
3131
|
|
|
|
|
|
|
$default_calendar = $eras->{$default_calendar}{alias}; |
3132
|
|
|
|
|
|
|
redo BUNDLES; |
3133
|
|
|
|
|
|
|
} |
3134
|
|
|
|
|
|
|
|
3135
|
|
|
|
|
|
|
if (exists $eras->{$default_calendar}{$width}{alias}) { |
3136
|
|
|
|
|
|
|
$width = $eras->{$default_calendar}{$width}{alias}; |
3137
|
|
|
|
|
|
|
redo BUNDLES; |
3138
|
|
|
|
|
|
|
} |
3139
|
|
|
|
|
|
|
|
3140
|
|
|
|
|
|
|
my $result = $eras->{$default_calendar}{$width}; |
3141
|
|
|
|
|
|
|
|
3142
|
|
|
|
|
|
|
my @result; |
3143
|
|
|
|
|
|
|
@result[keys %$result] = values %$result; |
3144
|
|
|
|
|
|
|
|
3145
|
|
|
|
|
|
|
return \@result if keys %$result; |
3146
|
|
|
|
|
|
|
} |
3147
|
|
|
|
|
|
|
} |
3148
|
|
|
|
|
|
|
|
3149
|
|
|
|
|
|
|
return []; |
3150
|
|
|
|
|
|
|
} |
3151
|
|
|
|
|
|
|
|
3152
|
|
|
|
|
|
|
# The next three are for DateDime::Locale |
3153
|
|
|
|
|
|
|
sub _build_era_wide { |
3154
|
|
|
|
|
|
|
my $self = shift; |
3155
|
|
|
|
|
|
|
my ($width) = (qw( wide )); |
3156
|
|
|
|
|
|
|
|
3157
|
|
|
|
|
|
|
my $result = $self->_build_any_era($width); |
3158
|
|
|
|
|
|
|
|
3159
|
|
|
|
|
|
|
return [@$result[0, 1]]; |
3160
|
|
|
|
|
|
|
} |
3161
|
|
|
|
|
|
|
|
3162
|
|
|
|
|
|
|
sub _build_era_abbreviated { |
3163
|
|
|
|
|
|
|
my $self = shift; |
3164
|
|
|
|
|
|
|
my ($width) = (qw( abbreviated )); |
3165
|
|
|
|
|
|
|
|
3166
|
|
|
|
|
|
|
my $result = $self->_build_any_era($width); |
3167
|
|
|
|
|
|
|
|
3168
|
|
|
|
|
|
|
return [@$result[0, 1]]; |
3169
|
|
|
|
|
|
|
} |
3170
|
|
|
|
|
|
|
|
3171
|
|
|
|
|
|
|
sub _build_era_narrow { |
3172
|
|
|
|
|
|
|
my $self = shift; |
3173
|
|
|
|
|
|
|
my ($width) = (qw( narrow )); |
3174
|
|
|
|
|
|
|
|
3175
|
|
|
|
|
|
|
my $result = $self->_build_any_era($width); |
3176
|
|
|
|
|
|
|
|
3177
|
|
|
|
|
|
|
return [@$result[0, 1]]; |
3178
|
|
|
|
|
|
|
} |
3179
|
|
|
|
|
|
|
|
3180
|
|
|
|
|
|
|
# Now get all the era data |
3181
|
|
|
|
|
|
|
sub _build_era_format_wide { |
3182
|
|
|
|
|
|
|
my $self = shift; |
3183
|
|
|
|
|
|
|
my ($width) = (qw( wide )); |
3184
|
|
|
|
|
|
|
|
3185
|
|
|
|
|
|
|
return $self->_build_any_era($width); |
3186
|
|
|
|
|
|
|
} |
3187
|
|
|
|
|
|
|
|
3188
|
|
|
|
|
|
|
sub _build_era_format_abbreviated { |
3189
|
|
|
|
|
|
|
my $self = shift; |
3190
|
|
|
|
|
|
|
my ($width) = (qw( abbreviated )); |
3191
|
|
|
|
|
|
|
|
3192
|
|
|
|
|
|
|
return $self->_build_any_era($width); |
3193
|
|
|
|
|
|
|
} |
3194
|
|
|
|
|
|
|
|
3195
|
|
|
|
|
|
|
sub _build_era_format_narrow { |
3196
|
|
|
|
|
|
|
my $self = shift; |
3197
|
|
|
|
|
|
|
my ($type, $width) = (qw( narrow )); |
3198
|
|
|
|
|
|
|
|
3199
|
|
|
|
|
|
|
return $self->_build_any_era($type, $width); |
3200
|
|
|
|
|
|
|
} |
3201
|
|
|
|
|
|
|
|
3202
|
|
|
|
|
|
|
*_build_era_stand_alone_wide = \&_build_era_format_wide; |
3203
|
|
|
|
|
|
|
*_build_era_stand_alone_abbreviated = \&_build_era_format_abbreviated; |
3204
|
|
|
|
|
|
|
*_build_era_stand_alone_narrow = \&_build_era_format_narrow; |
3205
|
|
|
|
|
|
|
|
3206
|
|
|
|
|
|
|
sub _build_any_date_format { |
3207
|
|
|
|
|
|
|
my ($self, $width) = @_; |
3208
|
|
|
|
|
|
|
my $default_calendar = $self->default_calendar(); |
3209
|
|
|
|
|
|
|
|
3210
|
|
|
|
|
|
|
my @bundles = $self->_find_bundle('date_formats'); |
3211
|
|
|
|
|
|
|
|
3212
|
|
|
|
|
|
|
BUNDLES: { |
3213
|
|
|
|
|
|
|
foreach my $bundle (@bundles) { |
3214
|
|
|
|
|
|
|
my $date_formats = $bundle->date_formats; |
3215
|
|
|
|
|
|
|
if (exists $date_formats->{alias}) { |
3216
|
|
|
|
|
|
|
$default_calendar = $date_formats->{alias}; |
3217
|
|
|
|
|
|
|
redo BUNDLES; |
3218
|
|
|
|
|
|
|
} |
3219
|
|
|
|
|
|
|
|
3220
|
|
|
|
|
|
|
my $result = $date_formats->{$default_calendar}{$width}; |
3221
|
|
|
|
|
|
|
return $result if $result; |
3222
|
|
|
|
|
|
|
} |
3223
|
|
|
|
|
|
|
} |
3224
|
|
|
|
|
|
|
return ''; |
3225
|
|
|
|
|
|
|
} |
3226
|
|
|
|
|
|
|
|
3227
|
|
|
|
|
|
|
sub _build_date_format_full { |
3228
|
|
|
|
|
|
|
my $self = shift; |
3229
|
|
|
|
|
|
|
|
3230
|
|
|
|
|
|
|
my ($width) = ('full'); |
3231
|
|
|
|
|
|
|
return $self->_build_any_date_format($width); |
3232
|
|
|
|
|
|
|
} |
3233
|
|
|
|
|
|
|
|
3234
|
|
|
|
|
|
|
sub _build_date_format_long { |
3235
|
|
|
|
|
|
|
my $self = shift; |
3236
|
|
|
|
|
|
|
|
3237
|
|
|
|
|
|
|
my ($width) = ('long'); |
3238
|
|
|
|
|
|
|
return $self->_build_any_date_format($width); |
3239
|
|
|
|
|
|
|
} |
3240
|
|
|
|
|
|
|
|
3241
|
|
|
|
|
|
|
sub _build_date_format_medium { |
3242
|
|
|
|
|
|
|
my $self = shift; |
3243
|
|
|
|
|
|
|
|
3244
|
|
|
|
|
|
|
my ($width) = ('medium'); |
3245
|
|
|
|
|
|
|
return $self->_build_any_date_format($width); |
3246
|
|
|
|
|
|
|
} |
3247
|
|
|
|
|
|
|
|
3248
|
|
|
|
|
|
|
sub _build_date_format_short { |
3249
|
|
|
|
|
|
|
my $self = shift; |
3250
|
|
|
|
|
|
|
|
3251
|
|
|
|
|
|
|
my ($width) = ('short'); |
3252
|
|
|
|
|
|
|
return $self->_build_any_date_format($width); |
3253
|
|
|
|
|
|
|
} |
3254
|
|
|
|
|
|
|
|
3255
|
|
|
|
|
|
|
sub _build_any_time_format { |
3256
|
|
|
|
|
|
|
my ($self, $width) = @_; |
3257
|
|
|
|
|
|
|
my $default_calendar = $self->default_calendar(); |
3258
|
|
|
|
|
|
|
|
3259
|
|
|
|
|
|
|
my @bundles = $self->_find_bundle('time_formats'); |
3260
|
|
|
|
|
|
|
|
3261
|
|
|
|
|
|
|
BUNDLES: { |
3262
|
|
|
|
|
|
|
foreach my $bundle (@bundles) { |
3263
|
|
|
|
|
|
|
my $time_formats = $bundle->time_formats; |
3264
|
|
|
|
|
|
|
if (exists $time_formats->{$default_calendar}{alias}) { |
3265
|
|
|
|
|
|
|
$default_calendar = $time_formats->{$default_calendar}{alias}; |
3266
|
|
|
|
|
|
|
redo BUNDLES; |
3267
|
|
|
|
|
|
|
} |
3268
|
|
|
|
|
|
|
|
3269
|
|
|
|
|
|
|
my $result = $time_formats->{$default_calendar}{$width}; |
3270
|
|
|
|
|
|
|
return $result if $result; |
3271
|
|
|
|
|
|
|
} |
3272
|
|
|
|
|
|
|
} |
3273
|
|
|
|
|
|
|
return ''; |
3274
|
|
|
|
|
|
|
} |
3275
|
|
|
|
|
|
|
|
3276
|
|
|
|
|
|
|
sub _build_time_format_full { |
3277
|
|
|
|
|
|
|
my $self = shift; |
3278
|
|
|
|
|
|
|
my $width = 'full'; |
3279
|
|
|
|
|
|
|
|
3280
|
|
|
|
|
|
|
return $self->_build_any_time_format($width); |
3281
|
|
|
|
|
|
|
} |
3282
|
|
|
|
|
|
|
|
3283
|
|
|
|
|
|
|
sub _build_time_format_long { |
3284
|
|
|
|
|
|
|
my $self = shift; |
3285
|
|
|
|
|
|
|
|
3286
|
|
|
|
|
|
|
my $width = 'long'; |
3287
|
|
|
|
|
|
|
return $self->_build_any_time_format($width); |
3288
|
|
|
|
|
|
|
} |
3289
|
|
|
|
|
|
|
|
3290
|
|
|
|
|
|
|
sub _build_time_format_medium { |
3291
|
|
|
|
|
|
|
my $self = shift; |
3292
|
|
|
|
|
|
|
|
3293
|
|
|
|
|
|
|
my $width = 'medium'; |
3294
|
|
|
|
|
|
|
return $self->_build_any_time_format($width); |
3295
|
|
|
|
|
|
|
} |
3296
|
|
|
|
|
|
|
|
3297
|
|
|
|
|
|
|
sub _build_time_format_short { |
3298
|
|
|
|
|
|
|
my $self = shift; |
3299
|
|
|
|
|
|
|
|
3300
|
|
|
|
|
|
|
my $width = 'short'; |
3301
|
|
|
|
|
|
|
return $self->_build_any_time_format($width); |
3302
|
|
|
|
|
|
|
} |
3303
|
|
|
|
|
|
|
|
3304
|
|
|
|
|
|
|
sub _build_any_datetime_format { |
3305
|
|
|
|
|
|
|
my ($self, $width) = @_; |
3306
|
|
|
|
|
|
|
my $default_calendar = $self->default_calendar(); |
3307
|
|
|
|
|
|
|
|
3308
|
|
|
|
|
|
|
my @bundles = $self->_find_bundle('datetime_formats'); |
3309
|
|
|
|
|
|
|
|
3310
|
|
|
|
|
|
|
BUNDLES: { |
3311
|
|
|
|
|
|
|
foreach my $bundle (@bundles) { |
3312
|
|
|
|
|
|
|
my $datetime_formats = $bundle->datetime_formats; |
3313
|
|
|
|
|
|
|
if (exists $datetime_formats->{$default_calendar}{alias}) { |
3314
|
|
|
|
|
|
|
$default_calendar = $datetime_formats->{$default_calendar}{alias}; |
3315
|
|
|
|
|
|
|
redo BUNDLES; |
3316
|
|
|
|
|
|
|
} |
3317
|
|
|
|
|
|
|
|
3318
|
|
|
|
|
|
|
my $result = $datetime_formats->{$default_calendar}{$width}; |
3319
|
|
|
|
|
|
|
return $result if $result; |
3320
|
|
|
|
|
|
|
} |
3321
|
|
|
|
|
|
|
} |
3322
|
|
|
|
|
|
|
|
3323
|
|
|
|
|
|
|
return ''; |
3324
|
|
|
|
|
|
|
} |
3325
|
|
|
|
|
|
|
|
3326
|
|
|
|
|
|
|
sub _build_datetime_format_full { |
3327
|
|
|
|
|
|
|
my $self = shift; |
3328
|
|
|
|
|
|
|
|
3329
|
|
|
|
|
|
|
my $width = 'full'; |
3330
|
|
|
|
|
|
|
my $format = $self->_build_any_datetime_format($width); |
3331
|
|
|
|
|
|
|
|
3332
|
|
|
|
|
|
|
my $date = $self->_build_any_date_format($width); |
3333
|
|
|
|
|
|
|
my $time = $self->_build_any_time_format($width); |
3334
|
|
|
|
|
|
|
|
3335
|
|
|
|
|
|
|
$format =~ s/\{0\}/$time/; |
3336
|
|
|
|
|
|
|
$format =~ s/\{1\}/$date/; |
3337
|
|
|
|
|
|
|
|
3338
|
|
|
|
|
|
|
return $format; |
3339
|
|
|
|
|
|
|
} |
3340
|
|
|
|
|
|
|
|
3341
|
|
|
|
|
|
|
sub _build_datetime_format_long { |
3342
|
|
|
|
|
|
|
my $self = shift; |
3343
|
|
|
|
|
|
|
|
3344
|
|
|
|
|
|
|
my $width = 'long'; |
3345
|
|
|
|
|
|
|
my $format = $self->_build_any_datetime_format($width); |
3346
|
|
|
|
|
|
|
|
3347
|
|
|
|
|
|
|
my $date = $self->_build_any_date_format($width); |
3348
|
|
|
|
|
|
|
my $time = $self->_build_any_time_format($width); |
3349
|
|
|
|
|
|
|
|
3350
|
|
|
|
|
|
|
$format =~ s/\{0\}/$time/; |
3351
|
|
|
|
|
|
|
$format =~ s/\{1\}/$date/; |
3352
|
|
|
|
|
|
|
|
3353
|
|
|
|
|
|
|
return $format; |
3354
|
|
|
|
|
|
|
} |
3355
|
|
|
|
|
|
|
|
3356
|
|
|
|
|
|
|
sub _build_datetime_format_medium { |
3357
|
|
|
|
|
|
|
my $self = shift; |
3358
|
|
|
|
|
|
|
|
3359
|
|
|
|
|
|
|
my $width = 'medium'; |
3360
|
|
|
|
|
|
|
my $format = $self->_build_any_datetime_format($width); |
3361
|
|
|
|
|
|
|
|
3362
|
|
|
|
|
|
|
my $date = $self->_build_any_date_format($width); |
3363
|
|
|
|
|
|
|
my $time = $self->_build_any_time_format($width); |
3364
|
|
|
|
|
|
|
|
3365
|
|
|
|
|
|
|
$format =~ s/\{0\}/$time/; |
3366
|
|
|
|
|
|
|
$format =~ s/\{1\}/$date/; |
3367
|
|
|
|
|
|
|
|
3368
|
|
|
|
|
|
|
return $format; |
3369
|
|
|
|
|
|
|
} |
3370
|
|
|
|
|
|
|
|
3371
|
|
|
|
|
|
|
sub _build_datetime_format_short { |
3372
|
|
|
|
|
|
|
my $self = shift; |
3373
|
|
|
|
|
|
|
|
3374
|
|
|
|
|
|
|
my $width = 'short'; |
3375
|
|
|
|
|
|
|
my $format = $self->_build_any_datetime_format($width); |
3376
|
|
|
|
|
|
|
|
3377
|
|
|
|
|
|
|
my $date = $self->_build_any_date_format($width); |
3378
|
|
|
|
|
|
|
my $time = $self->_build_any_time_format($width); |
3379
|
|
|
|
|
|
|
|
3380
|
|
|
|
|
|
|
$format =~ s/\{0\}/$time/; |
3381
|
|
|
|
|
|
|
$format =~ s/\{1\}/$date/; |
3382
|
|
|
|
|
|
|
|
3383
|
|
|
|
|
|
|
return $format; |
3384
|
|
|
|
|
|
|
} |
3385
|
|
|
|
|
|
|
|
3386
|
|
|
|
|
|
|
sub _build_format_data { |
3387
|
|
|
|
|
|
|
my $self = shift; |
3388
|
|
|
|
|
|
|
my $default_calendar = $self->default_calendar(); |
3389
|
|
|
|
|
|
|
|
3390
|
|
|
|
|
|
|
my @bundles = $self->_find_bundle('datetime_formats_available_formats'); |
3391
|
|
|
|
|
|
|
foreach my $calendar ($default_calendar, 'gregorian') { |
3392
|
|
|
|
|
|
|
foreach my $bundle (@bundles) { |
3393
|
|
|
|
|
|
|
my $datetime_formats_available_formats = $bundle->datetime_formats_available_formats; |
3394
|
|
|
|
|
|
|
my $result = $datetime_formats_available_formats->{$calendar}; |
3395
|
|
|
|
|
|
|
return $result if $result; |
3396
|
|
|
|
|
|
|
} |
3397
|
|
|
|
|
|
|
} |
3398
|
|
|
|
|
|
|
|
3399
|
|
|
|
|
|
|
return {}; |
3400
|
|
|
|
|
|
|
} |
3401
|
|
|
|
|
|
|
|
3402
|
|
|
|
|
|
|
sub format_for { |
3403
|
|
|
|
|
|
|
my ($self, $format) = @_; |
3404
|
|
|
|
|
|
|
|
3405
|
|
|
|
|
|
|
my $format_data = $self->format_data; |
3406
|
|
|
|
|
|
|
|
3407
|
|
|
|
|
|
|
return $format_data->{$format} // ''; |
3408
|
|
|
|
|
|
|
} |
3409
|
|
|
|
|
|
|
|
3410
|
|
|
|
|
|
|
sub _build_available_formats { |
3411
|
|
|
|
|
|
|
my $self = shift; |
3412
|
|
|
|
|
|
|
|
3413
|
|
|
|
|
|
|
my $format_data = $self->format_data; |
3414
|
|
|
|
|
|
|
|
3415
|
|
|
|
|
|
|
return [keys %$format_data]; |
3416
|
|
|
|
|
|
|
} |
3417
|
|
|
|
|
|
|
|
3418
|
|
|
|
|
|
|
sub _build_default_date_format_length { |
3419
|
|
|
|
|
|
|
my $self = shift; |
3420
|
|
|
|
|
|
|
|
3421
|
|
|
|
|
|
|
my $default_calendar = $self->default_calendar(); |
3422
|
|
|
|
|
|
|
|
3423
|
|
|
|
|
|
|
my @bundles = $self->_find_bundle('date_formats'); |
3424
|
|
|
|
|
|
|
foreach my $calendar ($default_calendar, 'gregorian') { |
3425
|
|
|
|
|
|
|
foreach my $bundle (@bundles) { |
3426
|
|
|
|
|
|
|
my $date_formats = $bundle->date_formats; |
3427
|
|
|
|
|
|
|
my $result = $date_formats->{$calendar}{default}; |
3428
|
|
|
|
|
|
|
return $result if $result; |
3429
|
|
|
|
|
|
|
} |
3430
|
|
|
|
|
|
|
} |
3431
|
|
|
|
|
|
|
} |
3432
|
|
|
|
|
|
|
|
3433
|
|
|
|
|
|
|
sub _build_default_time_format_length { |
3434
|
|
|
|
|
|
|
my $self = shift; |
3435
|
|
|
|
|
|
|
|
3436
|
|
|
|
|
|
|
my $default_calendar = $self->default_calendar(); |
3437
|
|
|
|
|
|
|
|
3438
|
|
|
|
|
|
|
my @bundles = $self->_find_bundle('time_formats'); |
3439
|
|
|
|
|
|
|
foreach my $calendar ($default_calendar, 'gregorian') { |
3440
|
|
|
|
|
|
|
foreach my $bundle (@bundles) { |
3441
|
|
|
|
|
|
|
my $time_formats = $bundle->time_formats; |
3442
|
|
|
|
|
|
|
my $result = $time_formats->{$calendar}{default}; |
3443
|
|
|
|
|
|
|
return $result if $result; |
3444
|
|
|
|
|
|
|
} |
3445
|
|
|
|
|
|
|
} |
3446
|
|
|
|
|
|
|
} |
3447
|
|
|
|
|
|
|
|
3448
|
|
|
|
|
|
|
sub _build_prefers_24_hour_time { |
3449
|
|
|
|
|
|
|
my $self = shift; |
3450
|
|
|
|
|
|
|
|
3451
|
|
|
|
|
|
|
return $self->time_format_short() =~ /h|K/ ? 0 : 1; |
3452
|
|
|
|
|
|
|
} |
3453
|
|
|
|
|
|
|
|
3454
|
|
|
|
|
|
|
{ |
3455
|
|
|
|
|
|
|
my %days_2_number = ( |
3456
|
|
|
|
|
|
|
mon => 1, |
3457
|
|
|
|
|
|
|
tue => 2, |
3458
|
|
|
|
|
|
|
wen => 3, |
3459
|
|
|
|
|
|
|
thu => 4, |
3460
|
|
|
|
|
|
|
fri => 5, |
3461
|
|
|
|
|
|
|
sat => 6, |
3462
|
|
|
|
|
|
|
sun => 7, |
3463
|
|
|
|
|
|
|
); |
3464
|
|
|
|
|
|
|
|
3465
|
|
|
|
|
|
|
sub _build_first_day_of_week { |
3466
|
|
|
|
|
|
|
|
3467
|
|
|
|
|
|
|
my $self = shift; |
3468
|
|
|
|
|
|
|
|
3469
|
|
|
|
|
|
|
my $first_day = $self->week_data_first_day; |
3470
|
|
|
|
|
|
|
|
3471
|
|
|
|
|
|
|
return $days_2_number{$first_day}; |
3472
|
|
|
|
|
|
|
} |
3473
|
|
|
|
|
|
|
} |
3474
|
|
|
|
|
|
|
|
3475
|
|
|
|
|
|
|
# Sub to mangle Unicode regex to Perl regex |
3476
|
|
|
|
|
|
|
# Backwards compatibility hack |
3477
|
|
|
|
|
|
|
*_unicode_to_perl = eval <<'EOT' || \&_new_perl; |
3478
|
|
|
|
|
|
|
sub { |
3479
|
|
|
|
|
|
|
my $regex = shift; |
3480
|
|
|
|
|
|
|
|
3481
|
|
|
|
|
|
|
return '' unless length $regex; |
3482
|
|
|
|
|
|
|
$regex =~ s/ |
3483
|
|
|
|
|
|
|
(?:\\\\)*+ # Pairs of \ |
3484
|
|
|
|
|
|
|
(?!\\) # Not followed by \ |
3485
|
|
|
|
|
|
|
\K # But we don't want to keep that |
3486
|
|
|
|
|
|
|
(?<set> # Capture this |
3487
|
|
|
|
|
|
|
\[ # Start a set |
3488
|
|
|
|
|
|
|
(?: |
3489
|
|
|
|
|
|
|
[^\[\]\\]+ # One or more of not []\ |
3490
|
|
|
|
|
|
|
| # or |
3491
|
|
|
|
|
|
|
(?: |
3492
|
|
|
|
|
|
|
(?:\\\\)*+ # One or more pairs of \ without back tracking |
3493
|
|
|
|
|
|
|
\\. # Followed by an escaped character |
3494
|
|
|
|
|
|
|
) |
3495
|
|
|
|
|
|
|
| # or |
3496
|
|
|
|
|
|
|
(?&set) # An inner set |
3497
|
|
|
|
|
|
|
)++ # Do the inside set stuff one or more times without backtracking |
3498
|
|
|
|
|
|
|
\] # End the set |
3499
|
|
|
|
|
|
|
) |
3500
|
|
|
|
|
|
|
/ _convert($1) /xeg; |
3501
|
|
|
|
|
|
|
no warnings "experimental::regex_sets"; |
3502
|
|
|
|
|
|
|
no warnings "deprecated"; # Because CLDR uses surrogates |
3503
|
|
|
|
|
|
|
return qr/$regex/x; |
3504
|
|
|
|
|
|
|
}; |
3505
|
|
|
|
|
|
|
|
3506
|
|
|
|
|
|
|
EOT |
3507
|
|
|
|
|
|
|
|
3508
|
|
|
|
|
|
|
# Backwards compatibility hack |
3509
|
|
|
|
|
|
|
*_convert = eval <<'EOT' || \&_new_perl; |
3510
|
|
|
|
|
|
|
sub { |
3511
|
|
|
|
|
|
|
my $set = shift; |
3512
|
|
|
|
|
|
|
|
3513
|
|
|
|
|
|
|
# Some definitions |
3514
|
|
|
|
|
|
|
my $posix = qr/(?(DEFINE) |
3515
|
|
|
|
|
|
|
(?<posix> (?> \[: .+? :\] ) ) |
3516
|
|
|
|
|
|
|
)/x; |
3517
|
|
|
|
|
|
|
|
3518
|
|
|
|
|
|
|
# Convert Unicode escapes \u1234 to characters |
3519
|
|
|
|
|
|
|
$set =~ s/\\u(\p{Ahex}+)/chr(hex($1))/egx; |
3520
|
|
|
|
|
|
|
|
3521
|
|
|
|
|
|
|
# Check to see if this is a normal character set |
3522
|
|
|
|
|
|
|
my $normal = 0; |
3523
|
|
|
|
|
|
|
|
3524
|
|
|
|
|
|
|
$normal = 1 if $set =~ /^ |
3525
|
|
|
|
|
|
|
\s* # Possible white space |
3526
|
|
|
|
|
|
|
\[ # Opening set |
3527
|
|
|
|
|
|
|
^? # Possible negation |
3528
|
|
|
|
|
|
|
(?: # One of |
3529
|
|
|
|
|
|
|
[^\[\]]++ # Not an open or close set |
3530
|
|
|
|
|
|
|
| # Or |
3531
|
|
|
|
|
|
|
(?<=\\)[\[\]] # An open or close set preceded by \ |
3532
|
|
|
|
|
|
|
| # Or |
3533
|
|
|
|
|
|
|
(?: |
3534
|
|
|
|
|
|
|
\s* # Possible white space |
3535
|
|
|
|
|
|
|
(?&posix) # A posix class |
3536
|
|
|
|
|
|
|
(?! # Not followed by |
3537
|
|
|
|
|
|
|
\s* # Possible white space |
3538
|
|
|
|
|
|
|
[&-] # A Unicode regex op |
3539
|
|
|
|
|
|
|
\s* # Possible white space |
3540
|
|
|
|
|
|
|
\[ # A set opener |
3541
|
|
|
|
|
|
|
) |
3542
|
|
|
|
|
|
|
) |
3543
|
|
|
|
|
|
|
)+ |
3544
|
|
|
|
|
|
|
\] # Close the set |
3545
|
|
|
|
|
|
|
\s* # Possible white space |
3546
|
|
|
|
|
|
|
$ |
3547
|
|
|
|
|
|
|
$posix |
3548
|
|
|
|
|
|
|
/x; |
3549
|
|
|
|
|
|
|
|
3550
|
|
|
|
|
|
|
# Convert posix to perl |
3551
|
|
|
|
|
|
|
$set =~ s/\[:(.*?):\]/\\p{$1}/g; |
3552
|
|
|
|
|
|
|
|
3553
|
|
|
|
|
|
|
if ($normal) { |
3554
|
|
|
|
|
|
|
return "$set"; |
3555
|
|
|
|
|
|
|
} |
3556
|
|
|
|
|
|
|
|
3557
|
|
|
|
|
|
|
# Fix up [abc[de]] to [[abc][de]] |
3558
|
|
|
|
|
|
|
$set =~ s/\[ ( (?>\^? \s*) [^\]]+? ) \s* \[/[[$1][/gx; |
3559
|
|
|
|
|
|
|
|
3560
|
|
|
|
|
|
|
# Fix up [[ab]cde] to [[ab][cde]] |
3561
|
|
|
|
|
|
|
$set =~ s/\[ \^?+ \s* \[ [^\]]+? \] \K \s* ( [^\[]+ ) \]/[$1]]/gx; |
3562
|
|
|
|
|
|
|
|
3563
|
|
|
|
|
|
|
# Unicode uses ^ to compliment the set where as Perl uses ! |
3564
|
|
|
|
|
|
|
$set =~ s/\[ \^ \s*/[!/gx; |
3565
|
|
|
|
|
|
|
|
3566
|
|
|
|
|
|
|
# The above can leave us with empty sets. Strip them out |
3567
|
|
|
|
|
|
|
$set =~ s/\[\]//g; |
3568
|
|
|
|
|
|
|
|
3569
|
|
|
|
|
|
|
# Fixup inner sets with no operator |
3570
|
|
|
|
|
|
|
1 while $set =~ s/ \] \s* \[ /] + [/gx; |
3571
|
|
|
|
|
|
|
1 while $set =~ s/ \] \s * (\\p\{.*?\}) /] + $1/xg; |
3572
|
|
|
|
|
|
|
1 while $set =~ s/ \\p\{.*?\} \s* \K \[ / + [/xg; |
3573
|
|
|
|
|
|
|
1 while $set =~ s/ \\p\{.*?\} \s* \K (\\p\{.*?\}) / + $1/xg; |
3574
|
|
|
|
|
|
|
|
3575
|
|
|
|
|
|
|
# Unicode uses [] for grouping as well as starting an inner set |
3576
|
|
|
|
|
|
|
# Perl uses ( ) So fix that up now |
3577
|
|
|
|
|
|
|
|
3578
|
|
|
|
|
|
|
$set =~ s/. \K \[ (?> (!?) \s*) \[ /($1\[/gx; |
3579
|
|
|
|
|
|
|
$set =~ s/ \] \s* \] (.) /])$1/gx; |
3580
|
|
|
|
|
|
|
|
3581
|
|
|
|
|
|
|
return "(?$set)"; |
3582
|
|
|
|
|
|
|
} |
3583
|
|
|
|
|
|
|
|
3584
|
|
|
|
|
|
|
EOT |
3585
|
|
|
|
|
|
|
|
3586
|
|
|
|
|
|
|
# The following pod is for methods defined in the Moose Role |
3587
|
|
|
|
|
|
|
# files that are automatically generated from the data |
3588
|
|
|
|
|
|
|
=back |
3589
|
|
|
|
|
|
|
|
3590
|
|
|
|
|
|
|
=head2 Valid codes |
3591
|
|
|
|
|
|
|
|
3592
|
|
|
|
|
|
|
=over 4 |
3593
|
|
|
|
|
|
|
|
3594
|
|
|
|
|
|
|
=item valid_languages() |
3595
|
|
|
|
|
|
|
|
3596
|
|
|
|
|
|
|
This method returns a list containing all the valid language codes |
3597
|
|
|
|
|
|
|
|
3598
|
|
|
|
|
|
|
=item valid_scripts() |
3599
|
|
|
|
|
|
|
|
3600
|
|
|
|
|
|
|
This method returns a list containing all the valid script codes |
3601
|
|
|
|
|
|
|
|
3602
|
|
|
|
|
|
|
=item valid_territories() |
3603
|
|
|
|
|
|
|
|
3604
|
|
|
|
|
|
|
This method returns a list containing all the valid territory codes |
3605
|
|
|
|
|
|
|
|
3606
|
|
|
|
|
|
|
=item valid_variants() |
3607
|
|
|
|
|
|
|
|
3608
|
|
|
|
|
|
|
This method returns a list containing all the valid variant codes |
3609
|
|
|
|
|
|
|
|
3610
|
|
|
|
|
|
|
=item key_aliases() |
3611
|
|
|
|
|
|
|
|
3612
|
|
|
|
|
|
|
This method returns a hash that maps valid keys to their valid aliases |
3613
|
|
|
|
|
|
|
|
3614
|
|
|
|
|
|
|
=item key_names() |
3615
|
|
|
|
|
|
|
|
3616
|
|
|
|
|
|
|
This method returns a hash that maps valid key aliases to their valid keys |
3617
|
|
|
|
|
|
|
|
3618
|
|
|
|
|
|
|
=item valid_keys() |
3619
|
|
|
|
|
|
|
|
3620
|
|
|
|
|
|
|
This method returns a hash of valid keys and the valid type codes you |
3621
|
|
|
|
|
|
|
can have with each key |
3622
|
|
|
|
|
|
|
|
3623
|
|
|
|
|
|
|
=item language_aliases() |
3624
|
|
|
|
|
|
|
|
3625
|
|
|
|
|
|
|
This method returns a hash that maps valid language codes to their valid aliases |
3626
|
|
|
|
|
|
|
|
3627
|
|
|
|
|
|
|
=item territory_aliases() |
3628
|
|
|
|
|
|
|
|
3629
|
|
|
|
|
|
|
This method returns a hash that maps valid territory codes to their valid aliases |
3630
|
|
|
|
|
|
|
|
3631
|
|
|
|
|
|
|
=item variant_aliases() |
3632
|
|
|
|
|
|
|
|
3633
|
|
|
|
|
|
|
This method returns a hash that maps valid variant codes to their valid aliases |
3634
|
|
|
|
|
|
|
|
3635
|
|
|
|
|
|
|
=back |
3636
|
|
|
|
|
|
|
|
3637
|
|
|
|
|
|
|
=head2 Information about weeks |
3638
|
|
|
|
|
|
|
|
3639
|
|
|
|
|
|
|
There are no standard codes for the days of the weeks so CLDR uses the following |
3640
|
|
|
|
|
|
|
three letter codes to represent unlocalised days |
3641
|
|
|
|
|
|
|
|
3642
|
|
|
|
|
|
|
=over 4 |
3643
|
|
|
|
|
|
|
|
3644
|
|
|
|
|
|
|
=item sun |
3645
|
|
|
|
|
|
|
|
3646
|
|
|
|
|
|
|
Sunday |
3647
|
|
|
|
|
|
|
|
3648
|
|
|
|
|
|
|
=item mon |
3649
|
|
|
|
|
|
|
|
3650
|
|
|
|
|
|
|
Monday |
3651
|
|
|
|
|
|
|
|
3652
|
|
|
|
|
|
|
=item tue |
3653
|
|
|
|
|
|
|
|
3654
|
|
|
|
|
|
|
Tuesday |
3655
|
|
|
|
|
|
|
|
3656
|
|
|
|
|
|
|
=item wed |
3657
|
|
|
|
|
|
|
|
3658
|
|
|
|
|
|
|
Wednesday |
3659
|
|
|
|
|
|
|
|
3660
|
|
|
|
|
|
|
=item thu |
3661
|
|
|
|
|
|
|
|
3662
|
|
|
|
|
|
|
Thursday |
3663
|
|
|
|
|
|
|
|
3664
|
|
|
|
|
|
|
=item fri |
3665
|
|
|
|
|
|
|
|
3666
|
|
|
|
|
|
|
Friday |
3667
|
|
|
|
|
|
|
|
3668
|
|
|
|
|
|
|
=item sat |
3669
|
|
|
|
|
|
|
|
3670
|
|
|
|
|
|
|
Saturday |
3671
|
|
|
|
|
|
|
|
3672
|
|
|
|
|
|
|
=back |
3673
|
|
|
|
|
|
|
|
3674
|
|
|
|
|
|
|
=cut |
3675
|
|
|
|
|
|
|
|
3676
|
|
|
|
|
|
|
sub _week_data { |
3677
|
|
|
|
|
|
|
my ($self, $territory_id, $week_data_hash) = @_; |
3678
|
|
|
|
|
|
|
|
3679
|
|
|
|
|
|
|
$territory_id //= ( $self->territory_id || $self->likely_subtag->territory_id ); |
3680
|
|
|
|
|
|
|
|
3681
|
|
|
|
|
|
|
return $week_data_hash->{$territory_id} if exists $week_data_hash->{$territory_id}; |
3682
|
|
|
|
|
|
|
|
3683
|
|
|
|
|
|
|
while (1) { |
3684
|
|
|
|
|
|
|
$territory_id = $self->territory_contained_by()->{$territory_id}; |
3685
|
|
|
|
|
|
|
return unless defined $territory_id; |
3686
|
|
|
|
|
|
|
return $week_data_hash->{$territory_id} if exists $week_data_hash->{$territory_id}; |
3687
|
|
|
|
|
|
|
} |
3688
|
|
|
|
|
|
|
} |
3689
|
|
|
|
|
|
|
|
3690
|
|
|
|
|
|
|
=over 4 |
3691
|
|
|
|
|
|
|
|
3692
|
|
|
|
|
|
|
=item week_data_min_days($territory_id) |
3693
|
|
|
|
|
|
|
|
3694
|
|
|
|
|
|
|
This method takes an optional territory id and returns a the minimum number of days |
3695
|
|
|
|
|
|
|
a week must have to count as the starting week of the new year. It uses the current |
3696
|
|
|
|
|
|
|
locale's territory if no territory id is passed in. |
3697
|
|
|
|
|
|
|
|
3698
|
|
|
|
|
|
|
=cut |
3699
|
|
|
|
|
|
|
|
3700
|
|
|
|
|
|
|
sub week_data_min_days { |
3701
|
|
|
|
|
|
|
my ($self, $territory_id) = @_; |
3702
|
|
|
|
|
|
|
|
3703
|
|
|
|
|
|
|
my $week_data_hash = $self->_week_data_min_days(); |
3704
|
|
|
|
|
|
|
return _week_data($self, $territory_id, $week_data_hash); |
3705
|
|
|
|
|
|
|
} |
3706
|
|
|
|
|
|
|
|
3707
|
|
|
|
|
|
|
=item week_data_first_day($territory_id) |
3708
|
|
|
|
|
|
|
|
3709
|
|
|
|
|
|
|
This method takes an optional territory id and returns the three letter code of the |
3710
|
|
|
|
|
|
|
first day of the week for that territory. If no territory id is passed in then it |
3711
|
|
|
|
|
|
|
uses the current locale's territory. |
3712
|
|
|
|
|
|
|
|
3713
|
|
|
|
|
|
|
=cut |
3714
|
|
|
|
|
|
|
|
3715
|
|
|
|
|
|
|
sub week_data_first_day { |
3716
|
|
|
|
|
|
|
my ($self, $territory_id) = @_; |
3717
|
|
|
|
|
|
|
|
3718
|
|
|
|
|
|
|
my $week_data_hash = $self->_week_data_first_day(); |
3719
|
|
|
|
|
|
|
return _week_data($self, $territory_id, $week_data_hash); |
3720
|
|
|
|
|
|
|
} |
3721
|
|
|
|
|
|
|
|
3722
|
|
|
|
|
|
|
=item week_data_weekend_start() |
3723
|
|
|
|
|
|
|
|
3724
|
|
|
|
|
|
|
This method takes an optional territory id and returns the three letter code of the |
3725
|
|
|
|
|
|
|
first day of the week end for that territory. If no territory id is passed in then it |
3726
|
|
|
|
|
|
|
uses the current locale's territory. |
3727
|
|
|
|
|
|
|
|
3728
|
|
|
|
|
|
|
=cut |
3729
|
|
|
|
|
|
|
|
3730
|
|
|
|
|
|
|
sub week_data_weekend_start { |
3731
|
|
|
|
|
|
|
my ($self, $territory_id) = @_; |
3732
|
|
|
|
|
|
|
my $week_data_hash = $self->_week_data_weekend_start(); |
3733
|
|
|
|
|
|
|
|
3734
|
|
|
|
|
|
|
return _week_data($self, $territory_id, $week_data_hash); |
3735
|
|
|
|
|
|
|
} |
3736
|
|
|
|
|
|
|
|
3737
|
|
|
|
|
|
|
=item week_data_weekend_end() |
3738
|
|
|
|
|
|
|
|
3739
|
|
|
|
|
|
|
This method takes an optional territory id and returns the three letter code of the |
3740
|
|
|
|
|
|
|
first day of the week end for that territory. If no territory id is passed in then it |
3741
|
|
|
|
|
|
|
uses the current locale's territory. |
3742
|
|
|
|
|
|
|
|
3743
|
|
|
|
|
|
|
=cut |
3744
|
|
|
|
|
|
|
|
3745
|
|
|
|
|
|
|
sub week_data_weekend_end { |
3746
|
|
|
|
|
|
|
my ($self, $territory_id) = @_; |
3747
|
|
|
|
|
|
|
my $week_data_hash = $self->_week_data_weekend_end(); |
3748
|
|
|
|
|
|
|
|
3749
|
|
|
|
|
|
|
return _week_data($self, $territory_id, $week_data_hash); |
3750
|
|
|
|
|
|
|
} |
3751
|
|
|
|
|
|
|
|
3752
|
|
|
|
|
|
|
=back |
3753
|
|
|
|
|
|
|
|
3754
|
|
|
|
|
|
|
=head2 Territory Containment |
3755
|
|
|
|
|
|
|
|
3756
|
|
|
|
|
|
|
=over 4 |
3757
|
|
|
|
|
|
|
|
3758
|
|
|
|
|
|
|
=item territory_contains() |
3759
|
|
|
|
|
|
|
|
3760
|
|
|
|
|
|
|
This method returns a hash ref keyed on territory id. The value is an array ref. |
3761
|
|
|
|
|
|
|
Each element of the array ref is a territory id of a territory immediately |
3762
|
|
|
|
|
|
|
contained in the territory used as the key |
3763
|
|
|
|
|
|
|
|
3764
|
|
|
|
|
|
|
=item territory_contained_by() |
3765
|
|
|
|
|
|
|
|
3766
|
|
|
|
|
|
|
This method returns a hash ref keyed on territory id. The value of the hash |
3767
|
|
|
|
|
|
|
is the territory id of the immediately containing territory. |
3768
|
|
|
|
|
|
|
|
3769
|
|
|
|
|
|
|
=back |
3770
|
|
|
|
|
|
|
|
3771
|
|
|
|
|
|
|
=head2 Numbering Systems |
3772
|
|
|
|
|
|
|
|
3773
|
|
|
|
|
|
|
=over 4 |
3774
|
|
|
|
|
|
|
|
3775
|
|
|
|
|
|
|
=item numbering_system() |
3776
|
|
|
|
|
|
|
|
3777
|
|
|
|
|
|
|
This method returns a hash ref keyed on numbering system id which, for a given |
3778
|
|
|
|
|
|
|
locale, can be got by calling the default_numbering_system() method. The values |
3779
|
|
|
|
|
|
|
of the hash are a two element hash ref the keys being C<type> and C<data>. If the |
3780
|
|
|
|
|
|
|
type is C<numeric> then the data is an array ref of characters. The position in the |
3781
|
|
|
|
|
|
|
array matches the numeric value of the character. If the type is C<algorithmic> |
3782
|
|
|
|
|
|
|
then data is the name of the algorithm used to display numbers in that format. |
3783
|
|
|
|
|
|
|
|
3784
|
|
|
|
|
|
|
=back |
3785
|
|
|
|
|
|
|
|
3786
|
|
|
|
|
|
|
=head2 Number Formatting |
3787
|
|
|
|
|
|
|
|
3788
|
|
|
|
|
|
|
=over 4 |
3789
|
|
|
|
|
|
|
|
3790
|
|
|
|
|
|
|
=item format_number($number, $format, $currency, $for_cash) |
3791
|
|
|
|
|
|
|
|
3792
|
|
|
|
|
|
|
This method formats the number $number using the format $format. If the format contains |
3793
|
|
|
|
|
|
|
the currency symbol C<¤> then the currency symbol for the currency code in $currency |
3794
|
|
|
|
|
|
|
will be used. If $currency is undef() then the default currency code for the locale |
3795
|
|
|
|
|
|
|
will be used. |
3796
|
|
|
|
|
|
|
|
3797
|
|
|
|
|
|
|
Note that currency codes are based on territory so if you do not pass in a currency |
3798
|
|
|
|
|
|
|
and your locale did not get passed a territory in the constructor you are going |
3799
|
|
|
|
|
|
|
to end up with the L<likely sub tag's|/likely_subtags> idea of the currency. This |
3800
|
|
|
|
|
|
|
functionality may be removed or at least changed to emit a warning in future |
3801
|
|
|
|
|
|
|
releases. |
3802
|
|
|
|
|
|
|
|
3803
|
|
|
|
|
|
|
$for_cash is only used during currency formatting. If true then cash rounding |
3804
|
|
|
|
|
|
|
will be used otherwise financial rounding will be used. |
3805
|
|
|
|
|
|
|
|
3806
|
|
|
|
|
|
|
This function also handles rule based number formatting. If $format is string equivalent |
3807
|
|
|
|
|
|
|
to one of the current locale's public rule based number formats then $number will be |
3808
|
|
|
|
|
|
|
formatted according to that rule. |
3809
|
|
|
|
|
|
|
|
3810
|
|
|
|
|
|
|
=item add_currency_symbol($format, $symbol) |
3811
|
|
|
|
|
|
|
|
3812
|
|
|
|
|
|
|
This method returns the format with the currency symbol $symbol correctly inserted |
3813
|
|
|
|
|
|
|
into the format |
3814
|
|
|
|
|
|
|
|
3815
|
|
|
|
|
|
|
=item parse_number_format($format, $currency, $currency_data, $for_cash) |
3816
|
|
|
|
|
|
|
|
3817
|
|
|
|
|
|
|
This method parses a CLDR numeric format string into a hash ref containing data used to |
3818
|
|
|
|
|
|
|
format a number. If a currency is being formatted then $currency contains the |
3819
|
|
|
|
|
|
|
currency code, $currency_data is a hashref containing the currency rounding |
3820
|
|
|
|
|
|
|
information and $for_cash is a flag to signal cash or financial rounding. |
3821
|
|
|
|
|
|
|
|
3822
|
|
|
|
|
|
|
This should probably be a private function. |
3823
|
|
|
|
|
|
|
|
3824
|
|
|
|
|
|
|
=item round($number, $increment, $decimal_digits) |
3825
|
|
|
|
|
|
|
|
3826
|
|
|
|
|
|
|
This method returns $number rounded to the nearest $increment with $decimal_digits |
3827
|
|
|
|
|
|
|
digits after the decimal point |
3828
|
|
|
|
|
|
|
|
3829
|
|
|
|
|
|
|
=item get_formatted_number($number, $format, $currency_data, $for_cash) |
3830
|
|
|
|
|
|
|
|
3831
|
|
|
|
|
|
|
This method takes the $format produced by parse_number_format() and uses it to |
3832
|
|
|
|
|
|
|
parse $number. It returns a string containing the parsed number. If a currency |
3833
|
|
|
|
|
|
|
is being formatted then $currency_data is a hashref containing the currency |
3834
|
|
|
|
|
|
|
rounding information and $for_cash is a flag to signal cash or financial rounding. |
3835
|
|
|
|
|
|
|
|
3836
|
|
|
|
|
|
|
=item get_digits() |
3837
|
|
|
|
|
|
|
|
3838
|
|
|
|
|
|
|
This method returns an array containing the digits used by the locale, The order of the |
3839
|
|
|
|
|
|
|
array is the order of the digits. It the locale's numbering system is C<algorithmic> it |
3840
|
|
|
|
|
|
|
will return C<[0,1,2,3,4,5,6,7,8,9]> |
3841
|
|
|
|
|
|
|
|
3842
|
|
|
|
|
|
|
=item default_numbering_system() |
3843
|
|
|
|
|
|
|
|
3844
|
|
|
|
|
|
|
This method returns the numbering system id for the locale. |
3845
|
|
|
|
|
|
|
|
3846
|
|
|
|
|
|
|
=back |
3847
|
|
|
|
|
|
|
|
3848
|
|
|
|
|
|
|
=head2 Measurement Information |
3849
|
|
|
|
|
|
|
|
3850
|
|
|
|
|
|
|
=over 4 |
3851
|
|
|
|
|
|
|
|
3852
|
|
|
|
|
|
|
=item measurement_system() |
3853
|
|
|
|
|
|
|
|
3854
|
|
|
|
|
|
|
This method returns a hash ref keyed on territory, the value being the measurement system |
3855
|
|
|
|
|
|
|
id for the territory. If the territory you are interested in is not listed use the |
3856
|
|
|
|
|
|
|
territory_contained_by() method until you find an entry. |
3857
|
|
|
|
|
|
|
|
3858
|
|
|
|
|
|
|
=item paper_size() |
3859
|
|
|
|
|
|
|
|
3860
|
|
|
|
|
|
|
This method returns a hash ref keyed on territory, the value being the paper size used |
3861
|
|
|
|
|
|
|
in that territory. If the territory you are interested in is not listed use the |
3862
|
|
|
|
|
|
|
territory_contained_by() method until you find an entry. |
3863
|
|
|
|
|
|
|
|
3864
|
|
|
|
|
|
|
=back |
3865
|
|
|
|
|
|
|
|
3866
|
|
|
|
|
|
|
=head2 Likely Tags |
3867
|
|
|
|
|
|
|
|
3868
|
|
|
|
|
|
|
=over 4 |
3869
|
|
|
|
|
|
|
|
3870
|
|
|
|
|
|
|
=item likely_subtags() |
3871
|
|
|
|
|
|
|
|
3872
|
|
|
|
|
|
|
A full locale tag requires, as a minimum, a language, script and territory code. However for |
3873
|
|
|
|
|
|
|
some locales it is possible to infer the missing element if the other two are given, e.g. |
3874
|
|
|
|
|
|
|
given C<en_GB> you can infer the script will be latn. It is also possible to fill in the |
3875
|
|
|
|
|
|
|
missing elements of a locale with sensible defaults given sufficient knowledge of the layout |
3876
|
|
|
|
|
|
|
of the CLDR data and usage patterns of locales around the world. |
3877
|
|
|
|
|
|
|
|
3878
|
|
|
|
|
|
|
This function returns a hash ref keyed on partial locale id's with the value being the locale |
3879
|
|
|
|
|
|
|
id for the most likely language, script and territory code for the key. |
3880
|
|
|
|
|
|
|
|
3881
|
|
|
|
|
|
|
=back |
3882
|
|
|
|
|
|
|
|
3883
|
|
|
|
|
|
|
=head2 Currency Information |
3884
|
|
|
|
|
|
|
|
3885
|
|
|
|
|
|
|
=over 4 |
3886
|
|
|
|
|
|
|
|
3887
|
|
|
|
|
|
|
=item currency_fractions() |
3888
|
|
|
|
|
|
|
|
3889
|
|
|
|
|
|
|
This method returns a hash ref keyed on currency id. The value is a hash ref containing four keys. |
3890
|
|
|
|
|
|
|
The keys are |
3891
|
|
|
|
|
|
|
|
3892
|
|
|
|
|
|
|
=over 8 |
3893
|
|
|
|
|
|
|
|
3894
|
|
|
|
|
|
|
=item digits |
3895
|
|
|
|
|
|
|
|
3896
|
|
|
|
|
|
|
The number of decimal digits normally formatted. |
3897
|
|
|
|
|
|
|
|
3898
|
|
|
|
|
|
|
=item rounding |
3899
|
|
|
|
|
|
|
|
3900
|
|
|
|
|
|
|
The rounding increment, in units of 10^-digits. |
3901
|
|
|
|
|
|
|
|
3902
|
|
|
|
|
|
|
=item cashdigits |
3903
|
|
|
|
|
|
|
|
3904
|
|
|
|
|
|
|
The number of decimal digits to be used when formatting quantities used in cash transactions (as opposed |
3905
|
|
|
|
|
|
|
to a quantity that would appear in a more formal setting, such as on a bank statement). |
3906
|
|
|
|
|
|
|
|
3907
|
|
|
|
|
|
|
=item cashrounding |
3908
|
|
|
|
|
|
|
|
3909
|
|
|
|
|
|
|
The cash rounding increment, in units of 10^-cashdigits. |
3910
|
|
|
|
|
|
|
|
3911
|
|
|
|
|
|
|
=back |
3912
|
|
|
|
|
|
|
|
3913
|
|
|
|
|
|
|
=item default_currency($territory_id) |
3914
|
|
|
|
|
|
|
|
3915
|
|
|
|
|
|
|
This method returns the default currency id for the territory id. |
3916
|
|
|
|
|
|
|
If no territory id is given then the current locale's is used |
3917
|
|
|
|
|
|
|
|
3918
|
|
|
|
|
|
|
=cut |
3919
|
|
|
|
|
|
|
|
3920
|
|
|
|
|
|
|
sub default_currency { |
3921
|
|
|
|
|
|
|
my ($self, $territory_id) = @_; |
3922
|
|
|
|
|
|
|
|
3923
|
|
|
|
|
|
|
$territory_id //= $self->territory_id; |
3924
|
|
|
|
|
|
|
|
3925
|
|
|
|
|
|
|
if (! $territory_id) { |
3926
|
|
|
|
|
|
|
$territory_id = $self->likely_subtag->territory_id; |
3927
|
|
|
|
|
|
|
warn "Locale::CLDR::default_currency:- No territory given using $territory_id at "; |
3928
|
|
|
|
|
|
|
} |
3929
|
|
|
|
|
|
|
|
3930
|
|
|
|
|
|
|
my $default_currencies = $self->_default_currency; |
3931
|
|
|
|
|
|
|
|
3932
|
|
|
|
|
|
|
return $default_currencies->{$territory_id} if exists $default_currencies->{$territory_id}; |
3933
|
|
|
|
|
|
|
|
3934
|
|
|
|
|
|
|
while (1) { |
3935
|
|
|
|
|
|
|
$territory_id = $self->territory_contained_by($territory_id); |
3936
|
|
|
|
|
|
|
last unless $territory_id; |
3937
|
|
|
|
|
|
|
return $default_currencies->{$territory_id} if exists $default_currencies->{$territory_id}; |
3938
|
|
|
|
|
|
|
} |
3939
|
|
|
|
|
|
|
} |
3940
|
|
|
|
|
|
|
|
3941
|
|
|
|
|
|
|
=item currency_symbol($currency_id) |
3942
|
|
|
|
|
|
|
|
3943
|
|
|
|
|
|
|
This method returns the currency symbol for the given currency id in the current locale. |
3944
|
|
|
|
|
|
|
If no currency id is given it uses the locale's default currency |
3945
|
|
|
|
|
|
|
|
3946
|
|
|
|
|
|
|
=cut |
3947
|
|
|
|
|
|
|
|
3948
|
|
|
|
|
|
|
sub currency_symbol { |
3949
|
|
|
|
|
|
|
my ($self, $currency_id) = @_; |
3950
|
|
|
|
|
|
|
|
3951
|
|
|
|
|
|
|
$currency_id //= $self->default_currency; |
3952
|
|
|
|
|
|
|
|
3953
|
|
|
|
|
|
|
my @bundles = reverse $self->_find_bundle('curriencies'); |
3954
|
|
|
|
|
|
|
foreach my $bundle (@bundles) { |
3955
|
|
|
|
|
|
|
my $symbol = $bundle->curriencies()->{$currency_id}{symbol}; |
3956
|
|
|
|
|
|
|
return $symbol if $symbol; |
3957
|
|
|
|
|
|
|
} |
3958
|
|
|
|
|
|
|
|
3959
|
|
|
|
|
|
|
return ''; |
3960
|
|
|
|
|
|
|
} |
3961
|
|
|
|
|
|
|
|
3962
|
|
|
|
|
|
|
=back |
3963
|
|
|
|
|
|
|
|
3964
|
|
|
|
|
|
|
=head2 Calendar Information |
3965
|
|
|
|
|
|
|
|
3966
|
|
|
|
|
|
|
=over 4 |
3967
|
|
|
|
|
|
|
|
3968
|
|
|
|
|
|
|
=item calendar_preferences() |
3969
|
|
|
|
|
|
|
|
3970
|
|
|
|
|
|
|
This method returns a hash ref keyed on territory id. The values are array refs containing the preferred |
3971
|
|
|
|
|
|
|
calendar id's in order of preference. |
3972
|
|
|
|
|
|
|
|
3973
|
|
|
|
|
|
|
=item default_calendar($territory) |
3974
|
|
|
|
|
|
|
|
3975
|
|
|
|
|
|
|
This method returns the default calendar id for the given territory. If no territory id given it |
3976
|
|
|
|
|
|
|
used the territory of the current locale. |
3977
|
|
|
|
|
|
|
|
3978
|
|
|
|
|
|
|
=back |
3979
|
|
|
|
|
|
|
|
3980
|
|
|
|
|
|
|
=begin comment |
3981
|
|
|
|
|
|
|
|
3982
|
|
|
|
|
|
|
=head2 Collation |
3983
|
|
|
|
|
|
|
|
3984
|
|
|
|
|
|
|
=over 4 |
3985
|
|
|
|
|
|
|
|
3986
|
|
|
|
|
|
|
=item collation() |
3987
|
|
|
|
|
|
|
|
3988
|
|
|
|
|
|
|
This method returns a Locale::CLDR::Collator object. This is still in development. Future releases will |
3989
|
|
|
|
|
|
|
try and match the API from L<Unicode::Collate> as much as possible and add tailoring for locales. |
3990
|
|
|
|
|
|
|
|
3991
|
|
|
|
|
|
|
=back |
3992
|
|
|
|
|
|
|
|
3993
|
|
|
|
|
|
|
=end comment |
3994
|
|
|
|
|
|
|
|
3995
|
|
|
|
|
|
|
=cut |
3996
|
|
|
|
|
|
|
|
3997
|
|
|
|
|
|
|
=begin comment |
3998
|
|
|
|
|
|
|
|
3999
|
|
|
|
|
|
|
sub collation { |
4000
|
|
|
|
|
|
|
my ($self, %params) = @_; |
4001
|
|
|
|
|
|
|
|
4002
|
|
|
|
|
|
|
$params{type} //= $self->_default_collation; |
4003
|
|
|
|
|
|
|
$params{strength} //= $self->_default_collation_strength; |
4004
|
|
|
|
|
|
|
|
4005
|
|
|
|
|
|
|
return Locale::CLDR::Collator->new(locale => $self, %params); |
4006
|
|
|
|
|
|
|
} |
4007
|
|
|
|
|
|
|
|
4008
|
|
|
|
|
|
|
sub collation_overrides { |
4009
|
|
|
|
|
|
|
my ($self, $type) = @_; |
4010
|
|
|
|
|
|
|
|
4011
|
|
|
|
|
|
|
my @bundles = reverse $self->_find_bundle('collation'); |
4012
|
|
|
|
|
|
|
|
4013
|
|
|
|
|
|
|
my $override = ''; |
4014
|
|
|
|
|
|
|
foreach my $bundle (@bundles) { |
4015
|
|
|
|
|
|
|
last if $override = $bundle->collation()->{$type}; |
4016
|
|
|
|
|
|
|
} |
4017
|
|
|
|
|
|
|
|
4018
|
|
|
|
|
|
|
if ($type ne 'standard' && ! $override) { |
4019
|
|
|
|
|
|
|
foreach my $bundle (@bundles) { |
4020
|
|
|
|
|
|
|
last if $override = $bundle->collation()->{standard}; |
4021
|
|
|
|
|
|
|
} |
4022
|
|
|
|
|
|
|
} |
4023
|
|
|
|
|
|
|
|
4024
|
|
|
|
|
|
|
return $override || []; |
4025
|
|
|
|
|
|
|
} |
4026
|
|
|
|
|
|
|
|
4027
|
|
|
|
|
|
|
sub _default_collation { |
4028
|
|
|
|
|
|
|
return 'standard'; |
4029
|
|
|
|
|
|
|
} |
4030
|
|
|
|
|
|
|
|
4031
|
|
|
|
|
|
|
sub _default_collation_strength { |
4032
|
|
|
|
|
|
|
return 3; |
4033
|
|
|
|
|
|
|
} |
4034
|
|
|
|
|
|
|
|
4035
|
|
|
|
|
|
|
=end comment |
4036
|
|
|
|
|
|
|
|
4037
|
|
|
|
|
|
|
=head1 Locales |
4038
|
|
|
|
|
|
|
|
4039
|
|
|
|
|
|
|
Other locales can be found on CPAN. You can install Language packs from the |
4040
|
|
|
|
|
|
|
Locale::CLDR::Locales::* packages. You can also install language packs for |
4041
|
|
|
|
|
|
|
a given territory by looking for a Bundle::Locale::CLDR::* package |
4042
|
|
|
|
|
|
|
|
4043
|
|
|
|
|
|
|
=head1 AUTHOR |
4044
|
|
|
|
|
|
|
|
4045
|
|
|
|
|
|
|
John Imrie, C<< <john dot imrie1 at gmail dot com> >> |
4046
|
|
|
|
|
|
|
|
4047
|
|
|
|
|
|
|
=head1 BUGS |
4048
|
|
|
|
|
|
|
|
4049
|
|
|
|
|
|
|
Please report any bugs or feature requests to C<bug-locale-cldr at rt.cpan.org>, or through |
4050
|
|
|
|
|
|
|
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Locale-CLDR>. I will be notified, and then you'll |
4051
|
|
|
|
|
|
|
automatically be notified of progress on your bug as I make changes. |
4052
|
|
|
|
|
|
|
|
4053
|
|
|
|
|
|
|
=head1 SUPPORT |
4054
|
|
|
|
|
|
|
|
4055
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command. |
4056
|
|
|
|
|
|
|
|
4057
|
|
|
|
|
|
|
perldoc Locale::CLDR |
4058
|
|
|
|
|
|
|
|
4059
|
|
|
|
|
|
|
You can also look for information at: |
4060
|
|
|
|
|
|
|
|
4061
|
|
|
|
|
|
|
=over 4 |
4062
|
|
|
|
|
|
|
|
4063
|
|
|
|
|
|
|
=item * RT: CPAN's request tracker |
4064
|
|
|
|
|
|
|
|
4065
|
|
|
|
|
|
|
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Locale-CLDR> |
4066
|
|
|
|
|
|
|
|
4067
|
|
|
|
|
|
|
=item * AnnoCPAN: Annotated CPAN documentation |
4068
|
|
|
|
|
|
|
|
4069
|
|
|
|
|
|
|
L<http://annocpan.org/dist/Locale-CLDR> |
4070
|
|
|
|
|
|
|
|
4071
|
|
|
|
|
|
|
=item * CPAN Ratings |
4072
|
|
|
|
|
|
|
|
4073
|
|
|
|
|
|
|
L<http://cpanratings.perl.org/d/Locale-CLDR> |
4074
|
|
|
|
|
|
|
|
4075
|
|
|
|
|
|
|
=item * Search CPAN |
4076
|
|
|
|
|
|
|
|
4077
|
|
|
|
|
|
|
L<http://search.cpan.org/dist/Locale-CLDR/> |
4078
|
|
|
|
|
|
|
|
4079
|
|
|
|
|
|
|
=back |
4080
|
|
|
|
|
|
|
|
4081
|
|
|
|
|
|
|
|
4082
|
|
|
|
|
|
|
=head1 ACKNOWLEDGEMENTS |
4083
|
|
|
|
|
|
|
|
4084
|
|
|
|
|
|
|
Everyone at the Unicode Consortium for providing the data. |
4085
|
|
|
|
|
|
|
|
4086
|
|
|
|
|
|
|
Karl Williams for his tireless work on Unicode in the Perl |
4087
|
|
|
|
|
|
|
regex engine. |
4088
|
|
|
|
|
|
|
|
4089
|
|
|
|
|
|
|
=head1 COPYRIGHT & LICENSE |
4090
|
|
|
|
|
|
|
|
4091
|
|
|
|
|
|
|
Copyright 2009-2014 John Imrie. |
4092
|
|
|
|
|
|
|
Backwards compatible Case Folding Copyright Andrew Rodland ARODLAND@cpan.org |
4093
|
|
|
|
|
|
|
|
4094
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it |
4095
|
|
|
|
|
|
|
under the terms of either: the GNU General Public License as published |
4096
|
|
|
|
|
|
|
by the Free Software Foundation; or the Artistic License. |
4097
|
|
|
|
|
|
|
|
4098
|
|
|
|
|
|
|
See http://dev.perl.org/licenses/ for more information. |
4099
|
|
|
|
|
|
|
|
4100
|
|
|
|
|
|
|
=cut |
4101
|
|
|
|
|
|
|
|
4102
|
|
|
|
|
|
|
1; # End of Locale::CLDR |