Profile of DateTime/Locale.pm

Filename	/usr/local/share/perl/5.10.1/DateTime/Locale.pm
Statements	Executed 14999 statements in 73.0ms

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
466	1	1	22.9ms	49.2ms	DateTime::Locale::::_registerDateTime::Locale::_register
1	1	1	13.7ms	14.0ms	DateTime::Locale::::BEGIN@11DateTime::Locale::BEGIN@11
1	1	1	4.79ms	13.3ms	DateTime::Locale::::BEGIN@10DateTime::Locale::BEGIN@10
1	1	1	4.54ms	21.6ms	DateTime::Locale::::add_aliasesDateTime::Locale::add_aliases
422	1	1	3.95ms	17.1ms	DateTime::Locale::::_registered_idDateTime::Locale::_registered_id
1	1	1	3.26ms	52.4ms	DateTime::Locale::::registerDateTime::Locale::register
1	1	1	544µs	6.25ms	DateTime::Locale::::_load_class_from_idDateTime::Locale::_load_class_from_id
466	1	1	487µs	487µs	DateTime::Locale::::CORE:matchDateTime::Locale::CORE:match (opcode)
1	1	1	49µs	74.4ms	DateTime::Locale::::BEGIN@140DateTime::Locale::BEGIN@140
1	1	1	23µs	23µs	DateTime::Locale::::BEGIN@6DateTime::Locale::BEGIN@6
1	1	1	23µs	6.31ms	DateTime::Locale::::loadDateTime::Locale::load
1	1	1	16µs	20µs	DateTime::Locale::::BEGIN@3DateTime::Locale::BEGIN@3
1	1	1	11µs	68µs	DateTime::Locale::::BEGIN@12DateTime::Locale::BEGIN@12
1	1	1	10µs	22µs	DateTime::Locale::::BEGIN@4DateTime::Locale::BEGIN@4
0	0	0	0s	0s	DateTime::Locale::::_guess_idDateTime::Locale::_guess_id
0	0	0	0s	0s	DateTime::Locale::::_parse_idDateTime::Locale::_parse_id
0	0	0	0s	0s	DateTime::Locale::::idsDateTime::Locale::ids
0	0	0	0s	0s	DateTime::Locale::::namesDateTime::Locale::names
0	0	0	0s	0s	DateTime::Locale::::native_namesDateTime::Locale::native_names
0	0	0	0s	0s	DateTime::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
1					package DateTime::Locale;
2
3	3	32µs	2	24µs	# spent 20µs (16+4) within DateTime::Locale::BEGIN@3 which was called: # once (16µs+4µs) by DateTime::BEGIN@45 at line 3 use strict; # spent 20µs making 1 call to DateTime::Locale::BEGIN@3 # spent 4µs making 1 call to strict::import
4	3	35µs	2	35µs	# spent 22µs (10+13) within DateTime::Locale::BEGIN@4 which was called: # once (10µs+13µs) by DateTime::BEGIN@45 at line 4 use warnings; # spent 22µs making 1 call to DateTime::Locale::BEGIN@4 # spent 13µs making 1 call to warnings::import
5
6	3	55µs	1	23µs	# spent 23µs within DateTime::Locale::BEGIN@6 which was called: # once (23µs+0s) by DateTime::BEGIN@45 at line 6 use 5.006; # spent 23µ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	127µs	1	13.3ms	# spent 13.3ms (4.79+8.55) within DateTime::Locale::BEGIN@10 which was called: # once (4.79ms+8.55ms) by DateTime::BEGIN@45 at line 10 use DateTime::Locale::Base; # spent 13.3ms making 1 call to DateTime::Locale::BEGIN@10
11	3	162µs	1	14.0ms	# spent 14.0ms (13.7+293µs) within DateTime::Locale::BEGIN@11 which was called: # once (13.7ms+293µs) by DateTime::BEGIN@45 at line 11 use DateTime::Locale::Catalog; # spent 14.0ms making 1 call to DateTime::Locale::BEGIN@11
12	3	1.00ms	2	125µs	# spent 68µs (11+57) within DateTime::Locale::BEGIN@12 which was called: # once (11µs+57µs) by DateTime::BEGIN@45 at line 12 use Params::Validate qw( validate validate_pos SCALAR ); # spent 68µs making 1 call to DateTime::Locale::BEGIN@12 # spent 57µs making 1 call to Exporter::import
13
14	1	800ns			our $VERSION = '0.45';
15
16	1	200ns			my %Class;
17	1	100ns			my %DataForID;
18	1	100ns			my %NameToID;
19	1	100ns			my %NativeNameToID;
20	1	100ns			my %AliasToID;
21	1	100ns			my %IDToExtra;
22
23	1	100ns			my %LoadCache;
24
25					# spent 52.4ms (3.26+49.2) within DateTime::Locale::register which was called: # once (3.26ms+49.2ms) by DateTime::Locale::BEGIN@140 at line 141 sub register {
26	1	1µs			my $class = shift;
27
28	1	700ns			%LoadCache = ();
29
30	1	2.58ms	466	49.2ms	if ( ref $_[0] ) { # spent 49.2ms making 466 calls to DateTime::Locale::_register, avg 106µs/call
31					$class->_register(%$_) foreach @_;
32					}
33					else {
34					$class->_register(@_);
35					}
36					}
37
38					# spent 49.2ms (22.9+26.3) within DateTime::Locale::_register which was called 466 times, avg 106µs/call: # 466 times (22.9ms+26.3ms) by DateTime::Locale::register at line 30, avg 106µs/call sub _register {
39	466	274µs			my $class = shift;
40
41	466	36.1ms	466	25.8ms	my %p = validate( # spent 25.8ms making 466 calls to Params::Validate::_validate, avg 55µs/call # spent 1.97ms 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	466	287µs			my $id = $p{id};
61
62	466	1.62ms	466	487µs	die "'\@' or '=' are not allowed in locale ids" # spent 487µs making 466 calls to DateTime::Locale::CORE:match, avg 1µs/call
63					if $id =~ /[\@=]/;
64
65	466	576µs			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	466	217µs			$p{native_language} = $p{en_language}
70					unless exists $p{native_language};
71
72	466	93µs			my @en_pieces;
73	466	48µs			my @native_pieces;
74	466	482µs			foreach my $p (qw( language script territory variant )) {
75	1864	1.48ms			push @en_pieces, $p{"en_$p"} if exists $p{"en_$p"};
76	1864	1.84ms			push @native_pieces, $p{"native_$p"} if exists $p{"native_$p"};
77					}
78
79	466	646µs			$p{en_complete_name} = join ' ', @en_pieces;
80	466	555µs			$p{native_complete_name} = join ' ', @native_pieces;
81
82	466	431µs			$DataForID{$id} = \%p;
83
84	466	489µs			$NameToID{ $p{en_complete_name} } = $id;
85	466	476µs			$NativeNameToID{ $p{native_complete_name} } = $id;
86
87	466	2.29ms			$Class{$id} = $p{class} if defined exists $p{class};
88					}
89
90					# spent 17.1ms (3.95+13.1) within DateTime::Locale::_registered_id which was called 422 times, avg 40µs/call: # 422 times (3.95ms+13.1ms) by DateTime::Locale::add_aliases at line 108, avg 40µs/call sub _registered_id {
91	422	134µs			shift;
92	422	14.2ms	422	13.1ms	my ($id) = validate_pos( @_, { type => SCALAR } ); # spent 13.1ms making 422 calls to Params::Validate::_validate_pos, avg 31µs/call # spent 1.70ms executing statements in 422 string evals (merged)
93
94	422	195µs			return 1 if $AliasToID{$id};
95	422	1.48ms			return 1 if $DataForID{$id};
96
97					return 0;
98					}
99
100					# spent 21.6ms (4.54+17.1) within DateTime::Locale::add_aliases which was called: # once (4.54ms+17.1ms) by DateTime::Locale::BEGIN@140 at line 142 sub add_aliases {
101	1	400ns			shift;
102
103	1	700ns			%LoadCache = ();
104
105	1	219µs			my $aliases = ref $_[0] ? $_[0] : {@_};
106
107	1	879µs			while ( my ( $alias, $id ) = each %$aliases ) {
108	422	871µs	422	17.1ms	die # spent 17.1ms making 422 calls to DateTime::Locale::_registered_id, avg 40µs/call
109					"Unregistered locale '$id' cannot be used as an alias target for $alias"
110					unless __PACKAGE__->_registered_id($id);
111
112	422	241µs			die "Can't alias an id to itself"
113					if $alias eq $id;
114
115					# check for overwrite?
116
117	422	644µs			my %seen = ( $alias => 1, $id => 1 );
118	422	125µs			my $copy = $id;
119	422	338µs			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	422	632µs			$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 74.4ms (49µs+74.3) within DateTime::Locale::BEGIN@140 which was called: # once (49µs+74.3ms) by DateTime::BEGIN@45 at line 143 BEGIN {
141	1	30µs	2	52.5ms	__PACKAGE__->register( DateTime::Locale::Catalog->Locales() ); # spent 52.4ms making 1 call to DateTime::Locale::register # spent 26µs making 1 call to DateTime::Locale::Catalog::Locales
142	1	18µs	2	21.9ms	__PACKAGE__->add_aliases( DateTime::Locale::Catalog->Aliases() ); # spent 21.6ms making 1 call to DateTime::Locale::add_aliases # spent 227µs making 1 call to DateTime::Locale::Catalog::Aliases
143	1	1.00ms	1	74.4ms	} # spent 74.4ms 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	10µ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 6.31ms (23µs+6.29) within DateTime::Locale::load which was called: # once (23µs+6.29ms) by DateTime::DefaultLocale at line 104 of DateTime.pm sub load {
181	1	800ns			my $class = shift;
182	1	46µs	1	40µs	my ($name) = validate_pos( @_, { type => SCALAR } ); # spent 40µs making 1 call to Params::Validate::_validate_pos # spent 4µs executing statements in string eval
183
184					# Support RFC 3066 language tags, which use '-' instead of '_'.
185	1	1µs			$name =~ tr/-/_/;
186
187	1	600ns			my $key = $name;
188
189	1	800ns			return $LoadCache{$key} if exists $LoadCache{$key};
190
191					# Custom class registered by user
192	1	1µs			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	1	500ns			$name = $OldAliases{$name} if exists $OldAliases{$name};
199
200	1	9µs	1	6.25ms	if ( exists $DataForID{$name} \|\| exists $AliasToID{$name} ) { # spent 6.25ms 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 6.25ms (544µs+5.70) within DateTime::Locale::_load_class_from_id which was called: # once (544µs+5.70ms) by DateTime::Locale::load at line 200 sub _load_class_from_id {
265	1	800ns			my $class = shift;
266	1	300ns			my $id = shift;
267	1	300ns			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	1	400ns			my $data_id = $id;
273	1	1µs			while ( exists $AliasToID{$data_id} && !exists $DataForID{$data_id} ) {
274					$data_id = $AliasToID{$data_id};
275					}
276
277	1	1µs			$real_class \|\|= "DateTime::Locale::$data_id";
278
279	1	9µs	1	2µs	unless ( $real_class->can('new') ) { # spent 2µs making 1 call to UNIVERSAL::can
280	1	25µs			eval "require $real_class"; # spent 107µs executing statements in string eval
281
282	1	400ns			die $@ if $@;
283					}
284
285					my $locale = $real_class->new(
286	1	15µs	1	46µs	%{ $DataForID{$data_id} }, # spent 46µs making 1 call to DateTime::Locale::Base::new
287					id => $id,
288					);
289
290	1	300ns			return $locale if $DateTime::Locale::InGenerator;
291
292	1	10µs	1	2µs	if ( $locale->can('cldr_version') ) { # spent 2µs making 1 call to UNIVERSAL::can
293	1	2µs	1	2µs	my $object_version = $locale->cldr_version(); # spent 2µs making 1 call to DateTime::Locale::en_US::cldr_version
294	1	6µs	1	3µs	my $catalog_version = DateTime::Locale::Catalog->CLDRVersion(); # spent 3µs making 1 call to DateTime::Locale::Catalog::CLDRVersion
295
296	1	1µs			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	1	4µs			return $locale;
305					}
306
307	1	12µs			1;
308
309					__END__

					# spent 487µs within DateTime::Locale::CORE:match which was called 466 times, avg 1µs/call: # 466 times (487µs+0s) by DateTime::Locale::_register at line 62, avg 1µs/call sub DateTime::Locale::CORE:match; # opcode