—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—

              
package Locale::CLDR;
HideShow 37 lines of Pod
=encoding utf8
=head1 NAME
Locale::CLDR - A Module to create locale objects with localisation data from the CLDR
=head1 VERSION
Version 0.25.4
=head1 SYNOPSIS
This module provides a locale object you can use to localise your output.
The localisation data comes from the Unicode Common Locale Data Repository.
Most of this code can be used with Perl version 5.10 or above. There are a
few parts of the code that require version 5.18 or above.
=head1 USAGE
 my $locale = Locale::CLDR->new('en_GB');
or
 my $locale = Locale::CLDR->new(language_id => 'en', territory_id => 'gb');
  
A full locale identifier is
  
C<language>_C<script>_C<territory>_C<variant>_u_C<extension name>_C<extension value>
  
 my $locale = Locale::CLDR->new('en_latn_GB_SCOUSE_u_nu_traditional');
  
or
  
 my $locale = Locale::CLDR->new(language_id => 'en', script_id => 'latn', territory_id => 'gb', variant => 'SCOUSE', extensions => { nu => 'traditional' } );
  
=cut
use v5.10;
use version;
our $VERSION = version->declare('v0.25.4');
use open ':encoding(utf8)';
use utf8;
use if $^V ge v5.12.0, feature => 'unicode_strings';
use Moose;
use MooseX::ClassAttribute;
with 'Locale::CLDR::ValidCodes', 'Locale::CLDR::EraBoundries', 'Locale::CLDR::WeekData', 
        'Locale::CLDR::MeasurementSystem', 'Locale::CLDR::LikelySubtags', 'Locale::CLDR::NumberingSystems',
        'Locale::CLDR::NumberFormatter', 'Locale::CLDR::TerritoryContainment', 'Locale::CLDR::CalendarPreferences',
        'Locale::CLDR::Currencies', 'Locale::CLDR::Plurals';
         
use Class::Load;
use namespace::autoclean;
use List::Util qw(first);
use Class::MOP;
use DateTime::Locale;
use Unicode::Normalize();
use Unicode::Collate();
use File::Spec();
# Backwards compatibility
BEGIN {
        if (defined &CORE::fc) { #v5.16
                *fc = \&CORE::fc;
        }
        else {
                # This code taken from Unicode::CaseFold by Andrew Rodland
                require Unicode::UCD;
                *fc = sub {
                        my ($string) = @_;
                         
                        my $out = "";
                        for my $codepoint (unpack "U*", $string) {
                                my $mapping = Unicode::UCD::casefold($codepoint);
                                my @cp;
                                if (!defined $mapping) {
                                        @cp = ($codepoint);
                                } else {
                                        @cp = map hex, split / /, $mapping->{'full'};
                                }
                                $out .= pack "U*", @cp;
                        }
                        return $out;
                };
        }
}
HideShow 12 lines of Pod
=head1 ATTRIBUTES
These can be passed into the constructor and all are optional.
=over 4
=item language_id
A valid language or language alias id, such as C<en>
=cut
has 'language_id' => (
        is                      => 'ro',
        isa                     => 'Str',
        required        => 1,
);
# language aliases
around 'language_id' => sub {
        my ($orig, $self) = @_;
        my $value = $self->$orig;
        return $self->language_aliases->{$value} // $value;
};
HideShow 7 lines of Pod
=item script_id
A valid script id, such as C<latn> or C<Ctcl>. The code will pick a likely script
depending on the given language if non is provided.
=cut
has 'script_id' => (
        is                      => 'ro',
        isa                     => 'Str',
        default         => '',
        predicate       => 'has_script',
);
HideShow 6 lines of Pod
=item territory_id
A valid territory id or territory alias such as C<GB>
=cut
has 'territory_id' => (
        is                      => 'ro',
        isa                     => 'Str',
        default         => '',
        predicate       => 'has_territory',
);
# territory aliases
around 'territory_id' => sub {
        my ($orig, $self) = @_;
        my $value = $self->$orig;
        return $value if defined $value;
        my $alias = $self->territory_aliases->{$value};
        return (split /\s+/, $alias)[0];
};
HideShow 6 lines of Pod
=item variant_id
A valid variant id. The code currently ignores this
=cut
has 'variant_id' => (
        is                      => 'ro',
        isa                     => 'Str',
        default         => '',
        predicate       => 'has_variant',
);
HideShow 360 lines of Pod
=item extensions 
A Hashref of extension names and values. You can use this to override
the locales number formatting and calendar by passing in the Unicode
extension names or aliases as keys and the extension value as the hash 
value.
Currently supported extensions are
=over 8
=item nu
=item numbers
The number type can be one of
=over 12
=item arab
Arabic-Indic Digits
=item arabext
Extended Arabic-Indic Digits
=item armn
Armenian Numerals
=item armnlow
Armenian Lowercase Numerals
=item bali
Balinese Digits
=item beng
Bengali Digits
=item brah
Brahmi Digits
=item cakm
Chakma Digits
=item cham
Cham Digits
=item deva
Devanagari Digits
=item ethi
Ethiopic Numerals
=item finance
Financial Numerals
=item fullwide
Full Width Digits
=item geor
Georgian Numerals
=item grek
Greek Numerals
=item greklow
Greek Lowercase Numerals
=item gujr
Gujarati Digits
=item guru
Gurmukhi Digits
=item hanidays
Chinese Calendar Day-of-Month Numerals
=item hanidec
Chinese Decimal Numerals
=item hans
Simplified Chinese Numerals
=item hansfin
Simplified Chinese Financial Numerals
=item hant
Traditional Chinese Numerals
=item hantfin
Traditional Chinese Financial Numerals
=item hebr
Hebrew Numerals
=item java
Javanese Digits
=item jpan
Japanese Numerals
=item jpanfin
Japanese Financial Numerals
=item kali
Kayah Li Digits
=item khmr
Khmer Digits
=item knda
Kannada Digits
=item lana
Tai Tham Hora Digits
=item lanatham
Tai Tham Tham Digits
=item laoo
Lao Digits
=item latn
Western Digits
=item lepc
Lepcha Digits
=item limb
Limbu Digits
=item mlym
Malayalam Digits
=item mong
Mongolian Digits
=item mtei
Meetei Mayek Digits
=item mymr
Myanmar Digits
=item mymrshan
Myanmar Shan Digits
=item native
Native Digits
=item nkoo
N'Ko Digits
=item olck
Ol Chiki Digits
=item orya
Oriya Digits
=item osma
Osmanya Digits
=item roman
Roman Numerals
=item romanlow
Roman Lowercase Numerals
=item saur
Saurashtra Digits
=item shrd
Sharada Digits
=item sora
Sora Sompeng Digits
=item sund
Sundanese Digits
=item takr
Takri Digits
=item talu
New Tai Lue Digits
=item taml
Traditional Tamil Numerals
=item tamldec
Tamil Digits
=item telu
Telugu Digits
=item thai
Thai Digits
=item tibt
Tibetan Digits
=item traditional
Traditional Numerals
=item vaii
Vai Digits
=back
Note that the code currently only handles digits ie locales with 
characters corresponding to 0 - 9, if you use a numerical number
type it will fall back to C<latn>. Later versions are planned to 
handle numerals correctly.
=item ca
=item calendar
You can use this to override a locales default calendar. Valid values are
=over 12
=item buddhist
Buddhist Calendar
=item chinese
Chinese Calendar
=item coptic
Coptic Calendar
=item dangi
Dangi Calendar
=item ethiopic
Ethiopic Calendar
=item ethiopic-amete-alem
Ethiopic Amete Alem Calendar
=item gregorian
Gregorian Calendar
=item hebrew
Hebrew Calendar
=item indian
Indian National Calendar
=item islamic
Islamic Calendar
=item islamic-civil
Islamic Calendar (tabular, civil epoch)
=item islamic-rgsa
Islamic Calendar (Saudi Arabia, sighting)
=item islamic-tbla
Islamic Calendar (tabular, astronomical epoch)
=item islamic-umalqura
Islamic Calendar (Umm al-Qura)
=item iso8601
ISO-8601 Calendar
=item japanese
Japanese Calendar
=item persian
Persian Calendar
=item roc
Minguo Calendar
=back
=back
=cut
has 'extensions' => (
        is                      => 'ro',
        isa                     => 'Undef|HashRef',
        default         => undef,
        writer          => '_set_extensions',
);
HideShow 21 lines of Pod
=back
=head1 Methods
The following methods can be called on the locale object
=over 4
=item id()
The local identifier. This is what you get if you attempt to
stringify a locale object.
=item likely_language()
Given a locale with no language passed in or with the explicit language
code of C<und>, this method attempts to use the script and territory
data to guess the locales language.
=cut
has 'likely_language' => (
        is                      => 'ro',
        isa                     => 'Str',
        init_arg        => undef,
        lazy            => 1,
        builder         => '_build_likely_language',
);
sub _build_likely_language {
        my $self = shift;
         
        my $language = $self->language();
         
        return $language unless $language eq 'und';
         
        return $self->likely_subtag->language;
}
HideShow 7 lines of Pod
=item likely_script()
Given a locale with no script passed in this method attempts to use the
language and territory data to guess the locales script.
=cut
has 'likely_script' => (
        is                      => 'ro',
        isa                     => 'Str',
        init_arg        => undef,
        lazy            => 1,
        builder         => '_build_likely_script',
);
sub _build_likely_script {
        my $self = shift;
         
        my $script = $self->script();
         
        return $script if $script;
         
        return $self->likely_subtag->script || '';
}
HideShow 9 lines of Pod
=item likely_territory()
Given a locale with no territory passed in this method attempts to use the
language and script data to guess the locales territory.
=back
=cut
has 'likely_territory' => (
        is                      => 'ro',
        isa                     => 'Str',
        init_arg        => undef,
        lazy            => 1,
        builder         => '_build_likely_territory',
);
sub _build_likely_territory {
        my $self = shift;
         
        my $territory = $self->territory();
         
        return $territory if $territory;
         
        return $self->likely_subtag->territory || '';
}
has 'module' => (
        is                      => 'ro',
        isa                     => 'Object',
        init_arg        => undef,
        lazy            => 1,
        builder         => '_build_module',
);
sub _build_module {
        # Create the new path
        my $self = shift;
         
        my @path = map { ucfirst lc }
                map { $_ ? $_ : 'Any' } (
                        $self->language_id,
                        $self->script_id,
                        $self->territory_id,
                );
        my @likely_path = 
                map { ucfirst lc } (
                        $self->has_likely_subtag ? $self->likely_subtag->language_id : 'Any',
                        $self->has_likely_subtag ? $self->likely_subtag->script_id : 'Any',
                        $self->has_likely_subtag ? $self->likely_subtag->territory_id : 'Any',
                );
         
        for (my $i = 0; $i < @path; $i++) {
                $likely_path[$i] = $path[$i] unless $path[$i] eq 'und' or $path[$i] eq 'Any';
        }
         
        # Note the order we push these onto the stack is important
        @path = join '::', @likely_path;
        push @path, join '::', $likely_path[0], 'Any', $likely_path[2];
        push @path, join '::', @likely_path[0 .. 1], 'Any';
        push @path, join '::', $likely_path[0], 'Any', 'Any';
         
        # Now we go through the path loading each module
        # And calling new on it. 
        my $module;
        foreach my $module_name (@path) {
                $module_name = "Locale::CLDR::$module_name";
                eval { Class::Load::load_class($module_name); };
                next if $@;
                $module = $module_name->new;
                last;
        }
        # If we only have the root module then we have a problem as
        # none of the language specific data is in the root. So we
        # fall back to the en module
        if (! $module || ref $module eq 'Locale::CLDR::Root') {
                Class::Load::load_class('Locale::CLDR::En');
                $module = Locale::CLDR::En->new
        }
        return $module;
}
class_has 'method_cache' => (
        is                      => 'rw',
        isa                     => 'HashRef[HashRef[ArrayRef[Object]]]',
        init_arg        => undef,
        default         => sub { return {}},
);
has 'break_grapheme_cluster' => (
        is => 'ro',
        isa => 'ArrayRef',
        init_arg => undef(),
        lazy => 1,
        default => sub {shift->_build_break('GraphemeClusterBreak')},
);
has 'break_word' => (
        is => 'ro',
        isa => 'ArrayRef',
        init_arg => undef(),
        lazy => 1,
        default => sub {shift->_build_break('WordBreak')},
);
has 'break_line' => (
        is => 'ro',
        isa => 'ArrayRef',
        init_arg => undef(),
        lazy => 1,
        default => sub {shift->_build_break('LineBreak')},
);
has 'break_sentence' => (
        is => 'ro',
        isa => 'ArrayRef',
        init_arg => undef(),
        lazy => 1,
        default => sub {shift->_build_break('SentenceBreak')},
);
HideShow 68 lines of Pod
=head2 Meta Data
The following methods return, in English, the names if the various 
id's passed into the locales constructor. I.e. if you passed 
C<language =E<gt> 'fr'> to the constructor you would get back C<French>
for the language.
=over 4
=item name
The locales name. This is usually built up out of the language, 
script, territory and variant of the locale
=item language
The name of the locales language
=item script
The name of the locales script
=item territory
The name of the locales territory
=item variant
The name of the locales variant
=back
=head2 Native Meta Data
Like Meta Data above this provides the names of the various id's 
passed into the locales constructor. However in this case the
names are formatted to match the locale. I.e. if you passed 
C<language =E<gt> 'fr'> to the constructor you would get back 
C<français> for the language.
=over 4
=item native_name
The locales name. This is usually built up out of the language, 
script, territory and variant of the locale. Returned in the locales
language and script
=item native_language
The name of the locales language in the locales language and script.
=item native_script
The name of the locales script in the locales language and script.
=item native_territory
The name of the locales territory in the locales language and script.
=item native_variant
The name of the locales variant in the locales language and script.
=back
=cut
foreach my $property (qw( name language script territory variant)) {
        has $property => (
                is => 'ro',
                isa => 'Str',
                init_arg => undef,
                lazy => 1,
                builder => "_build_$property",
        );
        no strict 'refs';
        *{"native_$property"} = sub {
                my ($self, $for) = @_;
                 
                $for //= $self;
                my $build = "_build_native_$property";
                return $self->$build($for);
        };
}
HideShow 77 lines of Pod
=head2 Calenders
The Calendar data is built to hook into L<DateTime::Locale> so that 
all Locale::CLDR objects can be used as replacements for DateTime::Locale's 
locale data. To use, say, the French data do
 my $french_locale = Locale::CLDR->new('fr_FR');
 my $french_dt = DateTime->now(locale => $french_locale);
 say "French month : ", $french_dt->month_name; # prints out the current month in French
