line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# $Id: Locale.pm 30361 2009-02-20 08:13:39Z tokuhirom $ |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
package DateTimeX::Lite::Locale; |
4
|
62
|
|
|
62
|
|
213718
|
use strict; |
|
62
|
|
|
|
|
139
|
|
|
62
|
|
|
|
|
8313
|
|
5
|
62
|
|
|
62
|
|
345
|
use warnings; |
|
62
|
|
|
|
|
183
|
|
|
62
|
|
|
|
|
2509
|
|
6
|
62
|
|
|
62
|
|
22330
|
use File::ShareDir qw(dist_file); |
|
62
|
|
|
|
|
191519
|
|
|
62
|
|
|
|
|
4134
|
|
7
|
62
|
|
|
62
|
|
458
|
use File::Spec; |
|
62
|
|
|
|
|
135
|
|
|
62
|
|
|
|
|
1607
|
|
8
|
62
|
|
|
62
|
|
342
|
use Carp (); |
|
62
|
|
|
|
|
275
|
|
|
62
|
|
|
|
|
35286
|
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
our %CachedLocales; |
11
|
|
|
|
|
|
|
our %Aliases; |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
{ |
14
|
|
|
|
|
|
|
my $db = dist_file('DateTimeX-Lite', 'DateTimeX/Lite/Locale/Aliases.dat'); |
15
|
|
|
|
|
|
|
my $aliases = do $db |
16
|
|
|
|
|
|
|
or die "cannot load alias database"; |
17
|
|
|
|
|
|
|
%Aliases = %$aliases; |
18
|
|
|
|
|
|
|
} |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
sub _load_locale { |
21
|
508
|
|
|
508
|
|
1894
|
my $name = shift; |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
# XXX - original comment as follows: |
24
|
|
|
|
|
|
|
# Support RFC 3066 language tags, which use '-' instead of '_' |
25
|
508
|
|
|
|
|
2172
|
$name =~ tr/-/_/; |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
# Strip off charset for LC_* ids : en_GB.UTF-8 etc |
28
|
508
|
|
|
|
|
1673
|
$name =~ s/\..*$//; |
29
|
|
|
|
|
|
|
|
30
|
508
|
|
|
|
|
1189
|
my $original = $name; |
31
|
508
|
|
|
|
|
2826
|
while (exists $Aliases{$name}) { |
32
|
10
|
|
|
|
|
37
|
$name = $Aliases{$name}; |
33
|
|
|
|
|
|
|
} |
34
|
|
|
|
|
|
|
|
35
|
508
|
|
|
|
|
2213
|
my ($language, $script, $territory, $variant ) = _parse_id($name); |
36
|
|
|
|
|
|
|
|
37
|
508
|
|
|
|
|
1168
|
my @guesses; |
38
|
|
|
|
|
|
|
|
39
|
508
|
100
|
|
|
|
1682
|
if ( defined $script ) |
40
|
|
|
|
|
|
|
{ |
41
|
61
|
|
|
|
|
416
|
my $guess = join '_', lc $language, ucfirst lc $script; |
42
|
|
|
|
|
|
|
|
43
|
61
|
|
|
|
|
170
|
push @guesses, $guess; |
44
|
|
|
|
|
|
|
|
45
|
61
|
100
|
|
|
|
303
|
$guess .= '_' . uc $territory if defined $territory; |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
# version with script comes first |
48
|
61
|
|
|
|
|
241
|
unshift @guesses, $guess; |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
|
51
|
508
|
100
|
|
|
|
1590
|
if ( defined $variant ) |
52
|
|
|
|
|
|
|
{ |
53
|
5
|
|
|
|
|
29
|
push @guesses, |
54
|
|
|
|
|
|
|
join '_', lc $language, uc $territory, uc $variant; |
55
|
|
|
|
|
|
|
} |
56
|
|
|
|
|
|
|
|
57
|
508
|
100
|
|
|
|
1770
|
if ( defined $territory ) |
58
|
|
|
|
|
|
|
{ |
59
|
333
|
|
|
|
|
1904
|
push @guesses, |
60
|
|
|
|
|
|
|
join '_', lc $language, uc $territory; |
61
|
|
|
|
|
|
|
} |
62
|
|
|
|
|
|
|
|
63
|
508
|
|
|
|
|
1725
|
push @guesses, lc $language; |
64
|
|
|
|
|
|
|
|
65
|
508
|
|
|
|
|
1712
|
foreach my $id (@guesses) { |
66
|
508
|
|
|
|
|
801
|
my $h; |
67
|
508
|
|
|
|
|
1713332
|
$h = do "DateTimeX/Lite/Locale/$id.dat"; |
68
|
508
|
100
|
66
|
|
|
29512
|
if (! $@ && $h) { |
69
|
506
|
100
|
|
|
|
2347
|
$h->{id} = $original if $original ne $name; |
70
|
506
|
|
|
|
|
2638
|
return $h; |
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
} |
73
|
2
|
|
|
|
|
11
|
return (); |
74
|
|
|
|
|
|
|
} |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
sub load { |
77
|
4828
|
|
|
4828
|
0
|
320613
|
my ($class, $name) = @_; |
78
|
|
|
|
|
|
|
|
79
|
4828
|
100
|
|
|
|
29610
|
return $CachedLocales{$name} if $CachedLocales{$name}; |
80
|
|
|
|
|
|
|
|
81
|
508
|
|
|
|
|
16952
|
my $conf = _load_locale($name); |
82
|
508
|
100
|
|
|
|
2342
|
if (! $conf) { |
83
|
2
|
|
|
|
|
682
|
Carp::croak("Invalid locale name or id: locale $name not found"); |
84
|
|
|
|
|
|
|
} |
85
|
506
|
|
|
|
|
10798
|
return $CachedLocales{$name} = $class->new(%$conf); |
86
|
|
|
|
|
|
|
} |
87
|
|
|
|
|
|
|
|
88
|
62
|
|
|
62
|
|
87671
|
use List::MoreUtils (); |
|
62
|
|
|
|
|
737735
|
|
|
62
|
|
|
|
|
6611
|
|
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
BEGIN |
91
|
|
|
|
|
|
|
{ |
92
|
62
|
|
|
62
|
|
287
|
foreach my $field ( qw( id en_complete_name native_complete_name |
93
|
|
|
|
|
|
|
en_language en_script en_territory en_variant |
94
|
|
|
|
|
|
|
native_language native_script native_territory native_variant |
95
|
|
|
|
|
|
|
) |
96
|
|
|
|
|
|
|
) |
97
|
|
|
|
|
|
|
{ |
98
|
|
|
|
|
|
|
# remove leading 'en_' for method name |
99
|
682
|
|
|
|
|
1766
|
(my $meth_name = $field) =~ s/^en_//; |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
# also remove 'complete_' |
102
|
682
|
|
|
|
|
1189
|
$meth_name =~ s/complete_//; |
103
|
|
|
|
|
|
|
|
104
|
62
|
|
|
62
|
|
473
|
no strict 'refs'; |
|
62
|
|
|
|
|
129
|
|
|
62
|
|
|
|
|
4040
|
|
105
|
682
|
|
|
9606
|
|
2222
|
*{$meth_name} = sub { $_[0]->{$field} } } |
|
682
|
|
|
|
|
95094
|
|
|
9606
|
|
|
|
|
575842
|
|
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
sub new |
109
|
|
|
|
|
|
|
{ |
110
|
506
|
|
|
506
|
0
|
2109
|
my $class = shift; |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
# By making the default format lengths part of the object's hash |
113
|
|
|
|
|
|
|
# key, it allows them to be settable. |
114
|
506
|
|
|
|
|
14655
|
my $self = bless { @_, |
115
|
|
|
|
|
|
|
default_date_format_length => 'medium', |
116
|
|
|
|
|
|
|
default_time_format_length => 'medium', |
117
|
|
|
|
|
|
|
}, $class; |
118
|
|
|
|
|
|
|
|
119
|
506
|
100
|
|
|
|
5468
|
$self->{native_language} = $self->{en_language} |
120
|
|
|
|
|
|
|
unless exists $self->{native_language}; |
121
|
|
|
|
|
|
|
|
122
|
506
|
|
|
|
|
1145
|
my @en_pieces; |
123
|
|
|
|
|
|
|
my @native_pieces; |
124
|
506
|
|
|
|
|
3073
|
foreach my $p ( qw( language script territory variant ) ) |
125
|
|
|
|
|
|
|
{ |
126
|
2024
|
100
|
|
|
|
13631
|
push @en_pieces, $self->{"en_$p"} if exists $self->{"en_$p"}; |
127
|
2024
|
100
|
|
|
|
8028
|
push @native_pieces, $self->{"native_$p"} if exists $self->{"native_$p"}; |
128
|
|
|
|
|
|
|
} |
129
|
|
|
|
|
|
|
|
130
|
506
|
|
|
|
|
3255
|
$self->{en_complete_name} = join ' ', @en_pieces; |
131
|
506
|
|
|
|
|
2318
|
$self->{native_complete_name} = join ' ', @native_pieces; |
132
|
|
|
|
|
|
|
|
133
|
506
|
|
|
|
|
4011
|
return $self; |
134
|
|
|
|
|
|
|
} |
135
|
|
|
|
|
|
|
|
136
|
3
|
|
|
3
|
0
|
26
|
sub language_id { ( DateTimeX::Lite::Locale::_parse_id( $_[0]->id ) )[0] } |
137
|
1
|
|
|
1
|
0
|
6
|
sub script_id { ( DateTimeX::Lite::Locale::_parse_id( $_[0]->id ) )[1] } |
138
|
4
|
|
|
4
|
0
|
193
|
sub territory_id { ( DateTimeX::Lite::Locale::_parse_id( $_[0]->id ) )[2] } |
139
|
3
|
|
|
3
|
0
|
23
|
sub variant_id { ( DateTimeX::Lite::Locale::_parse_id( $_[0]->id ) )[3] } |
140
|
|
|
|
|
|
|
sub _parse_id |
141
|
|
|
|
|
|
|
{ |
142
|
519
|
|
|
519
|
|
3647
|
$_[0] =~ /([a-z]+) # id |
143
|
|
|
|
|
|
|
(?: _([A-Z][a-z]+) )? # script - Title Case - optional |
144
|
|
|
|
|
|
|
(?: _([A-Z]+) )? # territory - ALL CAPS - optional |
145
|
|
|
|
|
|
|
(?: _([A-Z]+) )? # variant - ALL CAPS - optional |
146
|
|
|
|
|
|
|
/x; |
147
|
|
|
|
|
|
|
|
148
|
519
|
|
|
|
|
3947
|
return $1, $2, $3, $4; |
149
|
|
|
|
|
|
|
} |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
my @FormatLengths = qw( short medium long full ); |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
sub date_format_default { |
155
|
3
|
|
|
3
|
0
|
15
|
my $default = $_[0]->default_date_format_length(); |
156
|
3
|
50
|
|
|
|
14
|
if (! $default) { |
157
|
0
|
|
|
|
|
0
|
die sprintf("DateTimeX::Lite::Locale %s did not return a proper value from default_date_format_length()", $_[0]->{id}); |
158
|
|
|
|
|
|
|
} |
159
|
3
|
|
|
|
|
10
|
my $meth = "date_format_$default"; |
160
|
3
|
|
|
|
|
20
|
$_[0]->$meth(); |
161
|
|
|
|
|
|
|
} |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
sub date_formats |
164
|
|
|
|
|
|
|
{ |
165
|
|
|
|
|
|
|
return |
166
|
448
|
|
|
448
|
0
|
1901
|
{ map { my $meth = 'date_format_' . $_; |
|
1792
|
|
|
|
|
3964
|
|
167
|
1792
|
|
|
|
|
7362
|
$_ => $_[0]->$meth() } @FormatLengths } |
168
|
|
|
|
|
|
|
} |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
sub time_format_default |
171
|
|
|
|
|
|
|
{ |
172
|
3
|
|
|
3
|
0
|
16
|
my $default = $_[0]->default_time_format_length(); |
173
|
3
|
50
|
|
|
|
12
|
if (! $default) { |
174
|
0
|
|
|
|
|
0
|
die sprintf("DateTimeX::Lite::Locale %s did not return a proper value from default_time_format_length()", $_[0]->{name}); |
175
|
|
|
|
|
|
|
} |
176
|
3
|
|
|
|
|
11
|
my $meth = "time_format_$default"; |
177
|
3
|
|
|
|
|
17
|
$_[0]->$meth(); |
178
|
|
|
|
|
|
|
} |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
sub time_formats |
181
|
|
|
|
|
|
|
{ |
182
|
|
|
|
|
|
|
return |
183
|
448
|
|
|
448
|
0
|
1211
|
{ map { my $meth = 'time_format_' . $_; |
|
1792
|
|
|
|
|
3696
|
|
184
|
1792
|
|
|
|
|
17533
|
$_ => $_[0]->$meth() } @FormatLengths } |
185
|
|
|
|
|
|
|
} |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
sub format_for |
188
|
|
|
|
|
|
|
{ |
189
|
44
|
|
|
44
|
0
|
1327
|
my $self = shift; |
190
|
44
|
|
|
|
|
50
|
my $for = shift; |
191
|
|
|
|
|
|
|
|
192
|
44
|
|
|
|
|
92
|
my $meth = '_format_for_' . $for; |
193
|
|
|
|
|
|
|
|
194
|
44
|
50
|
|
|
|
198
|
return unless $self->can($meth); |
195
|
|
|
|
|
|
|
|
196
|
44
|
|
|
|
|
140
|
return $self->$meth(); |
197
|
|
|
|
|
|
|
} |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
sub available_formats |
200
|
|
|
|
|
|
|
{ |
201
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
# The various parens seem to be necessary to force uniq() to see |
204
|
|
|
|
|
|
|
# the caller's list context. Go figure. |
205
|
0
|
0
|
|
|
|
0
|
my @uniq = List::MoreUtils::uniq( map { keys %{ $_->_available_formats() || {} } } |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
206
|
|
|
|
|
|
|
Class::ISA::self_and_super_path( ref $self ) |
207
|
|
|
|
|
|
|
); |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
# Doing the sort in the same expression doesn't work under 5.6.x. |
210
|
0
|
|
|
|
|
0
|
return sort @uniq; |
211
|
|
|
|
|
|
|
} |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
# Just needed for the above method. |
214
|
0
|
|
|
0
|
|
0
|
sub _available_formats { } |
215
|
|
|
|
|
|
|
|
216
|
8
|
|
|
8
|
0
|
56
|
sub default_date_format_length { $_[0]->{default_date_format_length} } |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
sub set_default_date_format_length |
219
|
|
|
|
|
|
|
{ |
220
|
1
|
|
|
1
|
0
|
4
|
my ($self, $l) = @_; |
221
|
1
|
50
|
|
|
|
10
|
die unless $l =~ /^(?:full|long|medium|short)$/i; |
222
|
|
|
|
|
|
|
|
223
|
1
|
|
|
|
|
5
|
$self->{default_date_format_length} = lc $l; |
224
|
|
|
|
|
|
|
} |
225
|
|
|
|
|
|
|
|
226
|
8
|
|
|
8
|
0
|
33
|
sub default_time_format_length { $_[0]->{default_time_format_length} } |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
sub set_default_time_format_length |
229
|
|
|
|
|
|
|
{ |
230
|
1
|
|
|
1
|
0
|
3
|
my ($self, $l) = @_; |
231
|
1
|
50
|
|
|
|
48
|
die unless $l =~ /^(?:full|long|medium|short)$/i; |
232
|
|
|
|
|
|
|
|
233
|
1
|
|
|
|
|
6
|
$self->{default_time_format_length} = lc $l; |
234
|
|
|
|
|
|
|
} |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
for my $length ( qw( full long medium short ) ) |
237
|
|
|
|
|
|
|
{ |
238
|
|
|
|
|
|
|
my $key = 'datetime_format_' . $length; |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
my $sub = |
241
|
4
|
|
|
4
|
|
38
|
sub { my $self = shift; |
242
|
|
|
|
|
|
|
|
243
|
4
|
50
|
|
|
|
16
|
return $self->{$key} if exists $self->{$key}; |
244
|
|
|
|
|
|
|
|
245
|
4
|
|
|
|
|
11
|
my $date_meth = 'date_format_' . $length; |
246
|
4
|
|
|
|
|
9
|
my $time_meth = 'time_format_' . $length; |
247
|
|
|
|
|
|
|
|
248
|
4
|
|
|
|
|
14
|
return $self->{$key} = $self->_make_datetime_format( $date_meth, $time_meth ); |
249
|
|
|
|
|
|
|
}; |
250
|
|
|
|
|
|
|
|
251
|
62
|
|
|
62
|
|
513
|
no strict 'refs'; |
|
62
|
|
|
|
|
384
|
|
|
62
|
|
|
|
|
120896
|
|
252
|
|
|
|
|
|
|
*{$key} = $sub; |
253
|
|
|
|
|
|
|
} |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
sub datetime_format_default |
256
|
|
|
|
|
|
|
{ |
257
|
3
|
|
|
3
|
0
|
24
|
my $self = shift; |
258
|
|
|
|
|
|
|
|
259
|
3
|
|
|
|
|
14
|
my $date_meth = 'date_format_' . $self->default_date_format_length(); |
260
|
3
|
|
|
|
|
14
|
my $time_meth = 'time_format_' . $self->default_time_format_length(); |
261
|
|
|
|
|
|
|
|
262
|
3
|
|
|
|
|
14
|
return $self->_make_datetime_format( $date_meth, $time_meth ); |
263
|
|
|
|
|
|
|
} |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
sub _make_datetime_format |
266
|
|
|
|
|
|
|
{ |
267
|
7
|
|
|
7
|
|
11
|
my $self = shift; |
268
|
7
|
|
|
|
|
18
|
my $date_meth = shift; |
269
|
7
|
|
|
|
|
15
|
my $time_meth = shift; |
270
|
|
|
|
|
|
|
|
271
|
7
|
|
|
|
|
23
|
my $dt_format = $self->datetime_format(); |
272
|
|
|
|
|
|
|
|
273
|
7
|
|
|
|
|
30
|
my $time = $self->$time_meth(); |
274
|
7
|
|
|
|
|
66
|
my $date = $self->$date_meth(); |
275
|
|
|
|
|
|
|
|
276
|
7
|
|
|
|
|
32
|
$dt_format =~ s/\{0\}/$time/g; |
277
|
7
|
|
|
|
|
25
|
$dt_format =~ s/\{1\}/$date/g; |
278
|
|
|
|
|
|
|
|
279
|
7
|
|
|
|
|
44
|
return $dt_format; |
280
|
|
|
|
|
|
|
} |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
sub prefers_24_hour_time |
283
|
|
|
|
|
|
|
{ |
284
|
3
|
|
|
3
|
0
|
17
|
my $self = shift; |
285
|
|
|
|
|
|
|
|
286
|
3
|
100
|
|
|
|
21
|
return $self->{prefers_24_hour_time} |
287
|
|
|
|
|
|
|
if exists $self->{prefers_24_hour_time}; |
288
|
|
|
|
|
|
|
|
289
|
2
|
100
|
|
|
|
11
|
$self->{prefers_24_hour_time} = |
290
|
|
|
|
|
|
|
$self->time_format_short() =~ /h|K/ ? 0 : 1; |
291
|
|
|
|
|
|
|
} |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
sub date_before_time |
294
|
|
|
|
|
|
|
{ |
295
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
296
|
|
|
|
|
|
|
|
297
|
0
|
|
|
|
|
0
|
my $dt_format = $self->datetime_format(); |
298
|
|
|
|
|
|
|
|
299
|
0
|
0
|
|
|
|
0
|
return $dt_format =~ /\{1\}.*\{0\}/ ? 1 : 0; |
300
|
|
|
|
|
|
|
} |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
sub date_parts_order |
303
|
|
|
|
|
|
|
{ |
304
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
305
|
|
|
|
|
|
|
|
306
|
0
|
|
|
|
|
0
|
my $short = $self->date_format_short(); |
307
|
|
|
|
|
|
|
|
308
|
0
|
|
|
|
|
0
|
$short =~ tr{dmyDMY}{}cd; |
309
|
0
|
|
|
|
|
0
|
$short =~ tr{dmyDMY}{dmydmy}s; |
310
|
|
|
|
|
|
|
|
311
|
0
|
|
|
|
|
0
|
return $short; |
312
|
|
|
|
|
|
|
} |
313
|
|
|
|
|
|
|
|
314
|
0
|
|
|
0
|
0
|
0
|
sub full_date_format { $_[0]->_convert_to_strftime( $_[0]->date_format_full() ) } |
315
|
0
|
|
|
0
|
0
|
0
|
sub long_date_format { $_[0]->_convert_to_strftime( $_[0]->date_format_long() ) } |
316
|
0
|
|
|
0
|
0
|
0
|
sub medium_date_format { $_[0]->_convert_to_strftime( $_[0]->date_format_medium() ) } |
317
|
0
|
|
|
0
|
0
|
0
|
sub short_date_format { $_[0]->_convert_to_strftime( $_[0]->date_format_short() ) } |
318
|
0
|
|
|
0
|
0
|
0
|
sub default_date_format { $_[0]->_convert_to_strftime( $_[0]->date_format_default() ) } |
319
|
|
|
|
|
|
|
|
320
|
0
|
|
|
0
|
0
|
0
|
sub full_time_format { $_[0]->_convert_to_strftime( $_[0]->time_format_full() ) } |
321
|
0
|
|
|
0
|
0
|
0
|
sub long_time_format { $_[0]->_convert_to_strftime( $_[0]->time_format_long() ) } |
322
|
0
|
|
|
0
|
0
|
0
|
sub medium_time_format { $_[0]->_convert_to_strftime( $_[0]->time_format_medium() ) } |
323
|
0
|
|
|
0
|
0
|
0
|
sub short_time_format { $_[0]->_convert_to_strftime( $_[0]->time_format_short() ) } |
324
|
0
|
|
|
0
|
0
|
0
|
sub default_time_format { $_[0]->_convert_to_strftime( $_[0]->time_format_default() ) } |
325
|
|
|
|
|
|
|
|
326
|
0
|
|
|
0
|
0
|
0
|
sub full_datetime_format { $_[0]->_convert_to_strftime( $_[0]->datetime_format_full() ) } |
327
|
0
|
|
|
0
|
0
|
0
|
sub long_datetime_format { $_[0]->_convert_to_strftime( $_[0]->datetime_format_long() ) } |
328
|
0
|
|
|
0
|
0
|
0
|
sub medium_datetime_format { $_[0]->_convert_to_strftime( $_[0]->datetime_format_medium() ) } |
329
|
0
|
|
|
0
|
0
|
0
|
sub short_datetime_format { $_[0]->_convert_to_strftime( $_[0]->datetime_format_short() ) } |
330
|
0
|
|
|
0
|
0
|
0
|
sub default_datetime_format { $_[0]->_convert_to_strftime( $_[0]->datetime_format_default() ) } |
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
# Older versions of DateTime.pm will not pass in the $cldr_ok flag, so |
333
|
|
|
|
|
|
|
# we will give them the converted-to-strftime pattern (bugs and all). |
334
|
|
|
|
|
|
|
sub _convert_to_strftime |
335
|
|
|
|
|
|
|
{ |
336
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
337
|
0
|
|
|
|
|
0
|
my $pattern = shift; |
338
|
0
|
|
|
|
|
0
|
my $cldr_ok = shift; |
339
|
|
|
|
|
|
|
|
340
|
0
|
0
|
|
|
|
0
|
return $pattern if $cldr_ok; |
341
|
|
|
|
|
|
|
|
342
|
0
|
0
|
|
|
|
0
|
return $self->{_converted_patterns}{$pattern} |
343
|
|
|
|
|
|
|
if exists $self->{_converted_patterns}{$pattern}; |
344
|
|
|
|
|
|
|
|
345
|
0
|
|
|
|
|
0
|
return $self->{_converted_patterns}{$pattern} = $self->_cldr_to_strftime($pattern); |
346
|
|
|
|
|
|
|
} |
347
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
{ |
349
|
|
|
|
|
|
|
my @JavaPatterns = |
350
|
|
|
|
|
|
|
( qr/G/ => '{era}', |
351
|
|
|
|
|
|
|
qr/yyyy/ => '{ce_year}', |
352
|
|
|
|
|
|
|
qr/y/ => 'y', |
353
|
|
|
|
|
|
|
qr/u/ => 'Y', |
354
|
|
|
|
|
|
|
qr/MMMM/ => 'B', |
355
|
|
|
|
|
|
|
qr/MMM/ => 'b', |
356
|
|
|
|
|
|
|
qr/MM/ => 'm', |
357
|
|
|
|
|
|
|
qr/M/ => '{month}', |
358
|
|
|
|
|
|
|
qr/dd/ => 'd', |
359
|
|
|
|
|
|
|
qr/d/ => '{day}', |
360
|
|
|
|
|
|
|
qr/hh/ => 'l', |
361
|
|
|
|
|
|
|
qr/h/ => '{hour_12}', |
362
|
|
|
|
|
|
|
qr/HH/ => 'H', |
363
|
|
|
|
|
|
|
qr/H/ => '{hour}', |
364
|
|
|
|
|
|
|
qr/mm/ => 'M', |
365
|
|
|
|
|
|
|
qr/m/ => '{minute}', |
366
|
|
|
|
|
|
|
qr/ss/ => 'S', |
367
|
|
|
|
|
|
|
qr/s/ => '{second}', |
368
|
|
|
|
|
|
|
qr/S/ => 'N', |
369
|
|
|
|
|
|
|
qr/EEEE/ => 'A', |
370
|
|
|
|
|
|
|
qr/E/ => 'a', |
371
|
|
|
|
|
|
|
qr/D/ => 'j', |
372
|
|
|
|
|
|
|
qr/F/ => '{weekday_of_month}', |
373
|
|
|
|
|
|
|
qr/w/ => 'V', |
374
|
|
|
|
|
|
|
qr/W/ => '{week_month}', |
375
|
|
|
|
|
|
|
qr/a/ => 'p', |
376
|
|
|
|
|
|
|
qr/k/ => '{hour_1}', |
377
|
|
|
|
|
|
|
qr/K/ => '{hour_12_0}', |
378
|
|
|
|
|
|
|
qr/z/ => '{time_zone_long_name}', |
379
|
|
|
|
|
|
|
); |
380
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
sub _cldr_to_strftime |
382
|
|
|
|
|
|
|
{ |
383
|
0
|
|
|
0
|
|
0
|
shift; |
384
|
0
|
|
|
|
|
0
|
my $simple = shift; |
385
|
|
|
|
|
|
|
|
386
|
0
|
|
|
|
|
0
|
$simple =~ |
387
|
|
|
|
|
|
|
s/(G+|y+|u+|M+|d+|h+|H+|m+|s+|S+|E+|D+|F+|w+|W+|a+|k+|K+|z+)|'((?:[^']|'')*)'/ |
388
|
0
|
0
|
|
|
|
0
|
$2 ? _stringify($2) : $1 ? _convert($1) : "'"/eg; |
|
|
0
|
|
|
|
|
|
389
|
|
|
|
|
|
|
|
390
|
0
|
|
|
|
|
0
|
return $simple; |
391
|
|
|
|
|
|
|
} |
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
sub _convert |
394
|
|
|
|
|
|
|
{ |
395
|
0
|
|
|
0
|
|
0
|
my $simple = shift; |
396
|
|
|
|
|
|
|
|
397
|
0
|
|
|
|
|
0
|
for ( my $x = 0; $x < @JavaPatterns; $x += 2 ) |
398
|
|
|
|
|
|
|
{ |
399
|
0
|
0
|
|
|
|
0
|
return '%' . $JavaPatterns[ $x + 1 ] if $simple =~ /$JavaPatterns[$x]/; |
400
|
|
|
|
|
|
|
} |
401
|
|
|
|
|
|
|
|
402
|
0
|
|
|
|
|
0
|
die "**Dont know $simple***"; |
403
|
|
|
|
|
|
|
} |
404
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
sub _stringify |
406
|
|
|
|
|
|
|
{ |
407
|
0
|
|
|
0
|
|
0
|
my $string = shift; |
408
|
|
|
|
|
|
|
|
409
|
0
|
|
|
|
|
0
|
$string =~ s/%(?:[^%])/%%/g; |
410
|
0
|
|
|
|
|
0
|
$string =~ s/\'\'/\'/g; |
411
|
|
|
|
|
|
|
|
412
|
0
|
|
|
|
|
0
|
return $string; |
413
|
|
|
|
|
|
|
} |
414
|
|
|
|
|
|
|
} |
415
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
foreach my $field (qw( |
417
|
|
|
|
|
|
|
am_pm_abbreviated |
418
|
|
|
|
|
|
|
date_format_full |
419
|
|
|
|
|
|
|
date_format_long |
420
|
|
|
|
|
|
|
date_format_medium |
421
|
|
|
|
|
|
|
date_format_short |
422
|
|
|
|
|
|
|
datetime_format |
423
|
|
|
|
|
|
|
day_format_abbreviated |
424
|
|
|
|
|
|
|
day_format_narrow |
425
|
|
|
|
|
|
|
day_format_wide |
426
|
|
|
|
|
|
|
day_stand_alone_abbreviated |
427
|
|
|
|
|
|
|
day_stand_alone_narrow |
428
|
|
|
|
|
|
|
day_stand_alone_wide |
429
|
|
|
|
|
|
|
era_abbreviated |
430
|
|
|
|
|
|
|
era_narrow |
431
|
|
|
|
|
|
|
era_wide |
432
|
|
|
|
|
|
|
first_day_of_week |
433
|
|
|
|
|
|
|
month_format_abbreviated |
434
|
|
|
|
|
|
|
month_format_narrow |
435
|
|
|
|
|
|
|
month_format_wide |
436
|
|
|
|
|
|
|
month_stand_alone_abbreviated |
437
|
|
|
|
|
|
|
month_stand_alone_narrow |
438
|
|
|
|
|
|
|
month_stand_alone_wide |
439
|
|
|
|
|
|
|
quarter_format_abbreviated |
440
|
|
|
|
|
|
|
quarter_format_narrow |
441
|
|
|
|
|
|
|
quarter_format_wide |
442
|
|
|
|
|
|
|
quarter_stand_alone_abbreviated |
443
|
|
|
|
|
|
|
quarter_stand_alone_narrow |
444
|
|
|
|
|
|
|
quarter_stand_alone_wide |
445
|
|
|
|
|
|
|
time_format_full |
446
|
|
|
|
|
|
|
time_format_long |
447
|
|
|
|
|
|
|
time_format_medium |
448
|
|
|
|
|
|
|
time_format_short |
449
|
|
|
|
|
|
|
_format_for_Hm |
450
|
|
|
|
|
|
|
_format_for_Hms |
451
|
|
|
|
|
|
|
_format_for_M |
452
|
|
|
|
|
|
|
_format_for_MEd |
453
|
|
|
|
|
|
|
_format_for_MMM |
454
|
|
|
|
|
|
|
_format_for_MMMEd |
455
|
|
|
|
|
|
|
_format_for_MMMMEd |
456
|
|
|
|
|
|
|
_format_for_MMMMd |
457
|
|
|
|
|
|
|
_format_for_MMMd |
458
|
|
|
|
|
|
|
_format_for_MMdd |
459
|
|
|
|
|
|
|
_format_for_Md |
460
|
|
|
|
|
|
|
_format_for_d |
461
|
|
|
|
|
|
|
_format_for_hm |
462
|
|
|
|
|
|
|
_format_for_ms |
463
|
|
|
|
|
|
|
_format_for_y |
464
|
|
|
|
|
|
|
_format_for_yM |
465
|
|
|
|
|
|
|
_format_for_yMEd |
466
|
|
|
|
|
|
|
_format_for_yMMM |
467
|
|
|
|
|
|
|
_format_for_yMMMEd |
468
|
|
|
|
|
|
|
_format_for_yMMMM |
469
|
|
|
|
|
|
|
_format_for_yQ |
470
|
|
|
|
|
|
|
_format_for_yQQQ |
471
|
|
|
|
|
|
|
_format_for_yyMMM |
472
|
|
|
|
|
|
|
_format_for_yyyyMM |
473
|
|
|
|
|
|
|
_format_for_yyyyMMMM |
474
|
|
|
|
|
|
|
)) { |
475
|
62
|
|
|
62
|
|
500
|
no strict 'refs'; |
|
62
|
|
|
|
|
152
|
|
|
62
|
|
|
|
|
55422
|
|
476
|
|
|
|
|
|
|
*{$field} = sub { |
477
|
31383
|
|
|
31383
|
|
3587084
|
my $v = $_[0]->{$field}; |
478
|
|
|
|
|
|
|
# XXX - This SUCKS. I need to fix up update-locale.pl to return |
479
|
|
|
|
|
|
|
# the value from the other aliases method |
480
|
31383
|
100
|
66
|
|
|
220368
|
if (defined $v && $v =~ /^alias:([^:]+)$/) { |
481
|
1117
|
|
|
|
|
6676
|
return $_[0]->$1; |
482
|
|
|
|
|
|
|
} |
483
|
30266
|
|
|
|
|
151269
|
return $v; |
484
|
|
|
|
|
|
|
} |
485
|
|
|
|
|
|
|
} |
486
|
|
|
|
|
|
|
|
487
|
5376
|
|
|
5376
|
0
|
35653
|
sub month_name { $_[0]->month_format_wide()->[ $_[1]->month - 1 ] } |
488
|
5376
|
|
|
5376
|
0
|
36885
|
sub month_abbreviation { $_[0]->month_format_abbreviated()->[ $_[1]->month - 1 ] } |
489
|
3136
|
|
|
3136
|
0
|
19389
|
sub day_name { $_[0]->day_format_wide()->[ $_[1]->day_of_week - 1 ] } |
490
|
3136
|
|
|
3136
|
0
|
18647
|
sub day_abbreviation { $_[0]->day_format_abbreviated->[ $_[1]->day_of_week - 1 ] } |
491
|
|
|
|
|
|
|
|
492
|
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
sub add_aliases { |
494
|
4
|
|
|
4
|
0
|
29
|
my $self = shift; |
495
|
4
|
50
|
|
|
|
18
|
my $aliases = ref $_[0] ? $_[0] : {@_}; |
496
|
|
|
|
|
|
|
|
497
|
4
|
|
|
|
|
18
|
while ( my ( $alias, $id ) = each %$aliases ) |
498
|
|
|
|
|
|
|
{ |
499
|
4
|
50
|
|
|
|
12
|
die "Can't alias an id to itself" |
500
|
|
|
|
|
|
|
if $alias eq $id; |
501
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
# check for overwrite? |
503
|
|
|
|
|
|
|
|
504
|
4
|
|
|
|
|
14
|
my %seen = ( $alias => 1, $id => 1 ); |
505
|
4
|
|
|
|
|
6
|
my $copy = $id; |
506
|
4
|
|
|
|
|
13
|
while ( $copy = $Aliases{$copy} ) |
507
|
|
|
|
|
|
|
{ |
508
|
4
|
100
|
|
|
|
19
|
die "Creating an alias from $alias to $id would create a loop.\n" |
509
|
|
|
|
|
|
|
if $seen{$copy}; |
510
|
|
|
|
|
|
|
|
511
|
3
|
|
|
|
|
10
|
$seen{$copy} = 1; |
512
|
|
|
|
|
|
|
} |
513
|
3
|
|
|
|
|
45
|
$Aliases{$alias} = $id; |
514
|
|
|
|
|
|
|
} |
515
|
|
|
|
|
|
|
} |
516
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
sub remove_alias { |
518
|
1
|
|
|
1
|
0
|
2
|
my ($self, $id) = @_; |
519
|
1
|
|
|
|
|
4
|
delete $CachedLocales{$id}; |
520
|
1
|
|
|
|
|
5
|
delete $Aliases{$id}; |
521
|
|
|
|
|
|
|
} |
522
|
|
|
|
|
|
|
|
523
|
|
|
|
|
|
|
|
524
|
|
|
|
|
|
|
1; |
525
|
|
|
|
|
|
|
|
526
|
|
|
|
|
|
|
__END__ |