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