| Filename | /2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/DateTime/Locale.pm |
| Statements | Executed 16469 statements in 61.0ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 466 | 1 | 1 | 15.7ms | 31.0ms | DateTime::Locale::_register |
| 1 | 1 | 1 | 8.45ms | 8.51ms | DateTime::Locale::BEGIN@11 |
| 295 | 2 | 1 | 5.50ms | 20.3ms | DateTime::Locale::load |
| 1 | 1 | 1 | 2.87ms | 3.19ms | DateTime::Locale::BEGIN@10 |
| 1 | 1 | 1 | 2.79ms | 11.9ms | DateTime::Locale::add_aliases |
| 422 | 1 | 1 | 2.41ms | 9.12ms | DateTime::Locale::_registered_id |
| 1 | 1 | 1 | 1.62ms | 32.7ms | DateTime::Locale::register |
| 1 | 1 | 1 | 344µs | 3.61ms | DateTime::Locale::_load_class_from_id |
| 466 | 1 | 1 | 279µs | 279µs | DateTime::Locale::CORE:match (opcode) |
| 1 | 1 | 1 | 57µs | 57µs | DateTime::Locale::BEGIN@6 |
| 1 | 1 | 1 | 47µs | 44.8ms | DateTime::Locale::BEGIN@140 |
| 1 | 1 | 1 | 15µs | 89µs | DateTime::Locale::BEGIN@12 |
| 1 | 1 | 1 | 15µs | 20µs | DateTime::Locale::BEGIN@3 |
| 1 | 1 | 1 | 9µs | 24µs | DateTime::Locale::BEGIN@4 |
| 0 | 0 | 0 | 0s | 0s | DateTime::Locale::_guess_id |
| 0 | 0 | 0 | 0s | 0s | DateTime::Locale::_parse_id |
| 0 | 0 | 0 | 0s | 0s | DateTime::Locale::ids |
| 0 | 0 | 0 | 0s | 0s | DateTime::Locale::names |
| 0 | 0 | 0 | 0s | 0s | DateTime::Locale::native_names |
| 0 | 0 | 0 | 0s | 0s | DateTime::Locale::remove_alias |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package DateTime::Locale; | ||||
| 2 | |||||
| 3 | 3 | 19µs | 2 | 25µs | # spent 20µs (15+5) within DateTime::Locale::BEGIN@3 which was called:
# once (15µs+5µs) by DateTime::BEGIN@47 at line 3 # spent 20µs making 1 call to DateTime::Locale::BEGIN@3
# spent 5µs making 1 call to strict::import |
| 4 | 3 | 18µs | 2 | 40µs | # spent 24µs (9+15) within DateTime::Locale::BEGIN@4 which was called:
# once (9µs+15µs) by DateTime::BEGIN@47 at line 4 # spent 24µs making 1 call to DateTime::Locale::BEGIN@4
# spent 16µs making 1 call to warnings::import |
| 5 | |||||
| 6 | 3 | 70µs | 1 | 57µs | # spent 57µs within DateTime::Locale::BEGIN@6 which was called:
# once (57µs+0s) by DateTime::BEGIN@47 at line 6 # spent 57µ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 | 95µs | 1 | 3.19ms | # spent 3.19ms (2.87+315µs) within DateTime::Locale::BEGIN@10 which was called:
# once (2.87ms+315µs) by DateTime::BEGIN@47 at line 10 # spent 3.19ms making 1 call to DateTime::Locale::BEGIN@10 |
| 11 | 3 | 482µs | 1 | 8.51ms | # spent 8.51ms (8.45+58µs) within DateTime::Locale::BEGIN@11 which was called:
# once (8.45ms+58µs) by DateTime::BEGIN@47 at line 11 # spent 8.51ms making 1 call to DateTime::Locale::BEGIN@11 |
| 12 | 3 | 539µs | 2 | 163µs | # spent 89µs (15+74) within DateTime::Locale::BEGIN@12 which was called:
# once (15µs+74µs) by DateTime::BEGIN@47 at line 12 # spent 89µs making 1 call to DateTime::Locale::BEGIN@12
# spent 74µs making 1 call to Exporter::import |
| 13 | |||||
| 14 | 1 | 600ns | our $VERSION = '0.45'; | ||
| 15 | |||||
| 16 | 1 | 100ns | my %Class; | ||
| 17 | 1 | 200ns | my %DataForID; | ||
| 18 | 1 | 200ns | my %NameToID; | ||
| 19 | 1 | 100ns | my %NativeNameToID; | ||
| 20 | 1 | 200ns | my %AliasToID; | ||
| 21 | 1 | 100ns | my %IDToExtra; | ||
| 22 | |||||
| 23 | 1 | 200ns | my %LoadCache; | ||
| 24 | |||||
| 25 | # spent 32.7ms (1.62+31.0) within DateTime::Locale::register which was called:
# once (1.62ms+31.0ms) by DateTime::Locale::BEGIN@140 at line 141 | ||||
| 26 | 3 | 1.19ms | my $class = shift; | ||
| 27 | |||||
| 28 | %LoadCache = (); | ||||
| 29 | |||||
| 30 | 466 | 31.0ms | if ( ref $_[0] ) { # spent 31.0ms making 466 calls to DateTime::Locale::_register, avg 67µs/call | ||
| 31 | $class->_register(%$_) foreach @_; | ||||
| 32 | } | ||||
| 33 | else { | ||||
| 34 | $class->_register(@_); | ||||
| 35 | } | ||||
| 36 | } | ||||
| 37 | |||||
| 38 | # spent 31.0ms (15.7+15.4) within DateTime::Locale::_register which was called 466 times, avg 67µs/call:
# 466 times (15.7ms+15.4ms) by DateTime::Locale::register at line 30, avg 67µs/call | ||||
| 39 | 10718 | 17.4ms | my $class = shift; | ||
| 40 | |||||
| 41 | 1 | 13.1ms | 466 | 15.1ms | my %p = validate( # spent 15.1ms making 466 calls to Params::Validate::XS::validate, avg 32µs/call # spent 883µs 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 | 279µs | die "'\@' or '=' are not allowed in locale ids" # spent 279µs making 466 calls to DateTime::Locale::CORE:match, avg 598ns/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 | 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 9.12ms (2.41+6.71) within DateTime::Locale::_registered_id which was called 422 times, avg 22µs/call:
# 422 times (2.41ms+6.71ms) by DateTime::Locale::add_aliases at line 108, avg 22µs/call | ||||
| 91 | 1688 | 6.13ms | shift; | ||
| 92 | 1 | 2.65ms | 422 | 6.71ms | my ($id) = validate_pos( @_, { type => SCALAR } ); # spent 6.71ms making 422 calls to Params::Validate::XS::validate_pos, avg 16µs/call # spent 754µs 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 11.9ms (2.79+9.12) within DateTime::Locale::add_aliases which was called:
# once (2.79ms+9.12ms) by DateTime::Locale::BEGIN@140 at line 142 | ||||
| 101 | 2536 | 2.37ms | shift; | ||
| 102 | |||||
| 103 | %LoadCache = (); | ||||
| 104 | |||||
| 105 | my $aliases = ref $_[0] ? $_[0] : {@_}; | ||||
| 106 | |||||
| 107 | while ( my ( $alias, $id ) = each %$aliases ) { | ||||
| 108 | 422 | 9.12ms | die # spent 9.12ms making 422 calls to DateTime::Locale::_registered_id, avg 22µ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 44.8ms (47µs+44.7) within DateTime::Locale::BEGIN@140 which was called:
# once (47µs+44.7ms) by DateTime::BEGIN@47 at line 143 | ||||
| 141 | 2 | 47µs | 2 | 32.7ms | __PACKAGE__->register( DateTime::Locale::Catalog->Locales() ); # spent 32.7ms making 1 call to DateTime::Locale::register
# spent 36µs making 1 call to DateTime::Locale::Catalog::Locales |
| 142 | 2 | 12.0ms | __PACKAGE__->add_aliases( DateTime::Locale::Catalog->Aliases() ); # spent 11.9ms making 1 call to DateTime::Locale::add_aliases
# spent 134µs making 1 call to DateTime::Locale::Catalog::Aliases | ||
| 143 | 1 | 675µs | 1 | 44.8ms | } # spent 44.8ms 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 | 12µ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 20.3ms (5.50+14.8) within DateTime::Locale::load which was called 295 times, avg 69µs/call:
# 294 times (5.48ms+11.1ms) by DateTime::_new at line 235 of DateTime.pm, avg 57µs/call
# once (26µs+3.64ms) by DateTime::DefaultLocale at line 106 of DateTime.pm | ||||
| 181 | 1478 | 11.2ms | my $class = shift; | ||
| 182 | 1 | 4.83ms | 295 | 11.2ms | my ($name) = validate_pos( @_, { type => SCALAR } ); # spent 11.2ms making 295 calls to Params::Validate::XS::validate_pos, avg 38µs/call # spent 1.09ms executing statements in 295 string evals (merged) |
| 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 | 3.61ms | if ( exists $DataForID{$name} || exists $AliasToID{$name} ) { # spent 3.61ms 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 3.61ms (344µs+3.27) within DateTime::Locale::_load_class_from_id which was called:
# once (344µs+3.27ms) by DateTime::Locale::load at line 200 | ||||
| 265 | 16 | 69µ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 | 1 | 1µs | unless ( $real_class->can('new') ) { # spent 1µs making 1 call to UNIVERSAL::can | ||
| 280 | eval "require $real_class"; # spent 88µs executing statements in string eval | ||||
| 281 | |||||
| 282 | die $@ if $@; | ||||
| 283 | } | ||||
| 284 | |||||
| 285 | my $locale = $real_class->new( | ||||
| 286 | 1 | 36µs | %{ $DataForID{$data_id} }, # spent 36µs making 1 call to DateTime::Locale::Base::new | ||
| 287 | id => $id, | ||||
| 288 | ); | ||||
| 289 | |||||
| 290 | return $locale if $DateTime::Locale::InGenerator; | ||||
| 291 | |||||
| 292 | 1 | 2µs | if ( $locale->can('cldr_version') ) { # spent 2µs making 1 call to UNIVERSAL::can | ||
| 293 | 1 | 1µs | my $object_version = $locale->cldr_version(); # spent 1µs making 1 call to DateTime::Locale::en_US::cldr_version | ||
| 294 | 1 | 3µs | my $catalog_version = DateTime::Locale::Catalog->CLDRVersion(); # spent 3µ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 | 8µs | 1; | ||
| 308 | |||||
| 309 | __END__ | ||||
# spent 279µs within DateTime::Locale::CORE:match which was called 466 times, avg 598ns/call:
# 466 times (279µs+0s) by DateTime::Locale::_register at line 62, avg 598ns/call |