← Index
NYTProf Performance Profile   « line view »
For -e
  Run on Thu Jun 30 16:34:56 2016
Reported on Thu Jun 30 16:35:09 2016

Filename/home/s1/perl5/perlbrew/perls/perl-5.22.1/lib/site_perl/5.22.1/DateTime/Locale.pm
StatementsExecuted 38 statements in 2.02ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
11115.3ms15.4msDateTime::Locale::::BEGIN@10DateTime::Locale::BEGIN@10
1111.32ms2.04msDateTime::Locale::::BEGIN@11DateTime::Locale::BEGIN@11
22229µs85µsDateTime::Locale::::loadDateTime::Locale::load
11121µs21µsDateTime::Locale::::BEGIN@3DateTime::Locale::BEGIN@3
11112µs42µsDateTime::Locale::::_locale_object_forDateTime::Locale::_locale_object_for
1118µs32µsDateTime::Locale::::BEGIN@12DateTime::Locale::BEGIN@12
1118µs10µsDateTime::Locale::::BEGIN@5DateTime::Locale::BEGIN@5
1117µs35µsDateTime::Locale::::BEGIN@13DateTime::Locale::BEGIN@13
1117µs12µsDateTime::Locale::::BEGIN@6DateTime::Locale::BEGIN@6
2112µs2µsDateTime::Locale::::CORE:substDateTime::Locale::CORE:subst (opcode)
0000s0sDateTime::Locale::::_guess_codeDateTime::Locale::_guess_code
0000s0sDateTime::Locale::::_load_class_from_codeDateTime::Locale::_load_class_from_code
0000s0sDateTime::Locale::::_registerDateTime::Locale::_register
0000s0sDateTime::Locale::::_registered_locale_forDateTime::Locale::_registered_locale_for
0000s0sDateTime::Locale::::add_aliasesDateTime::Locale::add_aliases
0000s0sDateTime::Locale::::codesDateTime::Locale::codes
0000s0sDateTime::Locale::::idsDateTime::Locale::ids
0000s0sDateTime::Locale::::namesDateTime::Locale::names
0000s0sDateTime::Locale::::native_namesDateTime::Locale::native_names
0000s0sDateTime::Locale::::registerDateTime::Locale::register
0000s0sDateTime::Locale::::remove_aliasDateTime::Locale::remove_alias
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package DateTime::Locale;
2
3245µs121µs
# spent 21µs within DateTime::Locale::BEGIN@3 which was called: # once (21µs+0s) by DateTime::BEGIN@14 at line 3
use 5.008001;
# spent 21µs making 1 call to DateTime::Locale::BEGIN@3
4
5222µs213µ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
use strict;
# spent 10µs making 1 call to DateTime::Locale::BEGIN@5 # spent 2µs making 1 call to strict::import
6233µs217µ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
use warnings;
# spent 12µs making 1 call to DateTime::Locale::BEGIN@6 # spent 5µs making 1 call to warnings::import
7
81500nsour $VERSION = '1.03';
9
102424µs115.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
use DateTime::Locale::Data;
# spent 15.4ms making 1 call to DateTime::Locale::BEGIN@10
112271µs12.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
use DateTime::Locale::FromData;
# spent 2.04ms making 1 call to DateTime::Locale::BEGIN@11
12227µs256µ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
use DateTime::Locale::Util qw( parse_locale_code );
# spent 32µs making 1 call to DateTime::Locale::BEGIN@12 # spent 24µs making 1 call to Exporter::import
1321.12ms263µ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
use Params::Validate qw( validate validate_pos SCALAR );
# spent 35µs making 1 call to DateTime::Locale::BEGIN@13 # spent 28µs making 1 call to Exporter::import
14
151300nsmy %Class;
16my %DataForCode;
17my %NameToCode;
18my %NativeNameToCode;
19my %UserDefinedAlias;
20
21my %LoadCache;
22
23sub 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
36sub _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
90sub 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
119sub 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
130sub ids {
131 shift->codes;
132}
133
134## no critic (Variables::ProhibitPackageVars)
135sub codes {
136 wantarray
137 ? keys %DateTime::Locale::Data::Codes
138 : [ keys %DateTime::Locale::Data::Codes ];
139}
140
141sub names {
142 wantarray
143 ? keys %DateTime::Locale::Data::Names
144 : [ keys %DateTime::Locale::Data::Names ];
145}
146
147sub 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.
155110µsmy %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
1841900nsmy %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
sub load {
1902600ns my $class = shift;
191224µs212µ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.
19522µs $code =~ tr/_/-/;
196
197 # Strip off charset for LC_* codes : en_GB.UTF-8 etc
19827µs22µs $code =~ s/\..*$//;
# spent 2µs making 2 calls to DateTime::Locale::CORE:subst, avg 800ns/call
199
20024µs return $LoadCache{$code} if exists $LoadCache{$code};
201
2021800ns while ( exists $UserDefinedAlias{$code} ) {
203 $code = $UserDefinedAlias{$code};
204 }
205
206 $code = $DateTimeLanguageAliases{$code}
2071600ns if exists $DateTimeLanguageAliases{$code};
2081400ns $code = $POSIXAliases{$code} if exists $POSIXAliases{$code};
209 $code = $DateTime::Locale::Data::ISO639Aliases{$code}
2101700ns if exists $DateTime::Locale::Data::ISO639Aliases{$code};
211
21216µs142µ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
237sub _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
sub _locale_object_for {
2751200ns shift;
2761500ns my $code = shift;
277
27812µs14µ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 ...
28216µs126µs return $LoadCache{$code} = DateTime::Locale::FromData->new( \%{$data} );
# spent 26µs making 1 call to DateTime::Locale::FromData::new
283}
284
285sub _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
310sub _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
35517µs1;
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
sub DateTime::Locale::CORE:subst; # opcode