Filename | /usr/lib/perl5/site_perl/5.12.1/DateTime/Locale.pm |
Statements | Executed 14999 statements in 342ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
466 | 1 | 1 | 130ms | 230ms | _register | DateTime::Locale::
1 | 1 | 1 | 55.8ms | 57.2ms | BEGIN@11 | DateTime::Locale::
1 | 1 | 1 | 28.9ms | 99.4ms | add_aliases | DateTime::Locale::
422 | 1 | 1 | 21.5ms | 70.4ms | _registered_id | DateTime::Locale::
1 | 1 | 1 | 18.1ms | 51.8ms | BEGIN@10 | DateTime::Locale::
1 | 1 | 1 | 15.1ms | 245ms | register | DateTime::Locale::
466 | 1 | 1 | 2.72ms | 2.72ms | CORE:match (opcode) | DateTime::Locale::
1 | 1 | 1 | 2.17ms | 25.8ms | _load_class_from_id | DateTime::Locale::
1 | 1 | 1 | 210µs | 346ms | BEGIN@140 | DateTime::Locale::
1 | 1 | 1 | 170µs | 26.1ms | load | DateTime::Locale::
1 | 1 | 1 | 117µs | 117µs | BEGIN@6 | DateTime::Locale::
1 | 1 | 1 | 79µs | 106µs | BEGIN@3 | DateTime::Locale::
1 | 1 | 1 | 63µs | 356µs | BEGIN@12 | DateTime::Locale::
1 | 1 | 1 | 55µs | 151µs | BEGIN@4 | DateTime::Locale::
0 | 0 | 0 | 0s | 0s | _guess_id | DateTime::Locale::
0 | 0 | 0 | 0s | 0s | _parse_id | 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 | remove_alias | DateTime::Locale::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package DateTime::Locale; | ||||
2 | |||||
3 | 3 | 133µs | 2 | 132µs | # spent 106µs (79+26) within DateTime::Locale::BEGIN@3 which was called:
# once (79µs+26µs) by DateTime::BEGIN@45 at line 3 # spent 106µs making 1 call to DateTime::Locale::BEGIN@3
# spent 26µs making 1 call to strict::import |
4 | 3 | 156µs | 2 | 246µs | # spent 151µs (55+96) within DateTime::Locale::BEGIN@4 which was called:
# once (55µs+96µs) by DateTime::BEGIN@45 at line 4 # spent 151µs making 1 call to DateTime::Locale::BEGIN@4
# spent 96µs making 1 call to warnings::import |
5 | |||||
6 | 3 | 227µs | 1 | 117µs | # spent 117µs within DateTime::Locale::BEGIN@6 which was called:
# once (117µs+0s) by DateTime::BEGIN@45 at line 6 # spent 117µs making 1 call to DateTime::Locale::BEGIN@6 |
7 | |||||
8 | # Loading this here isn't necessary, but it makes it easier to catch | ||||
9 | # syntax errors when testing. | ||||
10 | 3 | 568µs | 1 | 51.8ms | # spent 51.8ms (18.1+33.7) within DateTime::Locale::BEGIN@10 which was called:
# once (18.1ms+33.7ms) by DateTime::BEGIN@45 at line 10 # spent 51.8ms making 1 call to DateTime::Locale::BEGIN@10 |
11 | 3 | 846µs | 1 | 57.2ms | # spent 57.2ms (55.8+1.43) within DateTime::Locale::BEGIN@11 which was called:
# once (55.8ms+1.43ms) by DateTime::BEGIN@45 at line 11 # spent 57.2ms making 1 call to DateTime::Locale::BEGIN@11 |
12 | 3 | 4.33ms | 2 | 649µs | # spent 356µs (63+293) within DateTime::Locale::BEGIN@12 which was called:
# once (63µs+293µs) by DateTime::BEGIN@45 at line 12 # spent 356µs making 1 call to DateTime::Locale::BEGIN@12
# spent 293µs making 1 call to Exporter::import |
13 | |||||
14 | 1 | 8µs | our $VERSION = '0.45'; | ||
15 | |||||
16 | 1 | 3µs | my %Class; | ||
17 | 1 | 2µs | my %DataForID; | ||
18 | 1 | 2µs | my %NameToID; | ||
19 | 1 | 2µs | my %NativeNameToID; | ||
20 | 1 | 2µs | my %AliasToID; | ||
21 | 1 | 2µs | my %IDToExtra; | ||
22 | |||||
23 | 1 | 2µs | my %LoadCache; | ||
24 | |||||
25 | # spent 245ms (15.1+230) within DateTime::Locale::register which was called:
# once (15.1ms+230ms) by DateTime::Locale::BEGIN@140 at line 141 | ||||
26 | 3 | 12.7ms | my $class = shift; | ||
27 | |||||
28 | %LoadCache = (); | ||||
29 | |||||
30 | 466 | 230ms | if ( ref $_[0] ) { # spent 230ms making 466 calls to DateTime::Locale::_register, avg 494µs/call | ||
31 | $class->_register(%$_) foreach @_; | ||||
32 | } | ||||
33 | else { | ||||
34 | $class->_register(@_); | ||||
35 | } | ||||
36 | } | ||||
37 | |||||
38 | # spent 230ms (130+100) within DateTime::Locale::_register which was called 466 times, avg 494µs/call:
# 466 times (130ms+100ms) by DateTime::Locale::register at line 30, avg 494µs/call | ||||
39 | 6990 | 117ms | my $class = shift; | ||
40 | |||||
41 | 1 | 80.3ms | 466 | 97.7ms | my %p = validate( # spent 97.7ms making 466 calls to Params::Validate::XS::validate, avg 210µs/call # spent 7.84ms executing statements in 466 string evals (merged) |
42 | @_, { | ||||
43 | id => { type => SCALAR }, | ||||
44 | |||||
45 | en_language => { type => SCALAR }, | ||||
46 | en_script => { type => SCALAR, optional => 1 }, | ||||
47 | en_territory => { type => SCALAR, optional => 1 }, | ||||
48 | en_variant => { type => SCALAR, optional => 1 }, | ||||
49 | |||||
50 | native_language => { type => SCALAR, optional => 1 }, | ||||
51 | native_script => { type => SCALAR, optional => 1 }, | ||||
52 | native_territory => { type => SCALAR, optional => 1 }, | ||||
53 | native_variant => { type => SCALAR, optional => 1 }, | ||||
54 | |||||
55 | class => { type => SCALAR, optional => 1 }, | ||||
56 | replace => { type => SCALAR, default => 0 }, | ||||
57 | } | ||||
58 | ); | ||||
59 | |||||
60 | my $id = $p{id}; | ||||
61 | |||||
62 | 466 | 2.72ms | die "'\@' or '=' are not allowed in locale ids" # spent 2.72ms making 466 calls to DateTime::Locale::CORE:match, avg 6µs/call | ||
63 | if $id =~ /[\@=]/; | ||||
64 | |||||
65 | die | ||||
66 | "You cannot replace an existing locale ('$id') unless you also specify the 'replace' parameter as true\n" | ||||
67 | if !delete $p{replace} && exists $DataForID{$id}; | ||||
68 | |||||
69 | $p{native_language} = $p{en_language} | ||||
70 | unless exists $p{native_language}; | ||||
71 | |||||
72 | my @en_pieces; | ||||
73 | my @native_pieces; | ||||
74 | foreach my $p (qw( language script territory variant )) { | ||||
75 | 3728 | 27.6ms | push @en_pieces, $p{"en_$p"} if exists $p{"en_$p"}; | ||
76 | push @native_pieces, $p{"native_$p"} if exists $p{"native_$p"}; | ||||
77 | } | ||||
78 | |||||
79 | $p{en_complete_name} = join ' ', @en_pieces; | ||||
80 | $p{native_complete_name} = join ' ', @native_pieces; | ||||
81 | |||||
82 | $DataForID{$id} = \%p; | ||||
83 | |||||
84 | $NameToID{ $p{en_complete_name} } = $id; | ||||
85 | $NativeNameToID{ $p{native_complete_name} } = $id; | ||||
86 | |||||
87 | $Class{$id} = $p{class} if defined exists $p{class}; | ||||
88 | } | ||||
89 | |||||
90 | # spent 70.4ms (21.5+48.9) within DateTime::Locale::_registered_id which was called 422 times, avg 167µs/call:
# 422 times (21.5ms+48.9ms) by DateTime::Locale::add_aliases at line 108, avg 167µs/call | ||||
91 | 1688 | 46.5ms | shift; | ||
92 | 1 | 19.8ms | 422 | 48.9ms | my ($id) = validate_pos( @_, { type => SCALAR } ); # spent 48.9ms making 422 calls to Params::Validate::XS::validate_pos, avg 116µs/call # spent 6.47ms executing statements in 422 string evals (merged) |
93 | |||||
94 | return 1 if $AliasToID{$id}; | ||||
95 | return 1 if $DataForID{$id}; | ||||
96 | |||||
97 | return 0; | ||||
98 | } | ||||
99 | |||||
100 | # spent 99.4ms (28.9+70.4) within DateTime::Locale::add_aliases which was called:
# once (28.9ms+70.4ms) by DateTime::Locale::BEGIN@140 at line 142 | ||||
101 | 4 | 6.97ms | shift; | ||
102 | |||||
103 | %LoadCache = (); | ||||
104 | |||||
105 | my $aliases = ref $_[0] ? $_[0] : {@_}; | ||||
106 | |||||
107 | 2532 | 19.6ms | while ( my ( $alias, $id ) = each %$aliases ) { | ||
108 | 422 | 70.4ms | die # spent 70.4ms making 422 calls to DateTime::Locale::_registered_id, avg 167µs/call | ||
109 | "Unregistered locale '$id' cannot be used as an alias target for $alias" | ||||
110 | unless __PACKAGE__->_registered_id($id); | ||||
111 | |||||
112 | die "Can't alias an id to itself" | ||||
113 | if $alias eq $id; | ||||
114 | |||||
115 | # check for overwrite? | ||||
116 | |||||
117 | my %seen = ( $alias => 1, $id => 1 ); | ||||
118 | my $copy = $id; | ||||
119 | while ( $copy = $AliasToID{$copy} ) { | ||||
120 | die "Creating an alias from $alias to $id would create a loop.\n" | ||||
121 | if $seen{$copy}; | ||||
122 | |||||
123 | $seen{$copy} = 1; | ||||
124 | } | ||||
125 | |||||
126 | $AliasToID{$alias} = $id; | ||||
127 | } | ||||
128 | } | ||||
129 | |||||
130 | sub remove_alias { | ||||
131 | shift; | ||||
132 | |||||
133 | %LoadCache = (); | ||||
134 | |||||
135 | my ($alias) = validate_pos( @_, { type => SCALAR } ); | ||||
136 | |||||
137 | return delete $AliasToID{$alias}; | ||||
138 | } | ||||
139 | |||||
140 | # spent 346ms (210µs+345) within DateTime::Locale::BEGIN@140 which was called:
# once (210µs+345ms) by DateTime::BEGIN@45 at line 143 | ||||
141 | 2 | 168µs | 2 | 246ms | __PACKAGE__->register( DateTime::Locale::Catalog->Locales() ); # spent 245ms making 1 call to DateTime::Locale::register
# spent 102µs making 1 call to DateTime::Locale::Catalog::Locales |
142 | 2 | 99.9ms | __PACKAGE__->add_aliases( DateTime::Locale::Catalog->Aliases() ); # spent 99.4ms making 1 call to DateTime::Locale::add_aliases
# spent 510µs making 1 call to DateTime::Locale::Catalog::Aliases | ||
143 | 1 | 3.80ms | 1 | 346ms | } # spent 346ms making 1 call to DateTime::Locale::BEGIN@140 |
144 | |||||
145 | sub ids { wantarray ? keys %DataForID : [ keys %DataForID ] } | ||||
146 | sub names { wantarray ? keys %NameToID : [ keys %NameToID ] } | ||||
147 | |||||
148 | sub native_names { | ||||
149 | wantarray ? keys %NativeNameToID : [ keys %NativeNameToID ]; | ||||
150 | } | ||||
151 | |||||
152 | # These are hardcoded for backwards comaptibility with the | ||||
153 | # DateTime::Language code. | ||||
154 | 1 | 49µs | my %OldAliases = ( | ||
155 | 'Afar' => 'aa', | ||||
156 | 'Amharic' => 'am_ET', | ||||
157 | 'Austrian' => 'de_AT', | ||||
158 | 'Brazilian' => 'pt_BR', | ||||
159 | 'Czech' => 'cs_CZ', | ||||
160 | 'Danish' => 'da_DK', | ||||
161 | 'Dutch' => 'nl_NL', | ||||
162 | 'English' => 'en_US', | ||||
163 | 'French' => 'fr_FR', | ||||
164 | |||||
165 | # 'Gedeo' => undef, # XXX | ||||
166 | 'German' => 'de_DE', | ||||
167 | 'Italian' => 'it_IT', | ||||
168 | 'Norwegian' => 'no_NO', | ||||
169 | 'Oromo' => 'om_ET', # Maybe om_KE or plain om ? | ||||
170 | 'Portugese' => 'pt_PT', | ||||
171 | 'Sidama' => 'sid', | ||||
172 | 'Somali' => 'so_SO', | ||||
173 | 'Spanish' => 'es_ES', | ||||
174 | 'Swedish' => 'sv_SE', | ||||
175 | 'Tigre' => 'tig', | ||||
176 | 'TigrinyaEthiopian' => 'ti_ET', | ||||
177 | 'TigrinyaEritrean' => 'ti_ER', | ||||
178 | ); | ||||
179 | |||||
180 | # spent 26.1ms (170µs+25.9) within DateTime::Locale::load which was called:
# once (170µs+25.9ms) by DateTime::DefaultLocale at line 104 of DateTime.pm | ||||
181 | 8 | 227µs | my $class = shift; | ||
182 | 1 | 61µs | 1 | 136µs | my ($name) = validate_pos( @_, { type => SCALAR } ); # spent 136µs making 1 call to Params::Validate::XS::validate_pos # spent 16µs executing statements in string eval |
183 | |||||
184 | # Support RFC 3066 language tags, which use '-' instead of '_'. | ||||
185 | $name =~ tr/-/_/; | ||||
186 | |||||
187 | my $key = $name; | ||||
188 | |||||
189 | return $LoadCache{$key} if exists $LoadCache{$key}; | ||||
190 | |||||
191 | # Custom class registered by user | ||||
192 | if ( $Class{$name} ) { | ||||
193 | return $LoadCache{$key} | ||||
194 | = $class->_load_class_from_id( $name, $Class{$name} ); | ||||
195 | } | ||||
196 | |||||
197 | # special case for backwards compatibility with DT::Language | ||||
198 | $name = $OldAliases{$name} if exists $OldAliases{$name}; | ||||
199 | |||||
200 | 1 | 25.8ms | if ( exists $DataForID{$name} || exists $AliasToID{$name} ) { # spent 25.8ms making 1 call to DateTime::Locale::_load_class_from_id | ||
201 | return $LoadCache{$key} = $class->_load_class_from_id($name); | ||||
202 | } | ||||
203 | |||||
204 | foreach my $h ( \%NameToID, \%NativeNameToID ) { | ||||
205 | return $LoadCache{$key} = $class->_load_class_from_id( $h->{$name} ) | ||||
206 | if exists $h->{$name}; | ||||
207 | } | ||||
208 | |||||
209 | if ( my $id = $class->_guess_id($name) ) { | ||||
210 | return $LoadCache{$key} = $class->_load_class_from_id($id); | ||||
211 | } | ||||
212 | |||||
213 | die "Invalid locale name or id: $name\n"; | ||||
214 | } | ||||
215 | |||||
216 | sub _guess_id { | ||||
217 | my $class = shift; | ||||
218 | my $name = shift; | ||||
219 | |||||
220 | # Strip off charset for LC_* ids : en_GB.UTF-8 etc | ||||
221 | $name =~ s/\..*$//; | ||||
222 | |||||
223 | my ( $language, $script, $territory, $variant ) = _parse_id($name); | ||||
224 | |||||
225 | my @guesses; | ||||
226 | |||||
227 | if ( defined $script ) { | ||||
228 | my $guess = join '_', lc $language, ucfirst lc $script; | ||||
229 | |||||
230 | push @guesses, $guess; | ||||
231 | |||||
232 | $guess .= '_' . uc $territory if defined $territory; | ||||
233 | |||||
234 | # version with script comes first | ||||
235 | unshift @guesses, $guess; | ||||
236 | } | ||||
237 | |||||
238 | if ( defined $variant ) { | ||||
239 | push @guesses, join '_', lc $language, uc $territory, uc $variant; | ||||
240 | } | ||||
241 | |||||
242 | if ( defined $territory ) { | ||||
243 | push @guesses, join '_', lc $language, uc $territory; | ||||
244 | } | ||||
245 | |||||
246 | push @guesses, lc $language; | ||||
247 | |||||
248 | foreach my $id (@guesses) { | ||||
249 | return $id | ||||
250 | if exists $DataForID{$id} || exists $AliasToID{$id}; | ||||
251 | } | ||||
252 | } | ||||
253 | |||||
254 | sub _parse_id { | ||||
255 | $_[0] =~ /([a-z]+) # id | ||||
256 | (?: _([A-Z][a-z]+) )? # script - Title Case - optional | ||||
257 | (?: _([A-Z]+) )? # territory - ALL CAPS - optional | ||||
258 | (?: _([A-Z]+) )? # variant - ALL CAPS - optional | ||||
259 | /x; | ||||
260 | |||||
261 | return $1, $2, $3, $4; | ||||
262 | } | ||||
263 | |||||
264 | # spent 25.8ms (2.17+23.6) within DateTime::Locale::_load_class_from_id which was called:
# once (2.17ms+23.6ms) by DateTime::Locale::load at line 200 | ||||
265 | 11 | 228µs | my $class = shift; | ||
266 | my $id = shift; | ||||
267 | my $real_class = shift; | ||||
268 | |||||
269 | # We want the first alias for which there is data, even if it has | ||||
270 | # no corresponding .pm file. There may be multiple levels of | ||||
271 | # alias to go through. | ||||
272 | my $data_id = $id; | ||||
273 | while ( exists $AliasToID{$data_id} && !exists $DataForID{$data_id} ) { | ||||
274 | $data_id = $AliasToID{$data_id}; | ||||
275 | } | ||||
276 | |||||
277 | $real_class ||= "DateTime::Locale::$data_id"; | ||||
278 | |||||
279 | 2 | 94µs | 1 | 10µs | unless ( $real_class->can('new') ) { # spent 10µs making 1 call to UNIVERSAL::can |
280 | eval "require $real_class"; # spent 482µs executing statements in string eval | ||||
281 | |||||
282 | die $@ if $@; | ||||
283 | } | ||||
284 | |||||
285 | my $locale = $real_class->new( | ||||
286 | 1 | 218µs | %{ $DataForID{$data_id} }, # spent 218µs making 1 call to DateTime::Locale::Base::new | ||
287 | id => $id, | ||||
288 | ); | ||||
289 | |||||
290 | return $locale if $DateTime::Locale::InGenerator; | ||||
291 | |||||
292 | 3 | 51µs | 1 | 11µs | if ( $locale->can('cldr_version') ) { # spent 11µs making 1 call to UNIVERSAL::can |
293 | 1 | 13µs | my $object_version = $locale->cldr_version(); # spent 13µs making 1 call to DateTime::Locale::en_US::cldr_version | ||
294 | 1 | 14µs | my $catalog_version = DateTime::Locale::Catalog->CLDRVersion(); # spent 14µs making 1 call to DateTime::Locale::Catalog::CLDRVersion | ||
295 | |||||
296 | if ( $object_version ne $catalog_version ) { | ||||
297 | warn | ||||
298 | "Loaded $real_class, which is from an older version ($object_version)" | ||||
299 | . "of the CLDR database than this installation of" | ||||
300 | . "DateTime::Locale ($catalog_version).\n"; | ||||
301 | } | ||||
302 | } | ||||
303 | |||||
304 | return $locale; | ||||
305 | } | ||||
306 | |||||
307 | 1 | 42µs | 1; | ||
308 | |||||
309 | __END__ | ||||
# spent 2.72ms within DateTime::Locale::CORE:match which was called 466 times, avg 6µs/call:
# 466 times (2.72ms+0s) by DateTime::Locale::_register at line 62, avg 6µs/call |