| Filename | /home/s1/perl5/perlbrew/perls/perl-5.22.1/lib/site_perl/5.22.1/DateTime/Locale.pm |
| Statements | Executed 38 statements in 2.97ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 20.3ms | 20.3ms | DateTime::Locale::BEGIN@10 |
| 1 | 1 | 1 | 1.90ms | 3.03ms | DateTime::Locale::BEGIN@11 |
| 2 | 2 | 2 | 48µs | 132µs | DateTime::Locale::load |
| 1 | 1 | 1 | 32µs | 32µs | DateTime::Locale::BEGIN@3 |
| 1 | 1 | 1 | 20µs | 59µs | DateTime::Locale::_locale_object_for |
| 1 | 1 | 1 | 13µs | 17µs | DateTime::Locale::BEGIN@5 |
| 1 | 1 | 1 | 12µs | 34µs | DateTime::Locale::BEGIN@6 |
| 1 | 1 | 1 | 10µs | 40µs | DateTime::Locale::BEGIN@12 |
| 1 | 1 | 1 | 9µs | 46µs | DateTime::Locale::BEGIN@13 |
| 2 | 1 | 1 | 3µs | 3µs | DateTime::Locale::CORE:subst (opcode) |
| 0 | 0 | 0 | 0s | 0s | DateTime::Locale::_guess_code |
| 0 | 0 | 0 | 0s | 0s | DateTime::Locale::_load_class_from_code |
| 0 | 0 | 0 | 0s | 0s | DateTime::Locale::_register |
| 0 | 0 | 0 | 0s | 0s | DateTime::Locale::_registered_locale_for |
| 0 | 0 | 0 | 0s | 0s | DateTime::Locale::add_aliases |
| 0 | 0 | 0 | 0s | 0s | DateTime::Locale::codes |
| 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::register |
| 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 | 2 | 64µs | 1 | 32µs | # spent 32µs within DateTime::Locale::BEGIN@3 which was called:
# once (32µs+0s) by DateTime::BEGIN@14 at line 3 # spent 32µs making 1 call to DateTime::Locale::BEGIN@3 |
| 4 | |||||
| 5 | 2 | 34µs | 2 | 22µs | # spent 17µs (13+4) within DateTime::Locale::BEGIN@5 which was called:
# once (13µs+4µs) by DateTime::BEGIN@14 at line 5 # spent 17µs making 1 call to DateTime::Locale::BEGIN@5
# spent 4µs making 1 call to strict::import |
| 6 | 2 | 75µs | 2 | 55µs | # spent 34µs (12+22) within DateTime::Locale::BEGIN@6 which was called:
# once (12µs+22µs) by DateTime::BEGIN@14 at line 6 # spent 34µs making 1 call to DateTime::Locale::BEGIN@6
# spent 22µs making 1 call to warnings::import |
| 7 | |||||
| 8 | 1 | 900ns | our $VERSION = '1.03'; | ||
| 9 | |||||
| 10 | 2 | 644µs | 1 | 20.3ms | # spent 20.3ms (20.3+46µs) within DateTime::Locale::BEGIN@10 which was called:
# once (20.3ms+46µs) by DateTime::BEGIN@14 at line 10 # spent 20.3ms making 1 call to DateTime::Locale::BEGIN@10 |
| 11 | 2 | 542µs | 1 | 3.03ms | # spent 3.03ms (1.90+1.13) within DateTime::Locale::BEGIN@11 which was called:
# once (1.90ms+1.13ms) by DateTime::BEGIN@14 at line 11 # spent 3.03ms making 1 call to DateTime::Locale::BEGIN@11 |
| 12 | 2 | 34µs | 2 | 71µs | # spent 40µs (10+30) within DateTime::Locale::BEGIN@12 which was called:
# once (10µs+30µs) by DateTime::BEGIN@14 at line 12 # spent 40µs making 1 call to DateTime::Locale::BEGIN@12
# spent 30µs making 1 call to Exporter::import |
| 13 | 2 | 1.46ms | 2 | 83µs | # spent 46µs (9+37) within DateTime::Locale::BEGIN@13 which was called:
# once (9µs+37µs) by DateTime::BEGIN@14 at line 13 # spent 46µs making 1 call to DateTime::Locale::BEGIN@13
# spent 37µs making 1 call to Exporter::import |
| 14 | |||||
| 15 | 1 | 300ns | my %Class; | ||
| 16 | my %DataForCode; | ||||
| 17 | my %NameToCode; | ||||
| 18 | my %NativeNameToCode; | ||||
| 19 | my %UserDefinedAlias; | ||||
| 20 | |||||
| 21 | my %LoadCache; | ||||
| 22 | |||||
| 23 | sub 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 | |||||
| 36 | sub _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 | |||||
| 90 | sub 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 | |||||
| 119 | sub 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 | ||||
| 130 | sub ids { | ||||
| 131 | shift->codes; | ||||
| 132 | } | ||||
| 133 | |||||
| 134 | ## no critic (Variables::ProhibitPackageVars) | ||||
| 135 | sub codes { | ||||
| 136 | wantarray | ||||
| 137 | ? keys %DateTime::Locale::Data::Codes | ||||
| 138 | : [ keys %DateTime::Locale::Data::Codes ]; | ||||
| 139 | } | ||||
| 140 | |||||
| 141 | sub names { | ||||
| 142 | wantarray | ||||
| 143 | ? keys %DateTime::Locale::Data::Names | ||||
| 144 | : [ keys %DateTime::Locale::Data::Names ]; | ||||
| 145 | } | ||||
| 146 | |||||
| 147 | sub 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. | ||||
| 155 | 1 | 10µs | my %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 | |||||
| 184 | 1 | 1µs | my %POSIXAliases = ( | ||
| 185 | C => 'en-US-POSIX', | ||||
| 186 | POSIX => 'en-US-POSIX', | ||||
| 187 | ); | ||||
| 188 | |||||
| 189 | # spent 132µs (48+85) within DateTime::Locale::load which was called 2 times, avg 66µs/call:
# once (32µs+73µs) by FakeLocale::instance at line 131 of DateTime/Infinite.pm
# once (15µs+12µs) by DateTime::DefaultLocale at line 104 of DateTime.pm | ||||
| 190 | 2 | 1µs | my $class = shift; | ||
| 191 | 2 | 43µs | 2 | 23µs | my ($code) = validate_pos( @_, { type => SCALAR } ); # spent 23µs making 2 calls to Params::Validate::XS::validate_pos, avg 12µs/call |
| 192 | |||||
| 193 | # We used to use underscores in codes instead of dashes. We want to | ||||
| 194 | # support both indefinitely. | ||||
| 195 | 2 | 2µs | $code =~ tr/_/-/; | ||
| 196 | |||||
| 197 | # Strip off charset for LC_* codes : en_GB.UTF-8 etc | ||||
| 198 | 2 | 11µs | 2 | 3µs | $code =~ s/\..*$//; # spent 3µs making 2 calls to DateTime::Locale::CORE:subst, avg 1µs/call |
| 199 | |||||
| 200 | 2 | 8µs | return $LoadCache{$code} if exists $LoadCache{$code}; | ||
| 201 | |||||
| 202 | 1 | 1µs | while ( exists $UserDefinedAlias{$code} ) { | ||
| 203 | $code = $UserDefinedAlias{$code}; | ||||
| 204 | } | ||||
| 205 | |||||
| 206 | $code = $DateTimeLanguageAliases{$code} | ||||
| 207 | 1 | 800ns | if exists $DateTimeLanguageAliases{$code}; | ||
| 208 | 1 | 600ns | $code = $POSIXAliases{$code} if exists $POSIXAliases{$code}; | ||
| 209 | $code = $DateTime::Locale::Data::ISO639Aliases{$code} | ||||
| 210 | 1 | 700ns | if exists $DateTime::Locale::Data::ISO639Aliases{$code}; | ||
| 211 | |||||
| 212 | 1 | 9µs | 1 | 59µs | if ( exists $DateTime::Locale::Data::Codes{$code} ) { # spent 59µ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 | |||||
| 237 | sub _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 59µs (20+38) within DateTime::Locale::_locale_object_for which was called:
# once (20µs+38µs) by DateTime::Locale::load at line 212 | ||||
| 275 | 1 | 400ns | shift; | ||
| 276 | 1 | 800ns | my $code = shift; | ||
| 277 | |||||
| 278 | 1 | 3µs | 1 | 4µ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 ... | ||||
| 282 | 1 | 12µs | 1 | 34µs | return $LoadCache{$code} = DateTime::Locale::FromData->new( \%{$data} ); # spent 34µs making 1 call to DateTime::Locale::FromData::new |
| 283 | } | ||||
| 284 | |||||
| 285 | sub _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 | |||||
| 310 | sub _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 | |||||
| 355 | 1 | 9µs | 1; | ||
| 356 | |||||
| 357 | # ABSTRACT: Localization support for DateTime.pm | ||||
| 358 | |||||
| 359 | __END__ | ||||
# spent 3µs within DateTime::Locale::CORE:subst which was called 2 times, avg 1µs/call:
# 2 times (3µs+0s) by DateTime::Locale::load at line 198, avg 1µs/call |