=over 4
=item month_format_wide 
=item month_format_abbreviated 
=item month_format_narrow
=item month_stand_alone_wide
=item month_stand_alone_abbreviated
=item month_stand_alone_narrow
All the above return an arrayref of month names in the requested style.
=item day_format_wide 
=item day_format_abbreviated 
=item day_format_narrow
=item day_stand_alone_wide
=item day_stand_alone_abbreviated
=item day_stand_alone_narrow
All the above return an array ref of day names in the requested style.
=item quarter_format_wide 
=item quarter_format_abbreviated 
=item quarter_format_narrow
=item quarter_stand_alone_wide
=item quarter_stand_alone_abbreviated
=item quarter_stand_alone_narrow
All the above return an arrayref of quarter names in the requested style.
=item am_pm_wide
=item am_pm_abbreviated
=item am_pm_narrow
All the above return the date period name for AM and PM
in the requested style
=item era_wide
=item era_abbreviated
=item era_narrow
All the above return an array ref of era names. Note that these 
return the first two eras which is what you normally want for 
BC and AD etc. but won't work correctly for Japanese calendars.
=back
=cut
foreach my $property (qw( 
        month_format_wide month_format_abbreviated month_format_narrow
        month_stand_alone_wide month_stand_alone_abbreviated month_stand_alone_narrow
        day_format_wide day_format_abbreviated day_format_narrow
        day_stand_alone_wide day_stand_alone_abbreviated day_stand_alone_narrow
        quarter_format_wide quarter_format_abbreviated quarter_format_narrow
        quarter_stand_alone_wide quarter_stand_alone_abbreviated quarter_stand_alone_narrow
        am_pm_wide am_pm_abbreviated am_pm_narrow
        era_wide era_abbreviated era_narrow
        era_format_wide era_format_abbreviated era_format_narrow
        era_stand_alone_wide era_stand_alone_abbreviated era_stand_alone_narrow
)) {
        has $property => (
                is => 'ro',
                isa => 'ArrayRef',
                init_arg => undef,
                lazy => 1,
                builder => "_build_$property",
                clearer => "_clear_$property",
        );
}
HideShow 39 lines of Pod
=pod
The next set of methods are not used by DateTime::Locale but CLDR provide
the data and you might want it
=over 4
=item am_pm_format_wide 
=item am_pm_format_abbreviated
=item am_pm_format_narrow
=item am_pm_stand_alone_wide
=item am_pm_stand_alone_abbreviated
=item am_pm_stand_alone_narrow
All the above return a hashref keyed on date period
with the value being the value for that date period
=item era_format_wide 
=item era_format_abbreviated 
=item era_format_narrow
         
=item era_stand_alone_wide 
=item era_stand_alone_abbreviated 
=item era_stand_alone_narrow
All the above return an array ref with I<all> the era data for the
locale formatted to the requested width
=cut
foreach my $property (qw( 
        am_pm_format_wide am_pm_format_abbreviated am_pm_format_narrow
        am_pm_stand_alone_wide am_pm_stand_alone_abbreviated am_pm_stand_alone_narrow
)) {
        has $property => (
                is => 'ro',
                isa => 'HashRef',
                init_arg => undef,
                lazy => 1,
                builder => "_build_$property",
                clearer => "_clear_$property",
        );
}
HideShow 29 lines of Pod
=item date_format_full 
=item date_format_long 
=item date_format_medium 
=item date_format_short
         
=item time_format_full
=item time_format_long
=item time_format_medium
=item time_format_short
         
=item datetime_format_full
=item datetime_format_long
         
