Filename | /home/s1/perl5/perlbrew/perls/perl-5.22.1/lib/site_perl/5.22.1/DateTime/Locale.pm |
Statements | Executed 38 statements in 2.02ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 15.3ms | 15.4ms | BEGIN@10 | DateTime::Locale::
1 | 1 | 1 | 1.32ms | 2.04ms | BEGIN@11 | DateTime::Locale::
2 | 2 | 2 | 29µs | 85µs | load | DateTime::Locale::
1 | 1 | 1 | 21µs | 21µs | BEGIN@3 | DateTime::Locale::
1 | 1 | 1 | 12µs | 42µs | _locale_object_for | DateTime::Locale::
1 | 1 | 1 | 8µs | 32µs | BEGIN@12 | DateTime::Locale::
1 | 1 | 1 | 8µs | 10µs | BEGIN@5 | DateTime::Locale::
1 | 1 | 1 | 7µs | 35µs | BEGIN@13 | DateTime::Locale::
1 | 1 | 1 | 7µs | 12µs | BEGIN@6 | DateTime::Locale::
2 | 1 | 1 | 2µs | 2µs | CORE:subst (opcode) | DateTime::Locale::
0 | 0 | 0 | 0s | 0s | _guess_code | DateTime::Locale::
0 | 0 | 0 | 0s | 0s | _load_class_from_code | DateTime::Locale::
0 | 0 | 0 | 0s | 0s | _register | DateTime::Locale::
0 | 0 | 0 | 0s | 0s | _registered_locale_for | DateTime::Locale::
0 | 0 | 0 | 0s | 0s | add_aliases | DateTime::Locale::
0 | 0 | 0 | 0s | 0s | codes | DateTime::Locale::
0 | 0 | 0 | 0s | 0s | ids | DateTime::Locale::
0 | 0 | 0 | 0s | 0s | names | DateTime::Locale::
0 | 0 | 0 | 0s | 0s | native_names | DateTime::Locale::
0 | 0 | 0 | 0s | 0s | register | DateTime::Locale::
0 | 0 | 0 | 0s | 0s | remove_alias | DateTime::Locale::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package DateTime::Locale; | ||||
2 | |||||
3 | 2 | 45µs | 1 | 21µs | # spent 21µs within DateTime::Locale::BEGIN@3 which was called:
# once (21µs+0s) by DateTime::BEGIN@14 at line 3 # spent 21µs making 1 call to DateTime::Locale::BEGIN@3 |
4 | |||||
5 | 2 | 22µs | 2 | 13µs | # spent 10µs (8+2) within DateTime::Locale::BEGIN@5 which was called:
# once (8µs+2µs) by DateTime::BEGIN@14 at line 5 # spent 10µs making 1 call to DateTime::Locale::BEGIN@5
# spent 2µs making 1 call to strict::import |
6 | 2 | 33µs | 2 | 17µs | # spent 12µs (7+5) within DateTime::Locale::BEGIN@6 which was called:
# once (7µs+5µs) by DateTime::BEGIN@14 at line 6 # spent 12µs making 1 call to DateTime::Locale::BEGIN@6
# spent 5µs making 1 call to warnings::import |
7 | |||||
8 | 1 | 500ns | our $VERSION = '1.03'; | ||
9 | |||||
10 | 2 | 424µs | 1 | 15.4ms | # spent 15.4ms (15.3+47µs) within DateTime::Locale::BEGIN@10 which was called:
# once (15.3ms+47µs) by DateTime::BEGIN@14 at line 10 # spent 15.4ms making 1 call to DateTime::Locale::BEGIN@10 |
11 | 2 | 271µs | 1 | 2.04ms | # spent 2.04ms (1.32+723µs) within DateTime::Locale::BEGIN@11 which was called:
# once (1.32ms+723µs) by DateTime::BEGIN@14 at line 11 # spent 2.04ms making 1 call to DateTime::Locale::BEGIN@11 |
12 | 2 | 27µs | 2 | 56µs | # spent 32µs (8+24) within DateTime::Locale::BEGIN@12 which was called:
# once (8µs+24µs) by DateTime::BEGIN@14 at line 12 # spent 32µs making 1 call to DateTime::Locale::BEGIN@12
# spent 24µs making 1 call to Exporter::import |
13 | 2 | 1.12ms | 2 | 63µs | # spent 35µs (7+28) within DateTime::Locale::BEGIN@13 which was called:
# once (7µs+28µs) by DateTime::BEGIN@14 at line 13 # spent 35µs making 1 call to DateTime::Locale::BEGIN@13
# spent 28µs making 1 call to Exporter::import |
14 | |||||
15 | 1 | 300ns | my %Class; | ||
16 | my %DataForCode; | ||||
17 | my %NameToCode; | ||||
18 | my %NativeNameToCode; | ||||
19 | my %UserDefinedAlias; | ||||
20 | |||||
21 | my %LoadCache; | ||||
22 | |||||
23 | sub register { | ||||
24 | my $class = shift; | ||||
25 | |||||
26 | %LoadCache = (); | ||||
27 | |||||
28 | if ( ref $_[0] ) { | ||||
29 | $class->_register(%$_) foreach @_; | ||||
30 | } | ||||
31 | else { | ||||
32 | $class->_register(@_); | ||||
33 | } | ||||
34 | } | ||||
35 | |||||
36 | sub _register { | ||||
37 | my $class = shift; | ||||
38 | |||||
39 | my %p = validate( | ||||
40 | @_, { | ||||
41 | id => { type => SCALAR }, | ||||
42 | |||||
43 | en_language => { type => SCALAR }, | ||||
44 | en_script => { type => SCALAR, optional => 1 }, | ||||
45 | en_territory => { type => SCALAR, optional => 1 }, | ||||
46 | en_variant => { type => SCALAR, optional => 1 }, | ||||
47 | |||||
48 | native_language => { type => SCALAR, optional => 1 }, | ||||
49 | native_script => { type => SCALAR, optional => 1 }, | ||||
50 | native_territory => { type => SCALAR, optional => 1 }, | ||||
51 | native_variant => { type => SCALAR, optional => 1 }, | ||||
52 | |||||
53 | class => { type => SCALAR, optional => 1 }, | ||||
54 | replace => { type => SCALAR, default => 0 }, | ||||
55 | } | ||||
56 | ); | ||||
57 | |||||
58 | my $id = $p{id}; | ||||
59 | |||||
60 | die q{'\@' or '=' are not allowed in locale ids} | ||||
61 | if $id =~ /[\@=]/; | ||||
62 | |||||
63 | die | ||||
64 | "You cannot replace an existing locale ('$id') unless you also specify the 'replace' parameter as true\n" | ||||
65 | if !delete $p{replace} && exists $DataForCode{$id}; | ||||
66 | |||||
67 | $p{native_language} = $p{en_language} | ||||
68 | unless exists $p{native_language}; | ||||
69 | |||||
70 | my @en_pieces; | ||||
71 | my @native_pieces; | ||||
72 | foreach my $p (qw( language script territory variant )) { | ||||
73 | push @en_pieces, $p{"en_$p"} if exists $p{"en_$p"}; | ||||
74 | push @native_pieces, $p{"native_$p"} if exists $p{"native_$p"}; | ||||
75 | } | ||||
76 | |||||
77 | $p{en_complete_name} = join q{ }, @en_pieces; | ||||
78 | $p{native_complete_name} = join q{ }, @native_pieces; | ||||
79 | |||||
80 | $id =~ s/_/-/g; | ||||
81 | |||||
82 | $DataForCode{$id} = \%p; | ||||
83 | |||||
84 | $NameToCode{ $p{en_complete_name} } = $id; | ||||
85 | $NativeNameToCode{ $p{native_complete_name} } = $id; | ||||
86 | |||||
87 | $Class{$id} = $p{class} if defined exists $p{class}; | ||||
88 | } | ||||
89 | |||||
90 | sub add_aliases { | ||||
91 | shift; | ||||
92 | |||||
93 | %LoadCache = (); | ||||
94 | |||||
95 | my $aliases = ref $_[0] ? $_[0] : {@_}; | ||||
96 | |||||
97 | for my $alias ( keys %{$aliases} ) { | ||||
98 | my $code = $aliases->{$alias}; | ||||
99 | |||||
100 | die q{Can't alias an id to itself} | ||||
101 | if $alias eq $code; | ||||
102 | |||||
103 | # check for overwrite? | ||||
104 | |||||
105 | my %seen = ( $alias => 1, $code => 1 ); | ||||
106 | my $copy = $code; | ||||
107 | while ( $copy = $UserDefinedAlias{$copy} ) { | ||||
108 | die | ||||
109 | "Creating an alias from $alias to $code would create a loop.\n" | ||||
110 | if $seen{$copy}; | ||||
111 | |||||
112 | $seen{$copy} = 1; | ||||
113 | } | ||||
114 | |||||
115 | $UserDefinedAlias{$alias} = $code; | ||||
116 | } | ||||
117 | } | ||||
118 | |||||
119 | sub remove_alias { | ||||
120 | shift; | ||||
121 | |||||
122 | %LoadCache = (); | ||||
123 | |||||
124 | my ($alias) = validate_pos( @_, { type => SCALAR } ); | ||||
125 | |||||
126 | return delete $UserDefinedAlias{$alias}; | ||||
127 | } | ||||
128 | |||||
129 | # deprecated | ||||
130 | sub ids { | ||||
131 | shift->codes; | ||||
132 | } | ||||
133 | |||||
134 | ## no critic (Variables::ProhibitPackageVars) | ||||
135 | sub codes { | ||||
136 | wantarray | ||||
137 | ? keys %DateTime::Locale::Data::Codes | ||||
138 | : [ keys %DateTime::Locale::Data::Codes ]; | ||||
139 | } | ||||
140 | |||||
141 | sub names { | ||||
142 | wantarray | ||||
143 | ? keys %DateTime::Locale::Data::Names | ||||
144 | : [ keys %DateTime::Locale::Data::Names ]; | ||||
145 | } | ||||
146 | |||||
147 | sub native_names { | ||||
148 | wantarray | ||||
149 | ? keys %DateTime::Locale::Data::NativeNames | ||||
150 | : [ keys %DateTime::Locale::Data::NativeNames ]; | ||||
151 | } | ||||
152 | |||||
153 | # These are hard-coded for backwards comaptibility with the DateTime::Language | ||||
154 | # code. | ||||
155 | 1 | 10µs | my %DateTimeLanguageAliases = ( | ||
156 | |||||
157 | # 'Afar' => 'aa', | ||||
158 | 'Amharic' => 'am-ET', | ||||
159 | 'Austrian' => 'de-AT', | ||||
160 | 'Brazilian' => 'pt-BR', | ||||
161 | 'Czech' => 'cs-CZ', | ||||
162 | 'Danish' => 'da-DK', | ||||
163 | 'Dutch' => 'nl-NL', | ||||
164 | 'English' => 'en-US', | ||||
165 | 'French' => 'fr-FR', | ||||
166 | |||||
167 | # 'Gedeo' => undef, # XXX | ||||
168 | 'German' => 'de-DE', | ||||
169 | 'Italian' => 'it-IT', | ||||
170 | 'Norwegian' => 'no-NO', | ||||
171 | 'Oromo' => 'om-ET', # Maybe om-KE or plain om ? | ||||
172 | 'Portugese' => 'pt-PT', | ||||
173 | |||||
174 | # 'Sidama' => 'sid', | ||||
175 | 'Somali' => 'so-SO', | ||||
176 | 'Spanish' => 'es-ES', | ||||
177 | 'Swedish' => 'sv-SE', | ||||
178 | |||||
179 | # 'Tigre' => 'tig', | ||||
180 | 'TigrinyaEthiopian' => 'ti-ET', | ||||
181 | 'TigrinyaEritrean' => 'ti-ER', | ||||
182 | ); | ||||
183 | |||||
184 | 1 | 900ns | my %POSIXAliases = ( | ||
185 | C => 'en-US-POSIX', | ||||
186 | POSIX => 'en-US-POSIX', | ||||
187 | ); | ||||
188 | |||||
189 | # spent 85µs (29+56) within DateTime::Locale::load which was called 2 times, avg 42µs/call:
# once (22µs+50µs) by FakeLocale::instance at line 131 of DateTime/Infinite.pm
# once (8µs+6µs) by DateTime::DefaultLocale at line 104 of DateTime.pm | ||||
190 | 2 | 600ns | my $class = shift; | ||
191 | 2 | 24µs | 2 | 12µs | my ($code) = validate_pos( @_, { type => SCALAR } ); # spent 12µs making 2 calls to Params::Validate::XS::validate_pos, avg 6µs/call |
192 | |||||
193 | # We used to use underscores in codes instead of dashes. We want to | ||||
194 | # support both indefinitely. | ||||
195 | 2 | 2µs | $code =~ tr/_/-/; | ||
196 | |||||
197 | # Strip off charset for LC_* codes : en_GB.UTF-8 etc | ||||
198 | 2 | 7µs | 2 | 2µs | $code =~ s/\..*$//; # spent 2µs making 2 calls to DateTime::Locale::CORE:subst, avg 800ns/call |
199 | |||||
200 | 2 | 4µs | return $LoadCache{$code} if exists $LoadCache{$code}; | ||
201 | |||||
202 | 1 | 800ns | while ( exists $UserDefinedAlias{$code} ) { | ||
203 | $code = $UserDefinedAlias{$code}; | ||||
204 | } | ||||
205 | |||||
206 | $code = $DateTimeLanguageAliases{$code} | ||||
207 | 1 | 600ns | if exists $DateTimeLanguageAliases{$code}; | ||
208 | 1 | 400ns | $code = $POSIXAliases{$code} if exists $POSIXAliases{$code}; | ||
209 | $code = $DateTime::Locale::Data::ISO639Aliases{$code} | ||||
210 | 1 | 700ns | if exists $DateTime::Locale::Data::ISO639Aliases{$code}; | ||
211 | |||||
212 | 1 | 6µs | 1 | 42µs | if ( exists $DateTime::Locale::Data::Codes{$code} ) { # spent 42µs making 1 call to DateTime::Locale::_locale_object_for |
213 | return $class->_locale_object_for($code); | ||||
214 | } | ||||
215 | |||||
216 | if ( exists $DateTime::Locale::Data::Names{$code} ) { | ||||
217 | return $class->_locale_object_for( | ||||
218 | $DateTime::Locale::Data::Names{$code} ); | ||||
219 | } | ||||
220 | |||||
221 | if ( exists $DateTime::Locale::Data::NativeNames{$code} ) { | ||||
222 | return $class->_locale_object_for( | ||||
223 | $DateTime::Locale::Data::NativeNames{$code} ); | ||||
224 | } | ||||
225 | |||||
226 | if ( my $locale = $class->_registered_locale_for($code) ) { | ||||
227 | return $locale; | ||||
228 | } | ||||
229 | |||||
230 | if ( my $guessed = $class->_guess_code($code) ) { | ||||
231 | return $class->_locale_object_for($guessed); | ||||
232 | } | ||||
233 | |||||
234 | die "Invalid locale code or name: $code\n"; | ||||
235 | } | ||||
236 | |||||
237 | sub _guess_code { | ||||
238 | my $class = shift; | ||||
239 | my $code = shift; | ||||
240 | |||||
241 | my %codes = parse_locale_code($code); | ||||
242 | |||||
243 | my @guesses; | ||||
244 | |||||
245 | if ( $codes{script} ) { | ||||
246 | my $guess = join q{-}, $codes{language}, $codes{script}; | ||||
247 | |||||
248 | push @guesses, $guess; | ||||
249 | |||||
250 | $guess .= q{-} . $codes{territory} if defined $codes{territory}; | ||||
251 | |||||
252 | # version with script comes first | ||||
253 | unshift @guesses, $guess; | ||||
254 | } | ||||
255 | |||||
256 | if ( $codes{variant} ) { | ||||
257 | push @guesses, join q{-}, $codes{language}, $codes{territory}, | ||||
258 | $codes{variant}; | ||||
259 | } | ||||
260 | |||||
261 | if ( $codes{territory} ) { | ||||
262 | push @guesses, join q{-}, $codes{language}, $codes{territory}; | ||||
263 | } | ||||
264 | |||||
265 | push @guesses, $codes{language}; | ||||
266 | |||||
267 | for my $code (@guesses) { | ||||
268 | return $code | ||||
269 | if exists $DateTime::Locale::Data::Codes{$code} | ||||
270 | || exists $DateTime::Locale::Data::Names{$code}; | ||||
271 | } | ||||
272 | } | ||||
273 | |||||
274 | # spent 42µs (12+29) within DateTime::Locale::_locale_object_for which was called:
# once (12µs+29µs) by DateTime::Locale::load at line 212 | ||||
275 | 1 | 200ns | shift; | ||
276 | 1 | 500ns | my $code = shift; | ||
277 | |||||
278 | 1 | 2µs | 1 | 4µs | my $data = DateTime::Locale::Data::locale_data($code) # spent 4µs making 1 call to DateTime::Locale::Data::locale_data |
279 | or return; | ||||
280 | |||||
281 | # We want to make a copy of the data just in case ... | ||||
282 | 1 | 6µs | 1 | 26µs | return $LoadCache{$code} = DateTime::Locale::FromData->new( \%{$data} ); # spent 26µs making 1 call to DateTime::Locale::FromData::new |
283 | } | ||||
284 | |||||
285 | sub _registered_locale_for { | ||||
286 | my $class = shift; | ||||
287 | my $code = shift; | ||||
288 | |||||
289 | # Custom locale registered by user | ||||
290 | if ( $Class{$code} ) { | ||||
291 | return $LoadCache{$code} | ||||
292 | = $class->_load_class_from_code( $code, $Class{$code} ); | ||||
293 | } | ||||
294 | |||||
295 | if ( $DataForCode{$code} ) { | ||||
296 | return $LoadCache{$code} = $class->_load_class_from_code($code); | ||||
297 | } | ||||
298 | |||||
299 | if ( $NameToCode{$code} ) { | ||||
300 | return $LoadCache{$code} | ||||
301 | = $class->_load_class_from_code( $NameToCode{$code} ); | ||||
302 | } | ||||
303 | |||||
304 | if ( $NativeNameToCode{$code} ) { | ||||
305 | return $LoadCache{$code} | ||||
306 | = $class->_load_class_from_code( $NativeNameToCode{$code} ); | ||||
307 | } | ||||
308 | } | ||||
309 | |||||
310 | sub _load_class_from_code { | ||||
311 | my $class = shift; | ||||
312 | my $code = shift; | ||||
313 | my $real_class = shift; | ||||
314 | |||||
315 | # We want the first alias for which there is data, even if it has | ||||
316 | # no corresponding .pm file. There may be multiple levels of | ||||
317 | # alias to go through. | ||||
318 | my $data_code = $code; | ||||
319 | while ( exists $UserDefinedAlias{$data_code} | ||||
320 | && !exists $DataForCode{$data_code} ) { | ||||
321 | |||||
322 | $data_code = $UserDefinedAlias{$data_code}; | ||||
323 | } | ||||
324 | |||||
325 | ( my $underscore_code = $data_code ) =~ s/-/_/g; | ||||
326 | $real_class ||= "DateTime::Locale::$underscore_code"; | ||||
327 | |||||
328 | unless ( $real_class->can('new') ) { | ||||
329 | ## no critic (BuiltinFunctions::ProhibitStringyEval, ErrorHandling::RequireCheckingReturnValueOfEval) | ||||
330 | eval "require $real_class"; | ||||
331 | die $@ if $@; | ||||
332 | ## use critic | ||||
333 | } | ||||
334 | |||||
335 | my $locale = $real_class->new( | ||||
336 | %{ $DataForCode{$data_code} }, | ||||
337 | code => $code, | ||||
338 | ); | ||||
339 | |||||
340 | if ( $locale->can('cldr_version') ) { | ||||
341 | my $object_version = $locale->cldr_version; | ||||
342 | |||||
343 | if ( $object_version ne $DateTime::Locale::Data::CLDRVersion ) { | ||||
344 | warn | ||||
345 | "Loaded $real_class, which is from an older version ($object_version)" | ||||
346 | . ' of the CLDR database than this installation of' | ||||
347 | . " DateTime::Locale ($DateTime::Locale::Data::CLDRVersion).\n"; | ||||
348 | } | ||||
349 | } | ||||
350 | |||||
351 | return $locale; | ||||
352 | } | ||||
353 | ## use critic | ||||
354 | |||||
355 | 1 | 7µs | 1; | ||
356 | |||||
357 | # ABSTRACT: Localization support for DateTime.pm | ||||
358 | |||||
359 | __END__ | ||||
# spent 2µs within DateTime::Locale::CORE:subst which was called 2 times, avg 800ns/call:
# 2 times (2µs+0s) by DateTime::Locale::load at line 198, avg 800ns/call |