← Index
NYTProf Performance Profile   « block view • line view • sub view »
For /usr/share/koha/opac/cgi-bin/opac/opac-search.pl
  Run on Tue Oct 15 17:10:45 2013
Reported on Tue Oct 15 17:12:35 2013

Filename/usr/share/perl5/DateTime/Locale.pm
StatementsExecuted 14999 statements in 82.2ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
4661128.3ms57.7msDateTime::Locale::::_registerDateTime::Locale::_register
11111.1ms11.2msDateTime::Locale::::BEGIN@11DateTime::Locale::BEGIN@11
1114.71ms21.4msDateTime::Locale::::add_aliasesDateTime::Locale::add_aliases
422114.34ms16.7msDateTime::Locale::::_registered_idDateTime::Locale::_registered_id
1114.26ms61.9msDateTime::Locale::::registerDateTime::Locale::register
1113.98ms4.47msDateTime::Locale::::BEGIN@10DateTime::Locale::BEGIN@10
46611766µs766µsDateTime::Locale::::CORE:matchDateTime::Locale::CORE:match (opcode)
111539µs7.33msDateTime::Locale::::_load_class_from_idDateTime::Locale::_load_class_from_id
11199µs83.7msDateTime::Locale::::BEGIN@140DateTime::Locale::BEGIN@140
11161µs61µsDateTime::Locale::::BEGIN@6DateTime::Locale::BEGIN@6
11137µs7.42msDateTime::Locale::::loadDateTime::Locale::load
11120µs387µsDateTime::Locale::::BEGIN@12DateTime::Locale::BEGIN@12
11118µs23µsDateTime::Locale::::BEGIN@3DateTime::Locale::BEGIN@3
11110µs25µsDateTime::Locale::::BEGIN@4DateTime::Locale::BEGIN@4
0000s0sDateTime::Locale::::_guess_idDateTime::Locale::_guess_id
0000s0sDateTime::Locale::::_parse_idDateTime::Locale::_parse_id
0000s0sDateTime::Locale::::idsDateTime::Locale::ids
0000s0sDateTime::Locale::::namesDateTime::Locale::names
0000s0sDateTime::Locale::::native_namesDateTime::Locale::native_names
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
3329µs228µs
# spent 23µs (18+5) within DateTime::Locale::BEGIN@3 which was called: # once (18µs+5µs) by DateTime::BEGIN@40 at line 3
use strict;
# spent 23µs making 1 call to DateTime::Locale::BEGIN@3 # spent 5µs making 1 call to strict::import
4328µs240µs
# spent 25µs (10+15) within DateTime::Locale::BEGIN@4 which was called: # once (10µs+15µs) by DateTime::BEGIN@40 at line 4
use warnings;
# spent 25µs making 1 call to DateTime::Locale::BEGIN@4 # spent 15µs making 1 call to warnings::import
5
63142µs161µs
# spent 61µs within DateTime::Locale::BEGIN@6 which was called: # once (61µs+0s) by DateTime::BEGIN@40 at line 6
use 5.006;
# spent 61µ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.
103143µs24.48ms
# spent 4.47ms (3.98+492µs) within DateTime::Locale::BEGIN@10 which was called: # once (3.98ms+492µs) by DateTime::BEGIN@40 at line 10
use DateTime::Locale::Base;
# spent 4.47ms making 1 call to DateTime::Locale::BEGIN@10 # spent 5µs making 1 call to UNIVERSAL::import
113258µs211.2ms
# spent 11.2ms (11.1+93µs) within DateTime::Locale::BEGIN@11 which was called: # once (11.1ms+93µs) by DateTime::BEGIN@40 at line 11
use DateTime::Locale::Catalog;
# spent 11.2ms making 1 call to DateTime::Locale::BEGIN@11 # spent 7µs making 1 call to UNIVERSAL::import
123711µs2754µs
# spent 387µs (20+367) within DateTime::Locale::BEGIN@12 which was called: # once (20µs+367µs) by DateTime::BEGIN@40 at line 12
use Params::Validate qw( validate validate_pos SCALAR );
# spent 387µs making 1 call to DateTime::Locale::BEGIN@12 # spent 367µs making 1 call to Exporter::import
13
141800nsour $VERSION = '0.45';
15
161300nsmy %Class;
171200nsmy %DataForID;
181100nsmy %NameToID;
191200nsmy %NativeNameToID;
201200nsmy %AliasToID;
211200nsmy %IDToExtra;
22
231100nsmy %LoadCache;
24
25
# spent 61.9ms (4.26+57.7) within DateTime::Locale::register which was called: # once (4.26ms+57.7ms) by DateTime::Locale::BEGIN@140 at line 141
sub register {
2612µs my $class = shift;
27
2811µs %LoadCache = ();
29
3014.04ms46657.7ms if ( ref $_[0] ) {
# spent 57.7ms making 466 calls to DateTime::Locale::_register, avg 124µs/call
31 $class->_register(%$_) foreach @_;
32 }
33 else {
34 $class->_register(@_);
35 }
36}
37
38
# spent 57.7ms (28.3+29.4) within DateTime::Locale::_register which was called 466 times, avg 124µs/call: # 466 times (28.3ms+29.4ms) by DateTime::Locale::register at line 30, avg 124µs/call
sub _register {
39466413µs my $class = shift;
40
4146639.6ms46628.6ms my %p = validate(
# spent 28.6ms making 466 calls to Params::Validate::_validate, avg 61µs/call
# spent 2.20ms 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
60466465µs my $id = $p{id};
61
624662.28ms466766µs die "'\@' or '=' are not allowed in locale ids"
# spent 766µs making 466 calls to DateTime::Locale::CORE:match, avg 2µs/call
63 if $id =~ /[\@=]/;
64
65466841µ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
69466301µs $p{native_language} = $p{en_language}
70 unless exists $p{native_language};
71
72466147µs my @en_pieces;
73466104µs my @native_pieces;
74466742µs foreach my $p (qw( language script territory variant )) {
7518641.84ms push @en_pieces, $p{"en_$p"} if exists $p{"en_$p"};
7618642.38ms push @native_pieces, $p{"native_$p"} if exists $p{"native_$p"};
77 }
78
79466929µs $p{en_complete_name} = join ' ', @en_pieces;
80466733µs $p{native_complete_name} = join ' ', @native_pieces;
81
82466726µs $DataForID{$id} = \%p;
83
84466781µs $NameToID{ $p{en_complete_name} } = $id;
85466750µs $NativeNameToID{ $p{native_complete_name} } = $id;
86
874662.68ms $Class{$id} = $p{class} if defined exists $p{class};
88}
89
90
# spent 16.7ms (4.34+12.4) within DateTime::Locale::_registered_id which was called 422 times, avg 40µs/call: # 422 times (4.34ms+12.4ms) by DateTime::Locale::add_aliases at line 108, avg 40µs/call
sub _registered_id {
91422170µs shift;
9242213.6ms42212.4ms my ($id) = validate_pos( @_, { type => SCALAR } );
# spent 12.4ms making 422 calls to Params::Validate::_validate_pos, avg 29µs/call
# spent 1.53ms executing statements in 422 string evals (merged)
93
94422292µs return 1 if $AliasToID{$id};
954221.50ms return 1 if $DataForID{$id};
96
97 return 0;
98}
99
100
# spent 21.4ms (4.71+16.7) within DateTime::Locale::add_aliases which was called: # once (4.71ms+16.7ms) by DateTime::Locale::BEGIN@140 at line 142
sub add_aliases {
10111µs shift;
102
10312µs %LoadCache = ();
104
1051220µs my $aliases = ref $_[0] ? $_[0] : {@_};
106
1071958µs while ( my ( $alias, $id ) = each %$aliases ) {
108422953µs42216.7ms die
# spent 16.7ms 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
112422281µs die "Can't alias an id to itself"
113 if $alias eq $id;
114
115 # check for overwrite?
116
117422696µs my %seen = ( $alias => 1, $id => 1 );
118422140µs my $copy = $id;
119422474µ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
126422564µs $AliasToID{$alias} = $id;
127 }
128}
129
130sub 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 83.7ms (99µs+83.6) within DateTime::Locale::BEGIN@140 which was called: # once (99µs+83.6ms) by DateTime::BEGIN@40 at line 143
BEGIN {
141162µs262.0ms __PACKAGE__->register( DateTime::Locale::Catalog->Locales() );
# spent 61.9ms making 1 call to DateTime::Locale::register # spent 28µs making 1 call to DateTime::Locale::Catalog::Locales
142129µs221.6ms __PACKAGE__->add_aliases( DateTime::Locale::Catalog->Aliases() );
# spent 21.4ms making 1 call to DateTime::Locale::add_aliases # spent 239µs making 1 call to DateTime::Locale::Catalog::Aliases
1431948µs183.7ms}
# spent 83.7ms making 1 call to DateTime::Locale::BEGIN@140
144
145sub ids { wantarray ? keys %DataForID : [ keys %DataForID ] }
146sub names { wantarray ? keys %NameToID : [ keys %NameToID ] }
147
148sub native_names {
149 wantarray ? keys %NativeNameToID : [ keys %NativeNameToID ];
150}
151
152# These are hardcoded for backwards comaptibility with the
153# DateTime::Language code.
154115µsmy %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 7.42ms (37µs+7.39) within DateTime::Locale::load which was called: # once (37µs+7.39ms) by DateTime::DefaultLocale at line 99 of DateTime.pm
sub load {
18111µs my $class = shift;
182168µs160µs my ($name) = validate_pos( @_, { type => SCALAR } );
# spent 60µs making 1 call to Params::Validate::_validate_pos
# spent 8µs executing statements in string eval
183
184 # Support RFC 3066 language tags, which use '-' instead of '_'.
18512µs $name =~ tr/-/_/;
186
1871800ns my $key = $name;
188
18911µs return $LoadCache{$key} if exists $LoadCache{$key};
190
191 # Custom class registered by user
19213µ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
19811µs $name = $OldAliases{$name} if exists $OldAliases{$name};
199
200112µs17.33ms if ( exists $DataForID{$name} || exists $AliasToID{$name} ) {
# spent 7.33ms 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
216sub _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
254sub _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 7.33ms (539µs+6.79) within DateTime::Locale::_load_class_from_id which was called: # once (539µs+6.79ms) by DateTime::Locale::load at line 200
sub _load_class_from_id {
2651900ns my $class = shift;
2661800ns my $id = shift;
2671500ns 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.
2721500ns my $data_id = $id;
27312µs while ( exists $AliasToID{$data_id} && !exists $DataForID{$data_id} ) {
274 $data_id = $AliasToID{$data_id};
275 }
276
27712µs $real_class ||= "DateTime::Locale::$data_id";
278
279112µs12µs unless ( $real_class->can('new') ) {
# spent 2µs making 1 call to UNIVERSAL::can
280128µs eval "require $real_class";
# spent 115µs executing statements in string eval
281
28211µs die $@ if $@;
283 }
284
285 my $locale = $real_class->new(
286132µs1706µs %{ $DataForID{$data_id} },
# spent 706µs making 1 call to DateTime::Locale::Base::new
287 id => $id,
288 );
289
2901700ns return $locale if $DateTime::Locale::InGenerator;
291
292114µs13µs if ( $locale->can('cldr_version') ) {
# spent 3µs making 1 call to UNIVERSAL::can
29312µs11µs my $object_version = $locale->cldr_version();
# spent 1µs making 1 call to DateTime::Locale::en_US::cldr_version
29416µs13µs my $catalog_version = DateTime::Locale::Catalog->CLDRVersion();
# spent 3µs making 1 call to DateTime::Locale::Catalog::CLDRVersion
295
29612µ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
30416µs return $locale;
305}
306
307111µs1;
308
309__END__
 
# spent 766µs within DateTime::Locale::CORE:match which was called 466 times, avg 2µs/call: # 466 times (766µs+0s) by DateTime::Locale::_register at line 62, avg 2µs/call
sub DateTime::Locale::CORE:match; # opcode
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.