| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
##---------------------------------------------------------------------------- |
|
2
|
|
|
|
|
|
|
## Locale Intl - ~/lib/Locale/Intl.pm |
|
3
|
|
|
|
|
|
|
## Version v0.3.0 |
|
4
|
|
|
|
|
|
|
## Copyright(c) 2025 DEGUEST Pte. Ltd. |
|
5
|
|
|
|
|
|
|
## Author: Jacques Deguest <jack@deguest.jp> |
|
6
|
|
|
|
|
|
|
## Created 2024/09/16 |
|
7
|
|
|
|
|
|
|
## Modified 2025/10/16 |
|
8
|
|
|
|
|
|
|
## All rights reserved |
|
9
|
|
|
|
|
|
|
## |
|
10
|
|
|
|
|
|
|
## |
|
11
|
|
|
|
|
|
|
## This program is free software; you can redistribute it and/or modify it |
|
12
|
|
|
|
|
|
|
## under the same terms as Perl itself. |
|
13
|
|
|
|
|
|
|
##---------------------------------------------------------------------------- |
|
14
|
|
|
|
|
|
|
package Locale::Intl; |
|
15
|
|
|
|
|
|
|
BEGIN |
|
16
|
|
|
|
|
|
|
{ |
|
17
|
2
|
|
|
2
|
|
263814
|
use v5.10.1; |
|
|
2
|
|
|
|
|
9
|
|
|
18
|
2
|
|
|
2
|
|
16
|
use strict; |
|
|
2
|
|
|
|
|
4
|
|
|
|
2
|
|
|
|
|
102
|
|
|
19
|
2
|
|
|
2
|
|
22
|
use warnings; |
|
|
2
|
|
|
|
|
16
|
|
|
|
2
|
|
|
|
|
136
|
|
|
20
|
2
|
|
|
2
|
|
13
|
use warnings::register; |
|
|
2
|
|
|
|
|
4
|
|
|
|
2
|
|
|
|
|
178
|
|
|
21
|
2
|
|
|
2
|
|
1173
|
use parent qw( Locale::Unicode ); |
|
|
2
|
|
|
|
|
774
|
|
|
|
2
|
|
|
|
|
15
|
|
|
22
|
2
|
|
|
2
|
|
126476
|
use vars qw( $VERSION $ERROR $DEBUG ); |
|
|
2
|
|
|
|
|
4
|
|
|
|
2
|
|
|
|
|
123
|
|
|
23
|
2
|
|
|
2
|
|
10357
|
use Locale::Unicode::Data; |
|
|
2
|
|
|
|
|
262984
|
|
|
|
2
|
|
|
|
|
99
|
|
|
24
|
2
|
|
|
2
|
|
15
|
use Wanted; |
|
|
2
|
|
|
|
|
13
|
|
|
|
2
|
|
|
|
|
153
|
|
|
25
|
2
|
|
|
2
|
|
48
|
our $VERSION = 'v0.3.0'; |
|
26
|
|
|
|
|
|
|
}; |
|
27
|
|
|
|
|
|
|
|
|
28
|
2
|
|
|
2
|
|
8
|
use strict; |
|
|
2
|
|
|
|
|
4
|
|
|
|
2
|
|
|
|
|
35
|
|
|
29
|
2
|
|
|
2
|
|
5
|
use warnings; |
|
|
2
|
|
|
|
|
2
|
|
|
|
2
|
|
|
|
|
7795
|
|
|
30
|
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
sub new |
|
32
|
|
|
|
|
|
|
{ |
|
33
|
125
|
|
|
125
|
1
|
445906
|
my $this = shift( @_ ); |
|
34
|
125
|
|
|
|
|
264
|
my $locale = shift( @_ ); |
|
35
|
125
|
|
|
|
|
552
|
my $opts = $this->_get_args_as_hash( @_ ); |
|
36
|
125
|
|
50
|
|
|
2121
|
my $self = $this->Locale::Unicode::new( $locale, %$opts ) || |
|
37
|
|
|
|
|
|
|
return( $this->pass_error( $this->error ) ); |
|
38
|
|
|
|
|
|
|
# We have to handle 'language' and 'region' specially |
|
39
|
125
|
100
|
|
|
|
13627
|
if( exists( $opts->{language} ) ) |
|
40
|
|
|
|
|
|
|
{ |
|
41
|
2
|
|
|
|
|
5
|
my $lang = delete( $opts->{language} ); |
|
42
|
2
|
100
|
66
|
|
|
17
|
if( defined( $lang ) && |
|
43
|
|
|
|
|
|
|
length( $lang ) ) |
|
44
|
|
|
|
|
|
|
{ |
|
45
|
1
|
|
50
|
|
|
6
|
my $loc = Locale::Unicode->new( $lang ) || |
|
46
|
|
|
|
|
|
|
return( $this->pass_error( Locale::Unicode->error ) ); |
|
47
|
1
|
50
|
|
|
|
24
|
if( my $locale2 = $loc->locale ) |
|
|
|
0
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
{ |
|
49
|
1
|
|
|
|
|
101
|
$self->locale( $locale2 ); |
|
50
|
1
|
|
|
|
|
113
|
$self->locale3( undef ); |
|
51
|
|
|
|
|
|
|
} |
|
52
|
|
|
|
|
|
|
elsif( my $locale3 = $loc->locale3 ) |
|
53
|
|
|
|
|
|
|
{ |
|
54
|
0
|
|
|
|
|
0
|
$self->locale( undef ); |
|
55
|
0
|
|
|
|
|
0
|
$self->locale3( $locale3 ); |
|
56
|
|
|
|
|
|
|
} |
|
57
|
|
|
|
|
|
|
} |
|
58
|
|
|
|
|
|
|
# This is not good, but if this is what the user wants... |
|
59
|
|
|
|
|
|
|
else |
|
60
|
|
|
|
|
|
|
{ |
|
61
|
1
|
|
|
|
|
5
|
$self->locale( undef ); |
|
62
|
1
|
|
|
|
|
101
|
$self->locale3( undef ); |
|
63
|
|
|
|
|
|
|
} |
|
64
|
|
|
|
|
|
|
} |
|
65
|
|
|
|
|
|
|
|
|
66
|
125
|
100
|
|
|
|
568
|
if( exists( $opts->{region} ) ) |
|
67
|
|
|
|
|
|
|
{ |
|
68
|
2
|
|
|
|
|
8
|
my $region = delete( $opts->{region} ); |
|
69
|
2
|
50
|
33
|
|
|
16
|
if( defined( $region ) && |
|
70
|
|
|
|
|
|
|
length( $region ) ) |
|
71
|
|
|
|
|
|
|
{ |
|
72
|
|
|
|
|
|
|
# A country code |
|
73
|
2
|
50
|
|
|
|
13
|
if( $region =~ /^[a-zA-Z]{2}$/ ) |
|
|
|
0
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
{ |
|
75
|
2
|
|
|
|
|
9
|
$self->country_code( $region ); |
|
76
|
2
|
|
|
|
|
305
|
$self->SUPER::region( undef ); |
|
77
|
|
|
|
|
|
|
} |
|
78
|
|
|
|
|
|
|
# A world region |
|
79
|
|
|
|
|
|
|
elsif( $region =~ /^\d{3}$/ ) |
|
80
|
|
|
|
|
|
|
{ |
|
81
|
0
|
|
|
|
|
0
|
$self->country_code( undef ); |
|
82
|
0
|
|
|
|
|
0
|
$self->SUPER::region( $region ); |
|
83
|
|
|
|
|
|
|
} |
|
84
|
|
|
|
|
|
|
else |
|
85
|
|
|
|
|
|
|
{ |
|
86
|
0
|
|
0
|
|
|
0
|
return( $self->error( "Unknown region value '", ( $region // 'undef' ), "' provided." ) ); |
|
87
|
|
|
|
|
|
|
} |
|
88
|
|
|
|
|
|
|
} |
|
89
|
|
|
|
|
|
|
else |
|
90
|
|
|
|
|
|
|
{ |
|
91
|
0
|
|
|
|
|
0
|
$self->country_code( undef ); |
|
92
|
0
|
|
|
|
|
0
|
$self->SUPER::region( undef ); |
|
93
|
|
|
|
|
|
|
} |
|
94
|
|
|
|
|
|
|
} |
|
95
|
|
|
|
|
|
|
my $map = |
|
96
|
|
|
|
|
|
|
{ |
|
97
|
3
|
|
|
3
|
|
11
|
calendar => sub{ $self->SUPER::calendar( @_ ); }, |
|
98
|
3
|
|
|
3
|
|
11
|
caseFirst => sub{ $self->colCaseFirst( @_ ); }, |
|
99
|
0
|
|
|
0
|
|
0
|
collation => sub{ $self->SUPER::collation( @_ ); }, |
|
100
|
4
|
|
|
4
|
|
15
|
hourCycle => sub{ $self->hour_cycle( @_ ); }, |
|
101
|
1
|
|
|
1
|
|
6
|
numberingSystem => sub{ $self->number( @_ ); }, |
|
102
|
2
|
|
|
2
|
|
8
|
numeric => sub{ $self->colNumeric( @_ ); }, |
|
103
|
0
|
|
|
0
|
|
0
|
script => sub{ $self->SUPER::script( @_ ) }, |
|
104
|
125
|
|
|
|
|
2877
|
}; |
|
105
|
125
|
|
|
|
|
453
|
foreach my $prop ( keys( %$opts ) ) |
|
106
|
|
|
|
|
|
|
{ |
|
107
|
13
|
50
|
|
|
|
45
|
if( exists( $map->{ $prop } ) ) |
|
108
|
|
|
|
|
|
|
{ |
|
109
|
13
|
|
|
|
|
40
|
my $rv = $map->{ $prop }->( $opts->{ $prop } ); |
|
110
|
13
|
|
|
|
|
1609
|
delete( $opts->{ $prop } ); |
|
111
|
13
|
50
|
66
|
|
|
65
|
if( !defined( $rv ) && $self->error ) |
|
112
|
|
|
|
|
|
|
{ |
|
113
|
0
|
|
|
|
|
0
|
return( $this->pass_error( $self->error ) ); |
|
114
|
|
|
|
|
|
|
} |
|
115
|
|
|
|
|
|
|
} |
|
116
|
|
|
|
|
|
|
} |
|
117
|
|
|
|
|
|
|
|
|
118
|
125
|
50
|
|
|
|
355
|
if( scalar( keys( %$opts ) ) ) |
|
119
|
|
|
|
|
|
|
{ |
|
120
|
0
|
0
|
|
|
|
0
|
warn( "Unknow option parameters provided: '", join( "', '", map( overload::StrVal( $_ ), sort( keys( %$opts ) ) ) ), "'" ) if( warnings::enabled() ); |
|
121
|
|
|
|
|
|
|
} |
|
122
|
125
|
|
|
|
|
754
|
$self->{_cldr} = Locale::Unicode::Data->new; |
|
123
|
125
|
|
|
|
|
54557
|
return( $self ); |
|
124
|
|
|
|
|
|
|
} |
|
125
|
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
sub baseName |
|
127
|
|
|
|
|
|
|
{ |
|
128
|
5
|
|
|
5
|
1
|
3268
|
my $self = shift( @_ ); |
|
129
|
5
|
50
|
|
|
|
26
|
if( my $core = $self->core ) |
|
130
|
|
|
|
|
|
|
{ |
|
131
|
5
|
|
|
|
|
763
|
return( $core ); |
|
132
|
|
|
|
|
|
|
} |
|
133
|
|
|
|
|
|
|
# Otherwise, as per the specs, we return undef |
|
134
|
0
|
0
|
|
|
|
0
|
if( want( 'OBJECT' ) ) |
|
135
|
|
|
|
|
|
|
{ |
|
136
|
0
|
|
|
|
|
0
|
return( Locale::Intl::NullObject->new ); |
|
137
|
|
|
|
|
|
|
} |
|
138
|
0
|
|
|
|
|
0
|
return; |
|
139
|
|
|
|
|
|
|
} |
|
140
|
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
sub calendar |
|
142
|
|
|
|
|
|
|
{ |
|
143
|
60
|
|
|
60
|
1
|
17780
|
my $self = shift( @_ ); |
|
144
|
|
|
|
|
|
|
# This is a property, so it is read-only, but we need to ensure our parent package method keeps working |
|
145
|
60
|
100
|
|
|
|
197
|
if( @_ ) |
|
146
|
|
|
|
|
|
|
{ |
|
147
|
8
|
|
|
|
|
35
|
return( $self->SUPER::calendar( @_ ) ); |
|
148
|
|
|
|
|
|
|
} |
|
149
|
|
|
|
|
|
|
|
|
150
|
52
|
100
|
|
|
|
256
|
if( my $col = $self->SUPER::calendar ) |
|
151
|
|
|
|
|
|
|
{ |
|
152
|
7
|
|
|
|
|
938
|
return( $col ); |
|
153
|
|
|
|
|
|
|
} |
|
154
|
|
|
|
|
|
|
# Otherwise, as per the specs, we return undef |
|
155
|
45
|
50
|
|
|
|
4935
|
if( want( 'OBJECT' ) ) |
|
156
|
|
|
|
|
|
|
{ |
|
157
|
0
|
|
|
|
|
0
|
return( Locale::Intl::NullObject->new ); |
|
158
|
|
|
|
|
|
|
} |
|
159
|
45
|
|
|
|
|
3604
|
return; |
|
160
|
|
|
|
|
|
|
} |
|
161
|
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
sub caseFirst |
|
163
|
|
|
|
|
|
|
{ |
|
164
|
6
|
|
|
6
|
1
|
2365
|
my $self = shift( @_ ); |
|
165
|
6
|
100
|
|
|
|
29
|
if( my $cf = $self->colCaseFirst ) |
|
166
|
|
|
|
|
|
|
{ |
|
167
|
3
|
|
|
|
|
385
|
return( $cf ); |
|
168
|
|
|
|
|
|
|
} |
|
169
|
|
|
|
|
|
|
# Otherwise, as per the specs, we return undef |
|
170
|
3
|
50
|
|
|
|
390
|
if( want( 'OBJECT' ) ) |
|
171
|
|
|
|
|
|
|
{ |
|
172
|
0
|
|
|
|
|
0
|
return( Locale::Intl::NullObject->new ); |
|
173
|
|
|
|
|
|
|
} |
|
174
|
3
|
|
|
|
|
197
|
return; |
|
175
|
|
|
|
|
|
|
} |
|
176
|
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
sub collation |
|
178
|
|
|
|
|
|
|
{ |
|
179
|
104
|
|
|
104
|
1
|
44393
|
my $self = shift( @_ ); |
|
180
|
|
|
|
|
|
|
# This is a property, so it is read-only, but we need to ensure our parent package method keeps working |
|
181
|
104
|
100
|
|
|
|
327
|
if( @_ ) |
|
182
|
|
|
|
|
|
|
{ |
|
183
|
1
|
|
|
|
|
6
|
return( $self->SUPER::collation( @_ ) ); |
|
184
|
|
|
|
|
|
|
} |
|
185
|
|
|
|
|
|
|
|
|
186
|
103
|
50
|
|
|
|
439
|
if( my $col = $self->SUPER::collation ) |
|
187
|
|
|
|
|
|
|
{ |
|
188
|
0
|
|
|
|
|
0
|
return( $col ); |
|
189
|
|
|
|
|
|
|
} |
|
190
|
|
|
|
|
|
|
# Otherwise, as per the specs, we return undef |
|
191
|
103
|
50
|
|
|
|
12885
|
if( want( 'OBJECT' ) ) |
|
192
|
|
|
|
|
|
|
{ |
|
193
|
0
|
|
|
|
|
0
|
return( Locale::Intl::NullObject->new ); |
|
194
|
|
|
|
|
|
|
} |
|
195
|
103
|
|
|
|
|
6876
|
return; |
|
196
|
|
|
|
|
|
|
} |
|
197
|
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
sub error |
|
199
|
|
|
|
|
|
|
{ |
|
200
|
10
|
|
|
10
|
1
|
74
|
my $self = shift( @_ ); |
|
201
|
10
|
50
|
|
|
|
33
|
if( @_ ) |
|
202
|
|
|
|
|
|
|
{ |
|
203
|
0
|
0
|
|
|
|
0
|
my $msg = join( '', map( ( ref( $_ ) eq 'CODE' ) ? $_->() : $_, @_ ) ); |
|
204
|
0
|
|
|
|
|
0
|
$self->{error} = $ERROR = Locale::Intl::Exception->new({ |
|
205
|
|
|
|
|
|
|
skip_frames => 1, |
|
206
|
|
|
|
|
|
|
message => $msg, |
|
207
|
|
|
|
|
|
|
}); |
|
208
|
0
|
0
|
|
|
|
0
|
if( $self->fatal ) |
|
209
|
|
|
|
|
|
|
{ |
|
210
|
0
|
|
|
|
|
0
|
die( $self->{error} ); |
|
211
|
|
|
|
|
|
|
} |
|
212
|
|
|
|
|
|
|
else |
|
213
|
|
|
|
|
|
|
{ |
|
214
|
0
|
0
|
|
|
|
0
|
warn( $msg ) if( warnings::enabled() ); |
|
215
|
0
|
0
|
|
|
|
0
|
if( want( 'ARRAY' ) ) |
|
|
|
0
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
{ |
|
217
|
0
|
|
|
|
|
0
|
rreturn( [] ); |
|
218
|
|
|
|
|
|
|
} |
|
219
|
|
|
|
|
|
|
elsif( want( 'OBJECT' ) ) |
|
220
|
|
|
|
|
|
|
{ |
|
221
|
0
|
|
|
|
|
0
|
rreturn( Locale::Intl::NullObject->new ); |
|
222
|
|
|
|
|
|
|
} |
|
223
|
0
|
|
|
|
|
0
|
return; |
|
224
|
|
|
|
|
|
|
} |
|
225
|
|
|
|
|
|
|
} |
|
226
|
10
|
50
|
|
|
|
89
|
return( ref( $self ) ? $self->{error} : $ERROR ); |
|
227
|
|
|
|
|
|
|
} |
|
228
|
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
sub getAllCalendars |
|
230
|
|
|
|
|
|
|
{ |
|
231
|
1
|
|
|
1
|
1
|
4614
|
my $self = shift( @_ ); |
|
232
|
1
|
|
50
|
|
|
6
|
my $cldr = $self->_cldr || return( $self->pass_error ); |
|
233
|
1
|
|
|
|
|
6
|
my $all = $cldr->calendars; |
|
234
|
1
|
|
|
|
|
1204
|
my @cals = map( $_->{calendar}, @$all ); |
|
235
|
1
|
|
|
|
|
20
|
return( \@cals ); |
|
236
|
|
|
|
|
|
|
} |
|
237
|
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
sub getAllNumberingSystems |
|
239
|
|
|
|
|
|
|
{ |
|
240
|
1
|
|
|
1
|
1
|
5298
|
my $self = shift( @_ ); |
|
241
|
1
|
|
50
|
|
|
5
|
my $cldr = $self->_cldr || return( $self->pass_error ); |
|
242
|
1
|
|
|
|
|
7
|
my $all = $cldr->number_systems; |
|
243
|
1
|
|
|
|
|
9822
|
my @ids = map( $_->{number_system}, @$all ); |
|
244
|
1
|
|
|
|
|
121
|
return( \@ids ); |
|
245
|
|
|
|
|
|
|
} |
|
246
|
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
sub getAllTimeZones |
|
248
|
|
|
|
|
|
|
{ |
|
249
|
1
|
|
|
1
|
1
|
5451
|
my $self = shift( @_ ); |
|
250
|
1
|
|
50
|
|
|
6
|
my $cldr = $self->_cldr || return( $self->pass_error ); |
|
251
|
1
|
|
|
|
|
7
|
my $all = $cldr->timezones; |
|
252
|
1
|
|
|
|
|
31734
|
my @tzs = map( $_->{timezone}, @$all ); |
|
253
|
1
|
|
|
|
|
884
|
return( \@tzs ); |
|
254
|
|
|
|
|
|
|
} |
|
255
|
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
sub getCalendars |
|
257
|
|
|
|
|
|
|
{ |
|
258
|
4
|
|
|
4
|
1
|
24
|
my $self = shift( @_ ); |
|
259
|
4
|
|
50
|
|
|
16
|
my $cldr = $self->_cldr || return( $self->pass_error ); |
|
260
|
4
|
|
|
|
|
8
|
my $cc; |
|
261
|
|
|
|
|
|
|
# This is how the algorithm works. |
|
262
|
|
|
|
|
|
|
# If the locale set has no country code associated, we find out with the maximize() method |
|
263
|
|
|
|
|
|
|
# Then, we get the preferred calendars, or by default, 'gregory' |
|
264
|
4
|
100
|
|
|
|
18
|
unless( $cc = $self->country_code ) |
|
265
|
|
|
|
|
|
|
{ |
|
266
|
3
|
|
|
|
|
381
|
my $lang = $self->maximize; |
|
267
|
3
|
|
50
|
|
|
15
|
my $new = $self->new( $lang ) || return( $self->pass_error ); |
|
268
|
3
|
|
50
|
|
|
31
|
$cc = $new->country_code || return( $self->error( "Unable to find out a country code for this locale '", $self->core, "', or '${lang}'" ) ); |
|
269
|
|
|
|
|
|
|
} |
|
270
|
4
|
|
50
|
|
|
611
|
my $ref = $cldr->territory( territory => $cc ) || |
|
271
|
|
|
|
|
|
|
return( $self->error( "Unknown territory code '${cc}'" ) ); |
|
272
|
4
|
|
|
|
|
4884
|
my $cals = $ref->{calendars}; |
|
273
|
|
|
|
|
|
|
# If there are no calendars identified for this territory, by standard, we must look it up in the 'World' territory, i.e. '001' |
|
274
|
4
|
50
|
66
|
|
|
39
|
unless( $cals && ref( $cals ) eq 'ARRAY' && scalar( @$cals ) ) |
|
|
|
|
100
|
|
|
|
|
|
275
|
|
|
|
|
|
|
{ |
|
276
|
1
|
|
50
|
|
|
6
|
$ref = $cldr->territory( territory => '001' ) || |
|
277
|
|
|
|
|
|
|
return( $self->error( "Unknown territory code '001' used for World ! This should not be happening." ) ); |
|
278
|
1
|
50
|
33
|
|
|
2689
|
if( $ref && |
|
|
|
|
50
|
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
279
|
|
|
|
|
|
|
$ref->{calendars} && |
|
280
|
|
|
|
|
|
|
ref( $ref->{calendars} // '' ) eq 'ARRAY' && |
|
281
|
1
|
|
|
|
|
6
|
scalar( @{$ref->{calendars}} ) ) |
|
282
|
|
|
|
|
|
|
{ |
|
283
|
1
|
|
|
|
|
3
|
$cals = $ref->{calendars}; |
|
284
|
|
|
|
|
|
|
} |
|
285
|
|
|
|
|
|
|
else |
|
286
|
|
|
|
|
|
|
{ |
|
287
|
0
|
|
|
|
|
0
|
return( $self->error( "Unable to find the calendars data for the territory '001' (World). This should not be happening." ) ); |
|
288
|
|
|
|
|
|
|
} |
|
289
|
|
|
|
|
|
|
} |
|
290
|
4
|
|
|
|
|
38
|
return( $cals ); |
|
291
|
|
|
|
|
|
|
} |
|
292
|
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
sub getCollations |
|
294
|
|
|
|
|
|
|
{ |
|
295
|
3
|
|
|
3
|
1
|
22
|
my $self = shift( @_ ); |
|
296
|
3
|
|
50
|
|
|
15
|
my $cldr = $self->_cldr || return( $self->pass_error ); |
|
297
|
3
|
|
|
|
|
20
|
my $core = $self->core; |
|
298
|
3
|
|
50
|
|
|
353
|
my $tree = $cldr->make_inheritance_tree( $core ) || |
|
299
|
|
|
|
|
|
|
return( $self->pass_error( $cldr->error ) ); |
|
300
|
3
|
|
|
|
|
26555
|
my $collations; |
|
301
|
3
|
|
|
|
|
11
|
foreach my $loc ( @$tree ) |
|
302
|
|
|
|
|
|
|
{ |
|
303
|
4
|
|
|
|
|
44
|
my $ref = $cldr->locale( |
|
304
|
|
|
|
|
|
|
locale => $loc, |
|
305
|
|
|
|
|
|
|
); |
|
306
|
4
|
50
|
33
|
|
|
4335
|
return( $self->pass_error( $cldr->error ) ) if( !defined( $ref ) && $cldr->error ); |
|
307
|
4
|
50
|
66
|
|
|
59
|
if( $ref && |
|
|
|
|
66
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
308
|
|
|
|
|
|
|
defined( $ref->{collations} ) && |
|
309
|
|
|
|
|
|
|
ref( $ref->{collations} ) eq 'ARRAY' && |
|
310
|
3
|
|
|
|
|
17
|
scalar( @{$ref->{collations}} ) ) |
|
311
|
|
|
|
|
|
|
{ |
|
312
|
3
|
|
|
|
|
10
|
$collations = $ref->{collations}; |
|
313
|
3
|
|
|
|
|
17
|
last; |
|
314
|
|
|
|
|
|
|
} |
|
315
|
|
|
|
|
|
|
} |
|
316
|
3
|
|
|
|
|
20
|
return( $collations ); |
|
317
|
|
|
|
|
|
|
} |
|
318
|
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
sub getHourCycles |
|
320
|
|
|
|
|
|
|
{ |
|
321
|
3
|
|
|
3
|
1
|
20
|
my $self = shift( @_ ); |
|
322
|
3
|
|
50
|
|
|
12
|
my $cldr = $self->_cldr || return( $self->pass_error ); |
|
323
|
|
|
|
|
|
|
# If an hour cycle has been set, return it, as per the specs. |
|
324
|
3
|
100
|
|
|
|
16
|
if( my $hc = $self->hour_cycle ) |
|
325
|
|
|
|
|
|
|
{ |
|
326
|
1
|
|
|
|
|
107
|
return( [$hc] ); |
|
327
|
|
|
|
|
|
|
} |
|
328
|
2
|
|
|
|
|
227
|
my $core = $self->core; |
|
329
|
|
|
|
|
|
|
# Maybe something like fr-CA ? |
|
330
|
2
|
|
|
|
|
513
|
my $ref = $cldr->time_format( region => $core ); |
|
331
|
2
|
50
|
|
|
|
1734
|
if( !$ref ) |
|
332
|
|
|
|
|
|
|
{ |
|
333
|
2
|
|
33
|
|
|
11
|
my $cc = ( $self->country_code || $self->SUPER::region ); |
|
334
|
2
|
50
|
|
|
|
300
|
unless( $cc ) |
|
335
|
|
|
|
|
|
|
{ |
|
336
|
0
|
|
0
|
|
|
0
|
my $full = $self->maximize || return( $self->pass_error ); |
|
337
|
0
|
|
0
|
|
|
0
|
my $loc = $self->new( $full ) || return( $self->pass_error ); |
|
338
|
0
|
|
0
|
|
|
0
|
$cc = ( $self->country_code || $self->SUPER::region ); |
|
339
|
|
|
|
|
|
|
} |
|
340
|
2
|
50
|
|
|
|
7
|
return( [] ) if( !$cc ); |
|
341
|
2
|
|
|
|
|
11
|
my $all = $cldr->time_formats( territory => $cc ); |
|
342
|
2
|
50
|
33
|
|
|
2751
|
return( $self->pass_error( $cldr->error ) ) if( !defined( $all ) && $cldr->error ); |
|
343
|
2
|
50
|
33
|
|
|
22
|
$ref = $all->[0] if( $all && ref( $all ) eq 'ARRAY' ); |
|
344
|
|
|
|
|
|
|
} |
|
345
|
2
|
50
|
33
|
|
|
20
|
if( $ref && |
|
|
|
|
33
|
|
|
|
|
|
346
|
|
|
|
|
|
|
exists( $ref->{time_format} ) && |
|
347
|
|
|
|
|
|
|
$ref->{time_format} ) |
|
348
|
|
|
|
|
|
|
{ |
|
349
|
2
|
|
|
|
|
16
|
my $map = |
|
350
|
|
|
|
|
|
|
{ |
|
351
|
|
|
|
|
|
|
h => 'h12', |
|
352
|
|
|
|
|
|
|
H => 'h23', |
|
353
|
|
|
|
|
|
|
k => 'h24', |
|
354
|
|
|
|
|
|
|
K => 'h11', |
|
355
|
|
|
|
|
|
|
}; |
|
356
|
2
|
50
|
|
|
|
11
|
my @rv = map{ $map->{ $_ } || $_ } split( //, $ref->{time_format} ); |
|
|
2
|
|
|
|
|
40
|
|
|
357
|
2
|
|
|
|
|
20
|
return( \@rv ); |
|
358
|
|
|
|
|
|
|
} |
|
359
|
0
|
|
|
|
|
0
|
return( [] ); |
|
360
|
|
|
|
|
|
|
} |
|
361
|
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
sub getNumberingSystems |
|
363
|
|
|
|
|
|
|
{ |
|
364
|
2
|
|
|
2
|
1
|
16
|
my $self = shift( @_ ); |
|
365
|
|
|
|
|
|
|
# "If the Locale already has a numberingSystem, then the returned array contains that single value." |
|
366
|
2
|
50
|
|
|
|
18
|
if( my $nu = $self->number ) |
|
367
|
|
|
|
|
|
|
{ |
|
368
|
0
|
|
|
|
|
0
|
return( [$nu] ); |
|
369
|
|
|
|
|
|
|
} |
|
370
|
2
|
|
50
|
|
|
325
|
my $cldr = $self->_cldr || return( $self->pass_error ); |
|
371
|
2
|
|
|
|
|
13
|
my $core = $self->core; |
|
372
|
2
|
|
50
|
|
|
500
|
my $tree = $cldr->make_inheritance_tree( $core ) || |
|
373
|
|
|
|
|
|
|
return( $self->pass_error( $cldr->error ) ); |
|
374
|
2
|
|
|
|
|
15070
|
my $num_sys; |
|
375
|
2
|
|
|
|
|
7
|
foreach my $loc ( @$tree ) |
|
376
|
|
|
|
|
|
|
{ |
|
377
|
3
|
|
|
|
|
20
|
my $ref = $cldr->locale_number_system( |
|
378
|
|
|
|
|
|
|
locale => $loc, |
|
379
|
|
|
|
|
|
|
); |
|
380
|
3
|
50
|
33
|
|
|
2077
|
return( $self->pass_error( $cldr->error ) ) if( !defined( $ref ) && $cldr->error ); |
|
381
|
3
|
100
|
100
|
|
|
38
|
if( $ref && |
|
|
|
|
66
|
|
|
|
|
|
382
|
|
|
|
|
|
|
length( $ref->{number_system} // '' ) ) |
|
383
|
|
|
|
|
|
|
{ |
|
384
|
2
|
|
|
|
|
6
|
$num_sys = $ref->{number_system}; |
|
385
|
2
|
|
|
|
|
11
|
last; |
|
386
|
|
|
|
|
|
|
} |
|
387
|
|
|
|
|
|
|
} |
|
388
|
|
|
|
|
|
|
# Although we return an array, in reality, there is only one element in the array. |
|
389
|
2
|
50
|
|
|
|
17
|
return( [$num_sys] ) if( defined( $num_sys ) ); |
|
390
|
0
|
|
|
|
|
0
|
return( [] ); |
|
391
|
|
|
|
|
|
|
} |
|
392
|
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
sub getTextInfo |
|
394
|
|
|
|
|
|
|
{ |
|
395
|
2
|
|
|
2
|
1
|
13
|
my $self = shift( @_ ); |
|
396
|
2
|
|
50
|
|
|
11
|
my $cldr = $self->_cldr || return( $self->pass_error ); |
|
397
|
2
|
|
|
|
|
15
|
my $core = $self->core; |
|
398
|
2
|
|
50
|
|
|
269
|
my $tree = $cldr->make_inheritance_tree( $core ) || |
|
399
|
|
|
|
|
|
|
return( $self->pass_error( $cldr->error ) ); |
|
400
|
2
|
|
|
|
|
13662
|
my $orientation; |
|
401
|
2
|
|
|
|
|
8
|
foreach my $loc ( @$tree ) |
|
402
|
|
|
|
|
|
|
{ |
|
403
|
3
|
|
|
|
|
15
|
my $ref = $cldr->locales_info( |
|
404
|
|
|
|
|
|
|
locale => $loc, |
|
405
|
|
|
|
|
|
|
property => 'char_orientation', |
|
406
|
|
|
|
|
|
|
); |
|
407
|
3
|
50
|
66
|
|
|
12364
|
return( $self->pass_error( $cldr->error ) ) if( !defined( $ref ) && $cldr->error ); |
|
408
|
3
|
100
|
50
|
|
|
68
|
if( $ref && |
|
|
|
|
66
|
|
|
|
|
|
409
|
|
|
|
|
|
|
length( $ref->{value} // '' ) ) |
|
410
|
|
|
|
|
|
|
{ |
|
411
|
2
|
|
|
|
|
7
|
$orientation = $ref->{value}; |
|
412
|
2
|
|
|
|
|
8
|
last; |
|
413
|
|
|
|
|
|
|
} |
|
414
|
|
|
|
|
|
|
} |
|
415
|
2
|
|
|
|
|
12
|
my $map = |
|
416
|
|
|
|
|
|
|
{ |
|
417
|
|
|
|
|
|
|
'right-to-left' => 'rtl', |
|
418
|
|
|
|
|
|
|
'left-to-right' => 'ltr', |
|
419
|
|
|
|
|
|
|
}; |
|
420
|
2
|
50
|
|
|
|
7
|
if( defined( $orientation ) ) |
|
421
|
|
|
|
|
|
|
{ |
|
422
|
2
|
50
|
|
|
|
9
|
return( $self->error( "Unsupported value '${orientation}' found for locale '${core}'" ) ) if( !exists( $map->{ $orientation } ) ); |
|
423
|
2
|
|
|
|
|
17
|
return( $map->{ $orientation } ); |
|
424
|
|
|
|
|
|
|
} |
|
425
|
0
|
|
|
|
|
0
|
return( 'ltr' ); |
|
426
|
|
|
|
|
|
|
} |
|
427
|
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
sub getTimeZones |
|
429
|
|
|
|
|
|
|
{ |
|
430
|
4
|
|
|
4
|
1
|
54
|
my $self = shift( @_ ); |
|
431
|
4
|
|
50
|
|
|
20
|
my $cldr = $self->_cldr || return( $self->pass_error ); |
|
432
|
4
|
|
|
|
|
17
|
my $cc = $self->country_code; |
|
433
|
4
|
100
|
|
|
|
494
|
unless( $cc ) |
|
434
|
|
|
|
|
|
|
{ |
|
435
|
1
|
|
|
|
|
6
|
my $full = $self->maximize; |
|
436
|
1
|
|
50
|
|
|
6
|
my $loc = $self->new( $full ) || return( $self->error ); |
|
437
|
1
|
|
|
|
|
11
|
$cc = $loc->country_code; |
|
438
|
|
|
|
|
|
|
} |
|
439
|
4
|
50
|
|
|
|
184
|
if( $cc ) |
|
440
|
|
|
|
|
|
|
{ |
|
441
|
4
|
|
50
|
|
|
23
|
my $all = $cldr->timezones( territory => $cc, is_canonical => 1 ) || |
|
442
|
|
|
|
|
|
|
return( $self->pass_error( $cldr->error ) ); |
|
443
|
4
|
|
|
|
|
3828
|
my @timezones = map( $_->{timezone}, @$all ); |
|
444
|
4
|
|
|
|
|
35
|
return( \@timezones ); |
|
445
|
|
|
|
|
|
|
} |
|
446
|
|
|
|
|
|
|
else |
|
447
|
|
|
|
|
|
|
{ |
|
448
|
0
|
|
|
|
|
0
|
return( [] ); |
|
449
|
|
|
|
|
|
|
} |
|
450
|
|
|
|
|
|
|
} |
|
451
|
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
sub getWeekInfo |
|
453
|
|
|
|
|
|
|
{ |
|
454
|
4
|
|
|
4
|
1
|
23
|
my $self = shift( @_ ); |
|
455
|
4
|
|
50
|
|
|
16
|
my $cldr = $self->_cldr || return( $self->pass_error ); |
|
456
|
4
|
|
|
|
|
19
|
my $core = $self->core; |
|
457
|
4
|
|
|
|
|
737
|
my $cc; |
|
458
|
4
|
100
|
|
|
|
14
|
unless( $cc = $self->country_code ) |
|
459
|
|
|
|
|
|
|
{ |
|
460
|
2
|
|
50
|
|
|
237
|
my $full = $self->maximize || return( $self->pass_error ); |
|
461
|
2
|
|
50
|
|
|
21
|
my $locale = $self->new( $full ) || return( $self->pass_error ); |
|
462
|
2
|
|
50
|
|
|
20
|
$cc = $locale->country_code || return( $self->error( "No country code could be derived for this locale ${core}" ) ); |
|
463
|
|
|
|
|
|
|
} |
|
464
|
4
|
|
|
|
|
613
|
my $info = $cldr->territory( territory => $cc ); |
|
465
|
4
|
|
|
|
|
2046
|
my $fallback; |
|
466
|
4
|
|
|
|
|
9
|
my $def = {}; |
|
467
|
|
|
|
|
|
|
# Firt day of the week |
|
468
|
4
|
50
|
50
|
|
|
26
|
if( length( $info->{first_day} // '' ) ) |
|
469
|
|
|
|
|
|
|
{ |
|
470
|
4
|
|
|
|
|
17
|
$def->{firstDay} = $info->{first_day}; |
|
471
|
|
|
|
|
|
|
} |
|
472
|
|
|
|
|
|
|
else |
|
473
|
|
|
|
|
|
|
{ |
|
474
|
|
|
|
|
|
|
# 001 is the code for World, acting as the default fallback value |
|
475
|
0
|
0
|
|
|
|
0
|
$fallback = $cldr->territory( territory => '001' ) if( !defined( $fallback ) ); |
|
476
|
0
|
0
|
|
|
|
0
|
$def->{firstDay} = $fallback->{first_day} if( $fallback ); |
|
477
|
|
|
|
|
|
|
} |
|
478
|
|
|
|
|
|
|
# Minimum number of days for calendar display |
|
479
|
4
|
100
|
100
|
|
|
29
|
if( length( $info->{min_days} // '' ) ) |
|
480
|
|
|
|
|
|
|
{ |
|
481
|
1
|
|
|
|
|
3
|
$def->{minimalDays} = $info->{min_days}; |
|
482
|
|
|
|
|
|
|
} |
|
483
|
|
|
|
|
|
|
else |
|
484
|
|
|
|
|
|
|
{ |
|
485
|
|
|
|
|
|
|
# 001 is the code for World, acting as the default fallback value |
|
486
|
3
|
50
|
|
|
|
19
|
$fallback = $cldr->territory( territory => '001' ) if( !defined( $fallback ) ); |
|
487
|
3
|
50
|
|
|
|
1375
|
$def->{minimalDays} = $fallback->{min_days} if( $fallback ); |
|
488
|
|
|
|
|
|
|
} |
|
489
|
|
|
|
|
|
|
# Week-end start, end |
|
490
|
|
|
|
|
|
|
# The value is already an array reference in the database |
|
491
|
4
|
100
|
100
|
|
|
28
|
if( length( $info->{weekend} // '' ) ) |
|
492
|
|
|
|
|
|
|
{ |
|
493
|
1
|
|
|
|
|
3
|
$def->{weekend} = $info->{weekend}; |
|
494
|
|
|
|
|
|
|
} |
|
495
|
|
|
|
|
|
|
else |
|
496
|
|
|
|
|
|
|
{ |
|
497
|
|
|
|
|
|
|
# 001 is the code for World, acting as the default fallback value |
|
498
|
3
|
100
|
|
|
|
80
|
$fallback = $cldr->territory( territory => '001' ) if( !defined( $fallback ) ); |
|
499
|
3
|
50
|
|
|
|
469
|
$def->{weekend} = $fallback->{weekend} if( $fallback ); |
|
500
|
|
|
|
|
|
|
} |
|
501
|
4
|
|
|
|
|
54
|
return( $def ); |
|
502
|
|
|
|
|
|
|
} |
|
503
|
|
|
|
|
|
|
|
|
504
|
|
|
|
|
|
|
sub hourCycle |
|
505
|
|
|
|
|
|
|
{ |
|
506
|
7
|
|
|
7
|
1
|
256
|
my $self = shift( @_ ); |
|
507
|
|
|
|
|
|
|
# If hour cycle has been set as component of the locale, or as an object option |
|
508
|
|
|
|
|
|
|
# we return it |
|
509
|
7
|
100
|
|
|
|
33
|
if( my $hc = $self->hour_cycle ) |
|
510
|
|
|
|
|
|
|
{ |
|
511
|
2
|
|
|
|
|
229
|
return( $hc ); |
|
512
|
|
|
|
|
|
|
} |
|
513
|
|
|
|
|
|
|
# Otherwise, as per the specs, we return undef |
|
514
|
5
|
50
|
|
|
|
522
|
if( want( 'OBJECT' ) ) |
|
515
|
|
|
|
|
|
|
{ |
|
516
|
0
|
|
|
|
|
0
|
return( Locale::Intl::NullObject->new ); |
|
517
|
|
|
|
|
|
|
} |
|
518
|
5
|
|
|
|
|
338
|
return; |
|
519
|
|
|
|
|
|
|
} |
|
520
|
|
|
|
|
|
|
|
|
521
|
|
|
|
|
|
|
sub language |
|
522
|
|
|
|
|
|
|
{ |
|
523
|
294
|
|
|
294
|
1
|
433750
|
my $self = shift( @_ ); |
|
524
|
294
|
100
|
|
|
|
1023
|
if( @_ ) |
|
525
|
|
|
|
|
|
|
{ |
|
526
|
196
|
|
|
|
|
351
|
my $val = shift( @_ ); |
|
527
|
196
|
100
|
|
|
|
646
|
if( !defined( $val ) ) |
|
|
|
50
|
|
|
|
|
|
|
528
|
|
|
|
|
|
|
{ |
|
529
|
1
|
|
|
|
|
6
|
$self->SUPER::language( undef ); |
|
530
|
1
|
|
|
|
|
158
|
$self->SUPER::language3( undef ); |
|
531
|
|
|
|
|
|
|
} |
|
532
|
|
|
|
|
|
|
elsif( length( $val ) == 2 ) |
|
533
|
|
|
|
|
|
|
{ |
|
534
|
195
|
|
|
|
|
747
|
$self->SUPER::language( $val ); |
|
535
|
|
|
|
|
|
|
} |
|
536
|
|
|
|
|
|
|
else |
|
537
|
|
|
|
|
|
|
{ |
|
538
|
0
|
|
|
|
|
0
|
$self->SUPER::language3( $val ); |
|
539
|
|
|
|
|
|
|
} |
|
540
|
|
|
|
|
|
|
} |
|
541
|
294
|
100
|
100
|
|
|
31516
|
if( my $loc = ( $self->SUPER::language || $self->SUPER::language3 ) ) |
|
542
|
|
|
|
|
|
|
{ |
|
543
|
292
|
|
|
|
|
37832
|
return( $loc ); |
|
544
|
|
|
|
|
|
|
} |
|
545
|
2
|
50
|
|
|
|
711
|
if( want( 'OBJECT' ) ) |
|
546
|
|
|
|
|
|
|
{ |
|
547
|
0
|
|
|
|
|
0
|
return( Locale::Intl::NullObject->new ); |
|
548
|
|
|
|
|
|
|
} |
|
549
|
2
|
|
|
|
|
143
|
return; |
|
550
|
|
|
|
|
|
|
} |
|
551
|
|
|
|
|
|
|
|
|
552
|
0
|
|
|
0
|
1
|
0
|
sub maximise { return( shift->maximize( @_ ) ); } |
|
553
|
|
|
|
|
|
|
|
|
554
|
|
|
|
|
|
|
sub maximize |
|
555
|
|
|
|
|
|
|
{ |
|
556
|
19
|
|
|
19
|
1
|
72
|
my $self = shift( @_ ); |
|
557
|
19
|
|
50
|
|
|
59
|
my $cldr = $self->_cldr || return( $self->pass_error ); |
|
558
|
19
|
|
|
|
|
71
|
my $core = $self->core; |
|
559
|
19
|
|
50
|
|
|
2076
|
my $tree = $cldr->make_inheritance_tree( $core ) || |
|
560
|
|
|
|
|
|
|
return( $self->pass_error( $cldr->error ) ); |
|
561
|
19
|
|
|
|
|
131959
|
my $full; |
|
562
|
19
|
|
|
|
|
62
|
foreach my $loc ( @$tree ) |
|
563
|
|
|
|
|
|
|
{ |
|
564
|
19
|
|
|
|
|
145
|
my $ref = $cldr->likely_subtag( locale => $loc ); |
|
565
|
19
|
50
|
33
|
|
|
18862
|
if( $ref && $ref->{target} ) |
|
566
|
|
|
|
|
|
|
{ |
|
567
|
19
|
|
|
|
|
73
|
$full = $ref->{target}; |
|
568
|
19
|
|
|
|
|
64
|
last; |
|
569
|
|
|
|
|
|
|
} |
|
570
|
|
|
|
|
|
|
} |
|
571
|
|
|
|
|
|
|
|
|
572
|
19
|
50
|
|
|
|
51
|
if( defined( $full ) ) |
|
573
|
|
|
|
|
|
|
{ |
|
574
|
19
|
|
|
|
|
88
|
my $new = $self->new( $full ); |
|
575
|
19
|
|
|
|
|
128
|
my $clone = $self->clone; |
|
576
|
19
|
50
|
|
|
|
258
|
if( my $locale = $new->locale ) |
|
|
|
0
|
|
|
|
|
|
|
577
|
|
|
|
|
|
|
{ |
|
578
|
19
|
|
|
|
|
1988
|
$clone->locale( $locale ); |
|
579
|
|
|
|
|
|
|
} |
|
580
|
|
|
|
|
|
|
elsif( my $locale3 = $new->locale3 ) |
|
581
|
|
|
|
|
|
|
{ |
|
582
|
0
|
|
|
|
|
0
|
$clone->locale3( $locale3 ); |
|
583
|
|
|
|
|
|
|
} |
|
584
|
|
|
|
|
|
|
|
|
585
|
19
|
50
|
|
|
|
1923
|
if( my $script = $new->script ) |
|
586
|
|
|
|
|
|
|
{ |
|
587
|
19
|
|
|
|
|
55
|
$clone->script( $script ); |
|
588
|
|
|
|
|
|
|
} |
|
589
|
|
|
|
|
|
|
|
|
590
|
19
|
50
|
|
|
|
1987
|
if( my $cc = $new->country_code ) |
|
|
|
0
|
|
|
|
|
|
|
591
|
|
|
|
|
|
|
{ |
|
592
|
19
|
|
|
|
|
2128
|
$clone->country_code( $cc ); |
|
593
|
|
|
|
|
|
|
} |
|
594
|
|
|
|
|
|
|
elsif( my $code = $new->region ) |
|
595
|
|
|
|
|
|
|
{ |
|
596
|
0
|
|
|
|
|
0
|
$clone->region( $code ); |
|
597
|
|
|
|
|
|
|
} |
|
598
|
|
|
|
|
|
|
|
|
599
|
19
|
50
|
|
|
|
2752
|
if( my $variant = $new->variant ) |
|
600
|
|
|
|
|
|
|
{ |
|
601
|
0
|
|
|
|
|
0
|
$clone->variant( $variant ); |
|
602
|
|
|
|
|
|
|
} |
|
603
|
19
|
|
|
|
|
5066
|
return( $clone ); |
|
604
|
|
|
|
|
|
|
} |
|
605
|
|
|
|
|
|
|
else |
|
606
|
|
|
|
|
|
|
{ |
|
607
|
0
|
|
|
|
|
0
|
return( $self ); |
|
608
|
|
|
|
|
|
|
} |
|
609
|
|
|
|
|
|
|
} |
|
610
|
|
|
|
|
|
|
|
|
611
|
0
|
|
|
0
|
1
|
0
|
sub minimise { return( shift->minimize( @_ ) ); } |
|
612
|
|
|
|
|
|
|
|
|
613
|
|
|
|
|
|
|
sub minimize |
|
614
|
|
|
|
|
|
|
{ |
|
615
|
7
|
|
|
7
|
1
|
43
|
my $self = shift( @_ ); |
|
616
|
7
|
|
50
|
|
|
45
|
my $cldr = $self->_cldr || return( $self->pass_error ); |
|
617
|
7
|
|
|
|
|
25
|
my $core = $self->core; |
|
618
|
7
|
|
|
|
|
1239
|
my $locale = $self->locale; |
|
619
|
7
|
|
|
|
|
579
|
my $locale3 = $self->locale3; |
|
620
|
7
|
|
|
|
|
585
|
my $script = $self->script; |
|
621
|
7
|
|
|
|
|
22
|
my $cc = $self->country_code; |
|
622
|
7
|
|
|
|
|
744
|
my $clone = $self->clone; |
|
623
|
7
|
|
|
|
|
70
|
$clone->locale( undef ); |
|
624
|
7
|
|
|
|
|
589
|
$clone->locale3( undef ); |
|
625
|
7
|
|
|
|
|
499
|
$clone->script( undef ); |
|
626
|
7
|
|
|
|
|
636
|
$clone->country_code( undef ); |
|
627
|
7
|
|
|
|
|
649
|
$clone->SUPER::region( undef ); |
|
628
|
7
|
100
|
66
|
|
|
654
|
if( !defined( $locale ) || !length( $locale ) ) |
|
629
|
|
|
|
|
|
|
{ |
|
630
|
|
|
|
|
|
|
# If und, this should become, with maximize(), en-Latn-US |
|
631
|
1
|
|
50
|
|
|
5
|
$locale3 //= 'und'; |
|
632
|
1
|
|
|
|
|
6
|
my $test = $self->new( "${locale3}" )->maximize; |
|
633
|
1
|
|
|
|
|
11
|
$core = $test->core; |
|
634
|
|
|
|
|
|
|
# Maybe the locale3 provided is an invalid locale3, such as xyz. If so we would return it. |
|
635
|
1
|
50
|
|
|
|
249
|
if( $core eq $locale3 ) |
|
636
|
|
|
|
|
|
|
{ |
|
637
|
0
|
|
|
|
|
0
|
return( $self ); |
|
638
|
|
|
|
|
|
|
} |
|
639
|
1
|
|
|
|
|
5
|
$locale = $test->locale; |
|
640
|
1
|
|
|
|
|
112
|
$locale3 = $test->locale3; |
|
641
|
1
|
|
|
|
|
100
|
$script = $test->script; |
|
642
|
1
|
|
|
|
|
5
|
$cc = $test->country_code; |
|
643
|
1
|
|
|
|
|
119
|
$clone->locale( $locale ); |
|
644
|
|
|
|
|
|
|
} |
|
645
|
|
|
|
|
|
|
|
|
646
|
|
|
|
|
|
|
# First check if there is nothing to do |
|
647
|
|
|
|
|
|
|
# Even if it is an unknown language, such as xy, we still return it. |
|
648
|
7
|
50
|
33
|
|
|
160
|
if( defined( $locale ) && |
|
|
|
|
33
|
|
|
|
|
|
649
|
|
|
|
|
|
|
length( $locale ) && |
|
650
|
|
|
|
|
|
|
$core eq $locale ) |
|
651
|
|
|
|
|
|
|
{ |
|
652
|
0
|
|
|
|
|
0
|
return( $self ); |
|
653
|
|
|
|
|
|
|
} |
|
654
|
|
|
|
|
|
|
|
|
655
|
7
|
|
|
|
|
69
|
my $test = $self->new( "$locale" )->maximize; |
|
656
|
7
|
|
|
|
|
65
|
my $test_locale = $test->locale; |
|
657
|
|
|
|
|
|
|
# Maybe the same as our initial locale |
|
658
|
|
|
|
|
|
|
# For example: fr-FR -> fr-Latn-FR |
|
659
|
|
|
|
|
|
|
# but |
|
660
|
|
|
|
|
|
|
# und-Latn -> en-Latn-US |
|
661
|
7
|
50
|
|
|
|
671
|
if( $test_locale ) |
|
662
|
|
|
|
|
|
|
{ |
|
663
|
7
|
|
|
|
|
22
|
$clone->locale( $test_locale ); |
|
664
|
|
|
|
|
|
|
} |
|
665
|
|
|
|
|
|
|
# Should not happen |
|
666
|
|
|
|
|
|
|
else |
|
667
|
|
|
|
|
|
|
{ |
|
668
|
0
|
|
|
|
|
0
|
return( $self->error( "Unable to get a locale language by maximising \"${core}\"" ) ); |
|
669
|
|
|
|
|
|
|
} |
|
670
|
|
|
|
|
|
|
# First check if we have a country code, and maybe if this country code is the authority for this language |
|
671
|
|
|
|
|
|
|
# such as fr -> fr-FR |
|
672
|
|
|
|
|
|
|
# We get the maximised version derived from the 2-characters language and if it bears the same country code, |
|
673
|
|
|
|
|
|
|
# this means, this is the authoritative country for this language, and there is no need to add the country code. |
|
674
|
|
|
|
|
|
|
# Next, we check if the script, if any, can be removed. For that we use $CLDR_LANGUAGE_SCRIPTS and if found, we check |
|
675
|
|
|
|
|
|
|
# if it is the sole entry for this language. If not found, this means the script is the default 'Latn' |
|
676
|
7
|
|
|
|
|
614
|
my $test_cc = $test->country_code; |
|
677
|
7
|
|
|
|
|
649
|
my $test_script = $test->script; |
|
678
|
|
|
|
|
|
|
# Our country code is different than the default one for this locale, so we keep it |
|
679
|
7
|
50
|
|
|
|
26
|
if( $cc ) |
|
|
|
0
|
|
|
|
|
|
|
680
|
|
|
|
|
|
|
{ |
|
681
|
7
|
100
|
|
|
|
32
|
if( $cc ne $test_cc ) |
|
682
|
|
|
|
|
|
|
{ |
|
683
|
1
|
|
|
|
|
5
|
$clone->country_code( $cc ); |
|
684
|
|
|
|
|
|
|
} |
|
685
|
|
|
|
|
|
|
} |
|
686
|
|
|
|
|
|
|
elsif( $test_cc ) |
|
687
|
|
|
|
|
|
|
{ |
|
688
|
0
|
|
|
|
|
0
|
$clone->country_code( $test_cc ); |
|
689
|
|
|
|
|
|
|
} |
|
690
|
7
|
50
|
|
|
|
156
|
if( $script ) |
|
691
|
|
|
|
|
|
|
{ |
|
692
|
7
|
|
|
|
|
41
|
my $info = $cldr->language( language => $test_locale ); |
|
693
|
7
|
|
|
|
|
7497
|
my $lang_scripts; |
|
694
|
7
|
50
|
33
|
|
|
90
|
if( $info && |
|
|
|
|
50
|
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
695
|
|
|
|
|
|
|
exists( $info->{scripts} ) && |
|
696
|
|
|
|
|
|
|
ref( $info->{scripts} // '' ) eq 'ARRAY' && |
|
697
|
7
|
|
|
|
|
30
|
scalar( @{$info->{scripts}} ) ) |
|
698
|
|
|
|
|
|
|
{ |
|
699
|
7
|
|
|
|
|
13
|
$lang_scripts = $info->{scripts}; |
|
700
|
|
|
|
|
|
|
} |
|
701
|
|
|
|
|
|
|
else |
|
702
|
|
|
|
|
|
|
{ |
|
703
|
0
|
|
|
|
|
0
|
$lang_scripts = ['Latn']; |
|
704
|
|
|
|
|
|
|
} |
|
705
|
|
|
|
|
|
|
# There could be more than 1 script, but if our script is the first, i.e. |
|
706
|
|
|
|
|
|
|
# preferred one, it becomes superflous. |
|
707
|
7
|
100
|
|
|
|
64
|
if( $script ne $lang_scripts->[0] ) |
|
708
|
|
|
|
|
|
|
{ |
|
709
|
1
|
|
|
|
|
6
|
$clone->script( $script ); |
|
710
|
|
|
|
|
|
|
} |
|
711
|
|
|
|
|
|
|
} |
|
712
|
7
|
|
|
|
|
256
|
return( $clone ); |
|
713
|
|
|
|
|
|
|
} |
|
714
|
|
|
|
|
|
|
|
|
715
|
|
|
|
|
|
|
sub numberingSystem |
|
716
|
|
|
|
|
|
|
{ |
|
717
|
4
|
|
|
4
|
1
|
188
|
my $self = shift( @_ ); |
|
718
|
4
|
100
|
|
|
|
19
|
if( my $num = $self->number ) |
|
719
|
|
|
|
|
|
|
{ |
|
720
|
2
|
|
|
|
|
233
|
return( $num ); |
|
721
|
|
|
|
|
|
|
} |
|
722
|
|
|
|
|
|
|
|
|
723
|
2
|
50
|
|
|
|
205
|
if( want( 'OBJECT' ) ) |
|
724
|
|
|
|
|
|
|
{ |
|
725
|
0
|
|
|
|
|
0
|
return( Locale::Intl::NullObject->new ); |
|
726
|
|
|
|
|
|
|
} |
|
727
|
2
|
|
|
|
|
128
|
return; |
|
728
|
|
|
|
|
|
|
} |
|
729
|
|
|
|
|
|
|
|
|
730
|
|
|
|
|
|
|
sub numeric |
|
731
|
|
|
|
|
|
|
{ |
|
732
|
5
|
|
|
5
|
1
|
459
|
my $self = shift( @_ ); |
|
733
|
5
|
100
|
|
|
|
22
|
if( defined( my $bool = $self->colNumeric ) ) |
|
734
|
|
|
|
|
|
|
{ |
|
735
|
2
|
100
|
|
|
|
298
|
return( $bool ? Locale::Intl::Boolean->true : Locale::Intl::Boolean->false ); |
|
736
|
|
|
|
|
|
|
} |
|
737
|
|
|
|
|
|
|
|
|
738
|
3
|
50
|
|
|
|
354
|
if( want( 'OBJECT' ) ) |
|
739
|
|
|
|
|
|
|
{ |
|
740
|
0
|
|
|
|
|
0
|
return( Locale::Intl::NullObject->new ); |
|
741
|
|
|
|
|
|
|
} |
|
742
|
3
|
|
|
|
|
228
|
return; |
|
743
|
|
|
|
|
|
|
} |
|
744
|
|
|
|
|
|
|
|
|
745
|
|
|
|
|
|
|
sub pass_error |
|
746
|
|
|
|
|
|
|
{ |
|
747
|
0
|
|
|
0
|
0
|
0
|
my $self = shift( @_ ); |
|
748
|
0
|
|
0
|
|
|
0
|
my $pack = ref( $self ) || $self; |
|
749
|
0
|
|
|
|
|
0
|
my $opts = {}; |
|
750
|
0
|
|
|
|
|
0
|
my( $err, $class, $code ); |
|
751
|
2
|
|
|
2
|
|
18
|
no strict 'refs'; |
|
|
2
|
|
|
|
|
2
|
|
|
|
2
|
|
|
|
|
2755
|
|
|
752
|
0
|
0
|
|
|
|
0
|
if( scalar( @_ ) ) |
|
753
|
|
|
|
|
|
|
{ |
|
754
|
|
|
|
|
|
|
# Either an hash defining a new error and this will be passed along to error(); or |
|
755
|
|
|
|
|
|
|
# an hash with a single property: { class => 'Some::ExceptionClass' } |
|
756
|
0
|
0
|
0
|
|
|
0
|
if( scalar( @_ ) == 1 && ref( $_[0] ) eq 'HASH' ) |
|
757
|
|
|
|
|
|
|
{ |
|
758
|
0
|
|
|
|
|
0
|
$opts = $_[0]; |
|
759
|
|
|
|
|
|
|
} |
|
760
|
|
|
|
|
|
|
else |
|
761
|
|
|
|
|
|
|
{ |
|
762
|
0
|
0
|
0
|
|
|
0
|
if( scalar( @_ ) > 1 && ref( $_[-1] ) eq 'HASH' ) |
|
763
|
|
|
|
|
|
|
{ |
|
764
|
0
|
|
|
|
|
0
|
$opts = pop( @_ ); |
|
765
|
|
|
|
|
|
|
} |
|
766
|
0
|
|
|
|
|
0
|
$err = $_[0]; |
|
767
|
|
|
|
|
|
|
} |
|
768
|
|
|
|
|
|
|
} |
|
769
|
0
|
0
|
0
|
|
|
0
|
$err = $opts->{error} if( !defined( $err ) && CORE::exists( $opts->{error} ) && defined( $opts->{error} ) && CORE::length( $opts->{error} ) ); |
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
770
|
|
|
|
|
|
|
# We set $class only if the hash provided is a one-element hash and not an error-defining hash |
|
771
|
0
|
0
|
0
|
|
|
0
|
$class = $opts->{class} if( CORE::exists( $opts->{class} ) && defined( $opts->{class} ) && CORE::length( $opts->{class} ) ); |
|
|
|
|
0
|
|
|
|
|
|
772
|
0
|
0
|
0
|
|
|
0
|
$code = $opts->{code} if( CORE::exists( $opts->{code} ) && defined( $opts->{code} ) && CORE::length( $opts->{code} ) ); |
|
|
|
|
0
|
|
|
|
|
|
773
|
|
|
|
|
|
|
|
|
774
|
|
|
|
|
|
|
# called with no argument, most likely from the same class to pass on an error |
|
775
|
|
|
|
|
|
|
# set up earlier by another method; or |
|
776
|
|
|
|
|
|
|
# with an hash containing just one argument class => 'Some::ExceptionClass' |
|
777
|
0
|
0
|
0
|
|
|
0
|
if( !defined( $err ) && ( !scalar( @_ ) || defined( $class ) ) ) |
|
|
|
0
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
778
|
|
|
|
|
|
|
{ |
|
779
|
|
|
|
|
|
|
# $error is a previous erro robject |
|
780
|
0
|
0
|
|
|
|
0
|
my $error = ref( $self ) ? $self->{error} : length( ${ $pack . '::ERROR' } ) ? ${ $pack . '::ERROR' } : undef; |
|
|
0
|
0
|
|
|
|
0
|
|
|
|
0
|
|
|
|
|
0
|
|
|
781
|
0
|
0
|
|
|
|
0
|
if( !defined( $error ) ) |
|
782
|
|
|
|
|
|
|
{ |
|
783
|
0
|
|
|
|
|
0
|
warn( "No error object provided and no previous error set either! It seems the previous method call returned a simple undef" ); |
|
784
|
|
|
|
|
|
|
} |
|
785
|
|
|
|
|
|
|
else |
|
786
|
|
|
|
|
|
|
{ |
|
787
|
0
|
0
|
|
|
|
0
|
$err = ( defined( $class ) ? bless( $error => $class ) : $error ); |
|
788
|
0
|
0
|
|
|
|
0
|
$err->code( $code ) if( defined( $code ) ); |
|
789
|
|
|
|
|
|
|
} |
|
790
|
|
|
|
|
|
|
} |
|
791
|
|
|
|
|
|
|
elsif( defined( $err ) && |
|
792
|
|
|
|
|
|
|
Scalar::Util::blessed( $err ) && |
|
793
|
|
|
|
|
|
|
( scalar( @_ ) == 1 || |
|
794
|
|
|
|
|
|
|
( scalar( @_ ) == 2 && defined( $class ) ) |
|
795
|
|
|
|
|
|
|
) ) |
|
796
|
|
|
|
|
|
|
{ |
|
797
|
0
|
0
|
|
|
|
0
|
$self->{error} = ${ $pack . '::ERROR' } = ( defined( $class ) ? bless( $err => $class ) : $err ); |
|
|
0
|
|
|
|
|
0
|
|
|
798
|
0
|
0
|
0
|
|
|
0
|
$self->{error}->code( $code ) if( defined( $code ) && $self->{error}->can( 'code' ) ); |
|
799
|
|
|
|
|
|
|
|
|
800
|
0
|
0
|
0
|
|
|
0
|
if( $self->{fatal} || ( defined( ${"${class}\::FATAL_EXCEPTIONS"} ) && ${"${class}\::FATAL_EXCEPTIONS"} ) ) |
|
|
0
|
|
0
|
|
|
0
|
|
|
|
0
|
|
|
|
|
0
|
|
|
801
|
|
|
|
|
|
|
{ |
|
802
|
0
|
|
|
|
|
0
|
die( $self->{error} ); |
|
803
|
|
|
|
|
|
|
} |
|
804
|
|
|
|
|
|
|
} |
|
805
|
|
|
|
|
|
|
# If the error provided is not an object, we call error to create one |
|
806
|
|
|
|
|
|
|
else |
|
807
|
|
|
|
|
|
|
{ |
|
808
|
0
|
|
|
|
|
0
|
return( $self->error( @_ ) ); |
|
809
|
|
|
|
|
|
|
} |
|
810
|
|
|
|
|
|
|
|
|
811
|
0
|
0
|
|
|
|
0
|
if( want( 'OBJECT' ) ) |
|
812
|
|
|
|
|
|
|
{ |
|
813
|
0
|
|
|
|
|
0
|
rreturn( Locale::Intl::NullObject->new ); |
|
814
|
|
|
|
|
|
|
} |
|
815
|
0
|
|
|
|
|
0
|
return; |
|
816
|
|
|
|
|
|
|
} |
|
817
|
|
|
|
|
|
|
|
|
818
|
|
|
|
|
|
|
# NOTE: Locale::Unicode makes a distinction between a country code (a 2-letters code) and a region (a 3-digits numeric code) |
|
819
|
|
|
|
|
|
|
sub region |
|
820
|
|
|
|
|
|
|
{ |
|
821
|
67
|
|
|
67
|
1
|
9807
|
my $self = shift( @_ ); |
|
822
|
67
|
100
|
|
|
|
243
|
if( @_ ) |
|
823
|
|
|
|
|
|
|
{ |
|
824
|
3
|
|
|
|
|
15
|
return( $self->SUPER::region( @_ ) ); |
|
825
|
|
|
|
|
|
|
} |
|
826
|
64
|
100
|
100
|
|
|
179
|
if( my $rg = ( $self->country_code || $self->SUPER::region ) ) |
|
827
|
|
|
|
|
|
|
{ |
|
828
|
3
|
|
|
|
|
504
|
return( $rg ); |
|
829
|
|
|
|
|
|
|
} |
|
830
|
|
|
|
|
|
|
|
|
831
|
61
|
50
|
|
|
|
14129
|
if( want( 'OBJECT' ) ) |
|
832
|
|
|
|
|
|
|
{ |
|
833
|
0
|
|
|
|
|
0
|
return( Locale::Intl::NullObject->new ); |
|
834
|
|
|
|
|
|
|
} |
|
835
|
61
|
|
|
|
|
4226
|
return; |
|
836
|
|
|
|
|
|
|
} |
|
837
|
|
|
|
|
|
|
|
|
838
|
|
|
|
|
|
|
sub script |
|
839
|
|
|
|
|
|
|
{ |
|
840
|
211
|
|
|
211
|
1
|
20865
|
my $self = shift( @_ ); |
|
841
|
|
|
|
|
|
|
# This is a property, so it is read-only, but we need to ensure our parent package method keeps working |
|
842
|
211
|
100
|
|
|
|
653
|
if( @_ ) |
|
843
|
|
|
|
|
|
|
{ |
|
844
|
82
|
|
|
|
|
328
|
return( $self->SUPER::script( @_ ) ); |
|
845
|
|
|
|
|
|
|
} |
|
846
|
|
|
|
|
|
|
|
|
847
|
129
|
100
|
|
|
|
386
|
if( my $script = $self->SUPER::script ) |
|
848
|
|
|
|
|
|
|
{ |
|
849
|
66
|
|
|
|
|
6174
|
return( $script ); |
|
850
|
|
|
|
|
|
|
} |
|
851
|
|
|
|
|
|
|
|
|
852
|
63
|
50
|
|
|
|
6032
|
if( want( 'OBJECT' ) ) |
|
853
|
|
|
|
|
|
|
{ |
|
854
|
0
|
|
|
|
|
0
|
return( Locale::Intl::NullObject->new ); |
|
855
|
|
|
|
|
|
|
} |
|
856
|
63
|
|
|
|
|
4108
|
return; |
|
857
|
|
|
|
|
|
|
} |
|
858
|
|
|
|
|
|
|
|
|
859
|
3
|
|
|
3
|
1
|
30
|
sub toString { return( shift->as_string ); } |
|
860
|
|
|
|
|
|
|
|
|
861
|
|
|
|
|
|
|
sub _cldr |
|
862
|
|
|
|
|
|
|
{ |
|
863
|
51
|
|
|
51
|
|
145
|
my $self = shift( @_ ); |
|
864
|
51
|
|
|
|
|
95
|
my $cldr; |
|
865
|
51
|
100
|
|
|
|
161
|
if( ref( $self ) ) |
|
866
|
|
|
|
|
|
|
{ |
|
867
|
|
|
|
|
|
|
$cldr = $self->{_cldr} || |
|
868
|
48
|
|
50
|
|
|
187
|
return( $self->error( "The Locale::Unicode::Data object is gone!" ) ); |
|
869
|
|
|
|
|
|
|
} |
|
870
|
|
|
|
|
|
|
else |
|
871
|
|
|
|
|
|
|
{ |
|
872
|
3
|
|
50
|
|
|
19
|
$cldr = Locale::Unicode::Data->new || |
|
873
|
|
|
|
|
|
|
return( $self->pass_error( Locale::Unicode::Data->error ) ); |
|
874
|
|
|
|
|
|
|
} |
|
875
|
51
|
|
|
|
|
940
|
return( $cldr ); |
|
876
|
|
|
|
|
|
|
} |
|
877
|
|
|
|
|
|
|
|
|
878
|
|
|
|
|
|
|
# NOTE: Locale::Intl::Exception class |
|
879
|
|
|
|
|
|
|
package Locale::Intl::Exception; |
|
880
|
|
|
|
|
|
|
BEGIN |
|
881
|
|
|
|
|
|
|
{ |
|
882
|
2
|
|
|
2
|
|
20
|
use strict; |
|
|
2
|
|
|
|
|
4
|
|
|
|
2
|
|
|
|
|
49
|
|
|
883
|
2
|
|
|
2
|
|
6
|
use warnings; |
|
|
2
|
|
|
|
|
2
|
|
|
|
2
|
|
|
|
|
146
|
|
|
884
|
2
|
|
|
2
|
|
12
|
use vars qw( $VERSION ); |
|
|
2
|
|
|
|
|
3
|
|
|
|
2
|
|
|
|
|
187
|
|
|
885
|
|
|
|
|
|
|
use overload ( |
|
886
|
|
|
|
|
|
|
'""' => 'as_string', |
|
887
|
0
|
|
|
0
|
|
0
|
bool => sub{ $_[0] }, |
|
888
|
2
|
|
|
|
|
22
|
fallback => 1, |
|
889
|
2
|
|
|
2
|
|
12
|
); |
|
|
2
|
|
|
|
|
15
|
|
|
890
|
2
|
|
|
2
|
|
230
|
our $VERSION = 'v0.1.0'; |
|
891
|
|
|
|
|
|
|
}; |
|
892
|
2
|
|
|
2
|
|
7
|
use strict; |
|
|
2
|
|
|
|
|
2
|
|
|
|
2
|
|
|
|
|
40
|
|
|
893
|
2
|
|
|
2
|
|
5
|
use warnings; |
|
|
2
|
|
|
|
|
3
|
|
|
|
2
|
|
|
|
|
745
|
|
|
894
|
|
|
|
|
|
|
|
|
895
|
|
|
|
|
|
|
sub new |
|
896
|
|
|
|
|
|
|
{ |
|
897
|
0
|
|
|
0
|
|
0
|
my $this = shift( @_ ); |
|
898
|
0
|
|
0
|
|
|
0
|
my $self = bless( {} => ( ref( $this ) || $this ) ); |
|
899
|
0
|
|
|
|
|
0
|
my @info = caller; |
|
900
|
0
|
|
|
|
|
0
|
@$self{ qw( package file line ) } = @info[0..2]; |
|
901
|
0
|
|
|
|
|
0
|
my $args = {}; |
|
902
|
0
|
0
|
|
|
|
0
|
if( scalar( @_ ) == 1 ) |
|
903
|
|
|
|
|
|
|
{ |
|
904
|
0
|
0
|
0
|
|
|
0
|
if( ( ref( $_[0] ) || '' ) eq 'HASH' ) |
|
|
|
0
|
0
|
|
|
|
|
|
905
|
|
|
|
|
|
|
{ |
|
906
|
0
|
|
|
|
|
0
|
$args = shift( @_ ); |
|
907
|
0
|
0
|
|
|
|
0
|
if( $args->{skip_frames} ) |
|
908
|
|
|
|
|
|
|
{ |
|
909
|
0
|
|
|
|
|
0
|
@info = caller( int( $args->{skip_frames} ) ); |
|
910
|
0
|
|
|
|
|
0
|
@$self{ qw( package file line ) } = @info[0..2]; |
|
911
|
|
|
|
|
|
|
} |
|
912
|
0
|
|
0
|
|
|
0
|
$args->{message} ||= ''; |
|
913
|
0
|
|
|
|
|
0
|
foreach my $k ( qw( package file line message code type retry_after ) ) |
|
914
|
|
|
|
|
|
|
{ |
|
915
|
0
|
0
|
|
|
|
0
|
$self->{ $k } = $args->{ $k } if( CORE::exists( $args->{ $k } ) ); |
|
916
|
|
|
|
|
|
|
} |
|
917
|
|
|
|
|
|
|
} |
|
918
|
|
|
|
|
|
|
elsif( ref( $_[0] ) && $_[0]->isa( 'Locale::Intl::Exception' ) ) |
|
919
|
|
|
|
|
|
|
{ |
|
920
|
0
|
|
|
|
|
0
|
my $o = $args->{object} = shift( @_ ); |
|
921
|
0
|
|
|
|
|
0
|
$self->{message} = $o->message; |
|
922
|
0
|
|
|
|
|
0
|
$self->{code} = $o->code; |
|
923
|
0
|
|
|
|
|
0
|
$self->{type} = $o->type; |
|
924
|
0
|
|
|
|
|
0
|
$self->{retry_after} = $o->retry_after; |
|
925
|
|
|
|
|
|
|
} |
|
926
|
|
|
|
|
|
|
else |
|
927
|
|
|
|
|
|
|
{ |
|
928
|
0
|
|
|
|
|
0
|
die( "Unknown argument provided: '", overload::StrVal( $_[0] ), "'" ); |
|
929
|
|
|
|
|
|
|
} |
|
930
|
|
|
|
|
|
|
} |
|
931
|
|
|
|
|
|
|
else |
|
932
|
|
|
|
|
|
|
{ |
|
933
|
0
|
0
|
|
|
|
0
|
$args->{message} = join( '', map( ref( $_ ) eq 'CODE' ? $_->() : $_, @_ ) ); |
|
934
|
|
|
|
|
|
|
} |
|
935
|
0
|
|
|
|
|
0
|
return( $self ); |
|
936
|
|
|
|
|
|
|
} |
|
937
|
|
|
|
|
|
|
|
|
938
|
|
|
|
|
|
|
# This is important as stringification is called by die, so as per the manual page, we need to end with new line |
|
939
|
|
|
|
|
|
|
# And will add the stack trace |
|
940
|
|
|
|
|
|
|
sub as_string |
|
941
|
|
|
|
|
|
|
{ |
|
942
|
2
|
|
|
2
|
|
14
|
no overloading; |
|
|
2
|
|
|
|
|
3
|
|
|
|
2
|
|
|
|
|
1571
|
|
|
943
|
0
|
|
|
0
|
|
0
|
my $self = shift( @_ ); |
|
944
|
0
|
0
|
0
|
|
|
0
|
return( $self->{_cache_value} ) if( $self->{_cache_value} && !CORE::length( $self->{_reset} ) ); |
|
945
|
0
|
|
|
|
|
0
|
my $str = $self->message; |
|
946
|
0
|
|
|
|
|
0
|
$str = "$str"; |
|
947
|
0
|
|
|
|
|
0
|
$str =~ s/\r?\n$//g; |
|
948
|
0
|
|
0
|
|
|
0
|
$str .= sprintf( " within package %s at line %d in file %s", ( $self->{package} // 'undef' ), ( $self->{line} // 'undef' ), ( $self->{file} // 'undef' ) ); |
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
949
|
0
|
|
|
|
|
0
|
$self->{_cache_value} = $str; |
|
950
|
0
|
|
|
|
|
0
|
CORE::delete( $self->{_reset} ); |
|
951
|
0
|
|
|
|
|
0
|
return( $str ); |
|
952
|
|
|
|
|
|
|
} |
|
953
|
|
|
|
|
|
|
|
|
954
|
0
|
|
|
0
|
|
0
|
sub code { return( shift->reset(@_)->_set_get_prop( 'code', @_ ) ); } |
|
955
|
|
|
|
|
|
|
|
|
956
|
0
|
|
|
0
|
|
0
|
sub file { return( shift->reset(@_)->_set_get_prop( 'file', @_ ) ); } |
|
957
|
|
|
|
|
|
|
|
|
958
|
0
|
|
|
0
|
|
0
|
sub line { return( shift->reset(@_)->_set_get_prop( 'line', @_ ) ); } |
|
959
|
|
|
|
|
|
|
|
|
960
|
0
|
|
|
0
|
|
0
|
sub message { return( shift->reset(@_)->_set_get_prop( 'message', @_ ) ); } |
|
961
|
|
|
|
|
|
|
|
|
962
|
0
|
|
|
0
|
|
0
|
sub package { return( shift->reset(@_)->_set_get_prop( 'package', @_ ) ); } |
|
963
|
|
|
|
|
|
|
|
|
964
|
|
|
|
|
|
|
# From perlfunc docmentation on "die": |
|
965
|
|
|
|
|
|
|
# "If LIST was empty or made an empty string, and $@ contains an |
|
966
|
|
|
|
|
|
|
# object reference that has a "PROPAGATE" method, that method will |
|
967
|
|
|
|
|
|
|
# be called with additional file and line number parameters. The |
|
968
|
|
|
|
|
|
|
# return value replaces the value in $@; i.e., as if "$@ = eval { |
|
969
|
|
|
|
|
|
|
# $@->PROPAGATE(__FILE__, __LINE__) };" were called." |
|
970
|
|
|
|
|
|
|
sub PROPAGATE |
|
971
|
|
|
|
|
|
|
{ |
|
972
|
0
|
|
|
0
|
|
0
|
my( $self, $file, $line ) = @_; |
|
973
|
0
|
0
|
0
|
|
|
0
|
if( defined( $file ) && defined( $line ) ) |
|
974
|
|
|
|
|
|
|
{ |
|
975
|
0
|
|
|
|
|
0
|
my $clone = $self->clone; |
|
976
|
0
|
|
|
|
|
0
|
$clone->file( $file ); |
|
977
|
0
|
|
|
|
|
0
|
$clone->line( $line ); |
|
978
|
0
|
|
|
|
|
0
|
return( $clone ); |
|
979
|
|
|
|
|
|
|
} |
|
980
|
0
|
|
|
|
|
0
|
return( $self ); |
|
981
|
|
|
|
|
|
|
} |
|
982
|
|
|
|
|
|
|
|
|
983
|
|
|
|
|
|
|
sub reset |
|
984
|
|
|
|
|
|
|
{ |
|
985
|
0
|
|
|
0
|
|
0
|
my $self = shift( @_ ); |
|
986
|
0
|
0
|
0
|
|
|
0
|
if( !CORE::length( $self->{_reset} ) && scalar( @_ ) ) |
|
987
|
|
|
|
|
|
|
{ |
|
988
|
0
|
|
|
|
|
0
|
$self->{_reset} = scalar( @_ ); |
|
989
|
|
|
|
|
|
|
} |
|
990
|
0
|
|
|
|
|
0
|
return( $self ); |
|
991
|
|
|
|
|
|
|
} |
|
992
|
|
|
|
|
|
|
|
|
993
|
|
|
|
|
|
|
sub rethrow |
|
994
|
|
|
|
|
|
|
{ |
|
995
|
0
|
|
|
0
|
|
0
|
my $self = shift( @_ ); |
|
996
|
0
|
0
|
|
|
|
0
|
return if( !ref( $self ) ); |
|
997
|
0
|
|
|
|
|
0
|
die( $self ); |
|
998
|
|
|
|
|
|
|
} |
|
999
|
|
|
|
|
|
|
|
|
1000
|
0
|
|
|
0
|
|
0
|
sub retry_after { return( shift->_set_get_prop( 'retry_after', @_ ) ); } |
|
1001
|
|
|
|
|
|
|
|
|
1002
|
|
|
|
|
|
|
sub throw |
|
1003
|
|
|
|
|
|
|
{ |
|
1004
|
0
|
|
|
0
|
|
0
|
my $self = shift( @_ ); |
|
1005
|
0
|
|
|
|
|
0
|
my $e; |
|
1006
|
0
|
0
|
|
|
|
0
|
if( @_ ) |
|
1007
|
|
|
|
|
|
|
{ |
|
1008
|
0
|
|
|
|
|
0
|
my $msg = shift( @_ ); |
|
1009
|
0
|
|
|
|
|
0
|
$e = $self->new({ |
|
1010
|
|
|
|
|
|
|
skip_frames => 1, |
|
1011
|
|
|
|
|
|
|
message => $msg, |
|
1012
|
|
|
|
|
|
|
}); |
|
1013
|
|
|
|
|
|
|
} |
|
1014
|
|
|
|
|
|
|
else |
|
1015
|
|
|
|
|
|
|
{ |
|
1016
|
0
|
|
|
|
|
0
|
$e = $self; |
|
1017
|
|
|
|
|
|
|
} |
|
1018
|
0
|
|
|
|
|
0
|
die( $e ); |
|
1019
|
|
|
|
|
|
|
} |
|
1020
|
|
|
|
|
|
|
|
|
1021
|
0
|
|
|
0
|
|
0
|
sub type { return( shift->reset(@_)->_set_get_prop( 'type', @_ ) ); } |
|
1022
|
|
|
|
|
|
|
|
|
1023
|
|
|
|
|
|
|
sub _set_get_prop |
|
1024
|
|
|
|
|
|
|
{ |
|
1025
|
0
|
|
|
0
|
|
0
|
my $self = shift( @_ ); |
|
1026
|
0
|
|
0
|
|
|
0
|
my $prop = shift( @_ ) || die( "No object property was provided." ); |
|
1027
|
0
|
0
|
|
|
|
0
|
$self->{ $prop } = shift( @_ ) if( @_ ); |
|
1028
|
0
|
|
|
|
|
0
|
return( $self->{ $prop } ); |
|
1029
|
|
|
|
|
|
|
} |
|
1030
|
|
|
|
|
|
|
|
|
1031
|
|
|
|
|
|
|
sub FREEZE |
|
1032
|
|
|
|
|
|
|
{ |
|
1033
|
0
|
|
|
0
|
|
0
|
my $self = CORE::shift( @_ ); |
|
1034
|
0
|
|
0
|
|
|
0
|
my $serialiser = CORE::shift( @_ ) // ''; |
|
1035
|
0
|
|
|
|
|
0
|
my $class = CORE::ref( $self ); |
|
1036
|
0
|
|
|
|
|
0
|
my %hash = %$self; |
|
1037
|
|
|
|
|
|
|
# Return an array reference rather than a list so this works with Sereal and CBOR |
|
1038
|
|
|
|
|
|
|
# On or before Sereal version 4.023, Sereal did not support multiple values returned |
|
1039
|
0
|
0
|
0
|
|
|
0
|
CORE::return( [$class, \%hash] ) if( $serialiser eq 'Sereal' && Sereal::Encoder->VERSION <= version->parse( '4.023' ) ); |
|
1040
|
|
|
|
|
|
|
# But Storable want a list with the first element being the serialised element |
|
1041
|
0
|
|
|
|
|
0
|
CORE::return( $class, \%hash ); |
|
1042
|
|
|
|
|
|
|
} |
|
1043
|
|
|
|
|
|
|
|
|
1044
|
0
|
|
|
0
|
|
0
|
sub STORABLE_freeze { return( shift->FREEZE( @_ ) ); } |
|
1045
|
|
|
|
|
|
|
|
|
1046
|
0
|
|
|
0
|
|
0
|
sub STORABLE_thaw { return( shift->THAW( @_ ) ); } |
|
1047
|
|
|
|
|
|
|
|
|
1048
|
|
|
|
|
|
|
# NOTE: CBOR will call the THAW method with the stored classname as first argument, the constant string CBOR as second argument, and all values returned by FREEZE as remaining arguments. |
|
1049
|
|
|
|
|
|
|
# NOTE: Storable calls it with a blessed object it created followed with $cloning and any other arguments initially provided by STORABLE_freeze |
|
1050
|
|
|
|
|
|
|
sub THAW |
|
1051
|
|
|
|
|
|
|
{ |
|
1052
|
0
|
|
|
0
|
|
0
|
my( $self, undef, @args ) = @_; |
|
1053
|
0
|
0
|
0
|
|
|
0
|
my $ref = ( CORE::scalar( @args ) == 1 && CORE::ref( $args[0] ) eq 'ARRAY' ) ? CORE::shift( @args ) : \@args; |
|
1054
|
0
|
0
|
0
|
|
|
0
|
my $class = ( CORE::defined( $ref ) && CORE::ref( $ref ) eq 'ARRAY' && CORE::scalar( @$ref ) > 1 ) ? CORE::shift( @$ref ) : ( CORE::ref( $self ) || $self ); |
|
|
|
|
0
|
|
|
|
|
|
1055
|
0
|
0
|
|
|
|
0
|
my $hash = CORE::ref( $ref ) eq 'ARRAY' ? CORE::shift( @$ref ) : {}; |
|
1056
|
0
|
|
|
|
|
0
|
my $new; |
|
1057
|
|
|
|
|
|
|
# Storable pattern requires to modify the object it created rather than returning a new one |
|
1058
|
0
|
0
|
|
|
|
0
|
if( CORE::ref( $self ) ) |
|
1059
|
|
|
|
|
|
|
{ |
|
1060
|
0
|
|
|
|
|
0
|
foreach( CORE::keys( %$hash ) ) |
|
1061
|
|
|
|
|
|
|
{ |
|
1062
|
0
|
|
|
|
|
0
|
$self->{ $_ } = CORE::delete( $hash->{ $_ } ); |
|
1063
|
|
|
|
|
|
|
} |
|
1064
|
0
|
|
|
|
|
0
|
$new = $self; |
|
1065
|
|
|
|
|
|
|
} |
|
1066
|
|
|
|
|
|
|
else |
|
1067
|
|
|
|
|
|
|
{ |
|
1068
|
0
|
|
|
|
|
0
|
$new = CORE::bless( $hash => $class ); |
|
1069
|
|
|
|
|
|
|
} |
|
1070
|
0
|
|
|
|
|
0
|
CORE::return( $new ); |
|
1071
|
|
|
|
|
|
|
} |
|
1072
|
|
|
|
|
|
|
|
|
1073
|
0
|
|
|
0
|
|
0
|
sub TO_JSON { return( shift->as_string ); } |
|
1074
|
|
|
|
|
|
|
|
|
1075
|
|
|
|
|
|
|
# NOTE: Locale::Intl::Boolean class |
|
1076
|
|
|
|
|
|
|
package Locale::Intl::Boolean; |
|
1077
|
|
|
|
|
|
|
BEGIN |
|
1078
|
|
|
|
|
|
|
{ |
|
1079
|
2
|
|
|
2
|
|
12
|
use strict; |
|
|
2
|
|
|
|
|
3
|
|
|
|
2
|
|
|
|
|
45
|
|
|
1080
|
2
|
|
|
2
|
|
5
|
use warnings; |
|
|
2
|
|
|
|
|
3
|
|
|
|
2
|
|
|
|
|
76
|
|
|
1081
|
2
|
|
|
2
|
|
6
|
use vars qw( $true $false ); |
|
|
2
|
|
|
|
|
3
|
|
|
|
2
|
|
|
|
|
190
|
|
|
1082
|
|
|
|
|
|
|
use overload |
|
1083
|
4
|
|
|
4
|
|
1190
|
"0+" => sub{ ${$_[0]} }, |
|
|
4
|
|
|
|
|
28
|
|
|
1084
|
0
|
|
|
0
|
|
0
|
"++" => sub{ $_[0] = ${$_[0]} + 1 }, |
|
|
0
|
|
|
|
|
0
|
|
|
1085
|
0
|
|
|
0
|
|
0
|
"--" => sub{ $_[0] = ${$_[0]} - 1 }, |
|
|
0
|
|
|
|
|
0
|
|
|
1086
|
2
|
|
|
2
|
|
8
|
fallback => 1; |
|
|
2
|
|
|
|
|
2
|
|
|
|
2
|
|
|
|
|
14
|
|
|
1087
|
2
|
|
|
2
|
|
269
|
$true = do{ bless( \( my $dummy = 1 ) => 'Locale::Intl::Boolean' ) }; |
|
|
2
|
|
|
|
|
6
|
|
|
1088
|
2
|
|
|
|
|
2
|
$false = do{ bless( \( my $dummy = 0 ) => 'Locale::Intl::Boolean' ) }; |
|
|
2
|
|
|
|
|
3
|
|
|
1089
|
2
|
|
|
|
|
42
|
our( $VERSION ) = 'v0.1.0'; |
|
1090
|
|
|
|
|
|
|
}; |
|
1091
|
|
|
|
|
|
|
|
|
1092
|
2
|
|
|
2
|
|
8
|
use strict; |
|
|
2
|
|
|
|
|
3
|
|
|
|
2
|
|
|
|
|
41
|
|
|
1093
|
2
|
|
|
2
|
|
5
|
use warnings; |
|
|
2
|
|
|
|
|
2
|
|
|
|
2
|
|
|
|
|
643
|
|
|
1094
|
|
|
|
|
|
|
|
|
1095
|
0
|
0
|
|
0
|
|
0
|
sub new { return( $_[1] ? $true : $false ); } |
|
1096
|
|
|
|
|
|
|
|
|
1097
|
1
|
|
|
1
|
|
23
|
sub false () { $false } |
|
1098
|
|
|
|
|
|
|
|
|
1099
|
1
|
|
|
1
|
|
19
|
sub true () { $true } |
|
1100
|
|
|
|
|
|
|
|
|
1101
|
|
|
|
|
|
|
sub FREEZE |
|
1102
|
|
|
|
|
|
|
{ |
|
1103
|
0
|
|
|
0
|
|
|
my $self = CORE::shift( @_ ); |
|
1104
|
0
|
|
0
|
|
|
|
my $serialiser = CORE::shift( @_ ) // ''; |
|
1105
|
0
|
|
|
|
|
|
my $class = CORE::ref( $self ); |
|
1106
|
|
|
|
|
|
|
# Return an array reference rather than a list so this works with Sereal and CBOR |
|
1107
|
|
|
|
|
|
|
# On or before Sereal version 4.023, Sereal did not support multiple values returned |
|
1108
|
0
|
0
|
0
|
|
|
|
CORE::return( [$class, $$self] ) if( $serialiser eq 'Sereal' && Sereal::Encoder->VERSION <= version->parse( '4.023' ) ); |
|
1109
|
|
|
|
|
|
|
# But Storable want a list with the first element being the serialised element |
|
1110
|
0
|
|
|
|
|
|
CORE::return( $$self ); |
|
1111
|
|
|
|
|
|
|
} |
|
1112
|
|
|
|
|
|
|
|
|
1113
|
0
|
|
|
0
|
|
|
sub STORABLE_freeze { CORE::return( CORE::shift->FREEZE( @_ ) ); } |
|
1114
|
|
|
|
|
|
|
|
|
1115
|
0
|
|
|
0
|
|
|
sub STORABLE_thaw { CORE::return( CORE::shift->THAW( @_ ) ); } |
|
1116
|
|
|
|
|
|
|
|
|
1117
|
|
|
|
|
|
|
# NOTE: CBOR will call the THAW method with the stored classname as first argument, the constant string CBOR as second argument, and all values returned by FREEZE as remaining arguments. |
|
1118
|
|
|
|
|
|
|
# NOTE: Storable calls it with a blessed object it created followed with $cloning and any other arguments initially provided by STORABLE_freeze |
|
1119
|
|
|
|
|
|
|
sub THAW |
|
1120
|
|
|
|
|
|
|
{ |
|
1121
|
0
|
|
|
0
|
|
|
my( $self, undef, @args ) = @_; |
|
1122
|
0
|
|
|
|
|
|
my( $class, $str ); |
|
1123
|
0
|
0
|
0
|
|
|
|
if( CORE::scalar( @args ) == 1 && CORE::ref( $args[0] ) eq 'ARRAY' ) |
|
1124
|
|
|
|
|
|
|
{ |
|
1125
|
0
|
|
|
|
|
|
( $class, $str ) = @{$args[0]}; |
|
|
0
|
|
|
|
|
|
|
|
1126
|
|
|
|
|
|
|
} |
|
1127
|
|
|
|
|
|
|
else |
|
1128
|
|
|
|
|
|
|
{ |
|
1129
|
0
|
|
0
|
|
|
|
$class = CORE::ref( $self ) || $self; |
|
1130
|
0
|
|
|
|
|
|
$str = CORE::shift( @args ); |
|
1131
|
|
|
|
|
|
|
} |
|
1132
|
|
|
|
|
|
|
# Storable pattern requires to modify the object it created rather than returning a new one |
|
1133
|
0
|
0
|
|
|
|
|
if( CORE::ref( $self ) ) |
|
1134
|
|
|
|
|
|
|
{ |
|
1135
|
0
|
|
|
|
|
|
$$self = $str; |
|
1136
|
0
|
|
|
|
|
|
CORE::return( $self ); |
|
1137
|
|
|
|
|
|
|
} |
|
1138
|
|
|
|
|
|
|
else |
|
1139
|
|
|
|
|
|
|
{ |
|
1140
|
0
|
|
|
|
|
|
CORE::return( $class->new( $str ) ); |
|
1141
|
|
|
|
|
|
|
} |
|
1142
|
|
|
|
|
|
|
} |
|
1143
|
|
|
|
|
|
|
|
|
1144
|
|
|
|
|
|
|
sub TO_JSON |
|
1145
|
|
|
|
|
|
|
{ |
|
1146
|
|
|
|
|
|
|
# JSON does not check that the value is a proper true or false. It stupidly assumes this is a string |
|
1147
|
|
|
|
|
|
|
# The only way to make it understand is to return a scalar ref of 1 or 0 |
|
1148
|
|
|
|
|
|
|
# return( $_[0] ? 'true' : 'false' ); |
|
1149
|
0
|
0
|
|
0
|
|
|
return( $_[0] ? \1 : \0 ); |
|
1150
|
|
|
|
|
|
|
} |
|
1151
|
|
|
|
|
|
|
|
|
1152
|
|
|
|
|
|
|
{ |
|
1153
|
|
|
|
|
|
|
# NOTE: Locale::Intl::NullObject class |
|
1154
|
|
|
|
|
|
|
package |
|
1155
|
|
|
|
|
|
|
Locale::Intl::NullObject; |
|
1156
|
|
|
|
|
|
|
BEGIN |
|
1157
|
0
|
|
|
|
|
0
|
{ |
|
1158
|
2
|
|
|
2
|
|
13
|
use strict; |
|
|
2
|
|
|
|
|
3
|
|
|
|
2
|
|
|
|
|
55
|
|
|
1159
|
2
|
|
|
2
|
|
9
|
use warnings; |
|
|
2
|
|
|
|
|
2
|
|
|
|
2
|
|
|
|
|
105
|
|
|
1160
|
|
|
|
|
|
|
use overload ( |
|
1161
|
0
|
|
|
0
|
|
0
|
'""' => sub{ '' }, |
|
1162
|
2
|
|
|
|
|
22
|
fallback => 1, |
|
1163
|
2
|
|
|
2
|
|
24
|
); |
|
|
2
|
|
|
|
|
3
|
|
|
1164
|
2
|
|
|
2
|
|
103
|
use Wanted; |
|
|
2
|
|
|
0
|
|
2
|
|
|
|
2
|
|
|
|
|
127
|
|
|
1165
|
|
|
|
|
|
|
}; |
|
1166
|
2
|
|
|
2
|
|
6
|
use strict; |
|
|
2
|
|
|
|
|
2
|
|
|
|
2
|
|
|
|
|
27
|
|
|
1167
|
2
|
|
|
2
|
|
5
|
use warnings; |
|
|
2
|
|
|
|
|
1
|
|
|
|
2
|
|
|
|
|
412
|
|
|
1168
|
|
|
|
|
|
|
|
|
1169
|
|
|
|
|
|
|
sub new |
|
1170
|
|
|
|
|
|
|
{ |
|
1171
|
0
|
|
|
0
|
|
|
my $this = shift( @_ ); |
|
1172
|
0
|
0
|
|
|
|
|
my $ref = @_ ? { @_ } : {}; |
|
1173
|
0
|
|
0
|
|
|
|
return( bless( $ref => ( ref( $this ) || $this ) ) ); |
|
1174
|
|
|
|
|
|
|
} |
|
1175
|
|
|
|
|
|
|
|
|
1176
|
|
|
|
|
|
|
sub AUTOLOAD |
|
1177
|
|
|
|
|
|
|
{ |
|
1178
|
0
|
|
|
0
|
|
|
my( $method ) = our $AUTOLOAD =~ /([^:]+)$/; |
|
1179
|
0
|
|
|
|
|
|
my $self = shift( @_ ); |
|
1180
|
0
|
0
|
|
|
|
|
if( want( 'OBJECT' ) ) |
|
1181
|
|
|
|
|
|
|
{ |
|
1182
|
0
|
|
|
|
|
|
rreturn( $self ); |
|
1183
|
|
|
|
|
|
|
} |
|
1184
|
|
|
|
|
|
|
# Otherwise, we return undef; Empty return returns undef in scalar context and empty list in list context |
|
1185
|
0
|
|
|
|
|
|
return; |
|
1186
|
|
|
|
|
|
|
}; |
|
1187
|
|
|
|
|
|
|
} |
|
1188
|
|
|
|
|
|
|
|
|
1189
|
|
|
|
|
|
|
1; |
|
1190
|
|
|
|
|
|
|
# NOTE: POD |
|
1191
|
|
|
|
|
|
|
__END__ |
|
1192
|
|
|
|
|
|
|
|
|
1193
|
|
|
|
|
|
|
=encoding utf-8 |
|
1194
|
|
|
|
|
|
|
|
|
1195
|
|
|
|
|
|
|
=head1 NAME |
|
1196
|
|
|
|
|
|
|
|
|
1197
|
|
|
|
|
|
|
Locale::Intl - A Web Intl.Locale Class Implementation |
|
1198
|
|
|
|
|
|
|
|
|
1199
|
|
|
|
|
|
|
=head1 SYNOPSIS |
|
1200
|
|
|
|
|
|
|
|
|
1201
|
|
|
|
|
|
|
use Locale::Intl; |
|
1202
|
|
|
|
|
|
|
my $locale = Locale::Intl->new( 'ja-Kana-t-it' ) || |
|
1203
|
|
|
|
|
|
|
die( Locale::Intl->error ); |
|
1204
|
|
|
|
|
|
|
|
|
1205
|
|
|
|
|
|
|
my $korean = new Locale::Intl('ko', { |
|
1206
|
|
|
|
|
|
|
script => 'Kore', |
|
1207
|
|
|
|
|
|
|
region => 'KR', |
|
1208
|
|
|
|
|
|
|
hourCycle => 'h23', |
|
1209
|
|
|
|
|
|
|
calendar => 'gregory', |
|
1210
|
|
|
|
|
|
|
}); |
|
1211
|
|
|
|
|
|
|
|
|
1212
|
|
|
|
|
|
|
my $japanese = new Locale::Intl('ja-Jpan-JP-u-ca-japanese-hc-h12'); |
|
1213
|
|
|
|
|
|
|
|
|
1214
|
|
|
|
|
|
|
say $korean->baseName; |
|
1215
|
|
|
|
|
|
|
say $japanese->baseName; |
|
1216
|
|
|
|
|
|
|
# Expected output: |
|
1217
|
|
|
|
|
|
|
# ko-Kore-KR |
|
1218
|
|
|
|
|
|
|
# ja-Jpan-JP |
|
1219
|
|
|
|
|
|
|
|
|
1220
|
|
|
|
|
|
|
say $korean->hourCycle; |
|
1221
|
|
|
|
|
|
|
say $japanese->hourCycle; |
|
1222
|
|
|
|
|
|
|
# Expected output |
|
1223
|
|
|
|
|
|
|
# h23 |
|
1224
|
|
|
|
|
|
|
# h12 |
|
1225
|
|
|
|
|
|
|
|
|
1226
|
|
|
|
|
|
|
=head1 VERSION |
|
1227
|
|
|
|
|
|
|
|
|
1228
|
|
|
|
|
|
|
v0.3.0 |
|
1229
|
|
|
|
|
|
|
|
|
1230
|
|
|
|
|
|
|
=head1 DESCRIPTION |
|
1231
|
|
|
|
|
|
|
|
|
1232
|
|
|
|
|
|
|
This class inherits from L<Locale::Unicode>. |
|
1233
|
|
|
|
|
|
|
|
|
1234
|
|
|
|
|
|
|
Make sure to check the API of L<Locale::Unicode> for its constructor and its methods. |
|
1235
|
|
|
|
|
|
|
|
|
1236
|
|
|
|
|
|
|
It also accesses the Unicode CLDR (Common Locale Data Repository) data using L<Locale::Unicode::Data> |
|
1237
|
|
|
|
|
|
|
|
|
1238
|
|
|
|
|
|
|
It requires perl v5.10.1 minimum to run. |
|
1239
|
|
|
|
|
|
|
|
|
1240
|
|
|
|
|
|
|
=head1 CONSTRUCTOR |
|
1241
|
|
|
|
|
|
|
|
|
1242
|
|
|
|
|
|
|
# American English |
|
1243
|
|
|
|
|
|
|
my $us = Locale::Intl->new( 'en-US' ); |
|
1244
|
|
|
|
|
|
|
# Japanese Katakana |
|
1245
|
|
|
|
|
|
|
my $ja = Locale::Intl->new( 'ja-Kana' ); |
|
1246
|
|
|
|
|
|
|
# Swiss German as spoken in subdivision of Zurich |
|
1247
|
|
|
|
|
|
|
my $ch = Locale::Intl->new( 'gsw-u-sd-chzh' ); |
|
1248
|
|
|
|
|
|
|
# Hebrew as spoken in Israel with Hebrew calendar and Jerusalem time zone |
|
1249
|
|
|
|
|
|
|
my $he = Locale::Intl->new( 'he-IL-u-ca-hebrew-tz-jeruslm' ); |
|
1250
|
|
|
|
|
|
|
# Japanese with Japanese calendar and Tokyo time zone with Japanese Finance numbering |
|
1251
|
|
|
|
|
|
|
# translated from Austrian German by an unidentified vendor with private extension 'private-subtag' |
|
1252
|
|
|
|
|
|
|
my $ja = Locale::Intl->new( 'ja-t-de-AT-t0-und-u-ca-japanese-tz-jptyo-nu-jpanfin-x-private-subtag' ); |
|
1253
|
|
|
|
|
|
|
|
|
1254
|
|
|
|
|
|
|
Passing some overriding options: |
|
1255
|
|
|
|
|
|
|
|
|
1256
|
|
|
|
|
|
|
my $locale = new Locale::Intl( 'en-US', { hourCycle => 'h12' }); |
|
1257
|
|
|
|
|
|
|
say $locale->hourCycle; # h12 |
|
1258
|
|
|
|
|
|
|
|
|
1259
|
|
|
|
|
|
|
=head2 new |
|
1260
|
|
|
|
|
|
|
|
|
1261
|
|
|
|
|
|
|
This takes a L<Unicode locale identifier|Locale::Unicode> and an optional hash or hash reference of options, and returns a new instance of L<Locale::Intl>. For the syntax of L<locale identifier|Locale::Unicode> strings, see the L<Unicode documentation|https://www.unicode.org/reports/tr35/>. |
|
1262
|
|
|
|
|
|
|
|
|
1263
|
|
|
|
|
|
|
A C<locale> is composed of a C<language>, such as C<fr> (French) or C<ja> (Japanese) or C<gsw> (Swiss German), an optional C<script>, such as C<Latn> (Latin) or C<Kana> (Katanaka), a C<region>, which can be a L<country code|Locale::Unicode/country_code>, such as C<US> (United States) or a world region, such as C<150> (Europe) and a C<variant>, such as C<valencia> as in C<ca-ES-valencia>. Only the C<language> part is required. |
|
1264
|
|
|
|
|
|
|
|
|
1265
|
|
|
|
|
|
|
The supported options are: |
|
1266
|
|
|
|
|
|
|
|
|
1267
|
|
|
|
|
|
|
=over 4 |
|
1268
|
|
|
|
|
|
|
|
|
1269
|
|
|
|
|
|
|
=item * C<calendar> |
|
1270
|
|
|
|
|
|
|
|
|
1271
|
|
|
|
|
|
|
Any syntactically valid string following the L<Unicode type grammar|https://unicode.org/reports/tr35/#Unicode_locale_identifier> (one or more segments of 3–8 alphanumerals, joined by hyphens) is accepted. See L<getAllCalendars()|/getAllCalendars> for all the supported calendars. |
|
1272
|
|
|
|
|
|
|
|
|
1273
|
|
|
|
|
|
|
See also L<Locale::Unicode/calendar> |
|
1274
|
|
|
|
|
|
|
|
|
1275
|
|
|
|
|
|
|
=item * C<caseFirst> |
|
1276
|
|
|
|
|
|
|
|
|
1277
|
|
|
|
|
|
|
This is the case-first sort option. Possible values are C<upper>, C<lower>, or a false value, such as C<undef> or C<0>. |
|
1278
|
|
|
|
|
|
|
|
|
1279
|
|
|
|
|
|
|
See also L<Locale::Unicode/colCaseFirst> |
|
1280
|
|
|
|
|
|
|
|
|
1281
|
|
|
|
|
|
|
=item * C<collation> |
|
1282
|
|
|
|
|
|
|
|
|
1283
|
|
|
|
|
|
|
Any syntactically valid string following the L<Unicode type grammar|https://unicode.org/reports/tr35/#Unicode_locale_identifier> is accepted. See L<getCollations|/getCollations> for a list of supported collations. |
|
1284
|
|
|
|
|
|
|
|
|
1285
|
|
|
|
|
|
|
See also L<Locale::Unicode/collation> |
|
1286
|
|
|
|
|
|
|
|
|
1287
|
|
|
|
|
|
|
=item * C<hourCycle> |
|
1288
|
|
|
|
|
|
|
|
|
1289
|
|
|
|
|
|
|
Possible values are C<h23>, C<h12>, C<h11>, or the practically unused C<h24>, which are explained in L<getHourCycles|/getHourCycles> |
|
1290
|
|
|
|
|
|
|
|
|
1291
|
|
|
|
|
|
|
See also L<Locale::Unicode/hour_cycle> |
|
1292
|
|
|
|
|
|
|
|
|
1293
|
|
|
|
|
|
|
=item * C<language> |
|
1294
|
|
|
|
|
|
|
|
|
1295
|
|
|
|
|
|
|
Not to be confused, this is a part of a broader C<locale>. Any syntactically valid string following the L<Unicode language subtag grammar|https://unicode.org/reports/tr35/#unicode_language_subtag> (2–3 or 5–8 letters) is accepted. |
|
1296
|
|
|
|
|
|
|
|
|
1297
|
|
|
|
|
|
|
=item * C<numberingSystem> |
|
1298
|
|
|
|
|
|
|
|
|
1299
|
|
|
|
|
|
|
Any syntactically valid string following the L<Unicode type grammar|https://unicode.org/reports/tr35/#Unicode_locale_identifier> is accepted. See L<getNumberingSystems|/getNumberingSystems> for the numbering systems supported for the C<locale> set in the object, or L<getAllNumberingSystems|/getAllNumberingSystems> for the list of all supported numbering systems. |
|
1300
|
|
|
|
|
|
|
|
|
1301
|
|
|
|
|
|
|
See also L<Locale::Unicode/number> |
|
1302
|
|
|
|
|
|
|
|
|
1303
|
|
|
|
|
|
|
=item * C<numeric> |
|
1304
|
|
|
|
|
|
|
|
|
1305
|
|
|
|
|
|
|
The numeric sort option. This takes a boolean value. |
|
1306
|
|
|
|
|
|
|
|
|
1307
|
|
|
|
|
|
|
See also L<Locale::Unicode/colNumeric> |
|
1308
|
|
|
|
|
|
|
|
|
1309
|
|
|
|
|
|
|
=item * C<region> |
|
1310
|
|
|
|
|
|
|
|
|
1311
|
|
|
|
|
|
|
Any syntactically valid string following the L<Unicode region subtag grammar|https://unicode.org/reports/tr35/#unicode_region_subtag> (either 2 letters or 3 digits) is accepted. |
|
1312
|
|
|
|
|
|
|
|
|
1313
|
|
|
|
|
|
|
=item * C<script> |
|
1314
|
|
|
|
|
|
|
|
|
1315
|
|
|
|
|
|
|
Any syntactically valid string following the L<Unicode script subtag|https://unicode.org/reports/tr35/#unicode_script_subtag> grammar (4 letters) is accepted, but the implementation only recognizes certain kinds. |
|
1316
|
|
|
|
|
|
|
|
|
1317
|
|
|
|
|
|
|
See also L<Locale::Unicode/script> |
|
1318
|
|
|
|
|
|
|
|
|
1319
|
|
|
|
|
|
|
=back |
|
1320
|
|
|
|
|
|
|
|
|
1321
|
|
|
|
|
|
|
=head1 METHODS |
|
1322
|
|
|
|
|
|
|
|
|
1323
|
|
|
|
|
|
|
=head2 getAllCalendars |
|
1324
|
|
|
|
|
|
|
|
|
1325
|
|
|
|
|
|
|
This is a read-only method that returns an array of all possible calendar values supported by the current version of L<LDML (Locale Data Markup Language)|https://unicode.org/reports/tr35/>. |
|
1326
|
|
|
|
|
|
|
|
|
1327
|
|
|
|
|
|
|
=head2 getAllNumberingSystems |
|
1328
|
|
|
|
|
|
|
|
|
1329
|
|
|
|
|
|
|
This is a read-only method that returns an array of all possible numbering system values supported by the current version of L<LDML (Locale Data Markup Language)|https://unicode.org/reports/tr35/>. |
|
1330
|
|
|
|
|
|
|
|
|
1331
|
|
|
|
|
|
|
=head2 getAllTimeZones |
|
1332
|
|
|
|
|
|
|
|
|
1333
|
|
|
|
|
|
|
This is a read-only method that returns an array of all possible time zone values supported by the current version of L<LDML (Locale Data Markup Language)|https://unicode.org/reports/tr35/>. Please note that to ensure consistency, the LDML supports some values that are either outdated or removed from IANA's time zone database. |
|
1334
|
|
|
|
|
|
|
|
|
1335
|
|
|
|
|
|
|
=head2 getCalendars |
|
1336
|
|
|
|
|
|
|
|
|
1337
|
|
|
|
|
|
|
my $jaJP = new Locale::Intl( 'ja-JP' ); |
|
1338
|
|
|
|
|
|
|
say $jaJP->getCalendars(); # ["gregory", "japanese"] |
|
1339
|
|
|
|
|
|
|
|
|
1340
|
|
|
|
|
|
|
This method returns an array of one or more unique L<calendar|Locale::Unicode/calendar> identifiers for this C<locale>. |
|
1341
|
|
|
|
|
|
|
|
|
1342
|
|
|
|
|
|
|
See the L<Unicode Locale BCP47 extensions|Locale::Unicode/"BCP47 EXTENSIONS"> for the list of valid calendar values. |
|
1343
|
|
|
|
|
|
|
|
|
1344
|
|
|
|
|
|
|
=head2 getCollations |
|
1345
|
|
|
|
|
|
|
|
|
1346
|
|
|
|
|
|
|
my $locale = Locale::Intl->new( 'zh' ); |
|
1347
|
|
|
|
|
|
|
say $locale->getCollations(); # ["pinyin", "stroke", "zhuyin", "emoji", "eor"] |
|
1348
|
|
|
|
|
|
|
|
|
1349
|
|
|
|
|
|
|
The C<getCollations()> method returns an array of one or more collation types commonly used for this L<locale|Locale::Unicode>. If the L<Locale|Locale::Unicode> already has a C<collation>, then the returned array contains that single value. |
|
1350
|
|
|
|
|
|
|
|
|
1351
|
|
|
|
|
|
|
If the L<locale identifier|Locale::Unicode> object does not have a C<collation> already, C<getCollations()> lists all commonly-used collation types for the given L<locale identifier|Locale::Unicode>. |
|
1352
|
|
|
|
|
|
|
|
|
1353
|
|
|
|
|
|
|
See the L<Unicode Locale BCP47 extensions|Locale::Unicode/"BCP47 EXTENSIONS"> for the list of valid collation values. |
|
1354
|
|
|
|
|
|
|
|
|
1355
|
|
|
|
|
|
|
=head2 getHourCycles |
|
1356
|
|
|
|
|
|
|
|
|
1357
|
|
|
|
|
|
|
my $jaJP = Locale::Intl->new( 'ja-JP' ); |
|
1358
|
|
|
|
|
|
|
say $jaJP->getHourCycles(); # ["h23"] |
|
1359
|
|
|
|
|
|
|
|
|
1360
|
|
|
|
|
|
|
my $arEG = Locale::Intl->new( 'ar-EG' ); |
|
1361
|
|
|
|
|
|
|
say $arEG->getHourCycles(); # ["h12"] |
|
1362
|
|
|
|
|
|
|
|
|
1363
|
|
|
|
|
|
|
This method returns an array of one or more unique hour cycle identifiers commonly used for this L<locale|Locale::Unicode>, sorted in descending preference. If the Locale already has an hourCycle, then the returned array contains that single value. |
|
1364
|
|
|
|
|
|
|
|
|
1365
|
|
|
|
|
|
|
If the L<locale identifier|Locale::Unicode> object does not have a C<hourCycle> already, this method lists all commonly-used hour cycle identifiers for the given L<locale|Locale::Unicode>. |
|
1366
|
|
|
|
|
|
|
|
|
1367
|
|
|
|
|
|
|
Below are the valid values: |
|
1368
|
|
|
|
|
|
|
|
|
1369
|
|
|
|
|
|
|
=over 4 |
|
1370
|
|
|
|
|
|
|
|
|
1371
|
|
|
|
|
|
|
=item * C<h12> |
|
1372
|
|
|
|
|
|
|
|
|
1373
|
|
|
|
|
|
|
Hour system using C<1–12>; corresponds to C<h> in patterns. The 12 hour clock, with midnight starting at C<12:00> am. As used, for example, in the United States. |
|
1374
|
|
|
|
|
|
|
|
|
1375
|
|
|
|
|
|
|
=item * C<h23> |
|
1376
|
|
|
|
|
|
|
|
|
1377
|
|
|
|
|
|
|
Hour system using C<0–23>; corresponds to C<H> in patterns. The 24 hour clock, with midnight starting at C<0:00>. |
|
1378
|
|
|
|
|
|
|
|
|
1379
|
|
|
|
|
|
|
=item * C<h11> |
|
1380
|
|
|
|
|
|
|
|
|
1381
|
|
|
|
|
|
|
Hour system using C<0–11>; corresponds to C<K> in patterns. The 12 hour clock, with midnight starting at C<0:00> am. Mostly used in Japan. |
|
1382
|
|
|
|
|
|
|
|
|
1383
|
|
|
|
|
|
|
=item * C<h24> |
|
1384
|
|
|
|
|
|
|
|
|
1385
|
|
|
|
|
|
|
Hour system using C<1–24>; corresponds to C<k> in pattern. The 24 hour clock, with midnight starting at C<24:00>. Not used anywhere. |
|
1386
|
|
|
|
|
|
|
|
|
1387
|
|
|
|
|
|
|
=back |
|
1388
|
|
|
|
|
|
|
|
|
1389
|
|
|
|
|
|
|
Hour cycles usage in the world are: |
|
1390
|
|
|
|
|
|
|
|
|
1391
|
|
|
|
|
|
|
=over 4 |
|
1392
|
|
|
|
|
|
|
|
|
1393
|
|
|
|
|
|
|
=item * C<h12 h23> |
|
1394
|
|
|
|
|
|
|
|
|
1395
|
|
|
|
|
|
|
115 locales |
|
1396
|
|
|
|
|
|
|
|
|
1397
|
|
|
|
|
|
|
=item * C<h23 h12> |
|
1398
|
|
|
|
|
|
|
|
|
1399
|
|
|
|
|
|
|
95 locales |
|
1400
|
|
|
|
|
|
|
|
|
1401
|
|
|
|
|
|
|
=item * C<h23> |
|
1402
|
|
|
|
|
|
|
|
|
1403
|
|
|
|
|
|
|
60 locales |
|
1404
|
|
|
|
|
|
|
|
|
1405
|
|
|
|
|
|
|
=item * C<h23 h11 h12> |
|
1406
|
|
|
|
|
|
|
|
|
1407
|
|
|
|
|
|
|
1 locale |
|
1408
|
|
|
|
|
|
|
|
|
1409
|
|
|
|
|
|
|
=back |
|
1410
|
|
|
|
|
|
|
|
|
1411
|
|
|
|
|
|
|
See also the property L<hourCycle|/hourCycle> |
|
1412
|
|
|
|
|
|
|
|
|
1413
|
|
|
|
|
|
|
=head2 getNumberingSystems |
|
1414
|
|
|
|
|
|
|
|
|
1415
|
|
|
|
|
|
|
my $ja = Locale::Intl->new( 'ja' ); |
|
1416
|
|
|
|
|
|
|
say $ja->getNumberingSystems(); # ["latn"] |
|
1417
|
|
|
|
|
|
|
|
|
1418
|
|
|
|
|
|
|
my $arEG = Locale::Intl->new( 'ar-EG' ); |
|
1419
|
|
|
|
|
|
|
say $arEG->getNumberingSystems(); # ["arab"] |
|
1420
|
|
|
|
|
|
|
|
|
1421
|
|
|
|
|
|
|
This method returns an array of one or more unique numbering system identifiers commonly used for this L<locale|Locale::Unicode>, sorted in descending preference. If the Locale already has a numberingSystem, then the returned array contains that single value. |
|
1422
|
|
|
|
|
|
|
|
|
1423
|
|
|
|
|
|
|
See the L<Unicode Locale BCP47 extensions|Locale::Unicode/"BCP47 EXTENSIONS"> for the list of valid numbering system values. |
|
1424
|
|
|
|
|
|
|
|
|
1425
|
|
|
|
|
|
|
=head2 getTextInfo |
|
1426
|
|
|
|
|
|
|
|
|
1427
|
|
|
|
|
|
|
my $ar = Locale::Intl->new( 'ar' ); |
|
1428
|
|
|
|
|
|
|
say $ar->getTextInfo(); # rtl |
|
1429
|
|
|
|
|
|
|
|
|
1430
|
|
|
|
|
|
|
my $es = Locale::Intl->new( 'es' ); |
|
1431
|
|
|
|
|
|
|
say $es->getTextInfo(); # ltr |
|
1432
|
|
|
|
|
|
|
|
|
1433
|
|
|
|
|
|
|
This method returns a string representing the ordering of characters indicated by either C<ltr> (left-to-right) or by C<rtl> (right-to-left) for this L<locale|Locale::Unicode> as specified in L<UTS 35 Layouts Elements|https://www.unicode.org/reports/tr35/tr35-general.html#Layout_Elements>. |
|
1434
|
|
|
|
|
|
|
|
|
1435
|
|
|
|
|
|
|
=head2 getTimeZones |
|
1436
|
|
|
|
|
|
|
|
|
1437
|
|
|
|
|
|
|
my $jaJP = Locale::Intl->new( 'ja-JP' ); |
|
1438
|
|
|
|
|
|
|
say $jaJP->getTimeZones(); # ["Asia/Tokyo"] |
|
1439
|
|
|
|
|
|
|
|
|
1440
|
|
|
|
|
|
|
my $ar = Locale::Intl->new( 'ar' ); |
|
1441
|
|
|
|
|
|
|
# This will resolve to Africa/Cairo, because the locale 'ar' |
|
1442
|
|
|
|
|
|
|
3 will maximize to ar-Arab-EG and from there to Egypt |
|
1443
|
|
|
|
|
|
|
say $ar->getTimeZones(); # ["Africa/Cairo"] |
|
1444
|
|
|
|
|
|
|
|
|
1445
|
|
|
|
|
|
|
This method returns an array of supported time zones for this L<locale|Locale::Unicode>. |
|
1446
|
|
|
|
|
|
|
|
|
1447
|
|
|
|
|
|
|
ach value is an L<IANA time zone canonical name|https://en.wikipedia.org/wiki/Daylight_saving_time#IANA_time_zone_database>, sorted in alphabetical order. If the L<locale identifier|Locale::Unicode> does not contain a C<region> subtag, the returned value is C<undef>. |
|
1448
|
|
|
|
|
|
|
|
|
1449
|
|
|
|
|
|
|
Keep in mind that the values do not necessarily match the IANA database that changes from time to time. The Unicode LDML L<keeps old time zones for stability purpose|https://unicode.org/reports/tr35/#Time_Zone_Identifiers>. |
|
1450
|
|
|
|
|
|
|
|
|
1451
|
|
|
|
|
|
|
Also note that this method behaves slightly differently from its JavaScript counter part, as the L<JavaScript getTimeZones() method|https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Intl/Locale/getTimeZones> will return C<undef> if only a C<language> subtag is provided and not a C<locale> tha would include a C<country code>. This method, instead, will L<maximize|/maximize> the 2-letters C<locale> provided and from there will returns the time zone for the default country for that language. |
|
1452
|
|
|
|
|
|
|
|
|
1453
|
|
|
|
|
|
|
See also L<getAllTimeZones|/getAllTimeZones> to get a list of all available time zones. |
|
1454
|
|
|
|
|
|
|
|
|
1455
|
|
|
|
|
|
|
=head2 getWeekInfo |
|
1456
|
|
|
|
|
|
|
|
|
1457
|
|
|
|
|
|
|
const he = Locale::Intl->new( 'he' ); |
|
1458
|
|
|
|
|
|
|
say $he->getWeekInfo(); |
|
1459
|
|
|
|
|
|
|
# { firstDay => 7, weekend => [5, 6], minimalDays => 1 } |
|
1460
|
|
|
|
|
|
|
|
|
1461
|
|
|
|
|
|
|
const af = Locale::Intl->new( 'af' ); |
|
1462
|
|
|
|
|
|
|
say $af->getWeekInfo(); |
|
1463
|
|
|
|
|
|
|
# { firstDay => 7, weekend => [6, 7], minimalDays => 1 } |
|
1464
|
|
|
|
|
|
|
|
|
1465
|
|
|
|
|
|
|
const enGB = Locale::Intl->new( 'en-GB' ); |
|
1466
|
|
|
|
|
|
|
say $enGB->getWeekInfo(); |
|
1467
|
|
|
|
|
|
|
# { firstDay => 1, weekend => [6, 7], minimalDays => 4 } |
|
1468
|
|
|
|
|
|
|
|
|
1469
|
|
|
|
|
|
|
const msBN = Locale::Intl->new( 'ms-BN' ); |
|
1470
|
|
|
|
|
|
|
say $msBN->getWeekInfo(); |
|
1471
|
|
|
|
|
|
|
# { firstDay => 7, weekend => [5, 7], minimalDays => 1 } |
|
1472
|
|
|
|
|
|
|
# Brunei weekend is Friday and Sunday but not Saturday |
|
1473
|
|
|
|
|
|
|
|
|
1474
|
|
|
|
|
|
|
This method returns an hash reference with the properties C<firstDay>, C<weekend> and C<minimalDays> for this L<locale|Locale::Unicode>, as specified in L<UTS 35 Week Elements|https://www.unicode.org/reports/tr35/tr35-dates.html#Date_Patterns_Week_Elements>. |
|
1475
|
|
|
|
|
|
|
|
|
1476
|
|
|
|
|
|
|
=over 4 |
|
1477
|
|
|
|
|
|
|
|
|
1478
|
|
|
|
|
|
|
=item * C<firstDay> |
|
1479
|
|
|
|
|
|
|
|
|
1480
|
|
|
|
|
|
|
An integer indicating the first day of the week for the locale. Can be either C<1> (Monday) or C<7> (Sunday). |
|
1481
|
|
|
|
|
|
|
|
|
1482
|
|
|
|
|
|
|
=item * C<weekend> |
|
1483
|
|
|
|
|
|
|
|
|
1484
|
|
|
|
|
|
|
An array of integers indicating the weekend days for the locale, where C<1> is Monday and C<7> is Sunday. |
|
1485
|
|
|
|
|
|
|
|
|
1486
|
|
|
|
|
|
|
=item * C<minimalDays> |
|
1487
|
|
|
|
|
|
|
|
|
1488
|
|
|
|
|
|
|
An integer between C<1> and C<7> indicating the minimal days required in the first week of a month or year, for calendar purposes. |
|
1489
|
|
|
|
|
|
|
|
|
1490
|
|
|
|
|
|
|
=back |
|
1491
|
|
|
|
|
|
|
|
|
1492
|
|
|
|
|
|
|
See also the L<Unicode LDML specifications|https://unicode-org.github.io/cldr/ldml/tr35-dates.html#Date_Patterns_Week_Elements> |
|
1493
|
|
|
|
|
|
|
|
|
1494
|
|
|
|
|
|
|
=head2 maximise |
|
1495
|
|
|
|
|
|
|
|
|
1496
|
|
|
|
|
|
|
This is an alias for L<maximise|/maximise> |
|
1497
|
|
|
|
|
|
|
|
|
1498
|
|
|
|
|
|
|
=head2 maximize |
|
1499
|
|
|
|
|
|
|
|
|
1500
|
|
|
|
|
|
|
my $english = Locale::Intl->new( 'en' ); |
|
1501
|
|
|
|
|
|
|
my $korean = Locale::Intl->new( 'ko' ); |
|
1502
|
|
|
|
|
|
|
my $arabic = Locale::Intl->new( 'ar' ); |
|
1503
|
|
|
|
|
|
|
|
|
1504
|
|
|
|
|
|
|
say $english->maximize()->baseName; |
|
1505
|
|
|
|
|
|
|
# en-Latn-US |
|
1506
|
|
|
|
|
|
|
|
|
1507
|
|
|
|
|
|
|
say $korean->maximize()->baseName; |
|
1508
|
|
|
|
|
|
|
# ko-Kore-KR |
|
1509
|
|
|
|
|
|
|
|
|
1510
|
|
|
|
|
|
|
say $arabic->maximize()->baseName; |
|
1511
|
|
|
|
|
|
|
# ar-Arab-EG |
|
1512
|
|
|
|
|
|
|
|
|
1513
|
|
|
|
|
|
|
This method gets L<the most likely values|https://github.com/unicode-org/cldr-json/blob/main/cldr-json/cldr-core/supplemental/likelySubtags.json> for the C<language>, C<script>, and C<region> of this L<locale|Locale::Unicode> based on existing values and returns a new L<Locale::Intl> object. |
|
1514
|
|
|
|
|
|
|
|
|
1515
|
|
|
|
|
|
|
Sometimes, it is convenient to be able to identify the most likely L<locale language identifier|Locale::Unicode> subtags based on an incomplete C<language> ID. The L<Add Likely Subtags algorithm|https://www.unicode.org/reports/tr35/#Likely_Subtags> gives us this functionality. For instance, given the C<language> ID C<en>, the algorithm would return C<en-Latn-US>, since English can only be written in the Latin script, and is most likely to be used in the United States, as it is the largest English-speaking country in the world. This functionality is provided via this C<maximize()> method. C<maximize()> only affects the main subtags that comprise the C<language> identifier: C<language>, C<script>, and C<region> subtags. Other subtags after the C<-u> in the C<locale> identifier are L<called extension subtags|Locale::Unicode/"BCP47 EXTENSIONS"> and are not affected by the C<maximize()> method. Examples of these subtags include L<hourCycle|/hourCycle>, L<calendar|/calendar>, and L<numeric|/numeric>. |
|
1516
|
|
|
|
|
|
|
|
|
1517
|
|
|
|
|
|
|
Upon error, it sets an L<exception object|Locale::Intl::Exception> and returns C<undef> in scalar context, or an empty list in list context. |
|
1518
|
|
|
|
|
|
|
|
|
1519
|
|
|
|
|
|
|
Example: |
|
1520
|
|
|
|
|
|
|
|
|
1521
|
|
|
|
|
|
|
my $myLocale = Locale::Intl->new( 'fr', { |
|
1522
|
|
|
|
|
|
|
hourCycle => 'h12', |
|
1523
|
|
|
|
|
|
|
calendar => 'gregory', |
|
1524
|
|
|
|
|
|
|
}); |
|
1525
|
|
|
|
|
|
|
say $myLocale->baseName; # fr |
|
1526
|
|
|
|
|
|
|
say $myLocale->toString(); # fr-u-ca-gregory-hc-h12 |
|
1527
|
|
|
|
|
|
|
my $myLocMaximized = $myLocale->maximize(); |
|
1528
|
|
|
|
|
|
|
|
|
1529
|
|
|
|
|
|
|
# The "Latn" and "FR" tags are added |
|
1530
|
|
|
|
|
|
|
# fr-Latn-FR |
|
1531
|
|
|
|
|
|
|
# since French is only written in the Latin script and |
|
1532
|
|
|
|
|
|
|
# is most likely to be spoken in France. |
|
1533
|
|
|
|
|
|
|
say $myLocMaximized->baseName; |
|
1534
|
|
|
|
|
|
|
|
|
1535
|
|
|
|
|
|
|
# fr-Latn-FR-u-ca-gregory-hc-h12 |
|
1536
|
|
|
|
|
|
|
# Note that the extension tags (after '-u') remain unchanged. |
|
1537
|
|
|
|
|
|
|
say $myLocMaximized->toString(); |
|
1538
|
|
|
|
|
|
|
|
|
1539
|
|
|
|
|
|
|
=head2 minimise |
|
1540
|
|
|
|
|
|
|
|
|
1541
|
|
|
|
|
|
|
This is an alias for L<minimise|/minimise> |
|
1542
|
|
|
|
|
|
|
|
|
1543
|
|
|
|
|
|
|
=head2 minimize |
|
1544
|
|
|
|
|
|
|
|
|
1545
|
|
|
|
|
|
|
my $english = Locale::Intl->new( 'en-Latn-US' ); |
|
1546
|
|
|
|
|
|
|
my $korean = Locale::Intl->new( 'ko-Kore-KR' ); |
|
1547
|
|
|
|
|
|
|
my $arabic = Locale::Intl->new( 'ar-Arab-EG' ); |
|
1548
|
|
|
|
|
|
|
|
|
1549
|
|
|
|
|
|
|
say $english->minimize()->baseName; |
|
1550
|
|
|
|
|
|
|
# en |
|
1551
|
|
|
|
|
|
|
|
|
1552
|
|
|
|
|
|
|
say $korean->minimize()->baseName; |
|
1553
|
|
|
|
|
|
|
# ko |
|
1554
|
|
|
|
|
|
|
|
|
1555
|
|
|
|
|
|
|
say $arabic->minimize()->baseName; |
|
1556
|
|
|
|
|
|
|
# ar |
|
1557
|
|
|
|
|
|
|
|
|
1558
|
|
|
|
|
|
|
my $myLocale = Locale::Intl->new( 'fr-Latn-FR', { |
|
1559
|
|
|
|
|
|
|
hourCycle => 'h12', |
|
1560
|
|
|
|
|
|
|
calendar => 'gregory', |
|
1561
|
|
|
|
|
|
|
}); |
|
1562
|
|
|
|
|
|
|
say $myLocale->baseName; # fr-Latn-FR |
|
1563
|
|
|
|
|
|
|
say $myLocale->toString(); # fr-Latn-FR-u-ca-gregory-hc-h12 |
|
1564
|
|
|
|
|
|
|
|
|
1565
|
|
|
|
|
|
|
my $myLocMinimized = $myLocale->minimize(); |
|
1566
|
|
|
|
|
|
|
|
|
1567
|
|
|
|
|
|
|
# Prints 'fr', since French is only written in the Latin script and |
|
1568
|
|
|
|
|
|
|
# is most likely to be spoken in France. |
|
1569
|
|
|
|
|
|
|
say $myLocMinimized->baseName); |
|
1570
|
|
|
|
|
|
|
|
|
1571
|
|
|
|
|
|
|
# fr-u-ca-gregory-hc-h12 |
|
1572
|
|
|
|
|
|
|
# Note that the extension tags (after '-u') remain unchanged. |
|
1573
|
|
|
|
|
|
|
say $myLocMinimized->toString(); |
|
1574
|
|
|
|
|
|
|
|
|
1575
|
|
|
|
|
|
|
This method attempts to remove information about this C<locale> that would be added by calling L<maximize()|/maximize>, which means removing any language, script, or region subtags from the locale language identifier (essentially the contents of baseName). |
|
1576
|
|
|
|
|
|
|
|
|
1577
|
|
|
|
|
|
|
This is useful when there are superfluous subtags in the language identifier; for instance, C<en-Latn> can be simplified to C<en>, since C<Latn> is the only script used to write English. C<minimize()> only affects the main subtags that comprise the L<language identifier|Locale::Unicode>: C<language>, C<script>, and C<region> subtags. Other subtags after the C<-u> in the L<locale identifier|Locale::Unicode> are called L<extension subtags|Locale::Unicode/"BCP47 EXTENSIONS"> and are not affected by the C<minimize()> method. Examples of these subtags include L<hourCycle|/hourCycle>, L<calendar|/calendar>, and L<numeric|/numeric>. |
|
1578
|
|
|
|
|
|
|
|
|
1579
|
|
|
|
|
|
|
This returns a new L<Locale::Intl> instance whose L<baseName|/baseName> property returns the result of the L<Remove Likely Subtags|https://www.unicode.org/reports/tr35/#Likely_Subtags> algorithm executed against C<< $locale->baseName >>. |
|
1580
|
|
|
|
|
|
|
|
|
1581
|
|
|
|
|
|
|
=for Pod::Coverage pass_error |
|
1582
|
|
|
|
|
|
|
|
|
1583
|
|
|
|
|
|
|
=head2 toString |
|
1584
|
|
|
|
|
|
|
|
|
1585
|
|
|
|
|
|
|
my $french = Locale::Intl->new('fr-Latn-FR', { |
|
1586
|
|
|
|
|
|
|
calendar => 'gregory', |
|
1587
|
|
|
|
|
|
|
hourCycle => 'h12', |
|
1588
|
|
|
|
|
|
|
}); |
|
1589
|
|
|
|
|
|
|
const korean = Locale::Intl->new('ko-Kore-KR', { |
|
1590
|
|
|
|
|
|
|
numeric => 'true', |
|
1591
|
|
|
|
|
|
|
caseFirst => 'upper', |
|
1592
|
|
|
|
|
|
|
}); |
|
1593
|
|
|
|
|
|
|
|
|
1594
|
|
|
|
|
|
|
say $french->toString(); |
|
1595
|
|
|
|
|
|
|
# fr-Latn-FR-u-ca-gregory-hc-h12 |
|
1596
|
|
|
|
|
|
|
|
|
1597
|
|
|
|
|
|
|
say $korean->toString(); |
|
1598
|
|
|
|
|
|
|
# ko-Kore-KR-u-kf-upper-kn |
|
1599
|
|
|
|
|
|
|
|
|
1600
|
|
|
|
|
|
|
This method returns this L<Locale::Intl>'s full locale identifier string. |
|
1601
|
|
|
|
|
|
|
|
|
1602
|
|
|
|
|
|
|
The string value is computed once and is cached until any of the C<locale>'s attributes are changed. |
|
1603
|
|
|
|
|
|
|
|
|
1604
|
|
|
|
|
|
|
=head1 PROPERTIES |
|
1605
|
|
|
|
|
|
|
|
|
1606
|
|
|
|
|
|
|
=head2 baseName |
|
1607
|
|
|
|
|
|
|
|
|
1608
|
|
|
|
|
|
|
# Sets locale to Canadian French |
|
1609
|
|
|
|
|
|
|
my $myLoc = Locale::Intl->new( "fr-Latn-CA" ); |
|
1610
|
|
|
|
|
|
|
say $myLoc->toString(); # fr-Latn-CA-u-ca-gregory |
|
1611
|
|
|
|
|
|
|
say $myLoc->baseName; # fr-Latn-CA |
|
1612
|
|
|
|
|
|
|
|
|
1613
|
|
|
|
|
|
|
# calendar to Gregorian, hour cycle to 24 hours |
|
1614
|
|
|
|
|
|
|
my $japan = Locale::Intl->new( "ja-JP-u-ca-gregory-hc-24" ); |
|
1615
|
|
|
|
|
|
|
say $japan->toString(); # ja-JP-u-ca-gregory-hc-h24 |
|
1616
|
|
|
|
|
|
|
$japan->baseName; # ja-JP |
|
1617
|
|
|
|
|
|
|
|
|
1618
|
|
|
|
|
|
|
# Dutch and region as Belgium, but options override the region to the Netherlands |
|
1619
|
|
|
|
|
|
|
my $dutch = Locale::Intl->new( "nl-Latn-BE", { region => "NL" }); |
|
1620
|
|
|
|
|
|
|
|
|
1621
|
|
|
|
|
|
|
say $dutch->baseName; # nl-Latn-NL |
|
1622
|
|
|
|
|
|
|
|
|
1623
|
|
|
|
|
|
|
The C<baseName> accessor property of L<Locale::Intl> instances returns a substring of this C<locale>'s string representation, containing core information about this locale. |
|
1624
|
|
|
|
|
|
|
|
|
1625
|
|
|
|
|
|
|
Specifically, this returns the substring containing the C<language>, the C<script> and C<region> if available. |
|
1626
|
|
|
|
|
|
|
|
|
1627
|
|
|
|
|
|
|
See L<Unicode grammar ID|https://www.unicode.org/reports/tr35/#Identifiers> for more information. |
|
1628
|
|
|
|
|
|
|
|
|
1629
|
|
|
|
|
|
|
=head2 calendar |
|
1630
|
|
|
|
|
|
|
|
|
1631
|
|
|
|
|
|
|
This returns the calendar type for this locale. |
|
1632
|
|
|
|
|
|
|
|
|
1633
|
|
|
|
|
|
|
The C<calendar> property's value is set at object instantiation time, either through the C<ca> attribute of the C<locale> identifier or through the C<calendar> option of the L<Locale::Unicode> constructor. The latter takes priority if they are both present; and if neither is present, the property has value C<undef>. |
|
1634
|
|
|
|
|
|
|
|
|
1635
|
|
|
|
|
|
|
For a list of supported calendar types, see L<Locale::Intl/getCalendars>. |
|
1636
|
|
|
|
|
|
|
|
|
1637
|
|
|
|
|
|
|
For example: |
|
1638
|
|
|
|
|
|
|
|
|
1639
|
|
|
|
|
|
|
Adding a C<calendar> through the C<locale> attribute. |
|
1640
|
|
|
|
|
|
|
|
|
1641
|
|
|
|
|
|
|
In the L<Unicode locale string specifications|https://www.unicode.org/reports/tr35/>, C<calendar> era types are C<locale> attribute "extension subtags". These subtags add additional data about the C<locale>, and are added to C<locale> identifiers by using the C<-u> extension. Thus, the C<calendar> era type can be added to the initial C<locale> identifier string that is passed into the L<Locale::Intl> constructor. To add the calendar type, first add the C<-u> extension to the string. Next, add the L<-ca|Locale::Unicode/ca> extension to indicate that you are adding a calendar type. Finally, add the calendar era type to the string. |
|
1642
|
|
|
|
|
|
|
|
|
1643
|
|
|
|
|
|
|
my $locale = Locale::Intl->new( 'he-IL-u-ca-hebrew-tz-jeruslm' ); |
|
1644
|
|
|
|
|
|
|
say $locale->calendar; # hebrew |
|
1645
|
|
|
|
|
|
|
|
|
1646
|
|
|
|
|
|
|
Alternatively, you could also achieve the same results, using the methods inherited from L<Locale::Unicode>: |
|
1647
|
|
|
|
|
|
|
|
|
1648
|
|
|
|
|
|
|
my $locale = Locale::Intl->new( 'he-IL' ); |
|
1649
|
|
|
|
|
|
|
$locale->ca( 'hebrew' )->tz( 'jeruslm' ); |
|
1650
|
|
|
|
|
|
|
say $locale->calendar; # hebrew |
|
1651
|
|
|
|
|
|
|
|
|
1652
|
|
|
|
|
|
|
Adding a C<calendar> type via the optional hash or hash reference of options. |
|
1653
|
|
|
|
|
|
|
|
|
1654
|
|
|
|
|
|
|
The L<Locale::Intl> constructor takes an optional hash or hash reference of options, which can contain any of several extension types, including calendars. Set the C<calendar> property of the optional hash or hash reference to your desired C<calendar> era, and then pass it into the constructor. |
|
1655
|
|
|
|
|
|
|
|
|
1656
|
|
|
|
|
|
|
my $locale = Locale::Intl->new( 'he-IL', { calendar => 'hebrew' } ); |
|
1657
|
|
|
|
|
|
|
say $locale->calendar; # hebrew |
|
1658
|
|
|
|
|
|
|
|
|
1659
|
|
|
|
|
|
|
=head2 caseFirst |
|
1660
|
|
|
|
|
|
|
|
|
1661
|
|
|
|
|
|
|
The C<caseFirst> accessor property of L<Locale::Intl> instances returns whether case is taken into account for this C<locale>'s collation rules. |
|
1662
|
|
|
|
|
|
|
|
|
1663
|
|
|
|
|
|
|
There are 3 values that the C<caseFirst> property can have, outlined in the table below. |
|
1664
|
|
|
|
|
|
|
|
|
1665
|
|
|
|
|
|
|
=over 4 |
|
1666
|
|
|
|
|
|
|
|
|
1667
|
|
|
|
|
|
|
=item * C<upper> |
|
1668
|
|
|
|
|
|
|
|
|
1669
|
|
|
|
|
|
|
Upper case to be sorted before lower case. |
|
1670
|
|
|
|
|
|
|
|
|
1671
|
|
|
|
|
|
|
=item * C<lower> |
|
1672
|
|
|
|
|
|
|
|
|
1673
|
|
|
|
|
|
|
Lower case to be sorted before upper case. |
|
1674
|
|
|
|
|
|
|
|
|
1675
|
|
|
|
|
|
|
=item * C<false> |
|
1676
|
|
|
|
|
|
|
|
|
1677
|
|
|
|
|
|
|
No special case ordering. |
|
1678
|
|
|
|
|
|
|
|
|
1679
|
|
|
|
|
|
|
=back |
|
1680
|
|
|
|
|
|
|
|
|
1681
|
|
|
|
|
|
|
Setting the caseFirst value via the locale string |
|
1682
|
|
|
|
|
|
|
|
|
1683
|
|
|
|
|
|
|
In the L<Unicode locale string specifications|https://www.unicode.org/reports/tr35/>, the values that C<aseFirst> represents correspond to the attribute L<kf|Locale::Unicode/kf>. C<kf> is treated as a C<locale> string "extension subtag". These subtags add additional data about the C<locale>, and are added to C<locale> identifiers by using the C<-u> extension attribute. Thus, the C<caseFirst> value can be added to the initial C<locale> identifier string that is passed into the L<Locale|Locale::Unicode> constructor. To add the C<caseFirst> value, first add the C<-u> extension key to the string. Next, add the L<-kf|Locale::Unicode/kf> extension key to indicate that you are adding a value for C<caseFirst>. Finally, add the C<caseFirst> value to the string. |
|
1684
|
|
|
|
|
|
|
|
|
1685
|
|
|
|
|
|
|
my $locale = Locale::Intl->new( "fr-Latn-FR-u-kf-upper" ); |
|
1686
|
|
|
|
|
|
|
say $locale->caseFirst; # upper |
|
1687
|
|
|
|
|
|
|
|
|
1688
|
|
|
|
|
|
|
Setting the C<caseFirst> value via the optional hash or hash reference of options. |
|
1689
|
|
|
|
|
|
|
|
|
1690
|
|
|
|
|
|
|
The L<Locale::Intl> constructor takes an optional hash or hash reference of options, which can be used to pass extension types. Set the C<caseFirst> property of the configuration object to your desired C<caseFirst> value, and then pass it into the constructor. |
|
1691
|
|
|
|
|
|
|
|
|
1692
|
|
|
|
|
|
|
my $locale = Locale::Intl->new( "en-Latn-US", { caseFirst => "lower" }); |
|
1693
|
|
|
|
|
|
|
say $locale->caseFirst; # lower |
|
1694
|
|
|
|
|
|
|
|
|
1695
|
|
|
|
|
|
|
=head2 collation |
|
1696
|
|
|
|
|
|
|
|
|
1697
|
|
|
|
|
|
|
The C<collation> accessor property of L<Locale::Intl> instances returns the C<collation> type for this C<locale>, which is used to order strings according to the C<locale>'s rules. |
|
1698
|
|
|
|
|
|
|
|
|
1699
|
|
|
|
|
|
|
The C<collation> property's value is set at object instantiation time, either through the L<co|Locale::Unicode/co> attribute of the L<locale identifier|Locale::Unicode> or through the C<collation> option of the L<Locale::Intl> constructor. The latter takes priority if they are both present; and if neither is present, the property has value C<undef>. |
|
1700
|
|
|
|
|
|
|
|
|
1701
|
|
|
|
|
|
|
For a list of supported collation types, see L<getCollations()|Locale::Intl/getCollations>. |
|
1702
|
|
|
|
|
|
|
|
|
1703
|
|
|
|
|
|
|
For example: |
|
1704
|
|
|
|
|
|
|
|
|
1705
|
|
|
|
|
|
|
Adding a collation type via the locale string. |
|
1706
|
|
|
|
|
|
|
|
|
1707
|
|
|
|
|
|
|
In the L<Unicode locale string specifications|https://www.unicode.org/reports/tr35/>, C<collation> types are C<locale> attribute "extension subtags". These subtags add additional data about the C<locale>, and are added to L<locale identifiers|Locale::Unicode> by using the C<-u> extension. Thus, the L<collation|Locale::Unicode/collation> type can be added to the initial L<locale identifier|Locale::Unicode> string that is passed into the L<Locale::Intl> constructor. To add the C<collation> type, first add the C<-u> extension to the string. Next, add the C<-co> extension to indicate that you are adding a collation type. Finally, add the collation type to the string. |
|
1708
|
|
|
|
|
|
|
|
|
1709
|
|
|
|
|
|
|
my $locale = Locale::Intl->new( "zh-Hant-u-co-zhuyin" ); |
|
1710
|
|
|
|
|
|
|
say $locale->collation; # zhuyin |
|
1711
|
|
|
|
|
|
|
|
|
1712
|
|
|
|
|
|
|
Adding a collation type via the configuration object argument. |
|
1713
|
|
|
|
|
|
|
|
|
1714
|
|
|
|
|
|
|
The L<Locale::Intl> constructor has an optional hash or hash reference of options, which can contain any of several extension types, including C<collation> types. Set the C<collation> property of the configuration object to your desired C<collation> type, and then pass it into the constructor. |
|
1715
|
|
|
|
|
|
|
|
|
1716
|
|
|
|
|
|
|
my $locale = Locale::Intl->new( "zh-Hant", { collation => "zhuyin" }); |
|
1717
|
|
|
|
|
|
|
say $locale->collation; # zhuyin |
|
1718
|
|
|
|
|
|
|
|
|
1719
|
|
|
|
|
|
|
=head2 hourCycle |
|
1720
|
|
|
|
|
|
|
|
|
1721
|
|
|
|
|
|
|
The C<hourCycle> accessor property of L<Locale::Intl> instances returns the L<hour cycle|Locale::Unicode/hour_cycle> type for this L<locale identifier|Locale::Unicode>. |
|
1722
|
|
|
|
|
|
|
|
|
1723
|
|
|
|
|
|
|
There are 2 main types of time keeping conventions (clocks) used around the world: the 12 hour clock and the 24 hour clock. The C<hourCycle> property's value is set upon object instantiation, either through the L<hc|Locale::Unicode/hc> attribute of the L<locale identifier|Locale::Unicode> or through the C<hourCycle> option of the L<Locale::Intl> constructor. The latter takes priority if they are both present; and if neither is present, the property has value C<undef>. |
|
1724
|
|
|
|
|
|
|
|
|
1725
|
|
|
|
|
|
|
For a list of supported hour cycle types, see L<getHourCycles()|Locale::Intl/getHourCycles>. |
|
1726
|
|
|
|
|
|
|
|
|
1727
|
|
|
|
|
|
|
For example: |
|
1728
|
|
|
|
|
|
|
|
|
1729
|
|
|
|
|
|
|
Like other C<locale> subtags, the hour cycle type can be added to the L<Locale::Intl> object via the locale string, or an option upon object instantiation. |
|
1730
|
|
|
|
|
|
|
|
|
1731
|
|
|
|
|
|
|
Adding an hour cycle via the locale string |
|
1732
|
|
|
|
|
|
|
|
|
1733
|
|
|
|
|
|
|
In the L<Unicode locale string specifications|https://www.unicode.org/reports/tr35/>, L<hour cycle|Locale::Unicode/hour_cycle> types are locale attribute "extension subtags". These subtags add additional data about the C<locale>, and are added to L<locale identifiers|Locale::Unicode> by using the C<-u> extension. Thus, the hour cycle type can be added to the initial L<locale identifier|Locale::Unicode> string that is passed into the L<Locale::Intl> constructor. To add the L<hour cycle|Locale::Unicode/hour_cycle> type, first add the C<-u> extension key to the string. Next, add the C<-hc> extension to indicate that you are adding an hour cycle. Finally, add the hour cycle type to the string. |
|
1734
|
|
|
|
|
|
|
|
|
1735
|
|
|
|
|
|
|
my $locale = Locale::Intl->new( "fr-FR-u-hc-h23" ); |
|
1736
|
|
|
|
|
|
|
say $locale->hourCycle; # h23 |
|
1737
|
|
|
|
|
|
|
|
|
1738
|
|
|
|
|
|
|
Adding an hour cycle via the configuration object argument |
|
1739
|
|
|
|
|
|
|
|
|
1740
|
|
|
|
|
|
|
The L<Locale::Intl> constructor has an optional hash or hash reference of options, which can contain any of several extension types, including L<hour cycle|Locale::Unicode/hour_cycle> types. Set the C<hourCycle> property of the configuration object to your desired hour cycle type, and then pass it into the constructor. |
|
1741
|
|
|
|
|
|
|
|
|
1742
|
|
|
|
|
|
|
my $locale = Locale::Intl->new( "en-US", { hourCycle => "h12" }); |
|
1743
|
|
|
|
|
|
|
say $locale->hourCycle; # h12 |
|
1744
|
|
|
|
|
|
|
|
|
1745
|
|
|
|
|
|
|
=head2 language |
|
1746
|
|
|
|
|
|
|
|
|
1747
|
|
|
|
|
|
|
The C<language> accessor property of L<Locale::Intl> instances returns the C<language> associated with this C<locale>. |
|
1748
|
|
|
|
|
|
|
|
|
1749
|
|
|
|
|
|
|
Language is one of the core features of a C<locale>. The Unicode specification treats the C<language> identifier of a C<locale> as the C<language> and the C<region> together (to make a distinction between dialects and variations, e.g. British English vs. American English). However, the C<language> property of an L<Locale::Intl> object returns strictly the C<locale>'s C<language> subtag. This subtag can be a 2 or 3-characters code. |
|
1750
|
|
|
|
|
|
|
|
|
1751
|
|
|
|
|
|
|
For example: |
|
1752
|
|
|
|
|
|
|
|
|
1753
|
|
|
|
|
|
|
Setting the C<language> in the locale identifier string argument. |
|
1754
|
|
|
|
|
|
|
|
|
1755
|
|
|
|
|
|
|
In order to be a valid L<Unicode locale identifier|Locale::Unicode>, a string must start with the C<language> subtag. The main argument to the L<Locale::Intl> constructor must be a valid L<Unicode locale identifier|Locale::Unicode>, so whenever the constructor is used, it must be passed an identifier with a C<language> subtag. |
|
1756
|
|
|
|
|
|
|
|
|
1757
|
|
|
|
|
|
|
my $locale = Locale::Intl->new( "en-Latn-US" ); |
|
1758
|
|
|
|
|
|
|
say $locale->language; # en |
|
1759
|
|
|
|
|
|
|
|
|
1760
|
|
|
|
|
|
|
Overriding language via the configuration object. |
|
1761
|
|
|
|
|
|
|
|
|
1762
|
|
|
|
|
|
|
While the C<language> subtag must be specified, the L<Locale::Intl> constructor takes an hash or hash reference of options, which can override the C<language> subtag. |
|
1763
|
|
|
|
|
|
|
|
|
1764
|
|
|
|
|
|
|
my $locale = Locale::Intl->new( "en-Latn-US", { language => "es" }); |
|
1765
|
|
|
|
|
|
|
say $locale->language; # es |
|
1766
|
|
|
|
|
|
|
|
|
1767
|
|
|
|
|
|
|
=head2 numberingSystem |
|
1768
|
|
|
|
|
|
|
|
|
1769
|
|
|
|
|
|
|
The C<numberingSystem> accessor property of L<Locale::Intl> instances returns the numeral system for this C<locale>. |
|
1770
|
|
|
|
|
|
|
|
|
1771
|
|
|
|
|
|
|
A numeral system is a system for expressing numbers. The C<numberingSystem> property's value is set upon object instantiation, either through the L<nu|Locale::Unicode/nu> attribute of the L<locale identifier|Locale::Unicode> or through the C<numberingSystem> option of the L<Locale::Intl> constructor. The latter takes priority if they are both present; and if neither is present, the property has value C<undef>. |
|
1772
|
|
|
|
|
|
|
|
|
1773
|
|
|
|
|
|
|
For a list of supported numbering system types, see L<getNumberingSystems()|Locale::Intl/getNumberingSystems>. |
|
1774
|
|
|
|
|
|
|
|
|
1775
|
|
|
|
|
|
|
Adding a numbering system via the locale string. |
|
1776
|
|
|
|
|
|
|
|
|
1777
|
|
|
|
|
|
|
In the L<Unicode locale string specifications|https://www.unicode.org/reports/tr35/>, numbering system types are C<locale> attribute "extension subtags". These subtags add additional data about the C<locale>, and are added to C<locale> identifiers by using the C<-u> extension. Thus, the numbering system type can be added to the initial C<locale> identifier string that is passed into the L<Locale::Intl> constructor. To add the numbering system type, first add the C<-u> extension attribute to the string. Next, add the L<-nu|Locale::Unicode/nu> extension to indicate that you are adding a numbering system. Finally, add the numbering system type to the string. |
|
1778
|
|
|
|
|
|
|
|
|
1779
|
|
|
|
|
|
|
my $locale = Locale::Intl->new( "fr-Latn-FR-u-nu-mong" ); |
|
1780
|
|
|
|
|
|
|
say $locale->numberingSystem; # mong |
|
1781
|
|
|
|
|
|
|
|
|
1782
|
|
|
|
|
|
|
Adding a numbering system via the configuration object argument. |
|
1783
|
|
|
|
|
|
|
|
|
1784
|
|
|
|
|
|
|
The L<Locale::Intl> constructor has an optional hash or hash reference of options, which can contain any of several extension types, including numbering system types. Set the C<numberingSystem> property of the hash or hash reference of options to your desired numbering system type, and then pass it into the constructor. |
|
1785
|
|
|
|
|
|
|
|
|
1786
|
|
|
|
|
|
|
my $locale = Locale::Intl->new( "en-Latn-US", { numberingSystem => "latn" }); |
|
1787
|
|
|
|
|
|
|
say $locale->numberingSystem; # latn |
|
1788
|
|
|
|
|
|
|
|
|
1789
|
|
|
|
|
|
|
=head2 numeric |
|
1790
|
|
|
|
|
|
|
|
|
1791
|
|
|
|
|
|
|
The C<numeric> accessor property of L<Locale::Intl> instances returns a L<boolean object|Locale::Intl::Boolean> representing whether this C<locale> has special collation handling for C<numeric> characters. |
|
1792
|
|
|
|
|
|
|
|
|
1793
|
|
|
|
|
|
|
Like C<caseFirst>, C<numeric> represents a modification to the collation rules utilized by the locale. C<numeric> is a boolean value, which means that it can be either L<true|Locale::Intl::Boolean/true> or L<false|Locale::Intl::Boolean/false>. If C<numeric> is set to C<false>, there will be no special handling of C<numeric> values in strings. If C<numeric> is set to C<true>, then the C<locale> will take C<numeric> characters into account when collating strings. This special C<numeric> handling means that sequences of decimal digits will be compared as numbers. For example, the string C<A-21> will be considered less than C<A-123>. |
|
1794
|
|
|
|
|
|
|
|
|
1795
|
|
|
|
|
|
|
Example: |
|
1796
|
|
|
|
|
|
|
|
|
1797
|
|
|
|
|
|
|
Setting the numeric value via the locale string. |
|
1798
|
|
|
|
|
|
|
|
|
1799
|
|
|
|
|
|
|
In the L<Unicode locale string specifications|https://www.unicode.org/reports/tr35/>, the values that C<numeric> represents correspond to the attribute L<kn|Locale::Unicode/kn>. L<kn|Locale::Unicode/kn> is considered a L<locale|Locale::Unicode> string extension subtag". These subtags add additional data about the L<locale|Locale::Unicode>, and are added to L<locale identifiers|Locale::Unicode> by using the -u extension key. Thus, the C<numeric> value can be added to the initial L<locale identifier|Locale::Unicode> string that is passed into the L<Locale::Intl> constructor. To set the C<numeric> value, first add the C<-u> extension attribute to the string. Next, add the C<-kn> extension attribute to indicate that you are adding a value for C<numeric>. Finally, add the C<numeric> value to the string. If you want to set C<numeric> to true, adding the L<kn|Locale::Unicode/kn> attribute will suffice. To set the value to false, you must specify in by adding "false" after the L<kn|Locale::Unicode/kn> attribute. |
|
1800
|
|
|
|
|
|
|
|
|
1801
|
|
|
|
|
|
|
my $locale = Locale::Intl->new("fr-Latn-FR-u-kn-false"); |
|
1802
|
|
|
|
|
|
|
say $locale->numeric); # false |
|
1803
|
|
|
|
|
|
|
|
|
1804
|
|
|
|
|
|
|
Setting the numeric value via the configuration object argument. |
|
1805
|
|
|
|
|
|
|
|
|
1806
|
|
|
|
|
|
|
The L<Locale::Unicode> constructor has an optional hash or hash reference of options, which can be used to pass extension types. Set the C<numeric> property of the hash or hash reference of options to your desired C<numeric> value and pass it into the constructor. |
|
1807
|
|
|
|
|
|
|
|
|
1808
|
|
|
|
|
|
|
my $locale = Locale::Intl->new("en-Latn-US", { numeric => $true_value }); |
|
1809
|
|
|
|
|
|
|
say $locale->numeric; # true |
|
1810
|
|
|
|
|
|
|
|
|
1811
|
|
|
|
|
|
|
=head2 region |
|
1812
|
|
|
|
|
|
|
|
|
1813
|
|
|
|
|
|
|
The C<region> accessor property of L<Locale::Intl> instances returns the C<region> of the world (usually a country) associated with this C<locale>. This could be a L<country code|Locale::Unicode/country_code>, or a world region represented with a L<3-digits code|Locale::Unicode/region> |
|
1814
|
|
|
|
|
|
|
|
|
1815
|
|
|
|
|
|
|
The C<region> is an essential part of the L<locale identifier|Locale::Unicode>, as it places the C<locale> in a specific area of the world. Knowing the C<locale>'s region is vital to identifying differences between locales. For example, English is spoken in the United Kingdom and the United States of America, but there are differences in spelling and other C<language> conventions between those two countries. |
|
1816
|
|
|
|
|
|
|
|
|
1817
|
|
|
|
|
|
|
For example: |
|
1818
|
|
|
|
|
|
|
|
|
1819
|
|
|
|
|
|
|
Setting the region in the locale identifier string argument. |
|
1820
|
|
|
|
|
|
|
|
|
1821
|
|
|
|
|
|
|
The C<region> is the third part of a valid L<Unicode language identifier|Locale::Unicode> string, and can be set by adding it to the L<locale identifier|Locale::Unicode> string that is passed into the L<Locale::Intl> constructor. |
|
1822
|
|
|
|
|
|
|
|
|
1823
|
|
|
|
|
|
|
my $locale = Locale::Intl->new( "en-Latn-US" ); |
|
1824
|
|
|
|
|
|
|
say $locale->region; # US |
|
1825
|
|
|
|
|
|
|
|
|
1826
|
|
|
|
|
|
|
my $locale = Locale::Intl->new( "fr-Latn-150" ); |
|
1827
|
|
|
|
|
|
|
say $locale->region; # 150 |
|
1828
|
|
|
|
|
|
|
# 150 is the region code for Europe |
|
1829
|
|
|
|
|
|
|
|
|
1830
|
|
|
|
|
|
|
See the file C<territories.json> in the L<CLDR repository|https://github.com/unicode-org/cldr-json/tree/main/cldr-json/cldr-localenames-full> for the localised names of those territories. |
|
1831
|
|
|
|
|
|
|
|
|
1832
|
|
|
|
|
|
|
=head2 script |
|
1833
|
|
|
|
|
|
|
|
|
1834
|
|
|
|
|
|
|
The C<script> accessor property of L<Locale::Intl> instances returns the C<script> used for writing the particular C<language> used in this C<locale>. |
|
1835
|
|
|
|
|
|
|
|
|
1836
|
|
|
|
|
|
|
A C<script>, sometimes called writing system, is one of the core attributes of a L<locale|Locale::Unicode>. It indicates the set of symbols, or glyphs, that are used to write a particular C<language>. For instance, the C<script> associated with English is Latin (C<latn>), whereas the C<script> used to represent Japanese Katanaka is C<Kana> and the one typically associated with Korean is Hangul (C<Hang>). In many cases, denoting a C<script> is not strictly necessary, since the language (which is necessary) is only written in a single C<script>. There are exceptions to this rule, however, and it is important to indicate the C<script> whenever possible, in order to have a complete L<Unicode language identifier|Locale::Unicode>. |
|
1837
|
|
|
|
|
|
|
|
|
1838
|
|
|
|
|
|
|
For example: |
|
1839
|
|
|
|
|
|
|
|
|
1840
|
|
|
|
|
|
|
Setting the script in the locale identifier string argument. |
|
1841
|
|
|
|
|
|
|
|
|
1842
|
|
|
|
|
|
|
The C<script> is the second part of a valid L<Unicode language identifier|Locale::Unicode> string, and can be set by adding it to the L<locale identifier|Locale::Unicode> string that is passed into the L<Locale::Intl> constructor. Note that the C<script> is not a required part of a L<locale identifier|Locale::Unicode>. |
|
1843
|
|
|
|
|
|
|
|
|
1844
|
|
|
|
|
|
|
my $locale = Locale::Intl->new( "en-Latn-US" ); |
|
1845
|
|
|
|
|
|
|
say $locale->script); # Latn |
|
1846
|
|
|
|
|
|
|
|
|
1847
|
|
|
|
|
|
|
Setting the C<script> via the hash or hash reference of options. |
|
1848
|
|
|
|
|
|
|
|
|
1849
|
|
|
|
|
|
|
The L<Locale::Intl> constructor takes an hash or hash reference of options, which can be used to set the C<script> subtag and property. |
|
1850
|
|
|
|
|
|
|
|
|
1851
|
|
|
|
|
|
|
my $locale = Locale::Intl->new("fr-FR", { script => "Latn" }); |
|
1852
|
|
|
|
|
|
|
say $locale; # fr-Latn-FR |
|
1853
|
|
|
|
|
|
|
say $locale->script; # Latn |
|
1854
|
|
|
|
|
|
|
|
|
1855
|
|
|
|
|
|
|
=head1 OVERLOADING |
|
1856
|
|
|
|
|
|
|
|
|
1857
|
|
|
|
|
|
|
Instances of L<Locale::Intl> have the stringification overloaded as inherited from L<Locale::Unicode> |
|
1858
|
|
|
|
|
|
|
|
|
1859
|
|
|
|
|
|
|
=head1 AUTHOR |
|
1860
|
|
|
|
|
|
|
|
|
1861
|
|
|
|
|
|
|
Jacques Deguest E<lt>F<jack@deguest.jp>E<gt> |
|
1862
|
|
|
|
|
|
|
|
|
1863
|
|
|
|
|
|
|
=head1 SEE ALSO |
|
1864
|
|
|
|
|
|
|
|
|
1865
|
|
|
|
|
|
|
L<DateTime::Format::Intl> |
|
1866
|
|
|
|
|
|
|
|
|
1867
|
|
|
|
|
|
|
=head1 CREDITS |
|
1868
|
|
|
|
|
|
|
|
|
1869
|
|
|
|
|
|
|
Credits to Mozilla for L<parts of their documentation|https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Intl/Locale> I copied here. |
|
1870
|
|
|
|
|
|
|
|
|
1871
|
|
|
|
|
|
|
=head1 COPYRIGHT & LICENSE |
|
1872
|
|
|
|
|
|
|
|
|
1873
|
|
|
|
|
|
|
Copyright(c) 2024 DEGUEST Pte. Ltd. |
|
1874
|
|
|
|
|
|
|
|
|
1875
|
|
|
|
|
|
|
All rights reserved |
|
1876
|
|
|
|
|
|
|
|
|
1877
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. |
|
1878
|
|
|
|
|
|
|
|
|
1879
|
|
|
|
|
|
|
=cut |