=item datetime_format_medium
=item datetime_format_short
All the above return the CLDR I<date format pattern> for the given 
element and width
=cut
foreach my $property (qw(
        id
        date_format_full date_format_long 
        date_format_medium date_format_short
        time_format_full time_format_long
        time_format_medium time_format_short
        datetime_format_full datetime_format_long
        datetime_format_medium datetime_format_short
)) {
        has $property => (
                is => 'ro',
                isa => 'Str',
                init_arg => undef,
                lazy => 1,
                builder => "_build_$property",
                clearer => "_clear_$property",
        );
}
has '_available_formats' => (
        traits => ['Array'],
        is => 'ro',
        isa => 'ArrayRef',
        init_arg => undef,
        lazy => 1,
        builder => "_build_available_formats",
        clearer => "_clear_available_formats",
        handles => {
                available_formats => 'elements',
        },
);
has 'format_data' => (
        is => 'ro',
        isa => 'HashRef',
        init_arg => undef,
        lazy => 1,
        builder => "_build_format_data",
        clearer => "_clear_format_data",
);
# default_calendar
foreach my $property (qw(
        default_date_format_length default_time_format_length
)) {
        has $property => (
                is => 'ro',
                isa => 'Str',
                init_arg => undef,
                lazy => 1,
                builder => "_build_$property",
                writer => "set_$property" 
        );
}
HideShow 7 lines of Pod
=item prefers_24_hour_time()
Returns a boolean value, true if the locale has a preference
for 24 hour time over 12 hour
=cut
has 'prefers_24_hour_time' => (
        is => 'ro',
        isa => 'Bool',
        init_arg => undef,
        lazy => 1,
        builder => "_build_prefers_24_hour_time",
);
HideShow 7 lines of Pod
=item first_day_of_week()
Returns the numeric representation of the first day of the week
With 0 = Saturday
=cut
has 'first_day_of_week' => (
        is => 'ro',
        isa => 'Int',
        init_arg => undef,
        lazy => 1,
        builder => "_build_first_day_of_week",
);
has 'likely_subtag' => (
        is => 'ro',
        isa => __PACKAGE__,
        init_arg => undef,
        writer => '_set_likely_subtag',
        predicate => 'has_likely_subtag',
);
sub _build_break {
        my ($self, $what) = @_;
        my $vars = $self->_build_break_vars($what);
        my $rules = $self->_build_break_rules($vars, $what);
        return $rules;
}
sub _build_break_vars {
        my ($self, $what) = @_;
        my $name = "${what}_variables";
        my @bundles = $self->_find_bundle($name);
        my @vars;
        foreach my $bundle (reverse @bundles) {
                push @vars, @{$bundle->$name};
        }
        my %vars = ();
        while (my ($name, $value) = (shift @vars, shift @vars)) {
                last unless defined $name;
                if (! defined $value) {
                        delete $vars{$name};
                        next;
                }
                $value =~ s{ ( \$ \p{ID_START} \p{ID_CONTINUE}* ) }{$vars{$1}}msxeg;
                $vars{$name} = $value;
        }
        return \%vars;
}
sub _build_break_rules {
        my ($self, $vars, $what) = @_;
        my $name = "${what}_rules";
        my @bundles = $self->_find_bundle($name);
        my %rules;
        foreach my $bundle (reverse @bundles) {
                %rules = (%rules, %{$bundle->$name});
        }
        my @rules;
        foreach my $rule_number ( sort { $a <=> $b } keys %rules ) {
                # Test for deleted rules
                next unless defined $rules{$rule_number};
                $rules{$rule_number} =~ s{ ( \$ \p{ID_START} \p{ID_CONTINUE}* ) }{$vars->{$1}}msxeg;
                my ($first, $opp, $second) = split /(×|÷)/, $rules{$rule_number};
                foreach my $operand ($first, $second) {
                        if ($operand =~ m{ \S }msx) {
                                $operand = _unicode_to_perl($operand);
                        }
                        else {
                                $operand = '.';
                        }
                }
                 
                no warnings 'deprecated';
                push @rules, [qr{$first}msx, qr{$second}msx, ($opp eq '×' ? 1 : 0)];
        }
        push @rules, [ '.', '.', 0 ];
        return \@rules;
}
sub BUILDARGS {
        my $self = shift;
        my %args;
        # Used for arguments when we call new from our own code
        my %internal_args = ();
        if (@_ > 1 && ref $_[-1] eq 'HASH') {
                %internal_args = %{pop @_};
        }
        if (1 == @_ && ! ref $_[0]) {
                my ($language, $script, $territory, $variant, $extensions)
                        = $_[0]=~/^
                                ([a-zA-Z]+)
                                (?:[-_]([a-zA-Z]{4}))?
                                (?:[-_]([a-zA-Z]{2,3}))?
                                (?:[-_]([a-zA-Z0-9]+))?
                                (?:[-_]u[_-](.+))?
                        $/x;
                foreach ($language, $script, $territory, $variant) {
                        $_ = '' unless defined $_;
                }
                         
                %args = (
                        language_id     => $language,
                        script_id               => $script,
                        territory_id    => $territory,
                        variant_id              => $variant,
                        extensions      => $extensions,
                );
        }
        if (! keys %args ) {
                %args = ref $_[0]
                        ? %{$_[0]}
                        : @_
        }
        # Split up the extensions
        if ( defined $args{extensions} && ! ref $args{extensions} ) {
                $args{extensions} = {
                        map {lc}
                        split /[_-]/, $args{extensions}
                };
        }
        # Fix casing of args
        $args{language_id}      = lc $args{language_id}                 if defined $args{language_id};
        $args{script_id}        = ucfirst lc $args{script_id}   if defined $args{script_id};
        $args{territory_id}     = uc $args{territory_id}                if defined $args{territory_id};
        $args{variant_id}       = uc $args{variant_id}                  if defined $args{variant_id};
         
        # Set up undefined language
        $args{language_id} //= 'und';
        $self->SUPER::BUILDARGS(%args, %internal_args);
}
sub BUILD {
        my ($self, $args) = @_;
        # Check that the args are valid
        # also check for aliases
        $args->{language_id} = $self->language_aliases->{$args->{language_id}}
                // $args->{language_id};
                 
        die "Invalid language" if $args->{language_id}
                && ! first { $args->{language_id} eq $_ } $self->valid_languages;
        die "Invalid script" if $args->{script_id} 
                && ! first { ucfirst lc $args->{script_id} eq $_ } $self->valid_scripts;
        die "Invalid territory" if $args->{territory_id} 
                &&  ( !  ( first { uc $args->{territory_id} eq $_ } $self->valid_territories )
                        && ( ! $self->territory_aliases->{$self->{territory_id}} )
                );
     
        die "Invalid variant" if $args->{variant_id}
                &&  ( !  ( first { uc $args->{variant_id} eq $_ } $self->valid_variants )
                        && ( ! $self->variant_aliases->{lc $self->{variant_id}} )
        );
         
        if ($args->{extensions}) {
                my %valid_keys = $self->valid_keys;
                my %key_aliases = $self->key_names;
                my @keys = keys %{$args->{extensions}};
                foreach my $key ( @keys ) {
                        my $canonical_key = $key_aliases{$key} if exists $key_aliases{$key};
                        $canonical_key //= $key;
                        if ($canonical_key ne $key) {
                                $args->{extensions}{$canonical_key} = delete $args->{extensions}{$key};
                        }
                        $key = $canonical_key;
                        die "Invalid extension name" unless exists $valid_keys{$key};
                        die "Invalid extension value" unless 
                                first { $_ eq $args->{extensions}{$key} } @{$valid_keys{$key}};
                        $self->_set_extensions($args->{extensions})
                }
        }
        # Check for variant aliases
        if ($args->{variant_id} && (my $variant_alias = $self->variant_aliases->{lc $self->variant_id})) {
                delete $args->{variant_id};
                my ($what) = keys %{$variant_alias};
                my ($value) = values %{$variant_alias};
                $args->{$what} = $value;
        }
         
        # Now set up the module
        $self->_build_module;
}
after 'BUILD' => sub {
        my $self = shift;
         
        # Fix up likely sub tags
         
        my $likely_subtags = $self->likely_subtags;
        my $likely_subtag;
        my ($language_id, $script_id, $territory_id) = ($self->language_id, $self->script_id, $self->territory_id);
         
        unless ($language_id ne 'und' && $script_id && $territory_id ) {
                $likely_subtag = $likely_subtags->{join '_', grep { length() } ($language_id, $script_id, $territory_id)};
                 
                if (! $likely_subtag ) {
                        $likely_subtag = $likely_subtags->{join '_', $language_id, $territory_id};
                }
         
                if (! $likely_subtag ) {
                        $likely_subtag = $likely_subtags->{join '_', $language_id, $script_id};
                }
         
                if (! $likely_subtag ) { 
                        $likely_subtag = $likely_subtags->{$language_id};
                }
         
                if (! $likely_subtag ) {
                        $likely_subtag = $likely_subtags->{join '_', 'und', $script_id};
                }
        }
         
        my ($likely_language_id, $likely_script_id, $likely_territory_id);
        if ($likely_subtag) {
                ($likely_language_id, $likely_script_id, $likely_territory_id) = split /_/, $likely_subtag;
                $likely_language_id             = $language_id  unless $language_id eq 'und';
                $likely_script_id               = $script_id    if length $script_id;
                $likely_territory_id    = $territory_id if length $territory_id;
                $self->_set_likely_subtag(__PACKAGE__->new(join '_',$likely_language_id, $likely_script_id, $likely_territory_id));
        }
         
        # Fix up extension overrides
        my $extensions = $self->extensions;
        if (exists $extensions->{ca}) {
                $self->_set_default_ca(($territory_id // $likely_territory_id) => $extensions->{ca});
        }
        if (exists $extensions->{nu}) {
                $self->_clear_default_nu;
                $self->_set_default_nu($extensions->{nu});
        }
};
use overload 
  'bool'        => sub { 1 },
  '""'          => sub {shift->id};
sub _build_id {
        my $self = shift;
        my $string = lc $self->language_id;
        if ($self->script_id) {
                $string.= '_' . ucfirst lc $self->script_id;
        }
        if ($self->territory_id) {
                $string.= '_' . uc $self->territory_id;
        }
        if ($self->variant_id) {
                $string.= '_' . uc $self->variant_id;
        }
        if (defined $self->extensions) {
                $string.= '_u';
                foreach my $key (sort keys %{$self->extensions}) {
                        my $value = $self->extensions->{$key};
                        $string .= "_${key}_$value";
                }
                $string =~ s/_u$//;
        }
        return $string;
}
sub _get_english {
        my $self = shift;
        my $english;
        if ($self->language_id eq 'en') {
                $english = $self;
        }
        else {
                $english = Locale::CLDR->new('en_Latn_US');
        }
        return $english;
}
sub _build_name {
        my $self = shift;
        return $self->_get_english->native_name($self);
}
sub _build_native_name {
        my ($self, $for) = @_;
        return $self->locale_name($for);
}
sub _build_language {
        my $self = shift;
        return $self->_get_english->native_language($self);
}
sub _build_native_language {
        my ($self, $for) = @_;
        return $self->language_name($for) // '';
}
sub _build_script {
        my $self = shift;
        return $self->_get_english->native_script($self);
}
sub _build_native_script {
        my ($self, $for) = @_;
        return $self->script_name($for);
}
sub _build_territory {
        my $self = shift;
        return $self->_get_english->native_territory($self);
}
sub _build_native_territory {
        my ($self, $for) = @_;
        return $self->territory_name($for);
}
sub _build_variant {
        my $self = shift;
        return $self->_get_english->native_variant($self);
}
sub _build_native_variant {
        my ($self, $for) = @_;
        return $self->variant_name($for);
}
# Method to locate the resource bundle with the required data
sub _find_bundle {
        my ($self, $method_name) = @_;
        my $id = $self->has_likely_subtag()
                ? $self->likely_subtag()->id()
                : $self->id(); 
                 
         
        if ($self->method_cache->{$id}{$method_name}) {
                return wantarray
                        ? @{$self->method_cache->{$id}{$method_name}}
                        : $self->method_cache->{$id}{$method_name}[0];
        }
        foreach my $module ($self->module->meta->linearized_isa) {
                last if $module eq 'Moose::Object';
                if ($module->meta->has_method($method_name)) {
                        push @{$self->method_cache->{$id}{$method_name}}, $module->new;
                }
        }
        return unless $self->method_cache->{$id}{$method_name};
        return wantarray
                ? @{$self->method_cache->{$id}{$method_name}}
                : $self->method_cache->{$id}{$method_name}[0];
}
HideShow 18 lines of Pod
=back
=head2 Names
These methods allow you to pass in a locale, either by C<id> or as a
Locale::CLDR object and return an name formatted in the locale of $self.
If you don't pass in a locale then it will use $self.
=over 4 
=item locale_name($name)
Returns the given locale name in the current locales format. The name can be
a locale id or a locale object or non existent. If a name is not passed in
then the name of the current locale is returned.
=cut
sub locale_name {
        my ($self, $name) = @_;
        $name //= $self;
        my $code = ref $name
                ? join ( '_', $name->language_id, $name->territory_id ? $name->territory_id : () )
                : $name;
         
        my @bundles = $self->_find_bundle('display_name_language');
        foreach my $bundle (@bundles) {
                my $display_name = $bundle->display_name_language->($code);
                return $display_name if defined $display_name;
        }
        # $name can be a string or a Locale::CLDR::*
        if (! ref $name) {
                $name = Locale::CLDR->new($name);
        }
        # Now we have to process each individual element
        # to pass to the display name pattern
        my $language = $self->language_name($name);
        my $script = $self->script_name($name);
        my $territory = $self->territory_name($name);
        my $variant = $self->variant_name($name);
        my $bundle = $self->_find_bundle('display_name_pattern');
        return $bundle
                ->display_name_pattern($language, $territory, $script, $variant);
}
HideShow 8 lines of Pod
=item language_name($language)
Returns the language name in the current locales format. The name can be
a locale language id or a locale object or non existent. If a name is not
passed in then the language name of the current locale is returned.
=cut
sub language_name {
        my ($self, $name) = @_;
        $name //= $self;
        my $code = ref $name ? $name->language_id : eval { Locale::CLDR->new(language_id => $name)->language_id };
        my $language = undef;
        my @bundles = $self->_find_bundle('display_name_language');
        if ($code) {
                foreach my $bundle (@bundles) {
                        my $display_name = $bundle->display_name_language->($code);
                        if (defined $display_name) {
                                $language = $display_name;
                                last;
                        }
                }
        }
        # If we don't have a display name for the language we try again
        # with the und tag
        if (! defined $language ) {
                foreach my $bundle (@bundles) {
                        my $display_name = $bundle->display_name_language->('und');
                        if (defined $display_name) {
                                $language = $display_name;
                                last;
                        }
                }
        }
        return $language;
}
HideShow 7 lines of Pod
=item all_languages()
Returns a hash ref keyed on language id of all the languages the system 
knows about. The values are the language names for the corresponding id's 
=cut
sub all_languages {
        my $self = shift;
        my @bundles = $self->_find_bundle('display_name_language');
        my %languages;
        foreach my $bundle (@bundles) {
                my $languages = $bundle->display_name_language->();
                # Remove existing languages
                delete @{$languages}{keys %languages};
                # Assign new ones to the hash
                @languages{keys %$languages} = values %$languages;
        }
        return \%languages;
}
HideShow 8 lines of Pod
=item script_name($script)
Returns the script name in the current locales format. The script can be
a locale script id or a locale object or non existent. If a script is not
passed in then the script name of the current locale is returned.
=cut
sub script_name {
        my ($self, $name) = @_;
        $name //= $self;
        if (! ref $name ) {
                $name = eval {__PACKAGE__->new(script_id => $name)};
        }
        if ( ref $name && ! $name->script_id ) {
                return '';
        }
        my $script = undef;
        my @bundles = $self->_find_bundle('display_name_script');
        if ($name) {
                foreach my $bundle (@bundles) {
                        $script = $bundle->display_name_script->($name->script_id);
                        if (defined $script) {
                                last;
                        }
                }
        }
        if (! $script) {
                foreach my $bundle (@bundles) {
                        $script = $bundle->display_name_script->('Zzzz');
                        if (defined $script) {
                                last;
                        }
                }
        }
        return $script;
}
HideShow 7 lines of Pod
=item all_scripts()
Returns a hash ref keyed on script id of all the scripts the system 
knows about. The values are the script names for the corresponding id's 
=cut
sub all_scripts {
        my $self = shift;
        my @bundles = $self->_find_bundle('display_name_script');
        my %scripts;
        foreach my $bundle (@bundles) {
                my $scripts = $bundle->display_name_script->();
                # Remove existing scripts
                delete @{$scripts}{keys %scripts};
                # Assign new ones to the hash
                @scripts{keys %$scripts} = values %$scripts;
        }
        return \%scripts;
}
HideShow 8 lines of Pod
=item territory_name($territory)
Returns the territory name in the current locales format. The territory can be
a locale territory id or a locale object or non existent. If a territory is not
passed in then the territory name of the current locale is returned.
=cut
sub territory_name {
        my ($self, $name) = @_;
        $name //= $self;
        if (! ref $name ) {
                $name = eval { __PACKAGE__->new(language_id => 'und', territory_id => $name); };
        }
        if ( ref $name && ! $name->territory_id) {
                return '';
        }
        my $territory = undef;
        my @bundles = $self->_find_bundle('display_name_territory');
        if ($name) {
                foreach my $bundle (@bundles) {
                        $territory = $bundle->display_name_territory->{$name->territory_id};
                        if (defined $territory) {
                                last;
                        }
                }
        }
        if (! defined $territory) {
                foreach my $bundle (@bundles) {
                        $territory = $bundle->display_name_territory->{'ZZ'};
                        if (defined $territory) {
                                last;
                        }
                }
        }
        return $territory;
}
HideShow 7 lines of Pod
=item all_territories
Returns a hash ref keyed on territory id of all the territory the system 
knows about. The values are the territory names for the corresponding id's 
=cut
sub all_territories {
        my $self = shift;
        my @bundles = $self->_find_bundle('display_name_territory');
        my %territories;
        foreach my $bundle (@bundles) {
                my $territories = $bundle->display_name_territory;
                # Remove existing territories
                delete @{$territories}{keys %territories};
                # Assign new ones to the hash
                @territories{keys %$territories} = values %$territories;
        }
        return \%territories;
}
HideShow 8 lines of Pod
=item variant_name($variant)
Returns the variant name in the current locales format. The variant can be
a locale variant id or a locale object or non existent. If a variant is not
passed in then the variant name of the current locale is returned.
=cut
sub variant_name {
        my ($self, $name) = @_;
        $name //= $self;
        if (! ref $name ) {
                $name = __PACKAGE__->new(language_id=> 'und', variant_id => $name);
        }
        return '' unless $name->variant_id;
        my $variant = undef;
        if ($name->has_variant) {
                my @bundles = $self->_find_bundle('display_name_variant');
                foreach my $bundle (@bundles) {
                        $variant= $bundle->display_name_variant->{$name->variant_id};
                        if (defined $variant) {
                                last;
                        }
                }
        }
        return $variant // '';
}
HideShow 7 lines of Pod
=item key_name($key)
Returns the key name in the current locales format. The key must be
a locale key id as a string
=cut
sub key_name {
        my ($self, $key) = @_;
        $key = lc $key;
         
        my %key_aliases = $self->key_aliases;
        my %key_names   = $self->key_names;
        my %valid_keys  = $self->valid_keys;
        my $alias = $key_aliases{$key} // '';
        my $name  = $key_names{$key} // '';
        return '' unless exists $valid_keys{$key} || exists $valid_keys{$alias} || exists $valid_keys{$name};
        my @bundles = $self->_find_bundle('display_name_key');
        foreach my $bundle (@bundles) {
                my $return = $bundle->display_name_key->{$key};
                $return //= $bundle->display_name_key->{$alias}; 
                $return //= $bundle->display_name_key->{$name}; 
                return $return if defined $return && length $return;
        }
        return ucfirst ($key_names{$name} || $key_names{$alias} || $key_names{$key} || $key);
}
HideShow 7 lines of Pod
=item type_name($key, $type)
Returns the type name in the current locales format. The key and type must be
a locale key id and type id as a string
=cut
sub type_name {
        my ($self, $key, $type) = @_;
        $key    = lc $key;
        $type   = lc $type;
        my %key_aliases = $self->key_aliases;
        my %valid_keys  = $self->valid_keys;
        my %key_names   = $self->key_names;
        my $alias = $key_aliases{$key} // '';
        my $name  = $key_names{$key}   // '';
        return '' unless exists $valid_keys{$key} || $valid_keys{$alias} || $valid_keys{$name};
        return '' unless first { $_ eq $type } @{$valid_keys{$key} || []}, @{$valid_keys{$alias} || []}, @{$valid_keys{$name} || []};
        my @bundles = $self->_find_bundle('display_name_type');
        foreach my $bundle (@bundles) {
                my $types = $bundle->display_name_type->{$key} // $bundle->display_name_type->{$alias} // $bundle->display_name_type->{$name};
                my $type = $types->{$type};
                return $type if defined $type;
        }
        return '';
}
HideShow 7 lines of Pod
         
=item measurement_system_name($measurement_system)
Returns the measurement system name in the current locales format. The measurement system must be
a measurement system id as a string
=cut
         
sub measurement_system_name {
        my ($self, $name) = @_;
        # Fix case of code
        $name = uc $name;
        $name = 'metric' if $name eq 'METRIC';
        my @bundles = $self->_find_bundle('display_name_measurement_system');
        foreach my $bundle (@bundles) {
                my $system = $bundle->display_name_measurement_system->{$name};
                return $system if defined $system;
        }
        return '';
}
HideShow 7 lines of Pod
=item transform_name($name)
Returns the transform (transliteration) name in the current locales format. The transform must be
a transform id as a string
=cut
sub transform_name {
        my ($self, $name) = @_;
        $name = lc $name;
        my @bundles = $self->_find_bundle('display_name_transform_name');
        foreach my $bundle (@bundles) {
                my $key = $bundle->display_name_transform_name->{$name};
                return $key if length $key;
        }
        return '';
}
HideShow 8 lines of Pod
=item code_pattern($type, $locale)
This method formats a language, script or territory name, given as $type
from $locale in a way expected by the current locale. If $locale is
not passed in or is undef() the method uses the current locale.
=cut
sub code_pattern {
        my ($self, $type, $locale) = @_;
        $type = lc $type;
        # If locale is not passed in then we are using ourself
        $locale //= $self;
        # If locale is not an object then inflate it
        $locale = __PACKAGE__->new($locale) unless blessed $locale;
        return '' unless $type =~ m{ \A (?: language | script | territory ) \z }xms;
        my $method = $type . '_name';
        my $substitute = $self->$method($locale);
        my @bundles = $self->_find_bundle('display_name_code_patterns');
        foreach my $bundle (@bundles) {
                my $text = $bundle->display_name_code_patterns->{$type};
                next unless defined $text;
                my $match = qr{ \{ 0 \} }xms;
                $text=~ s{ $match }{$substitute}gxms;
                return $text;
        }
        return '';
}
HideShow 7 lines of Pod
=item text_orientation($type)
Gets the text orientation for the locale. Type must be one of 
C<lines> or C<characters>
=cut
sub text_orientation {
        my $self = shift;
        my $type = shift;
        my @bundles = $self->_find_bundle('text_orientation');
        foreach my $bundle (@bundles) {
                my $orientation = $bundle->text_orientation;
                next unless defined $orientation;
                return $orientation->{$type};
        }
        return;
}
sub _set_casing {
        my ($self, $casing, $string) = @_;
        my @words = $self->split_words($string);
        if ($casing eq 'titlecase-firstword') {
                # Check to see whether $words[0] is white space or not
                my $firstword_location = 0;
                if ($words[0] =~ m{ \A \s }msx) {
                        $firstword_location = 1;
                }
                $words[$firstword_location] = ucfirst $words[$firstword_location];
        }
        elsif ($casing eq 'titlecase-words') {
                @words = map{ ucfirst } @words;
        }
        elsif ($casing eq 'lowercase-words') {
                @words = map{ lc } @words;
        }
        return join '', @words;
}
HideShow 16 lines of Pod
=back
=head2 Segmentation
This group of methods allow you to split a string in various ways
Note you need Perl 5.18 or above for this
=over 4
=item split_grapheme_clusters($string)
Splits a string on grapheme clusters using the locals segmentation rules.
Returns a list of grapheme clusters.
=cut
# Need 5.18 and above
sub _new_perl {
        die "You need Perl 5.18 or later for this functionality\n"
                 if $^V lt v5.18.0;
}
sub split_grapheme_clusters {
        _new_perl();
         
        my ($self, $string) = @_;
        my $rules = $self->break_grapheme_cluster;
        my @clusters = $self->_split($rules, $string, 1);
        return @clusters;
}
HideShow 7 lines of Pod
=item split_words($string)
Splits a string on word boundaries using the locals segmentation rules.
Returns a list of words.
=cut
sub split_words {
        _new_perl();
         
        my ($self, $string) = @_;
        my $rules = $self->break_word;
        my @words = $self->_split($rules, $string);
        return @words;
}
HideShow 9 lines of Pod
=item split_sentences($string)
Splits a string on on all points where a sentence could
end using the locals segmentation rules. Returns a list
the end of each list element is the point where a sentence
could end.
=cut
sub split_sentences {
        _new_perl();
         
        my ($self, $string) = @_;
        my $rules = $self->break_sentence;
        my @sentences = $self->_split($rules, $string);
        return @sentences;
}
HideShow 9 lines of Pod
=item split_lines($string)
Splits a string on on all points where a line could
end using the locals segmentation rules. Returns a list
the end of each list element is the point where a line
could end.
=cut
sub split_lines {
        _new_perl();
         
        my ($self, $string) = @_;
        my $rules = $self->break_line;
        my @lines = $self->_split($rules, $string);
        return @lines;
}
sub _split {
        my ($self, $rules, $string, $grapheme_split) = @_;
        my @split = (scalar @$rules) x (length($string) - 1);
        pos($string)=0;
        # The Unicode Consortium has deprecated LB=Surrogate but the CLDR still
        # uses it, at last in this version.
        no warnings 'deprecated';
        while (length($string) -1 != pos $string) {
                my $rule_number = 0;
                my $first;
                foreach my $rule (@$rules) {
                        unless( ($first) = $string =~ m{
                                \G
                                ($rule->[0])
                                $rule->[1]
                        }msx) {
                                $rule_number++;
                                next;
                        }
                        my $location = pos($string) + length($first) -1;
                        $split[$location] = $rule_number;
                         
                        # If the left hand side was part of a grapheme cluster 
                        # we have to jump past the entire cluster
                        my $length = length $first;
                        my ($gc) = $string =~ /\G(\X)/;
                        $length = (! $grapheme_split && length($gc)) > $length ? length($gc) : $length;
                        pos($string)+= $length;
                        last;
                }
        }
        push @$rules,[undef,undef,1];
        @split = map {$rules->[$_][2] ? 1 : 0} @split;
        my $count = 0;
        my @sections = ('.');
        foreach my $split (@split) {
                $count++ unless $split;
                $sections[$count] .= '.';
        }
         
        my $regex = '(' . join(')(', @sections) . ')';
        $regex = qr{ \A $regex \z}msx;
        @split = $string =~ $regex;
        return @split;
}
HideShow 18 lines of Pod
=back
=head2 Characters
=over 4
=item is_exemplar_character( $type, $character)
=item is_exemplar_character($character)
Tests if the given character is used in the locale. There are 
three possible types; c<main>, C<auxiliary> and c<punctuation>.
If no type is given C<main> is assumed. Unless the C<index> type
is given you will have to have a Perl version of 5.18 or above
to use this method
=cut
sub is_exemplar_character {
        my ($self, @parameters) = @_;
        unshift @parameters, 'main' if @parameters == 1;
        _new_perl() unless $parameters[0] eq 'index';
         
        my @bundles = $self->_find_bundle('characters');
        foreach my $bundle (@bundles) {
                my $characters = $bundle->characters->{lc $parameters[0]};
                next unless defined $characters;
                return 1 if fc($parameters[1])=~$characters;
        }
        return;
}
HideShow 7 lines of Pod
=item index_characters()
Returns an array ref of characters normally used when creating 
an index.
=cut
sub index_characters {
        my $self = shift;
        my @bundles = $self->_find_bundle('characters');
        foreach my $bundle (@bundles) {
                my $characters = $bundle->characters->{index};
                next unless defined $characters;
                return $characters;
        }
        return [];
}
sub _truncated {
        my ($self, $type, @params) = @_;
        my @bundles = $self->_find_bundle('ellipsis');
        foreach my $bundle (@bundles) {
                my $ellipsis = $bundle->ellipsis->{$type};
                next unless defined $ellipsis;
                $ellipsis=~s{ \{ 0 \} }{$params[0]}msx;
                $ellipsis=~s{ \{ 1 \} }{$params[1]}msx;
                return $ellipsis;
        }
}
HideShow 15 lines of Pod
=back
=head2 Truncation
These methods format a string to show where part of the string has been removed
=over 4
=item truncated_beginning($string)
Adds the locale specific marking to show that the 
string has been truncated at the beginning.
=cut
sub truncated_beginning {
        shift->_truncated(initial => @_);
}
HideShow 9 lines of Pod
=item truncated_between($string, $string)
Adds the locale specific marking to show that something 
has been truncated between the two strings. Returns a
string comprising of the concatenation of the first string,
the mark and the second string
=cut
sub truncated_between {
        shift->_truncated(medial => @_);
}
HideShow 7 lines of Pod
=item truncated_end($string)
Adds the locale specific marking to show that the 
string has been truncated at the end.
=cut
sub truncated_end {
        shift->_truncated(final => @_);
}
HideShow 9 lines of Pod
=item truncated_word_beginning($string)
Adds the locale specific marking to show that the 
string has been truncated at the beginning. This
should be used in preference to C<truncated_beginning>
when the truncation occurs on a word boundary.
=cut
sub truncated_word_beginning {
        shift->_truncated('word-initial' => @_);
}
HideShow 11 lines of Pod
=item truncated_word_between($string, $string)
Adds the locale specific marking to show that something 
has been truncated between the two strings. Returns a
string comprising of the concatenation of the first string,
the mark and the second string. This should be used in
preference to C<truncated_between> when the truncation
occurs on a word boundary.
=cut
sub truncated_word_between {
        shift->_truncated('word-medial' => @_);
}
HideShow 9 lines of Pod
=item truncated_word_end($string)
Adds the locale specific marking to show that the 
string has been truncated at the end. This should be
used in preference to C<truncated_end> when the
truncation occurs on a word boundary.
=cut
sub truncated_word_end {
        shift->_truncated('word-final' => @_);
}
HideShow 17 lines of Pod
=back
=head2 Quoting
=over 4
=item quote($string)
Adds the locales primary quotation marks to the ends of the string.
Also scans the string for paired primary and auxiliary quotation
marks and flips them.
eg passing C<z “abc” z> to this method for the C<en_GB> locale
gives C<“z ‘abc’ z”>
=cut
sub quote {
        my ($self, $text) = @_;
        my %quote;
        my @bundles = $self->_find_bundle('quote_start');
        foreach my $bundle (@bundles) {
                my $quote = $bundle->quote_start;
                next unless defined $quote;
                $quote{start} = $quote;
                last;
        }
        @bundles = $self->_find_bundle('quote_end');
        foreach my $bundle (@bundles) {
                my $quote = $bundle->quote_end;
                next unless defined $quote;
                $quote{end} = $quote;
                last;
        }
        @bundles = $self->_find_bundle('alternate_quote_start');
        foreach my $bundle (@bundles) {
                my $quote = $bundle->alternate_quote_start;
                next unless defined $quote;
                $quote{alternate_start} = $quote;
                last;
        }
        @bundles = $self->_find_bundle('alternate_quote_end');
        foreach my $bundle (@bundles) {
                my $quote = $bundle->alternate_quote_end;
                next unless defined $quote;
                $quote{alternate_end} = $quote;
                last;
        }
        # Check to see if we need to switch quotes
        foreach (qw( start end alternate_start alternate_end)) {
                $quote{$_} //= '';
        }
        my $from = join ' | ', map {quotemeta} @quote{qw( start end alternate_start alternate_end)};
        my %to;
        @to{@quote{qw( start end alternate_start alternate_end)}}
                = @quote{qw( alternate_start alternate_end start end)};
        my $outer = index($text, $quote{start});
        my $inner = index($text, $quote{alternate_start});
        if ($inner == -1 || ($outer > -1 && $inner > -1 && $outer < $inner)) {
                $text =~ s{ ( $from ) }{ $to{$1} }msxeg;
        }
        return "$quote{start}$text$quote{end}";
}
HideShow 14 lines of Pod
=back
=head2 Miscellaneous
=over 4
=item more_information()
The more information string is one that can be displayed
in an interface to indicate that more information is
available.
=cut
sub more_information {
        my $self = shift;
        my @bundles = $self->_find_bundle('more_information');
        foreach my $bundle (@bundles) {
                my $info = $bundle->more_information;
                next unless defined $info;
                return $info;
        }
        return '';
}
HideShow 6 lines of Pod
=item measurement()
Returns the measurement type for the locale
=cut
sub measurement {
        my $self = shift;
         
        my $measurement_data = $self->measurement_system;
        my $territory = $self->territory_id // '001';
         
        my $data = $measurement_data->{$territory};
         
        until (defined $data) {
                $territory = $self->territory_contained_by->{$territory};
                $data = $measurement_data->{$territory};
        }
         
        return $data;
}
HideShow 6 lines of Pod
=item paper()
Returns the paper type for the locale
=cut
sub paper {
        my $self = shift;
         
        my $paper_size = $self->paper_size;
        my $territory = $self->territory_id // '001';
         
        my $data = $paper_size->{$territory};
         
        until (defined $data) {
                $territory = $self->territory_contained_by->{$territory};
                $data = $paper_size->{$territory};
        }
         
        return $data;
}
HideShow 12 lines of Pod
=back
=head2 Units
=over 4
=item all_units()
Returns a list of all the unit identifiers for the locale
=cut
sub all_units {
        my $self = shift;
        my @bundles = $self->_find_bundle('units');
         
        my %units;
        foreach my $bundle (reverse @bundles) {
                %units = %units, $bundle->units;
        }
         
        return keys %units;
}
HideShow 8 lines of Pod
=item unit($number, $unit, $width)
Returns the localised string for the given number and unit formatted for the 
required width. The number must not be the localized version of the number.
The returned string will be in the locales format, including the number.
=cut
sub unit {
        my ($self, $number, $what, $type) = @_;
        $type //= 'long';
         
        my $plural = $self->plural($number);
         
        my @bundles = $self->_find_bundle('units');
        my $format;
        foreach my $bundle (@bundles) {
                if (exists $bundle->units()->{$type}{$what}{$plural}) {
                        $format = $bundle->units()->{$type}{$what}{$plural};
                        last;
                }
                         
                if (exists $bundle->units()->{$type}{$what}{other}) {
                        $format = $bundle->units()->{$type}{$what}{other};
                        last;
                }
        }
         
        # Check for aliases
        unless ($format) {
                my $original_type = $type;
                my @aliases = $self->_find_bundle('unit_alias');
                foreach my $alias (@aliases) {
                        $type = $alias->unit_alias()->{$original_type};
                        next unless $type;
                        foreach my $bundle (@bundles) {
                                if (exists $bundle->units()->{$type}{$what}{$plural}) {
                                        $format = $bundle->units()->{$type}{$what}{$plural};
                                        last;
                                }
                         
                                if (exists $bundle->units()->{$type}{$what}{other}) {
                                        $format = $bundle->units()->{$type}{$what}{other};
                                        last;
                                }
                        }
                }
                $type = $original_type;
        }
         
        # Check for a compound unit that we don't specifically have
        if (! $format && (my ($dividend, $divisor) = $what =~ /^(.+)-per-(.+)$/)) {
                return $self->_unit_compound($number, $dividend, $divisor, $type);
        }
         
        $number = $self->format_number($number);
        return $number unless $format;
         
        $format =~ s/\{0\}/$number/g;
         
        return $format;
}
sub _unit_compound {
        my ($self, $number, $dividend_what, $divisor_what, $type) = @_;
         
        $type //= 'long';
         
        my $dividend = $self->unit($number, $dividend_what, $type);
        my $divisor = $self->unit(1, $divisor_what, $type);
         
        my $one = $self->format_number(1);
        $divisor =~ s/\s*$one\s*//;
        my @bundles = $self->_find_bundle('units');
        my $format;
        foreach my $bundle (@bundles) {
                if (exists $bundle->units()->{$type}{per}{''}) {
                        $format = $bundle->units()->{$type}{per}{''};
                        last;
                }
        }
        # Check for aliases
        unless ($format) {
                my $original_type = $type;
                my @aliases = $self->_find_bundle('unit_alias');
                foreach my $alias (@aliases) {
                        $type = $alias->unit_alias()->{$original_type};
                        foreach my $bundle (@bundles) {
                                if (exists $bundle->units()->{$type}{per}{''}) {
                                        $format = $bundle->units()->{$type}{per}{''};
                                        last;
                                }
                        }
                }
        }
         
        $format =~ s/\{0\}/$dividend/g;
        $format =~ s/\{1\}/$divisor/g;
         
        return $format;
}
HideShow 9 lines of Pod
=item duration_unit($format, @data)
This method formats a duration. The format must be one of
C<hm>, C<hms> or C<ms> corresponding to C<hour minute>, 
C<hour minute second> and C<minute second> respectively.
The data must correspond to the given format. 
=cut
sub duration_unit {
        # data in hh,mm; hh,mm,ss or mm,ss 
        my ($self, $format, @data) = @_;
         
        my $bundle = $self->_find_bundle('duration_units');
        my $parsed = $bundle->duration_units()->{$format};
         
        my $num_format = '#';
        foreach my $entry ( qr/(hh?)/, qr/(mm?)/, qr/(ss?)/) {
                $num_format = '00' if $parsed =~ s/$entry/$self->format_number(shift(@data), $num_format)/e;
        }
         
        return $parsed;
}
HideShow 16 lines of Pod
=back
=head2 Yes or No?
=over 4
=item is_yes($string)
Returns true if the passed in string matches the locales 
idea of a string designating yes. Note that under POSIX
rules unless the locales word for yes starts with C<Y>
(U+0079) then a single 'y' will also be accepted as yes.
The string will be matched case insensitive.
=cut
sub is_yes {
        my ($self, $test_str) = @_;
         
        my $bundle = $self->_find_bundle('yesstr');
        return $test_str =~ $bundle->yesstr ? 1 : 0;
}
HideShow 10 lines of Pod
=item is_no($string)
Returns true if the passed in string matches the locales 
idea of a string designating no. Note that under POSIX
rules unless the locales word for yes starts with C<n>
(U+006E) then a single 'n' will also be accepted as no
The string will be matched case insensitive.
=cut
sub is_no {
        my ($self, $test_str) = @_;
         
        my $bundle = $self->_find_bundle('nostr');
        return $test_str =~ $bundle->nostr ? 1 : 0;
}
HideShow 17 lines of Pod
=back
=head2 Transliteration
This method requires Perl version 5.18 or above to use
=over 4
=item transform(from => $from, to => $to, variant => $variant, text => $text)
This method returns the transliterated string of C<text> from script C<from>
to script C<to> using variant C<variant>. If c<from> is not given then the 
current locales script is used. If C<text> is not given then it defaults to an
empty string. The C<variant> is optional.
=cut
sub transform {
        _new_perl();
         
        my ($self, %params) = @_;
         
        my $from        = $params{from} // $self;
        my $to          = $params{to}; 
        my $variant     = $params{variant} // 'Any';
        my $text        = $params{text} // '';
         
        ($from, $to) = map {ref $_ ? $_->likely_script() : $_} ($from, $to);
        $_ = ucfirst(lc $_) foreach ($from, $to, $variant);
         
        my $package = __PACKAGE__ . "::Transformations::${variant}::${from}::${to}";
        eval { Class::Load::load_class($package); };
        warn $@ if $@;
        return $text if $@; # Can't load transform module so return original text
        use feature 'state';
        state $transforms;
        $transforms->{$variant}{$from}{$to} //= $package->new();
        my $rules = $transforms->{$variant}{$from}{$to}->transforms();
         
        # First get the filter rule
        my $filter = $rules->[0];
                 
        # Break up the input on the filter
        my @text;
        pos($text) = 0;
        while (pos($text) < length($text)) {
                my $characters = '';
                while (my ($char) = $text =~ /($filter)/) {
                        $characters .= $char;
                        pos($text) = pos($text) + length $char;
                }
                push @text, $characters;
                last unless pos($text) < length $text;
                 
                $characters = '';
                while ($text !~ /$filter/) {
                        my ($char) = $text =~ /\G(\X)/;
                        $characters .= $char;
                        pos($text) = pos($text) + length $char;
                }
                push @text, $characters;
        }
         
        my $to_transform = 1;
         
        foreach my $characters (@text) {
                if ($to_transform) {
                        foreach my $rule (@$rules[1 .. @$rules -1 ]) {
                                if ($rule->{type} eq 'transform') {
                                        $characters = $self->_transformation_transform($characters, $rule->{data}, $variant);
                                }
                                else {
                                        $characters = $self->_transform_convert($characters, $rule->{data});
                                }
                        }
                }
                $to_transform = ! $to_transform;
        }
         
        return join '', @text;
}
sub _transformation_transform {
        my ($self, $text, $rules, $variant) = @_;
                 
        foreach my $rule (@$rules) {
                for (lc $rule->{to}) {
                        if ($_ eq 'nfc') {
                                $text = Unicode::Normalize::NFC($text);
                        }
                        elsif($_ eq 'nfd') {
                                $text = Unicode::Normalize::NFD($text);
                        }
                        elsif($_ eq 'nfkd') {
                                $text = Unicode::Normalize::NFKD($text);
                        }
                        elsif($_ eq 'nfkc') {
                                $text = Unicode::Normalize::NFKC($text);
                        }
                        elsif($_ eq 'lower') {
                                $text = lc($text);
                        }
                        elsif($_ eq 'upper') {
                                $text = uc($text);
                        }
                        elsif($_ eq 'title') {
                                $text =~ s/(\X)/\u$1/g;
                        }
                        elsif($_ eq 'null') {
                        }
                        elsif($_ eq 'remove') {
                                $text = '';
                        }
                        else {
                                $text = $self->transform($text, $variant, $rule->{from}, $rule->to);
                        }
                }
        }
        return $text;
}               
sub _transform_convert {
        my ($self, $text, $rules) = @_;
         
        pos($text) = 0; # Make sure we start scanning at the beginning of the text
                 
        CHARACTER: while (pos($text) < length($text)) {
                foreach my $rule (@$rules) {
                        next if length $rule->{before} && $text !~ /$rule->{before}\G/;
                        my $regex = $rule->{replace};
                        $regex .= '(' . $rule->{after} . ')' if length $rule->{after};
                        my $result = 'q(' . $rule->{result} . ')';
                        $result .= '. $1' if length $rule->{after};
                        if ($text =~ s/\G$regex/eval $result/e) {
                                pos($text) += length($rule->{result}) - $rule->{revisit};
                                next CHARACTER;
                        }
                }
                 
                pos($text)++;
        }
         
        return $text;
}
HideShow 14 lines of Pod
=back
=head2 Lists
=over 4
=item list(@data)
Returns C<data> as a string formatted by the locales idea of producing a list
of elements. What is returned can be effected by the locale and the number
of items in C<data>. Note that C<data> can contain 0 or more items.
=cut
sub list {
        my ($self, @data) = @_;
         
        # Short circuit on 0 or 1 entries
        return '' unless @data;
        return $data[0] if 1 == @data;
         
        my @bundles = $self->_find_bundle('listPatterns');
         
        my %list_data;
        foreach my $bundle (reverse @bundles) {
                %list_data = %{$bundle->listPatterns};
        }
         
        if (my $pattern = $list_data{scalar @data}) {
                $pattern=~s/\{([0-9]+)\}/$data[$1]/eg;
                return $pattern;
        }
         
        my ($start, $middle, $end) = @list_data{qw( start middle end )};
         
        # First do the end
        my $pattern = $end;
        $pattern=~s/\{1\}/pop @data/e;
        $pattern=~s/\{0\}/pop @data/e;
         
        # If there is any data left do the middle
        while (@data > 1) {
                my $current = $pattern;
                $pattern = $middle;
                $pattern=~s/\{1\}/$current/;
                $pattern=~s/\{0\}/pop @data/e;
        }
         
        # Now do the start
        my $current = $pattern;
        $pattern = $start;
        $pattern=~s/\{1\}/$current/;
        $pattern=~s/\{0\}/pop @data/e;
         
        return $pattern;
}
HideShow 15 lines of Pod
=item plural($number)
This method takes a number and uses the locales pluralisation
rules to calculate the type of pluralisation required for
units, currencies and other data that changes depending on
the plural state of the number
=item plural_range($start, $end)
This method returns the plural type for the range $start to $end
$start and $end can either be numbers or one of the plural types
C<zero one two few many other>
=cut
sub _clear_calendar_data {
        my $self = shift;
        foreach my $property (qw(
                month_format_wide month_format_abbreviated month_format_narrow
                month_stand_alone_wide month_stand_alone_abbreviated
                month_stand_alone_narrow day_format_wide day_format_abbreviated
                day_format_narrow day_stand_alone_wide day_stand_alone_abreviated
                day_stand_alone_narrow quater_format_wide quater_format_abbreviated
                quater_format_narrow quater_stand_alone_wide
                quater_stand_alone_abreviated quater_stand_alone_narrow
                am_pm_wide am_pm_abbreviated am_pm_narrow am_pm_format_wide 
                am_pm_format_abbreviated am_pm_format_narrow am_pm_stand_alone_wide 
                am_pm_stand_alone_abbreviated am_pm_stand_alone_narrow era_wide 
                era_abbreviated era_narrow date_format_full date_format_long date_format_medium
                date_format_short time_format_full
                time_format_long time_format_medium time_format_short
                datetime_format_full datetime_format_long
                datetime_format_medium datetime_format_short
                available_formats format_data
        )) {
                my $method = "_clear_$property";
                $self->$method;
        }
}
sub _build_any_month {
        my ($self, $type, $width) = @_;
        my $default_calendar = $self->default_calendar();
        my @bundles = $self->_find_bundle('calendar_months');
        BUNDLES: {
                foreach my $bundle (@bundles) {
                        my $months = $bundle->calendar_months;
                        if (exists $months->{$default_calendar}{alias}) {
                                $default_calendar = $months->{$default_calendar}{alias};
                                redo BUNDLES;
                        }
                        if (exists $months->{$default_calendar}{$type}{$width}{alias}) {
                                ($type, $width) = @{$months->{$default_calendar}{$type}{$width}{alias}}{qw(context type)};
                                redo BUNDLES;
                        }
                         
                        my $result = $months->{$default_calendar}{$type}{$width}{nonleap};
                        return $result if defined $result;
                }
        }
         
        return [];
}
sub _build_month_format_wide {
        my $self = shift;
        my ($type, $width) = (qw(format wide));
         
        return $self->_build_any_month($type, $width);
}
sub _build_month_format_abbreviated {
        my $self = shift;
        my ($type, $width) = (qw(format abbreviated));
         
        return $self->_build_any_month($type, $width);
}
sub _build_month_format_narrow {
        my $self = shift;
        my ($type, $width) = (qw(format narrow));
         
        return $self->_build_any_month($type, $width);
}
sub _build_month_stand_alone_wide {
        my $self = shift;
        my ($type, $width) = ('stand-alone', 'wide');
         
        return $self->_build_any_month($type, $width);
}
sub _build_month_stand_alone_abbreviated {
        my $self = shift;
        my ($type, $width) = ('stand-alone', 'abbreviated');
         
        return $self->_build_any_month($type, $width);
}
sub _build_month_stand_alone_narrow {
        my $self = shift;
        my ($type, $width) = ('stand-alone', 'narrow');
         
        return $self->_build_any_month($type, $width);
}
sub _build_any_day {
        my ($self, $type, $width) = @_;
         
        my $default_calendar = $self->default_calendar();
        my @bundles = $self->_find_bundle('calendar_days');
        BUNDLES: {
                foreach my $bundle (@bundles) {
                        my $days= $bundle->calendar_days;
                         
                        if (exists $days->{$default_calendar}{alias}) {
                                $default_calendar = $days->{$default_calendar}{alias};
                                redo BUNDLES;
                        }
                        if (exists $days->{$default_calendar}{$type}{$width}{alias}) {
                                ($type, $width) = @{$days->{$default_calendar}{$type}{$width}{alias}}{qw(context type)};
                                redo BUNDLES;
                        }
                        my $result = $days->{$default_calendar}{$type}{$width};
                        return [ @{$result}{qw( mon tue wed thu fri sat sun )} ] if keys %$result;
                }
        }
        return [];
}
sub _build_day_format_wide {
        my $self = shift;
        my ($type, $width) = (qw(format wide));
         
        return $self->_build_any_day($type, $width);
}
sub _build_day_format_abbreviated {
        my $self = shift;
        my ($type, $width) = (qw(format abbreviated));
         
        return $self->_build_any_day($type, $width);
}
sub _build_day_format_narrow {
        my $self = shift;
        my ($type, $width) = (qw(format narrow));
         
        return $self->_build_any_day($type, $width);
}
sub _build_day_stand_alone_wide {
        my $self = shift;
        my ($type, $width) = ('stand-alone', 'wide');
         
        return $self->_build_any_day($type, $width);
}
sub _build_day_stand_alone_abbreviated {
        my $self = shift;
        my ($type, $width) = ('stand-alone', 'abbreviated');
        return $self->_build_any_day($type, $width);
}
sub _build_day_stand_alone_narrow {
        my $self = shift;
        my ($type, $width) = ('stand-alone', 'narrow');
         
        return $self->_build_any_day($type, $width);
}
sub _build_any_quarter {
        my ($self, $type, $width) = @_;
         
        my $default_calendar = $self->default_calendar();
        my @bundles = $self->_find_bundle('calendar_quarters');
        BUNDLES: {
                foreach my $bundle (@bundles) {
                        my $quarters= $bundle->calendar_quarters;
                         
                        if (exists $quarters->{$default_calendar}{alias}) {
                                $default_calendar = $quarters->{$default_calendar}{alias};
                                redo BUNDLES;
                        }
                        if (exists $quarters->{$default_calendar}{$type}{$width}{alias}) {
                                ($type, $width) = @{$quarters->{$default_calendar}{$type}{$width}{alias}}{qw(context type)};
                                redo BUNDLES;
                        }
                         
                        my $result = $quarters->{$default_calendar}{$type}{$width};
                        return [ @{$result}{qw( 0 1 2 3 )} ] if keys %$result;
                }
        }
        return [];
}
sub _build_quarter_format_wide {
        my $self = shift;
        my ($type, $width) = (qw( format wide ));
         
        return $self->_build_any_quarter($type, $width);
}
sub _build_quarter_format_abbreviated {
        my $self = shift;
        my ($type, $width) = (qw(format abbreviated));
        return $self->_build_any_quarter($type, $width);
}
sub _build_quarter_format_narrow {
        my $self = shift;
        my ($type, $width) = (qw(format narrow));
        return $self->_build_any_quarter($type, $width);
}
sub _build_quarter_stand_alone_wide {
        my $self = shift;
        my ($type, $width) = ('stand-alone', 'wide');
        return $self->_build_any_quarter($type, $width);
}
sub _build_quarter_stand_alone_abbreviated {
        my $self = shift;
        my ($type, $width) = ('stand-alone', 'abbreviated');
         
        return $self->_build_any_quarter($type, $width);
}
sub _build_quarter_stand_alone_narrow {
        my $self = shift;
        my ($type, $width) = ('stand-alone', 'narrow');
        return $self->_build_any_quarter($type, $width);
}
HideShow 8 lines of Pod
=item get_day_period($time)
This method will calculate the correct
period for a given time and return the period name in
the Locales language and script
=cut
sub get_day_period {
        # Time in hhmm
        my ($self, $time) = @_;
         
        my $default_calendar = $self->default_calendar();
         
        my $bundle = $self->_find_bundle('day_period_data');
         
        my $day_period = $bundle->day_period_data;
        $day_period = $self->$day_period($default_calendar, $time);
         
        my $am_pm = $self->am_pm_format_abbreviated;
         
        return $am_pm->{$day_period};
}
sub _build_any_am_pm {
        my ($self, $type, $width) = @_;
        my $default_calendar = $self->default_calendar();
        my @result;
        my @bundles = $self->_find_bundle('day_periods');
        my %return;
        BUNDLES: {
                foreach my $bundle (@bundles) {
                        my $am_pm = $bundle->day_periods;
         
                        if (exists $am_pm->{$default_calendar}{alias}) {
                                $default_calendar = $am_pm->{$default_calendar}{alias};
                                redo BUNDLES;
                        }
                        if (exists $am_pm->{$default_calendar}{$type}{alias}) {
                                $type = $am_pm->{$default_calendar}{$type}{alias};
                                redo BUNDLES;
                        }
                         
                        if (exists $am_pm->{$default_calendar}{$type}{$width}{alias}) {
                                $width = $am_pm->{$default_calendar}{$type}{$width}{alias};
                                redo BUNDLES;
                        }
                         
                        my $result = $am_pm->{$default_calendar}{$type}{$width};
                         
                        foreach (keys %$result) {
                                $return{$_} = $result->{$_} unless exists $return{$_};
                        }
                }
        }
        return \%return;
}
# The first 3 are to link in with Date::Time::Locale
sub _build_am_pm_wide {
        my $self = shift;
        my ($type, $width) = (qw( format wide ));
         
        my $result = $self->_build_any_am_pm($type, $width);
         
        return [ @$result{qw( am pm )} ];
}
sub _build_am_pm_abbreviated {
        my $self = shift;
        my ($type, $width) = (qw( format abbreviated ));
        my $result = $self->_build_any_am_pm($type, $width);
         
        return [ @$result{qw( am pm )} ];
}
sub _build_am_pm_narrow {
        my $self = shift;
        my ($type, $width) = (qw( format narrow ));
         
        my $result = $self->_build_any_am_pm($type, $width);
         
        return [ @$result{qw( am pm )} ];
}
# Now we do the full set of data
sub _build_am_pm_format_wide {
        my $self = shift;
        my ($type, $width) = (qw( format wide ));
         
        return $self->_build_any_am_pm($type, $width);
}
sub _build_am_pm_format_abbreviated {
        my $self = shift;
        my ($type, $width) = (qw( format abbreviated ));
        return $self->_build_any_am_pm($type, $width);
}
sub _build_am_pm_format_narrow {
        my $self = shift;
        my ($type, $width) = (qw( format narrow ));
         
        return $self->_build_any_am_pm($type, $width);
}
sub _build_am_pm_stand_alone_wide {
        my $self = shift;
        my ($type, $width) = ('stand-alone', 'wide');
         
        return $self->_build_any_am_pm($type, $width);
}
sub _build_am_pm_stand_alone_abbreviated {
        my $self = shift;
        my ($type, $width) = ('stand-alone', 'abbreviated');
        return $self->_build_any_am_pm($type, $width);
}
sub _build_am_pm_stand_alone_narrow {
        my $self = shift;
        my ($type, $width) = ('stand-alone', 'narrow');
         
        return $self->_build_any_am_pm($type, $width);
}
sub _build_any_era {
        my ($self, $width) = @_;
        my $default_calendar = $self->default_calendar();
        my @bundles = $self->_find_bundle('eras');
        BUNDLES: {
                foreach my $bundle (@bundles) {
                        my $eras = $bundle->eras;
         
                        if (exists $eras->{$default_calendar}{alias}) {
                                $default_calendar = $eras->{$default_calendar}{alias};
                                redo BUNDLES;
                        }
                        if (exists $eras->{$default_calendar}{$width}{alias}) {
                                $width = $eras->{$default_calendar}{$width}{alias};
                                redo BUNDLES;
                        }
                                                 
                        my $result = $eras->{$default_calendar}{$width};
                         
                        my @result = map {$result->{$_}} sort { $a <=> $b } keys %$result;
                         
                        return \@result if keys %$result;
                }
        }
        return [];
}
         
# The next three are for DateDime::Locale
sub _build_era_wide {
        my $self = shift;
        my ($width) = (qw( wide ));
        my $result = $self->_build_any_era($width);
         
        return [@$result[0, 1]];
}
sub _build_era_abbreviated {
        my $self = shift;
        my ($width) = (qw( abbreviated ));
        my $result = $self->_build_any_era($width);
         
        return [@$result[0, 1]];
}
sub _build_era_narrow {
        my $self = shift;
        my ($width) = (qw( narrow ));
        my $result = $self->_build_any_era($width);
         
        return [@$result[0, 1]];
}
# Now get all the era data
sub _build_era_format_wide {
        my $self = shift;
        my ($width) = (qw( wide ));
        return $self->_build_any_era($width);
}
sub _build_era_format_abbreviated {
        my $self = shift;
        my ($width) = (qw( abbreviated ));
        return $self->_build_any_era($width);
}
sub _build_era_format_narrow {
        my $self = shift;
        my ($type, $width) = (qw( narrow ));
        return $self->_build_any_era($type, $width);
}
*_build_era_stand_alone_wide = \&_build_era_format_wide;
*_build_era_stand_alone_abbreviated = \&_build_era_format_abbreviated;
*_build_era_stand_alone_narrow = \&_build_era_format_narrow;
sub _build_any_date_format {
        my ($self, $width) = @_;
        my $default_calendar = $self->default_calendar();
         
        my @bundles = $self->_find_bundle('date_formats');
        BUNDLES: {
                foreach my $bundle (@bundles) {
                        my $date_formats = $bundle->date_formats;
                        if (exists $date_formats->{alias}) {
                                $default_calendar = $date_formats->{alias};
                                redo BUNDLES;
                        }
                         
                        my $result = $date_formats->{$default_calendar}{$width};
                        return $result if $result;
                }
        }
        return '';
}
sub _build_date_format_full {
        my $self = shift;
         
        my ($width) = ('full');
        return $self->_build_any_date_format($width);
}
sub _build_date_format_long {
        my $self = shift;
         
        my ($width) = ('long');
        return $self->_build_any_date_format($width);
}
sub _build_date_format_medium {
        my $self = shift;
         
        my ($width) = ('medium');
        return $self->_build_any_date_format($width);
}
sub _build_date_format_short {
        my $self = shift;
         
        my ($width) = ('short');
        return $self->_build_any_date_format($width);
}
sub _build_any_time_format {
        my ($self, $width) = @_;
        my $default_calendar = $self->default_calendar();
         
        my @bundles = $self->_find_bundle('time_formats');
        BUNDLES: {
                foreach my $bundle (@bundles) {
                        my $time_formats = $bundle->time_formats;
                        if (exists $time_formats->{$default_calendar}{alias}) {
                                $default_calendar = $time_formats->{$default_calendar}{alias};
                                redo BUNDLES;
                        }
                         
                        my $result = $time_formats->{$default_calendar}{$width};
                        return $result if $result;
                }
        }
        return '';
}
sub _build_time_format_full {
        my $self = shift;
        my $width = 'full';
         
        return $self->_build_any_time_format($width);
}
sub _build_time_format_long {
        my $self = shift;
         
        my $width = 'long';
        return $self->_build_any_time_format($width);
}
sub _build_time_format_medium {
        my $self = shift;
         
        my $width = 'medium';
        return $self->_build_any_time_format($width);
}
sub _build_time_format_short {
        my $self = shift;
         
        my $width = 'short';
        return $self->_build_any_time_format($width);
}
sub _build_any_datetime_format {
        my ($self, $width) = @_;
        my $default_calendar = $self->default_calendar();
         
        my @bundles = $self->_find_bundle('datetime_formats');
        BUNDLES: {
                foreach my $bundle (@bundles) {
                        my $datetime_formats = $bundle->datetime_formats;
                        if (exists $datetime_formats->{$default_calendar}{alias}) {
                                $default_calendar = $datetime_formats->{$default_calendar}{alias};
                                redo BUNDLES;
                        }
                         
                        my $result = $datetime_formats->{$default_calendar}{$width};
                        return $result if $result;
                }
        }
         
        return '';
}       
sub _build_datetime_format_full {
        my $self = shift;
         
        my $width = 'full';
        my $format = $self->_build_any_datetime_format($width);
         
        my $date = $self->_build_any_date_format($width);
        my $time = $self->_build_any_time_format($width);
         
        $format =~ s/\{0\}/$time/;
        $format =~ s/\{1\}/$date/;
         
        return $format;
}
sub _build_datetime_format_long {
        my $self = shift;
                 
        my $width = 'long';
        my $format = $self->_build_any_datetime_format($width);
         
        my $date = $self->_build_any_date_format($width);
        my $time = $self->_build_any_time_format($width);
         
        $format =~ s/\{0\}/$time/;
        $format =~ s/\{1\}/$date/;
         
        return $format;
}
sub _build_datetime_format_medium {
        my $self = shift;
         
        my $width = 'medium';
        my $format = $self->_build_any_datetime_format($width);
         
        my $date = $self->_build_any_date_format($width);
        my $time = $self->_build_any_time_format($width);
         
        $format =~ s/\{0\}/$time/;
        $format =~ s/\{1\}/$date/;
         
        return $format;
}
sub _build_datetime_format_short {
        my $self = shift;
         
        my $width = 'short';
        my $format = $self->_build_any_datetime_format($width);
         
        my $date = $self->_build_any_date_format($width);
        my $time = $self->_build_any_time_format($width);
         
        $format =~ s/\{0\}/$time/;
        $format =~ s/\{1\}/$date/;
         
        return $format;
}
sub _build_format_data {
        my $self = shift;
        my $default_calendar = $self->default_calendar();
        my @bundles = $self->_find_bundle('datetime_formats_available_formats');
        foreach my $calendar ($default_calendar, 'gregorian') {
                foreach my $bundle (@bundles) {
                        my $datetime_formats_available_formats = $bundle->datetime_formats_available_formats;
                        my $result = $datetime_formats_available_formats->{$calendar};
                        return $result if $result;
                }
        }
        return {};
}
HideShow 6 lines of Pod
=item format_for
TODO fix this 
=cut
sub format_for {
        my ($self, $format) = @_;
        my $format_data = $self->format_data;
        return $format_data->{$format} // '';
}
sub _build_available_formats {
        my $self = shift;
        my $format_data = $self->format_data;
        return [keys %$format_data];
}
sub _build_default_date_format_length {
        my $self = shift;
         
        my $default_calendar = $self->default_calendar();
        my @bundles = $self->_find_bundle('date_formats');
        foreach my $calendar ($default_calendar, 'gregorian') {
                foreach my $bundle (@bundles) {
                        my $date_formats = $bundle->date_formats;
                        my $result = $date_formats->{$calendar}{default};
                        return $result if $result;
                }
        }
}
sub _build_default_time_format_length {
        my $self = shift;
         
        my $default_calendar = $self->default_calendar();
        my @bundles = $self->_find_bundle('time_formats');
        foreach my $calendar ($default_calendar, 'gregorian') {
                foreach my $bundle (@bundles) {
                        my $time_formats = $bundle->time_formats;
                        my $result = $time_formats->{$calendar}{default};
                        return $result if $result;
                }
        }
}
sub _build_prefers_24_hour_time {
        my $self = shift;
        return $self->time_format_short() =~ /h|K/ ? 0 : 1;
}
{
        my %days_2_number = (
                mon => 1,
                tue => 2,
                wen => 3,
                thu => 4,
                fri => 5,
                sat => 6,
                sun => 7,
        );
        sub _build_first_day_of_week {
                my $self = shift;
                my $first_day = $self->week_data_first_day;
                 
                return $days_2_number{$first_day};
        }
}
# Sub to mangle Unicode regex to Perl regex
# Backwards compatibility hack
*_unicode_to_perl = eval <<'EOT' || \&_new_perl;
sub {
        my $regex = shift;
        return '' unless length $regex;
        $regex =~ s/
                (?:\\\\)*+                      # Pairs of \
                (?!\\)                          # Not followed by \
                \K                              # But we don't want to keep that
                (?<set>                     # Capture this
                        \[                      # Start a set
                                (?:
                                        [^\[\]\\]+      # One or more of not []\
                                        |               # or
                                        (?:
                                                (?:\\\\)*+      # One or more pairs of \ without back tracking
                                                \\.         # Followed by an escaped character
                                        )
                                        |                               # or
                                        (?&set)                     # An inner set
                                )++                 # Do the inside set stuff one or more times without backtracking
                        \]                                              # End the set
                )
        / _convert($1) /xeg;
        no warnings "experimental::regex_sets";
        no warnings "deprecated"; # Because CLDR uses surrogates
        return qr/$regex/x;
};
EOT
# Backwards compatibility hack
*_convert = eval <<'EOT' || \&_new_perl;
sub {
        my $set = shift;
         
        # Some definitions
        my $posix = qr/(?(DEFINE)
                (?<posix> (?> \[: .+? :\] ) )
                )/x;
         
        # Convert Unicode escapes \u1234 to characters
        $set =~ s/\\u(\p{Ahex}+)/chr(hex($1))/egx;
         
        # Check to see if this is a normal character set
        my $normal = 0;
         
        $normal = 1 if $set =~ /^
                \s*                                     # Possible white space
                \[                                      # Opening set
                ^?                                      # Possible negation
                (?:                             # One of
                        [^\[\]]++                       # Not an open or close set 
                        |                                       # Or
                        (?<=\\)[\[\]]       # An open or close set preceded by \
                        |                   # Or
                        (?:
                                \s*                     # Possible white space
                                (?&posix)           # A posix class
                                (?!             # Not followed by
                                        \s*                     # Possible white space
                                        [&-]        # A Unicode regex op
                                        \s*             # Possible white space
                                        \[              # A set opener
                                )
                        )
                )+
                \]                                              # Close the set
                \s*                                             # Possible white space
                $
                $posix
        /x;
         
        # Convert posix to perl
        $set =~ s/\[:(.*?):\]/\\p{$1}/g;
         
        if ($normal) {
                return "$set";
        }
         
        # Fix up [abc[de]] to [[abc][de]]
        $set =~ s/\[ ( (?>\^? \s*) [^\]]+? ) \s* \[/[[$1][/gx;
         
        # Fix up [[ab]cde] to [[ab][cde]]
        $set =~ s/\[ \^?+ \s* \[ [^\]]+? \] \K \s* ( [^\[]+ ) \]/[$1]]/gx;
         
        # Unicode uses ^ to compliment the set where as Perl uses !
        $set =~ s/\[ \^ \s*/[!/gx;
         
        # The above can leave us with empty sets. Strip them out
        $set =~ s/\[\]//g;
         
        # Fixup inner sets with no operator
        1 while $set =~ s/ \] \s* \[ /] + [/gx;
        1 while $set =~ s/ \] \s * (\\p\{.*?\}) /] + $1/xg;
        1 while $set =~ s/ \\p\{.*?\} \s* \K \[ / + [/xg;
        1 while $set =~ s/ \\p\{.*?\} \s* \K (\\p\{.*?\}) / + $1/xg;
         
        # Unicode uses [] for grouping as well as starting an inner set
        # Perl uses ( ) So fix that up now
         
        $set =~ s/. \K \[ (?> (!?) \s*) \[ /($1\[/gx;
        $set =~ s/ \] \s* \] (.) /])$1/gx;
         
        return "(?$set)";
}
EOT
# The following pod is for methods defined in the Moose Role
HideShow 53 lines of Pod
# files that are automatically generated from the data
=back
=head2 Valid codes
=over 4
=item valid_languages()
This method returns a list containing all the valid language codes
=item valid_scripts()
This method returns a list containing all the valid script codes
=item valid_territories()
This method returns a list containing all the valid territory codes
=item valid_variants()
This method returns a list containing all the valid variant codes
=item key_aliases()
This method returns a hash that maps valid keys to their valid aliases
=item key_names()
This method returns a hash that maps valid key aliases to their valid keys
=item valid_keys()
This method returns a hash of valid keys and the valid type codes you 
can have with each key
=item language_aliases()
This method returns a hash that maps valid language codes to their valid aliases
=item territory_aliases()
This method returns a hash that maps valid territory codes to their valid aliases
=item variant_aliases()
This method returns a hash that maps valid variant codes to their valid aliases
=back
=head2 Information about weeks
=cut
sub _week_data {
        my ($self, $territory_id, $week_data_hash) = @_;
         
        $territory_id //= ( $self->territory_id || $self->likely_subtag->territory_id );
         
        return $week_data_hash->{$territory_id} if exists $week_data_hash->{$territory_id};
         
        while (1) {
                $territory_id = $self->territory_contained_by()->{$territory_id};
                return unless defined $territory_id;
                return $week_data_hash->{$territory_id} if exists $week_data_hash->{$territory_id};
        }
}
HideShow 10 lines of Pod
=over 4
=item week_data_min_days($territory_id)
This method takes an optional territory id and returns a the minimum number of days
a week must have to count as the starting week of the new year. It uses the current
locales territory if no territory id is passed in.
=cut
sub week_data_min_days {
        my ($self, $territory_id) = @_;
         
        my $week_data_hash = $self->_week_data_min_days();
        return _week_data($self, $territory_id, $week_data_hash);
}
HideShow 8 lines of Pod
=item week_data_first_day($territory_id)
This method takes an optional territory id and returns the three letter code of the 
first day of the week for that territory. If no territory id is passed in then it
uses the current locales territory.
=cut
sub week_data_first_day {
        my ($self, $territory_id) = @_;
         
        my $week_data_hash = $self->_week_data_first_day();
        return _week_data($self, $territory_id, $week_data_hash);
}
HideShow 8 lines of Pod
=item week_data_weekend_start()
This method takes an optional territory id and returns the three letter code of the 
first day of the week end for that territory. If no territory id is passed in then it
uses the current locales territory.
=cut
sub week_data_weekend_start {
        my ($self, $territory_id) = @_;
        my $week_data_hash = $self->_week_data_weekend_start();
         
        return _week_data($self, $territory_id, $week_data_hash);
}
HideShow 8 lines of Pod
=item week_data_weekend_end()
This method takes an optional territory id and returns the three letter code of the 
first day of the week end for that territory. If no territory id is passed in then it
uses the current locales territory.
=cut
sub week_data_weekend_end {
        my ($self, $territory_id) = @_;
        my $week_data_hash = $self->_week_data_weekend_end();
         
        return _week_data($self, $territory_id, $week_data_hash);
}
HideShow 164 lines of Pod
=back
=head2 Territory Containment
=over 4
=item territory_contains()
This method returns a hash ref keyed on territory id. The value is an array ref
Each element of the array ref is a territory id of a territory immediately 
contained in the territory used as the key
=item territory_contained_by()
This method returns a hash ref keyed on territory id. The value of the hash
is the territory id of the immediately containing territory.
=back
=head2 Numbering Systems
=over 4
=item numbering_system()
This method returns a hash ref keyed on numbering system id which, for a given 
locale, can be got by calling the default_numbering_system() method. The values
of the hash are a two element hash ref the keys being C<type> and C<data>. If the
type is C<numeric> then the data is an array ref of characters. The position in the
array matches the numeric value of the character. If the type is C<algorithmic>
then data is the name of the algorithm used to display numbers in that format.
=back
=head2 Number Formatting
=over 4
=item format_number($number, $format, $currency, $for_cash)
This method formats the number $number using the format $format. If the format contains
the currency symbol C<¤> then the currency symbol for the currency code in $currency
will be used. If $currency is undef() then the default currency code for the locale 
will be used. 
Note that currency codes are based on territory so if you do not pass in a currency 
and your locale did not get passed a territory in the constructor you are going
to end up with the L<likely sub tag's|/likely_subtags> idea of the currency. This
functionality may be removed or at least changed to emit a warning in future 
releases.
$for_cash is only used during currency formatting. If true then cash rounding
will be used otherwise financial rounding will be used. 
=item add_currency_symbol($format, $symbol)
This method returns the format with the currency symbol $symbol correctly inserted
into the format
=item parse_number_format($format, $currency, $currency_data, $for_cash)
This method parses a CLDR format string into a hash ref containing data used to 
format a number. If a currency is being formatted then $currency contains the
currency code, $currency_data is a hashref containing the currency rounding
information and $for_cash is a flag to signal cash or financial rounding. 
This should probably be a private function.
=item round($number, $increment, $decimal_digits)
This method returns $number rounded to the nearest $increment with $decimal_digits
digits after the decimal point
=item get_formatted_number($number, $format, $currency_data, $for_cash)
This method takes the $format produced by parse_number_format() and uses it to
parse $number. It returns a string containing the parsed number. If a currency
is being formatted then $currency_data is a hashref containing the currency 
rounding information and $for_cash is a flag to signal cash or financial rounding. 
=item get_digits()
This method returns an array containing the digits used by the locale, The order of the
array is the order of the digits. It the locale's numbering system is C<algorithmic> it
will return C<[0,1,2,3,4,5,6,7,8,9]>
=item default_numbering_system()
This method returns the numbering system id for the locale.
=back
=head2 Measurement Information
=over 4
=item measurement_system()
This method returns a hash ref keyed on territory, the value being the measurement system
id for the territory. If the territory you are interested in is not listed use the
territory_contained_by() method until you find an entry.
=item paper_size()
This method returns a hash ref keyed on territory, the value being the paper size used
in that territory. If the territory you are interested in is not listed use the
territory_contained_by() method until you find an entry.
=back
=head2 Likely Tags
=over 4
=item likely_subtags()
A full locale tag requires, as a minimum, a language, script and territory code. However for
some locales it is possible to infer the missing element if the other two are given, e.g.
given C<en_GB> you can infer the script will be latn. It is also possible to fill in the 
missing elements of a locale with sensible defaults given sufficient knowledge of the layout
of the CLDR data and usage patterns of locales around the world.
This function returns a hash ref keyed on partial locale id's with the value being the locale
id for the most likely language, script and territory code for the key.
=back
=head2 Currency Information
=over 4
=item currency_fractions()
This method returns a hash ref keyed on currency id. The value is a hash ref containing four keys.
The keys are 
=over 8
=item digits
The number of decimal digits normally formatted.
=item rounding
The rounding increment, in units of 10^-digits. 
=item cashdigits
The number of decimal digits to be used when formatting quantities used in cash transactions (as opposed
to a quantity that would appear in a more formal setting, such as on a bank statement).
=item cashrounding
The cash rounding increment, in units of 10^-cashdigits. 
=back
=item default_currency($territory_id)
This method returns the default currency id for the territory id.
If no territory id is given then the current locales is used
=cut
sub default_currency {
        my ($self, $territory_id) = @_;
         
        $territory_id //= $self->territory_id;
         
        if (! $territory_id) {
                 $territory_id = $self->likely_subtag->territory_id;
                 warn "Locale::CLDR::default_currency:- No territory given using $territory_id at ";
        }
         
        my $default_currencies = $self->_default_currency;
         
        return $default_currencies->{$territory_id} if exists $default_currencies->{$territory_id};
         
        while (1) {
                $territory_id = $self->territory_contained_by($territory_id);
                last unless $territory_id;
                return $default_currencies->{$territory_id} if exists $default_currencies->{$territory_id};
        }
}
HideShow 7 lines of Pod
=item currency_symbol($currency_id)
This method returns the currency symbol for the given currency id in the current locale.
If no currency id is given it uses the locales default currency
=cut
sub currency_symbol {
        my ($self, $currency_id) = @_;
         
        $currency_id //= $self->default_currency;
         
        my @bundles = reverse $self->_find_bundle('curriencies');
        foreach my $bundle (@bundles) {
                my $symbol = $bundle->curriencies()->{$currency_id}{symbol};
                return $symbol if $symbol;
        }
         
        return '';
}
HideShow 30 lines of Pod
=back
=head2 Calendar Information
=over 4
=item calendar_preferences()
This method returns a hash ref keyed on territory id. The values are array refs containing the preferred
calendar id's in order of preference.
=item  default_calendar($territory)
This method returns the default calendar id for the given territory. If no territory id given it 
used the territory of the current locale.
=back
=head2 Collation
=over 4
=item collation()
This method returns a Unicode::Collation object tailored to the current locale
=back
=cut
sub collation {
        my ($self, $type) = @_;
         
        $type //= $self->_default_collation;
         
        my $file = __FILE__;
        $file =~ s/\.pm$//;
         
        my $key_file = File::Spec->catfile($file, 'allkeys_CLDR.txt');
         
        # Monkey patching Unicode::Collate::read_table so we can give it a full path 
        {
                no warnings 'redefine';
                local *Unicode::Collate::read_table = sub {
                        my $self = shift;
                        my($f, $fh);
                         
                        $f = $self->{table};
                        open($fh, $f);
                         
                        while (my $line = <$fh>) {
                                next if $line =~ /^\s*#/;
                                if ($line =~ s/^\s*\@//) {
                                        $self->parseAtmark($line);
                                } else {
                                        $self->parseEntry($line);
                                }
                        }
                        close $fh;
                };
                         
                return Unicode::Collate->new(
                        table => $key_file,
                );
        }
}
sub _default_collation {
        return 'standard';
}
HideShow 64 lines of Pod
=head1 AUTHOR
John Imrie, C<< <john dot imrie1 at gmail dot com> >>
=head1 BUGS
Please report any bugs or feature requests to C<bug-locale-cldr at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Locale-CLDR>.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.
=head1 SUPPORT
You can find documentation for this module with the perldoc command.
    perldoc Locale::CLDR
You can also look for information at:
=over 4
=item * RT: CPAN's request tracker
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Locale-CLDR>
=item * AnnoCPAN: Annotated CPAN documentation
L<http://annocpan.org/dist/Locale-CLDR>
=item * CPAN Ratings
L<http://cpanratings.perl.org/d/Locale-CLDR>
=item * Search CPAN
L<http://search.cpan.org/dist/Locale-CLDR/>
=back
=head1 ACKNOWLEDGEMENTS
Everyone at the Unicode Consortium for providing the data.
Karl Williams for his tireless work on Unicode in the Perl 
regex engine.
Andrew Rodland for his L<Unicode::CaseFold> module that I
pinched the fc() code from for early versions of Perl that
don't have this function.
=head1 COPYRIGHT & LICENSE
Copyright 2009-2014 John Imrie.
Backwards compatible Case Folding Copyright Andrew Rodland  ARODLAND@cpan.org
This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.
See http://dev.perl.org/licenses/ for more information.
=cut
1; # End of Locale::CLDR