Initial Commit
This commit is contained in:
Riley Schneider
651
database/perl/vendor/lib/DateTime/Locale.pm
vendored
Normal file
651
database/perl/vendor/lib/DateTime/Locale.pm
vendored
Normal file
@@ -0,0 +1,651 @@
|
||||
package DateTime::Locale;
|
||||
|
||||
use 5.008004;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use namespace::autoclean;
|
||||
|
||||
our $VERSION = '1.31';
|
||||
|
||||
use DateTime::Locale::Data;
|
||||
use DateTime::Locale::FromData;
|
||||
use DateTime::Locale::Util qw( parse_locale_code );
|
||||
use Params::ValidationCompiler 0.13 qw( validation_for );
|
||||
use Specio::Library::String;
|
||||
|
||||
my %Class;
|
||||
my %DataForCode;
|
||||
my %NameToCode;
|
||||
my %NativeNameToCode;
|
||||
my %UserDefinedAlias;
|
||||
|
||||
my %LoadCache;
|
||||
|
||||
sub register {
|
||||
my $class = shift;
|
||||
|
||||
%LoadCache = ();
|
||||
|
||||
if ( ref $_[0] ) {
|
||||
$class->_register(%$_) foreach @_;
|
||||
}
|
||||
else {
|
||||
$class->_register(@_);
|
||||
}
|
||||
}
|
||||
|
||||
sub _register {
|
||||
shift;
|
||||
my %p = @_;
|
||||
|
||||
my $id = $p{id};
|
||||
|
||||
die q{'\@' or '=' are not allowed in locale ids}
|
||||
if $id =~ /[\@=]/;
|
||||
|
||||
die
|
||||
"You cannot replace an existing locale ('$id') unless you also specify the 'replace' parameter as true\n"
|
||||
if !delete $p{replace} && exists $DataForCode{$id};
|
||||
|
||||
$p{native_language} = $p{en_language}
|
||||
unless exists $p{native_language};
|
||||
|
||||
my @en_pieces;
|
||||
my @native_pieces;
|
||||
foreach my $p (qw( language script territory variant )) {
|
||||
push @en_pieces, $p{"en_$p"} if exists $p{"en_$p"};
|
||||
push @native_pieces, $p{"native_$p"} if exists $p{"native_$p"};
|
||||
}
|
||||
|
||||
$p{en_complete_name} = join q{ }, @en_pieces;
|
||||
$p{native_complete_name} = join q{ }, @native_pieces;
|
||||
|
||||
$id =~ s/_/-/g;
|
||||
|
||||
$DataForCode{$id} = \%p;
|
||||
|
||||
$NameToCode{ $p{en_complete_name} } = $id;
|
||||
$NativeNameToCode{ $p{native_complete_name} } = $id;
|
||||
|
||||
$Class{$id} = $p{class} if defined exists $p{class};
|
||||
}
|
||||
|
||||
sub register_from_data {
|
||||
shift;
|
||||
|
||||
%LoadCache = ();
|
||||
|
||||
my %p = ref $_[0] ? %{ $_[0] } : @_;
|
||||
|
||||
my $code = $p{code};
|
||||
|
||||
die q{'\@' or '=' are not allowed in locale codes}
|
||||
if $code =~ /[\@=]/;
|
||||
|
||||
$code =~ s/_/-/g;
|
||||
|
||||
DateTime::Locale::Data::add_locale( $code, \%p );
|
||||
return $LoadCache{$code} = DateTime::Locale::FromData->new( \%p );
|
||||
}
|
||||
|
||||
sub add_aliases {
|
||||
shift;
|
||||
|
||||
%LoadCache = ();
|
||||
|
||||
my $aliases = ref $_[0] ? $_[0] : {@_};
|
||||
|
||||
for my $alias ( keys %{$aliases} ) {
|
||||
my $code = $aliases->{$alias};
|
||||
|
||||
die q{Can't alias an id to itself}
|
||||
if $alias eq $code;
|
||||
|
||||
# check for overwrite?
|
||||
|
||||
my %seen = ( $alias => 1, $code => 1 );
|
||||
my $copy = $code;
|
||||
while ( $copy = $UserDefinedAlias{$copy} ) {
|
||||
die
|
||||
"Creating an alias from $alias to $code would create a loop.\n"
|
||||
if $seen{$copy};
|
||||
|
||||
$seen{$copy} = 1;
|
||||
}
|
||||
|
||||
$UserDefinedAlias{$alias} = $code;
|
||||
}
|
||||
}
|
||||
|
||||
sub remove_alias {
|
||||
shift;
|
||||
|
||||
%LoadCache = ();
|
||||
|
||||
my $alias = shift;
|
||||
|
||||
return delete $UserDefinedAlias{$alias};
|
||||
}
|
||||
|
||||
# deprecated
|
||||
sub ids {
|
||||
shift->codes;
|
||||
}
|
||||
|
||||
## no critic (Variables::ProhibitPackageVars)
|
||||
sub codes {
|
||||
wantarray
|
||||
? keys %DateTime::Locale::Data::Codes
|
||||
: [ keys %DateTime::Locale::Data::Codes ];
|
||||
}
|
||||
|
||||
sub names {
|
||||
wantarray
|
||||
? keys %DateTime::Locale::Data::Names
|
||||
: [ keys %DateTime::Locale::Data::Names ];
|
||||
}
|
||||
|
||||
sub native_names {
|
||||
wantarray
|
||||
? keys %DateTime::Locale::Data::NativeNames
|
||||
: [ keys %DateTime::Locale::Data::NativeNames ];
|
||||
}
|
||||
|
||||
# These are hard-coded for backwards comaptibility with the DateTime::Language
|
||||
# code.
|
||||
my %DateTimeLanguageAliases = (
|
||||
|
||||
# 'Afar' => 'aa',
|
||||
'Amharic' => 'am-ET',
|
||||
'Austrian' => 'de-AT',
|
||||
'Brazilian' => 'pt-BR',
|
||||
'Czech' => 'cs-CZ',
|
||||
'Danish' => 'da-DK',
|
||||
'Dutch' => 'nl-NL',
|
||||
'English' => 'en-US',
|
||||
'French' => 'fr-FR',
|
||||
|
||||
# 'Gedeo' => undef, # XXX
|
||||
'German' => 'de-DE',
|
||||
'Italian' => 'it-IT',
|
||||
'Norwegian' => 'no-NO',
|
||||
'Oromo' => 'om-ET', # Maybe om-KE or plain om ?
|
||||
'Portugese' => 'pt-PT',
|
||||
|
||||
# 'Sidama' => 'sid',
|
||||
'Somali' => 'so-SO',
|
||||
'Spanish' => 'es-ES',
|
||||
'Swedish' => 'sv-SE',
|
||||
|
||||
# 'Tigre' => 'tig',
|
||||
'TigrinyaEthiopian' => 'ti-ET',
|
||||
'TigrinyaEritrean' => 'ti-ER',
|
||||
);
|
||||
|
||||
my %POSIXAliases = (
|
||||
C => 'en-US-POSIX',
|
||||
POSIX => 'en-US-POSIX',
|
||||
);
|
||||
|
||||
{
|
||||
my $validator = validation_for(
|
||||
name => '_check_load_params',
|
||||
name_is_optional => 1,
|
||||
params => [
|
||||
{ type => t('NonEmptyStr') },
|
||||
],
|
||||
);
|
||||
|
||||
sub load {
|
||||
my $class = shift;
|
||||
my ($code) = $validator->(@_);
|
||||
|
||||
# We used to use underscores in codes instead of dashes. We want to
|
||||
# support both indefinitely.
|
||||
$code =~ tr/_/-/;
|
||||
|
||||
# Strip off charset for LC_* codes : en_GB.UTF-8 etc
|
||||
$code =~ s/\..*$//;
|
||||
|
||||
return $LoadCache{$code} if exists $LoadCache{$code};
|
||||
|
||||
while ( exists $UserDefinedAlias{$code} ) {
|
||||
$code = $UserDefinedAlias{$code};
|
||||
}
|
||||
|
||||
$code = $DateTimeLanguageAliases{$code}
|
||||
if exists $DateTimeLanguageAliases{$code};
|
||||
$code = $POSIXAliases{$code} if exists $POSIXAliases{$code};
|
||||
$code = $DateTime::Locale::Data::ISO639Aliases{$code}
|
||||
if exists $DateTime::Locale::Data::ISO639Aliases{$code};
|
||||
|
||||
if ( exists $DateTime::Locale::Data::Codes{$code} ) {
|
||||
return $class->_locale_object_for($code);
|
||||
}
|
||||
|
||||
if ( exists $DateTime::Locale::Data::Names{$code} ) {
|
||||
return $class->_locale_object_for(
|
||||
$DateTime::Locale::Data::Names{$code} );
|
||||
}
|
||||
|
||||
if ( exists $DateTime::Locale::Data::NativeNames{$code} ) {
|
||||
return $class->_locale_object_for(
|
||||
$DateTime::Locale::Data::NativeNames{$code} );
|
||||
}
|
||||
|
||||
if ( my $locale = $class->_registered_locale_for($code) ) {
|
||||
return $locale;
|
||||
}
|
||||
|
||||
if ( my $guessed = $class->_guess_code($code) ) {
|
||||
return $class->_locale_object_for($guessed);
|
||||
}
|
||||
|
||||
die "Invalid locale code or name: $code\n";
|
||||
}
|
||||
}
|
||||
|
||||
sub _guess_code {
|
||||
shift;
|
||||
my $code = shift;
|
||||
|
||||
my %codes = parse_locale_code($code);
|
||||
|
||||
my @guesses;
|
||||
|
||||
if ( $codes{script} ) {
|
||||
my $guess = join q{-}, $codes{language}, $codes{script};
|
||||
|
||||
push @guesses, $guess;
|
||||
|
||||
$guess .= q{-} . $codes{territory} if defined $codes{territory};
|
||||
|
||||
# version with script comes first
|
||||
unshift @guesses, $guess;
|
||||
}
|
||||
|
||||
if ( $codes{variant} ) {
|
||||
push @guesses, join q{-}, $codes{language}, $codes{territory},
|
||||
$codes{variant};
|
||||
}
|
||||
|
||||
if ( $codes{territory} ) {
|
||||
push @guesses, join q{-}, $codes{language}, $codes{territory};
|
||||
}
|
||||
|
||||
push @guesses, $codes{language};
|
||||
|
||||
for my $code (@guesses) {
|
||||
return $code
|
||||
if exists $DateTime::Locale::Data::Codes{$code}
|
||||
|| exists $DateTime::Locale::Data::Names{$code};
|
||||
}
|
||||
}
|
||||
|
||||
sub _locale_object_for {
|
||||
shift;
|
||||
my $code = shift;
|
||||
|
||||
my $data = DateTime::Locale::Data::locale_data($code)
|
||||
or return;
|
||||
|
||||
# We want to make a copy of the data just in case ...
|
||||
return $LoadCache{$code} = DateTime::Locale::FromData->new( \%{$data} );
|
||||
}
|
||||
|
||||
sub _registered_locale_for {
|
||||
my $class = shift;
|
||||
my $code = shift;
|
||||
|
||||
# Custom locale registered by user
|
||||
if ( $Class{$code} ) {
|
||||
return $LoadCache{$code}
|
||||
= $class->_load_class_from_code( $code, $Class{$code} );
|
||||
}
|
||||
|
||||
if ( $DataForCode{$code} ) {
|
||||
return $LoadCache{$code} = $class->_load_class_from_code($code);
|
||||
}
|
||||
|
||||
if ( $NameToCode{$code} ) {
|
||||
return $LoadCache{$code}
|
||||
= $class->_load_class_from_code( $NameToCode{$code} );
|
||||
}
|
||||
|
||||
if ( $NativeNameToCode{$code} ) {
|
||||
return $LoadCache{$code}
|
||||
= $class->_load_class_from_code( $NativeNameToCode{$code} );
|
||||
}
|
||||
}
|
||||
|
||||
sub _load_class_from_code {
|
||||
my $class = shift;
|
||||
my $code = shift;
|
||||
my $real_class = shift;
|
||||
|
||||
# We want the first alias for which there is data, even if it has
|
||||
# no corresponding .pm file. There may be multiple levels of
|
||||
# alias to go through.
|
||||
my $data_code = $code;
|
||||
while ( exists $UserDefinedAlias{$data_code}
|
||||
&& !exists $DataForCode{$data_code} ) {
|
||||
|
||||
$data_code = $UserDefinedAlias{$data_code};
|
||||
}
|
||||
|
||||
( my $underscore_code = $data_code ) =~ s/-/_/g;
|
||||
$real_class ||= "DateTime::Locale::$underscore_code";
|
||||
|
||||
unless ( $real_class->can('new') ) {
|
||||
## no critic (BuiltinFunctions::ProhibitStringyEval, ErrorHandling::RequireCheckingReturnValueOfEval)
|
||||
eval "require $real_class";
|
||||
die $@ if $@;
|
||||
## use critic
|
||||
}
|
||||
|
||||
my $locale = $real_class->new(
|
||||
%{ $DataForCode{$data_code} },
|
||||
code => $code,
|
||||
);
|
||||
|
||||
if ( $locale->can('cldr_version') ) {
|
||||
my $object_version = $locale->cldr_version;
|
||||
|
||||
if ( $object_version ne $DateTime::Locale::Data::CLDRVersion ) {
|
||||
warn
|
||||
"Loaded $real_class, which is from an older version ($object_version)"
|
||||
. ' of the CLDR database than this installation of'
|
||||
. " DateTime::Locale ($DateTime::Locale::Data::CLDRVersion).\n";
|
||||
}
|
||||
}
|
||||
|
||||
return $locale;
|
||||
}
|
||||
## use critic
|
||||
|
||||
1;
|
||||
|
||||
# ABSTRACT: Localization support for DateTime.pm
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
DateTime::Locale - Localization support for DateTime.pm
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 1.31
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use DateTime::Locale;
|
||||
|
||||
my $loc = DateTime::Locale->load('en-GB');
|
||||
|
||||
print $loc->native_name, "\n", $loc->datetime_format_long, "\n";
|
||||
|
||||
# but mostly just things like ...
|
||||
|
||||
my $dt = DateTime->now( locale => 'fr' );
|
||||
print "Aujourd'hui le mois est " . $dt->month_name, "\n";
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
DateTime::Locale is primarily a factory for the various locale subclasses. It
|
||||
also provides some functions for getting information on all the available
|
||||
locales.
|
||||
|
||||
If you want to know what methods are available for locale objects, then please
|
||||
read the C<DateTime::Locale::FromData> documentation.
|
||||
|
||||
=head1 USAGE
|
||||
|
||||
This module provides the following class methods:
|
||||
|
||||
=head2 DateTime::Locale->load( $locale_code | $locale_name )
|
||||
|
||||
Returns the locale object for the specified locale code or name - see the
|
||||
C<DateTime::Locale::Catalog> documentation for the list of available codes and
|
||||
names. The name provided may be either the English or native name.
|
||||
|
||||
If the requested locale is not found, a fallback search takes place to
|
||||
find a suitable replacement.
|
||||
|
||||
The fallback search order is:
|
||||
|
||||
{language}-{script}-{territory}
|
||||
{language}-{script}
|
||||
{language}-{territory}-{variant}
|
||||
{language}-{territory}
|
||||
{language}
|
||||
|
||||
Eg. For the locale code C<es-XX-UNKNOWN> the fallback search would be:
|
||||
|
||||
es-XX-UNKNOWN # Fails - no such locale
|
||||
es-XX # Fails - no such locale
|
||||
es # Found - the es locale is returned as the
|
||||
# closest match to the requested id
|
||||
|
||||
Eg. For the locale code C<es-Latn-XX> the fallback search would be:
|
||||
|
||||
es-Latn-XX # Fails - no such locale
|
||||
es-Latn # Fails - no such locale
|
||||
es-XX # Fails - no such locale
|
||||
es # Found - the es locale is returned as the
|
||||
# closest match to the requested id
|
||||
|
||||
If no suitable replacement is found, then an exception is thrown.
|
||||
|
||||
The loaded locale is cached, so that B<locale objects may be
|
||||
singletons>. Calling C<< DateTime::Locale->register_from_data >>, C<<
|
||||
DateTime::Locale->add_aliases >>, or C<< DateTime::Locale->remove_alias >>
|
||||
clears the cache.
|
||||
|
||||
=head2 DateTime::Locale->codes
|
||||
|
||||
my @codes = DateTime::Locale->codes;
|
||||
my $codes = DateTime::Locale->codes;
|
||||
|
||||
Returns an unsorted list of the available locale codes, or an array reference if
|
||||
called in a scalar context. This list does not include aliases.
|
||||
|
||||
=head2 DateTime::Locale->names
|
||||
|
||||
my @names = DateTime::Locale->names;
|
||||
my $names = DateTime::Locale->names;
|
||||
|
||||
Returns an unsorted list of the available locale names in English, or an array
|
||||
reference if called in a scalar context.
|
||||
|
||||
=head2 DateTime::Locale->native_names
|
||||
|
||||
my @names = DateTime::Locale->native_names;
|
||||
my $names = DateTime::Locale->native_names;
|
||||
|
||||
Returns an unsorted list of the available locale names in their native
|
||||
language, or an array reference if called in a scalar context. All native
|
||||
names use UTF-8 as appropriate.
|
||||
|
||||
=head2 DateTime::Locale->register_from_data( $locale_data )
|
||||
|
||||
This method allows you to register a custom locale. The data for the locale is
|
||||
specified as a hash (or hashref) where the keys match the method names given
|
||||
in C<DateTime::Locale::FromData>.
|
||||
|
||||
If you just want to make some small changes on top of an existing locale you
|
||||
can get that locale's data by calling C<< $locale->locale_data >>.
|
||||
|
||||
Here is an example of making a custom locale based off of C<en-US>:
|
||||
|
||||
my $locale = DateTime::Locale->load('en-US');
|
||||
my %data = $locale->locale_data;
|
||||
$data{code} = 'en-US-CUSTOM';
|
||||
$data{time_format_medium} = 'HH:mm:ss';
|
||||
|
||||
DateTime::Locale->register_from_data(%data);
|
||||
|
||||
# Prints 18:24:38
|
||||
say DateTime->now( locale => 'en-US-CUSTOM' )->strftime('%X');
|
||||
|
||||
# Prints 6:24:38 PM
|
||||
say DateTime->now( locale => 'en-US' )->strftime('%X');
|
||||
|
||||
The keys that should be present in the hash are the same as the accessor
|
||||
methods provided by L<DateTime::Locale::FromData>, except for the following:
|
||||
|
||||
=over 4
|
||||
|
||||
=item The C<*_code> methods
|
||||
|
||||
While you should provide a C<code> key, the other methods like
|
||||
C<language_code> and C<script_code> are determined by parsing the code.
|
||||
|
||||
=item All C<id> returning methods
|
||||
|
||||
These are aliases for the corresponding C<*code> methods.
|
||||
|
||||
=item C<prefers_24_hour_time>
|
||||
|
||||
This is determined by looking at the short time format to see how it formats
|
||||
hours,
|
||||
|
||||
=item C<date_format_default> and C<time_format_default>
|
||||
|
||||
These are the corresponding medium formats.
|
||||
|
||||
=item C<datetime_format> and C<datetime_format_default>
|
||||
|
||||
This is the same as the medium format.
|
||||
|
||||
=item C<date_formats> and C<time_formats>
|
||||
|
||||
These are calculated as needed.
|
||||
|
||||
=item C<available_formats>
|
||||
|
||||
This should be provided as a hashref where the keys are things like C<Gy> or
|
||||
C<MMMEd> and the values are an actual format like C<"y G"> or C<"E, MMM d">.
|
||||
|
||||
=item C<locale_data>
|
||||
|
||||
This is everything you pass in.
|
||||
|
||||
=back
|
||||
|
||||
=head1 LOADING LOCALES IN A PRE-FORKING SYSTEM
|
||||
|
||||
If you are running an application that does pre-forking (for example with
|
||||
Starman), then you should try to load all the locales that you'll need in the
|
||||
parent process. Locales are loaded on-demand, so loading them once in each
|
||||
child will waste memory that could otherwise be shared.
|
||||
|
||||
=head1 CLDR DATA BUGS
|
||||
|
||||
Please be aware that all locale data has been generated from the CLDR (Common
|
||||
Locale Data Repository) project locales data). The data is incomplete, and may
|
||||
contain errors in some locales.
|
||||
|
||||
When reporting errors in data, please check the primary data sources first,
|
||||
then where necessary report errors directly to the primary source via the CLDR
|
||||
bug report system. See http://unicode.org/cldr/filing_bug_reports.html for
|
||||
details.
|
||||
|
||||
Once these errors have been confirmed, please forward the error report and
|
||||
corrections to the DateTime mailing list, datetime@perl.org.
|
||||
|
||||
=head1 AUTHOR EMERITUS
|
||||
|
||||
Richard Evans wrote the first version of DateTime::Locale, including the tools
|
||||
to extract the CLDR data.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<DateTime::Locale::Base>
|
||||
|
||||
datetime@perl.org mailing list
|
||||
|
||||
http://datetime.perl.org/
|
||||
|
||||
=head1 SUPPORT
|
||||
|
||||
Bugs may be submitted at L<https://github.com/houseabsolute/DateTime-Locale/issues>.
|
||||
|
||||
There is a mailing list available for users of this distribution,
|
||||
L<mailto:datetime@perl.org>.
|
||||
|
||||
I am also usually active on IRC as 'autarch' on C<irc://irc.perl.org>.
|
||||
|
||||
=head1 SOURCE
|
||||
|
||||
The source code repository for DateTime-Locale can be found at L<https://github.com/houseabsolute/DateTime-Locale>.
|
||||
|
||||
=head1 DONATIONS
|
||||
|
||||
If you'd like to thank me for the work I've done on this module, please
|
||||
consider making a "donation" to me via PayPal. I spend a lot of free time
|
||||
creating free software, and would appreciate any support you'd care to offer.
|
||||
|
||||
Please note that B<I am not suggesting that you must do this> in order for me
|
||||
to continue working on this particular software. I will continue to do so,
|
||||
inasmuch as I have in the past, for as long as it interests me.
|
||||
|
||||
Similarly, a donation made in this way will probably not make me work on this
|
||||
software much more, unless I get so many donations that I can consider working
|
||||
on free software full time (let's all have a chuckle at that together).
|
||||
|
||||
To donate, log into PayPal and send money to autarch@urth.org, or use the
|
||||
button at L<https://www.urth.org/fs-donation.html>.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Dave Rolsky <autarch@urth.org>
|
||||
|
||||
=head1 CONTRIBUTORS
|
||||
|
||||
=for stopwords Alexander Pankoff Karen Etheridge Mohammad S Anwar Ryley Breiddal Sergey Leschenko yasu47b
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
Alexander Pankoff <ccntrq@screenri.de>
|
||||
|
||||
=item *
|
||||
|
||||
Karen Etheridge <ether@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Mohammad S Anwar <mohammad.anwar@yahoo.com>
|
||||
|
||||
=item *
|
||||
|
||||
Ryley Breiddal <rbreiddal@presinet.com>
|
||||
|
||||
=item *
|
||||
|
||||
Sergey Leschenko <Sergey.Leschenko@portaone.com>
|
||||
|
||||
=item *
|
||||
|
||||
yasu47b <nakayamayasuhiro1986@gmail.com>
|
||||
|
||||
=back
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
This software is copyright (c) 2003 - 2020 by Dave Rolsky.
|
||||
|
||||
This is free software; you can redistribute it and/or modify it under
|
||||
the same terms as the Perl 5 programming language system itself.
|
||||
|
||||
The full text of the license can be found in the
|
||||
F<LICENSE> file included with this distribution.
|
||||
|
||||
=cut
|
||||
Reference in New Issue
Block a user