| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package Locale::CLDR; | 
| 2 |  |  |  |  |  |  |  | 
| 3 |  |  |  |  |  |  | =encoding utf8 | 
| 4 |  |  |  |  |  |  |  | 
| 5 |  |  |  |  |  |  | =head1 NAME | 
| 6 |  |  |  |  |  |  |  | 
| 7 |  |  |  |  |  |  | Locale::CLDR - A Module to create locale objects with localisation data from the CLDR | 
| 8 |  |  |  |  |  |  |  | 
| 9 |  |  |  |  |  |  | =head1 VERSION | 
| 10 |  |  |  |  |  |  |  | 
| 11 |  |  |  |  |  |  | Version 0.27.0 | 
| 12 |  |  |  |  |  |  |  | 
| 13 |  |  |  |  |  |  | =head1 SYNOPSIS | 
| 14 |  |  |  |  |  |  |  | 
| 15 |  |  |  |  |  |  | This module provides a locale object you can use to localise your output. | 
| 16 |  |  |  |  |  |  | The localisation data comes from the Unicode Common Locale Data Repository. | 
| 17 |  |  |  |  |  |  | Most of this code can be used with Perl version 5.10 or above. There are a | 
| 18 |  |  |  |  |  |  | few parts of the code that require version 5.18 or above. | 
| 19 |  |  |  |  |  |  |  | 
| 20 |  |  |  |  |  |  | =head1 USAGE | 
| 21 |  |  |  |  |  |  |  | 
| 22 |  |  |  |  |  |  | my $locale = Locale::CLDR->new('en_US'); | 
| 23 |  |  |  |  |  |  |  | 
| 24 |  |  |  |  |  |  | or | 
| 25 |  |  |  |  |  |  |  | 
| 26 |  |  |  |  |  |  | my $locale = Locale::CLDR->new(language_id => 'en', territory_id => 'us'); | 
| 27 |  |  |  |  |  |  |  | 
| 28 |  |  |  |  |  |  | A full locale identifier is | 
| 29 |  |  |  |  |  |  |  | 
| 30 |  |  |  |  |  |  | C<language>_C<script>_C<territory>_C<variant>_u_C<extension name>_C<extension value> | 
| 31 |  |  |  |  |  |  |  | 
| 32 |  |  |  |  |  |  | my $locale = Locale::CLDR->new('en_latn_US_SCOUSE_u_nu_traditional'); | 
| 33 |  |  |  |  |  |  |  | 
| 34 |  |  |  |  |  |  | or | 
| 35 |  |  |  |  |  |  |  | 
| 36 |  |  |  |  |  |  | my $locale = Locale::CLDR->new(language_id => 'en', script_id => 'latn', territory_id => 'US', variant => 'SCOUSE', extensions => { nu => 'traditional' } ); | 
| 37 |  |  |  |  |  |  |  | 
| 38 |  |  |  |  |  |  | =cut | 
| 39 |  |  |  |  |  |  |  | 
| 40 | 20 |  |  | 20 |  | 398234 | use v5.10; | 
|  | 20 |  |  |  |  | 56 |  | 
|  | 20 |  |  |  |  | 710 |  | 
| 41 | 20 |  |  | 20 |  | 7655 | use version; | 
|  | 20 |  |  |  |  | 28308 |  | 
|  | 20 |  |  |  |  | 90 |  | 
| 42 |  |  |  |  |  |  | our $VERSION = version->declare('v0.27.0'); | 
| 43 |  |  |  |  |  |  |  | 
| 44 | 20 |  |  | 20 |  | 9604 | use open ':encoding(utf8)'; | 
|  | 20 |  |  |  |  | 17697 |  | 
|  | 20 |  |  |  |  | 86 |  | 
| 45 | 20 |  |  | 20 |  | 192142 | use utf8; | 
|  | 20 |  |  |  |  | 40 |  | 
|  | 20 |  |  |  |  | 90 |  | 
| 46 | 20 |  |  | 20 |  | 989 | use if ($^V ge v5.12.0), (feature => 'unicode_strings'); | 
|  | 20 |  |  |  |  | 30 |  | 
|  | 20 |  |  |  |  | 806 |  | 
| 47 |  |  |  |  |  |  |  | 
| 48 | 20 |  |  | 20 |  | 11115 | use Moose; | 
|  | 20 |  |  |  |  | 6439399 |  | 
|  | 20 |  |  |  |  | 140 |  | 
| 49 | 20 |  |  | 20 |  | 111859 | use MooseX::ClassAttribute; | 
|  | 20 |  |  |  |  | 1176794 |  | 
|  | 20 |  |  |  |  | 91 |  | 
| 50 |  |  |  |  |  |  | with 'Locale::CLDR::ValidCodes', 'Locale::CLDR::EraBoundries', 'Locale::CLDR::WeekData', | 
| 51 |  |  |  |  |  |  | 'Locale::CLDR::MeasurementSystem', 'Locale::CLDR::LikelySubtags', 'Locale::CLDR::NumberingSystems', | 
| 52 |  |  |  |  |  |  | 'Locale::CLDR::NumberFormatter', 'Locale::CLDR::TerritoryContainment', 'Locale::CLDR::CalendarPreferences', | 
| 53 |  |  |  |  |  |  | 'Locale::CLDR::Currencies', 'Locale::CLDR::Plurals'; | 
| 54 |  |  |  |  |  |  |  | 
| 55 | 20 |  |  | 20 |  | 4136683 | use Class::Load; | 
|  | 20 |  |  |  |  | 38 |  | 
|  | 20 |  |  |  |  | 756 |  | 
| 56 | 20 |  |  | 20 |  | 77 | use namespace::autoclean; | 
|  | 20 |  |  |  |  | 33 |  | 
|  | 20 |  |  |  |  | 148 |  | 
| 57 | 20 |  |  | 20 |  | 1594 | use List::Util qw(first); | 
|  | 20 |  |  |  |  | 25 |  | 
|  | 20 |  |  |  |  | 1026 |  | 
| 58 | 20 |  |  | 20 |  | 74 | use Class::MOP; | 
|  | 20 |  |  |  |  | 22 |  | 
|  | 20 |  |  |  |  | 283 |  | 
| 59 | 20 |  |  | 20 |  | 11635 | use DateTime::Locale; | 
|  | 20 |  |  |  |  | 838696 |  | 
|  | 20 |  |  |  |  | 616 |  | 
| 60 | 20 |  |  | 20 |  | 11853 | use Unicode::Normalize(); | 
|  | 20 |  |  |  |  | 31889 |  | 
|  | 20 |  |  |  |  | 584 |  | 
| 61 |  |  |  |  |  |  | #use Locale::CLDR::Collator(); | 
| 62 | 20 |  |  | 20 |  | 127 | use File::Spec(); | 
|  | 20 |  |  |  |  | 20 |  | 
|  | 20 |  |  |  |  | 2205 |  | 
| 63 |  |  |  |  |  |  |  | 
| 64 |  |  |  |  |  |  | # Backwards compatibility | 
| 65 |  |  |  |  |  |  | BEGIN { | 
| 66 | 20 | 50 |  | 20 |  | 77 | if (defined &CORE::fc) { #v5.16 | 
| 67 | 20 |  |  |  |  | 18649 | *fc = \&CORE::fc; | 
| 68 |  |  |  |  |  |  | } | 
| 69 |  |  |  |  |  |  | else { | 
| 70 |  |  |  |  |  |  | # We only use fc() with code that expects Perl v5.18 or above | 
| 71 | 0 |  |  |  |  | 0 | *fc = sub {}; | 
|  | 0 |  |  |  |  | 0 |  | 
| 72 |  |  |  |  |  |  | } | 
| 73 |  |  |  |  |  |  | } | 
| 74 |  |  |  |  |  |  |  | 
| 75 |  |  |  |  |  |  | =head1 ATTRIBUTES | 
| 76 |  |  |  |  |  |  |  | 
| 77 |  |  |  |  |  |  | These can be passed into the constructor and all are optional. | 
| 78 |  |  |  |  |  |  |  | 
| 79 |  |  |  |  |  |  | =over 4 | 
| 80 |  |  |  |  |  |  |  | 
| 81 |  |  |  |  |  |  | =item language_id | 
| 82 |  |  |  |  |  |  |  | 
| 83 |  |  |  |  |  |  | A valid language or language alias id, such as C<en> | 
| 84 |  |  |  |  |  |  |  | 
| 85 |  |  |  |  |  |  | =cut | 
| 86 |  |  |  |  |  |  |  | 
| 87 |  |  |  |  |  |  | has 'language_id' => ( | 
| 88 |  |  |  |  |  |  | is			=> 'ro', | 
| 89 |  |  |  |  |  |  | isa			=> 'Str', | 
| 90 |  |  |  |  |  |  | required	=> 1, | 
| 91 |  |  |  |  |  |  | ); | 
| 92 |  |  |  |  |  |  |  | 
| 93 |  |  |  |  |  |  | # language aliases | 
| 94 |  |  |  |  |  |  | around 'language_id' => sub { | 
| 95 |  |  |  |  |  |  | my ($orig, $self) = @_; | 
| 96 |  |  |  |  |  |  | my $value = $self->$orig; | 
| 97 |  |  |  |  |  |  | return $self->language_aliases->{$value} // $value; | 
| 98 |  |  |  |  |  |  | }; | 
| 99 |  |  |  |  |  |  |  | 
| 100 |  |  |  |  |  |  | =item script_id | 
| 101 |  |  |  |  |  |  |  | 
| 102 |  |  |  |  |  |  | A valid script id, such as C<latn> or C<Ctcl>. The code will pick a likely script | 
| 103 |  |  |  |  |  |  | depending on the given language if non is provided. | 
| 104 |  |  |  |  |  |  |  | 
| 105 |  |  |  |  |  |  | =cut | 
| 106 |  |  |  |  |  |  |  | 
| 107 |  |  |  |  |  |  | has 'script_id' => ( | 
| 108 |  |  |  |  |  |  | is			=> 'ro', | 
| 109 |  |  |  |  |  |  | isa			=> 'Str', | 
| 110 |  |  |  |  |  |  | default		=> '', | 
| 111 |  |  |  |  |  |  | predicate	=> 'has_script', | 
| 112 |  |  |  |  |  |  | ); | 
| 113 |  |  |  |  |  |  |  | 
| 114 |  |  |  |  |  |  | =item territory_id | 
| 115 |  |  |  |  |  |  |  | 
| 116 |  |  |  |  |  |  | A valid territory id or territory alias such as C<GB> | 
| 117 |  |  |  |  |  |  |  | 
| 118 |  |  |  |  |  |  | =cut | 
| 119 |  |  |  |  |  |  |  | 
| 120 |  |  |  |  |  |  | has 'territory_id' => ( | 
| 121 |  |  |  |  |  |  | is			=> 'ro', | 
| 122 |  |  |  |  |  |  | isa			=> 'Str', | 
| 123 |  |  |  |  |  |  | default		=> '', | 
| 124 |  |  |  |  |  |  | predicate	=> 'has_territory', | 
| 125 |  |  |  |  |  |  | ); | 
| 126 |  |  |  |  |  |  |  | 
| 127 |  |  |  |  |  |  | # territory aliases | 
| 128 |  |  |  |  |  |  | around 'territory_id' => sub { | 
| 129 |  |  |  |  |  |  | my ($orig, $self) = @_; | 
| 130 |  |  |  |  |  |  | my $value = $self->$orig; | 
| 131 |  |  |  |  |  |  | my $alias = $self->territory_aliases->{$value}; | 
| 132 |  |  |  |  |  |  | return $value if ! defined $alias; | 
| 133 |  |  |  |  |  |  | return (split /\s+/, $alias)[0]; | 
| 134 |  |  |  |  |  |  | }; | 
| 135 |  |  |  |  |  |  |  | 
| 136 |  |  |  |  |  |  | =item variant_id | 
| 137 |  |  |  |  |  |  |  | 
| 138 |  |  |  |  |  |  | A valid variant id. The code currently ignores this | 
| 139 |  |  |  |  |  |  |  | 
| 140 |  |  |  |  |  |  | =cut | 
| 141 |  |  |  |  |  |  |  | 
| 142 |  |  |  |  |  |  | has 'variant_id' => ( | 
| 143 |  |  |  |  |  |  | is			=> 'ro', | 
| 144 |  |  |  |  |  |  | isa			=> 'Str', | 
| 145 |  |  |  |  |  |  | default		=> '', | 
| 146 |  |  |  |  |  |  | predicate	=> 'has_variant', | 
| 147 |  |  |  |  |  |  | ); | 
| 148 |  |  |  |  |  |  |  | 
| 149 |  |  |  |  |  |  | =item extensions | 
| 150 |  |  |  |  |  |  |  | 
| 151 |  |  |  |  |  |  | A Hashref of extension names and values. You can use this to override | 
| 152 |  |  |  |  |  |  | the locales number formatting and calendar by passing in the Unicode | 
| 153 |  |  |  |  |  |  | extension names or aliases as keys and the extension value as the hash | 
| 154 |  |  |  |  |  |  | value. | 
| 155 |  |  |  |  |  |  |  | 
| 156 |  |  |  |  |  |  | Currently supported extensions are | 
| 157 |  |  |  |  |  |  |  | 
| 158 |  |  |  |  |  |  | =over 8 | 
| 159 |  |  |  |  |  |  |  | 
| 160 |  |  |  |  |  |  | =item nu | 
| 161 |  |  |  |  |  |  |  | 
| 162 |  |  |  |  |  |  | =item numbers | 
| 163 |  |  |  |  |  |  |  | 
| 164 |  |  |  |  |  |  | The number type can be one of | 
| 165 |  |  |  |  |  |  |  | 
| 166 |  |  |  |  |  |  | =over 12 | 
| 167 |  |  |  |  |  |  |  | 
| 168 |  |  |  |  |  |  | =item arab | 
| 169 |  |  |  |  |  |  |  | 
| 170 |  |  |  |  |  |  | Arabic-Indic Digits | 
| 171 |  |  |  |  |  |  |  | 
| 172 |  |  |  |  |  |  | =item arabext | 
| 173 |  |  |  |  |  |  |  | 
| 174 |  |  |  |  |  |  | Extended Arabic-Indic Digits | 
| 175 |  |  |  |  |  |  |  | 
| 176 |  |  |  |  |  |  | =item armn | 
| 177 |  |  |  |  |  |  |  | 
| 178 |  |  |  |  |  |  | Armenian Numerals | 
| 179 |  |  |  |  |  |  |  | 
| 180 |  |  |  |  |  |  | =item armnlow | 
| 181 |  |  |  |  |  |  |  | 
| 182 |  |  |  |  |  |  | Armenian Lowercase Numerals | 
| 183 |  |  |  |  |  |  |  | 
| 184 |  |  |  |  |  |  | =item bali | 
| 185 |  |  |  |  |  |  |  | 
| 186 |  |  |  |  |  |  | Balinese Digits | 
| 187 |  |  |  |  |  |  |  | 
| 188 |  |  |  |  |  |  | =item beng | 
| 189 |  |  |  |  |  |  |  | 
| 190 |  |  |  |  |  |  | Bengali Digits | 
| 191 |  |  |  |  |  |  |  | 
| 192 |  |  |  |  |  |  | =item brah | 
| 193 |  |  |  |  |  |  |  | 
| 194 |  |  |  |  |  |  | Brahmi Digits | 
| 195 |  |  |  |  |  |  |  | 
| 196 |  |  |  |  |  |  | =item cakm | 
| 197 |  |  |  |  |  |  |  | 
| 198 |  |  |  |  |  |  | Chakma Digits | 
| 199 |  |  |  |  |  |  |  | 
| 200 |  |  |  |  |  |  | =item cham | 
| 201 |  |  |  |  |  |  |  | 
| 202 |  |  |  |  |  |  | Cham Digits | 
| 203 |  |  |  |  |  |  |  | 
| 204 |  |  |  |  |  |  | =item deva | 
| 205 |  |  |  |  |  |  |  | 
| 206 |  |  |  |  |  |  | Devanagari Digits | 
| 207 |  |  |  |  |  |  |  | 
| 208 |  |  |  |  |  |  | =item ethi | 
| 209 |  |  |  |  |  |  |  | 
| 210 |  |  |  |  |  |  | Ethiopic Numerals | 
| 211 |  |  |  |  |  |  |  | 
| 212 |  |  |  |  |  |  | =item finance | 
| 213 |  |  |  |  |  |  |  | 
| 214 |  |  |  |  |  |  | Financial Numerals | 
| 215 |  |  |  |  |  |  |  | 
| 216 |  |  |  |  |  |  | =item fullwide | 
| 217 |  |  |  |  |  |  |  | 
| 218 |  |  |  |  |  |  | Full Width Digits | 
| 219 |  |  |  |  |  |  |  | 
| 220 |  |  |  |  |  |  | =item geor | 
| 221 |  |  |  |  |  |  |  | 
| 222 |  |  |  |  |  |  | Georgian Numerals | 
| 223 |  |  |  |  |  |  |  | 
| 224 |  |  |  |  |  |  | =item grek | 
| 225 |  |  |  |  |  |  |  | 
| 226 |  |  |  |  |  |  | Greek Numerals | 
| 227 |  |  |  |  |  |  |  | 
| 228 |  |  |  |  |  |  | =item greklow | 
| 229 |  |  |  |  |  |  |  | 
| 230 |  |  |  |  |  |  | Greek Lowercase Numerals | 
| 231 |  |  |  |  |  |  |  | 
| 232 |  |  |  |  |  |  | =item gujr | 
| 233 |  |  |  |  |  |  |  | 
| 234 |  |  |  |  |  |  | Gujarati Digits | 
| 235 |  |  |  |  |  |  |  | 
| 236 |  |  |  |  |  |  | =item guru | 
| 237 |  |  |  |  |  |  |  | 
| 238 |  |  |  |  |  |  | Gurmukhi Digits | 
| 239 |  |  |  |  |  |  |  | 
| 240 |  |  |  |  |  |  | =item hanidays | 
| 241 |  |  |  |  |  |  |  | 
| 242 |  |  |  |  |  |  | Chinese Calendar Day-of-Month Numerals | 
| 243 |  |  |  |  |  |  |  | 
| 244 |  |  |  |  |  |  | =item hanidec | 
| 245 |  |  |  |  |  |  |  | 
| 246 |  |  |  |  |  |  | Chinese Decimal Numerals | 
| 247 |  |  |  |  |  |  |  | 
| 248 |  |  |  |  |  |  | =item hans | 
| 249 |  |  |  |  |  |  |  | 
| 250 |  |  |  |  |  |  | Simplified Chinese Numerals | 
| 251 |  |  |  |  |  |  |  | 
| 252 |  |  |  |  |  |  | =item hansfin | 
| 253 |  |  |  |  |  |  |  | 
| 254 |  |  |  |  |  |  | Simplified Chinese Financial Numerals | 
| 255 |  |  |  |  |  |  |  | 
| 256 |  |  |  |  |  |  | =item hant | 
| 257 |  |  |  |  |  |  |  | 
| 258 |  |  |  |  |  |  | Traditional Chinese Numerals | 
| 259 |  |  |  |  |  |  |  | 
| 260 |  |  |  |  |  |  | =item hantfin | 
| 261 |  |  |  |  |  |  |  | 
| 262 |  |  |  |  |  |  | Traditional Chinese Financial Numerals | 
| 263 |  |  |  |  |  |  |  | 
| 264 |  |  |  |  |  |  | =item hebr | 
| 265 |  |  |  |  |  |  |  | 
| 266 |  |  |  |  |  |  | Hebrew Numerals | 
| 267 |  |  |  |  |  |  |  | 
| 268 |  |  |  |  |  |  | =item java | 
| 269 |  |  |  |  |  |  |  | 
| 270 |  |  |  |  |  |  | Javanese Digits | 
| 271 |  |  |  |  |  |  |  | 
| 272 |  |  |  |  |  |  | =item jpan | 
| 273 |  |  |  |  |  |  |  | 
| 274 |  |  |  |  |  |  | Japanese Numerals | 
| 275 |  |  |  |  |  |  |  | 
| 276 |  |  |  |  |  |  | =item jpanfin | 
| 277 |  |  |  |  |  |  |  | 
| 278 |  |  |  |  |  |  | Japanese Financial Numerals | 
| 279 |  |  |  |  |  |  |  | 
| 280 |  |  |  |  |  |  | =item kali | 
| 281 |  |  |  |  |  |  |  | 
| 282 |  |  |  |  |  |  | Kayah Li Digits | 
| 283 |  |  |  |  |  |  |  | 
| 284 |  |  |  |  |  |  | =item khmr | 
| 285 |  |  |  |  |  |  |  | 
| 286 |  |  |  |  |  |  | Khmer Digits | 
| 287 |  |  |  |  |  |  |  | 
| 288 |  |  |  |  |  |  | =item knda | 
| 289 |  |  |  |  |  |  |  | 
| 290 |  |  |  |  |  |  | Kannada Digits | 
| 291 |  |  |  |  |  |  |  | 
| 292 |  |  |  |  |  |  | =item lana | 
| 293 |  |  |  |  |  |  |  | 
| 294 |  |  |  |  |  |  | Tai Tham Hora Digits | 
| 295 |  |  |  |  |  |  |  | 
| 296 |  |  |  |  |  |  | =item lanatham | 
| 297 |  |  |  |  |  |  |  | 
| 298 |  |  |  |  |  |  | Tai Tham Tham Digits | 
| 299 |  |  |  |  |  |  |  | 
| 300 |  |  |  |  |  |  | =item laoo | 
| 301 |  |  |  |  |  |  |  | 
| 302 |  |  |  |  |  |  | Lao Digits | 
| 303 |  |  |  |  |  |  |  | 
| 304 |  |  |  |  |  |  | =item latn | 
| 305 |  |  |  |  |  |  |  | 
| 306 |  |  |  |  |  |  | Western Digits | 
| 307 |  |  |  |  |  |  |  | 
| 308 |  |  |  |  |  |  | =item lepc | 
| 309 |  |  |  |  |  |  |  | 
| 310 |  |  |  |  |  |  | Lepcha Digits | 
| 311 |  |  |  |  |  |  |  | 
| 312 |  |  |  |  |  |  | =item limb | 
| 313 |  |  |  |  |  |  |  | 
| 314 |  |  |  |  |  |  | Limbu Digits | 
| 315 |  |  |  |  |  |  |  | 
| 316 |  |  |  |  |  |  | =item mlym | 
| 317 |  |  |  |  |  |  |  | 
| 318 |  |  |  |  |  |  | Malayalam Digits | 
| 319 |  |  |  |  |  |  |  | 
| 320 |  |  |  |  |  |  | =item mong | 
| 321 |  |  |  |  |  |  |  | 
| 322 |  |  |  |  |  |  | Mongolian Digits | 
| 323 |  |  |  |  |  |  |  | 
| 324 |  |  |  |  |  |  | =item mtei | 
| 325 |  |  |  |  |  |  |  | 
| 326 |  |  |  |  |  |  | Meetei Mayek Digits | 
| 327 |  |  |  |  |  |  |  | 
| 328 |  |  |  |  |  |  | =item mymr | 
| 329 |  |  |  |  |  |  |  | 
| 330 |  |  |  |  |  |  | Myanmar Digits | 
| 331 |  |  |  |  |  |  |  | 
| 332 |  |  |  |  |  |  | =item mymrshan | 
| 333 |  |  |  |  |  |  |  | 
| 334 |  |  |  |  |  |  | Myanmar Shan Digits | 
| 335 |  |  |  |  |  |  |  | 
| 336 |  |  |  |  |  |  | =item native | 
| 337 |  |  |  |  |  |  |  | 
| 338 |  |  |  |  |  |  | Native Digits | 
| 339 |  |  |  |  |  |  |  | 
| 340 |  |  |  |  |  |  | =item nkoo | 
| 341 |  |  |  |  |  |  |  | 
| 342 |  |  |  |  |  |  | N'Ko Digits | 
| 343 |  |  |  |  |  |  |  | 
| 344 |  |  |  |  |  |  | =item olck | 
| 345 |  |  |  |  |  |  |  | 
| 346 |  |  |  |  |  |  | Ol Chiki Digits | 
| 347 |  |  |  |  |  |  |  | 
| 348 |  |  |  |  |  |  | =item orya | 
| 349 |  |  |  |  |  |  |  | 
| 350 |  |  |  |  |  |  | Oriya Digits | 
| 351 |  |  |  |  |  |  |  | 
| 352 |  |  |  |  |  |  | =item osma | 
| 353 |  |  |  |  |  |  |  | 
| 354 |  |  |  |  |  |  | Osmanya Digits | 
| 355 |  |  |  |  |  |  |  | 
| 356 |  |  |  |  |  |  | =item roman | 
| 357 |  |  |  |  |  |  |  | 
| 358 |  |  |  |  |  |  | Roman Numerals | 
| 359 |  |  |  |  |  |  |  | 
| 360 |  |  |  |  |  |  | =item romanlow | 
| 361 |  |  |  |  |  |  |  | 
| 362 |  |  |  |  |  |  | Roman Lowercase Numerals | 
| 363 |  |  |  |  |  |  |  | 
| 364 |  |  |  |  |  |  | =item saur | 
| 365 |  |  |  |  |  |  |  | 
| 366 |  |  |  |  |  |  | Saurashtra Digits | 
| 367 |  |  |  |  |  |  |  | 
| 368 |  |  |  |  |  |  | =item shrd | 
| 369 |  |  |  |  |  |  |  | 
| 370 |  |  |  |  |  |  | Sharada Digits | 
| 371 |  |  |  |  |  |  |  | 
| 372 |  |  |  |  |  |  | =item sora | 
| 373 |  |  |  |  |  |  |  | 
| 374 |  |  |  |  |  |  | Sora Sompeng Digits | 
| 375 |  |  |  |  |  |  |  | 
| 376 |  |  |  |  |  |  | =item sund | 
| 377 |  |  |  |  |  |  |  | 
| 378 |  |  |  |  |  |  | Sundanese Digits | 
| 379 |  |  |  |  |  |  |  | 
| 380 |  |  |  |  |  |  | =item takr | 
| 381 |  |  |  |  |  |  |  | 
| 382 |  |  |  |  |  |  | Takri Digits | 
| 383 |  |  |  |  |  |  |  | 
| 384 |  |  |  |  |  |  | =item talu | 
| 385 |  |  |  |  |  |  |  | 
| 386 |  |  |  |  |  |  | New Tai Lue Digits | 
| 387 |  |  |  |  |  |  |  | 
| 388 |  |  |  |  |  |  | =item taml | 
| 389 |  |  |  |  |  |  |  | 
| 390 |  |  |  |  |  |  | Traditional Tamil Numerals | 
| 391 |  |  |  |  |  |  |  | 
| 392 |  |  |  |  |  |  | =item tamldec | 
| 393 |  |  |  |  |  |  |  | 
| 394 |  |  |  |  |  |  | Tamil Digits | 
| 395 |  |  |  |  |  |  |  | 
| 396 |  |  |  |  |  |  | =item telu | 
| 397 |  |  |  |  |  |  |  | 
| 398 |  |  |  |  |  |  | Telugu Digits | 
| 399 |  |  |  |  |  |  |  | 
| 400 |  |  |  |  |  |  | =item thai | 
| 401 |  |  |  |  |  |  |  | 
| 402 |  |  |  |  |  |  | Thai Digits | 
| 403 |  |  |  |  |  |  |  | 
| 404 |  |  |  |  |  |  | =item tibt | 
| 405 |  |  |  |  |  |  |  | 
| 406 |  |  |  |  |  |  | Tibetan Digits | 
| 407 |  |  |  |  |  |  |  | 
| 408 |  |  |  |  |  |  | =item traditional | 
| 409 |  |  |  |  |  |  |  | 
| 410 |  |  |  |  |  |  | Traditional Numerals | 
| 411 |  |  |  |  |  |  |  | 
| 412 |  |  |  |  |  |  | =item vaii | 
| 413 |  |  |  |  |  |  |  | 
| 414 |  |  |  |  |  |  | Vai Digits | 
| 415 |  |  |  |  |  |  |  | 
| 416 |  |  |  |  |  |  | =back | 
| 417 |  |  |  |  |  |  |  | 
| 418 |  |  |  |  |  |  | =item ca | 
| 419 |  |  |  |  |  |  |  | 
| 420 |  |  |  |  |  |  | =item calendar | 
| 421 |  |  |  |  |  |  |  | 
| 422 |  |  |  |  |  |  | You can use this to override a locales default calendar. Valid values are | 
| 423 |  |  |  |  |  |  |  | 
| 424 |  |  |  |  |  |  | =over 12 | 
| 425 |  |  |  |  |  |  |  | 
| 426 |  |  |  |  |  |  | =item buddhist | 
| 427 |  |  |  |  |  |  |  | 
| 428 |  |  |  |  |  |  | Buddhist Calendar | 
| 429 |  |  |  |  |  |  |  | 
| 430 |  |  |  |  |  |  | =item chinese | 
| 431 |  |  |  |  |  |  |  | 
| 432 |  |  |  |  |  |  | Chinese Calendar | 
| 433 |  |  |  |  |  |  |  | 
| 434 |  |  |  |  |  |  | =item coptic | 
| 435 |  |  |  |  |  |  |  | 
| 436 |  |  |  |  |  |  | Coptic Calendar | 
| 437 |  |  |  |  |  |  |  | 
| 438 |  |  |  |  |  |  | =item dangi | 
| 439 |  |  |  |  |  |  |  | 
| 440 |  |  |  |  |  |  | Dangi Calendar | 
| 441 |  |  |  |  |  |  |  | 
| 442 |  |  |  |  |  |  | =item ethiopic | 
| 443 |  |  |  |  |  |  |  | 
| 444 |  |  |  |  |  |  | Ethiopic Calendar | 
| 445 |  |  |  |  |  |  |  | 
| 446 |  |  |  |  |  |  | =item ethiopic-amete-alem | 
| 447 |  |  |  |  |  |  |  | 
| 448 |  |  |  |  |  |  | Ethiopic Amete Alem Calendar | 
| 449 |  |  |  |  |  |  |  | 
| 450 |  |  |  |  |  |  | =item gregorian | 
| 451 |  |  |  |  |  |  |  | 
| 452 |  |  |  |  |  |  | Gregorian Calendar | 
| 453 |  |  |  |  |  |  |  | 
| 454 |  |  |  |  |  |  | =item hebrew | 
| 455 |  |  |  |  |  |  |  | 
| 456 |  |  |  |  |  |  | Hebrew Calendar | 
| 457 |  |  |  |  |  |  |  | 
| 458 |  |  |  |  |  |  | =item indian | 
| 459 |  |  |  |  |  |  |  | 
| 460 |  |  |  |  |  |  | Indian National Calendar | 
| 461 |  |  |  |  |  |  |  | 
| 462 |  |  |  |  |  |  | =item islamic | 
| 463 |  |  |  |  |  |  |  | 
| 464 |  |  |  |  |  |  | Islamic Calendar | 
| 465 |  |  |  |  |  |  |  | 
| 466 |  |  |  |  |  |  | =item islamic-civil | 
| 467 |  |  |  |  |  |  |  | 
| 468 |  |  |  |  |  |  | Islamic Calendar (tabular, civil epoch) | 
| 469 |  |  |  |  |  |  |  | 
| 470 |  |  |  |  |  |  | =item islamic-rgsa | 
| 471 |  |  |  |  |  |  |  | 
| 472 |  |  |  |  |  |  | Islamic Calendar (Saudi Arabia, sighting) | 
| 473 |  |  |  |  |  |  |  | 
| 474 |  |  |  |  |  |  | =item islamic-tbla | 
| 475 |  |  |  |  |  |  |  | 
| 476 |  |  |  |  |  |  | Islamic Calendar (tabular, astronomical epoch) | 
| 477 |  |  |  |  |  |  |  | 
| 478 |  |  |  |  |  |  | =item islamic-umalqura | 
| 479 |  |  |  |  |  |  |  | 
| 480 |  |  |  |  |  |  | Islamic Calendar (Umm al-Qura) | 
| 481 |  |  |  |  |  |  |  | 
| 482 |  |  |  |  |  |  | =item iso8601 | 
| 483 |  |  |  |  |  |  |  | 
| 484 |  |  |  |  |  |  | ISO-8601 Calendar | 
| 485 |  |  |  |  |  |  |  | 
| 486 |  |  |  |  |  |  | =item japanese | 
| 487 |  |  |  |  |  |  |  | 
| 488 |  |  |  |  |  |  | Japanese Calendar | 
| 489 |  |  |  |  |  |  |  | 
| 490 |  |  |  |  |  |  | =item persian | 
| 491 |  |  |  |  |  |  |  | 
| 492 |  |  |  |  |  |  | Persian Calendar | 
| 493 |  |  |  |  |  |  |  | 
| 494 |  |  |  |  |  |  | =item roc | 
| 495 |  |  |  |  |  |  |  | 
| 496 |  |  |  |  |  |  | Minguo Calendar | 
| 497 |  |  |  |  |  |  |  | 
| 498 |  |  |  |  |  |  | =back | 
| 499 |  |  |  |  |  |  |  | 
| 500 |  |  |  |  |  |  | =back | 
| 501 |  |  |  |  |  |  |  | 
| 502 |  |  |  |  |  |  | =cut | 
| 503 |  |  |  |  |  |  |  | 
| 504 |  |  |  |  |  |  | has 'extensions' => ( | 
| 505 |  |  |  |  |  |  | is			=> 'ro', | 
| 506 |  |  |  |  |  |  | isa			=> 'Undef|HashRef', | 
| 507 |  |  |  |  |  |  | default		=> undef, | 
| 508 |  |  |  |  |  |  | writer		=> '_set_extensions', | 
| 509 |  |  |  |  |  |  | ); | 
| 510 |  |  |  |  |  |  |  | 
| 511 |  |  |  |  |  |  | =back | 
| 512 |  |  |  |  |  |  |  | 
| 513 |  |  |  |  |  |  | =head1 Methods | 
| 514 |  |  |  |  |  |  |  | 
| 515 |  |  |  |  |  |  | The following methods can be called on the locale object | 
| 516 |  |  |  |  |  |  |  | 
| 517 |  |  |  |  |  |  | =over 4 | 
| 518 |  |  |  |  |  |  |  | 
| 519 |  |  |  |  |  |  | =item id() | 
| 520 |  |  |  |  |  |  |  | 
| 521 |  |  |  |  |  |  | The local identifier. This is what you get if you attempt to | 
| 522 |  |  |  |  |  |  | stringify a locale object. | 
| 523 |  |  |  |  |  |  |  | 
| 524 |  |  |  |  |  |  | =item likely_language() | 
| 525 |  |  |  |  |  |  |  | 
| 526 |  |  |  |  |  |  | Given a locale with no language passed in or with the explicit language | 
| 527 |  |  |  |  |  |  | code of C<und>, this method attempts to use the script and territory | 
| 528 |  |  |  |  |  |  | data to guess the locale's language. | 
| 529 |  |  |  |  |  |  |  | 
| 530 |  |  |  |  |  |  | =cut | 
| 531 |  |  |  |  |  |  |  | 
| 532 |  |  |  |  |  |  | has 'likely_language' => ( | 
| 533 |  |  |  |  |  |  | is			=> 'ro', | 
| 534 |  |  |  |  |  |  | isa			=> 'Str', | 
| 535 |  |  |  |  |  |  | init_arg	=> undef, | 
| 536 |  |  |  |  |  |  | lazy		=> 1, | 
| 537 |  |  |  |  |  |  | builder		=> '_build_likely_language', | 
| 538 |  |  |  |  |  |  | ); | 
| 539 |  |  |  |  |  |  |  | 
| 540 |  |  |  |  |  |  | sub _build_likely_language { | 
| 541 | 0 |  |  | 0 |  | 0 | my $self = shift; | 
| 542 |  |  |  |  |  |  |  | 
| 543 | 0 |  |  |  |  | 0 | my $language = $self->language(); | 
| 544 |  |  |  |  |  |  |  | 
| 545 | 0 | 0 |  |  |  | 0 | return $language unless $language eq 'und'; | 
| 546 |  |  |  |  |  |  |  | 
| 547 | 0 |  |  |  |  | 0 | return $self->likely_subtag->language; | 
| 548 |  |  |  |  |  |  | } | 
| 549 |  |  |  |  |  |  |  | 
| 550 |  |  |  |  |  |  | =item likely_script() | 
| 551 |  |  |  |  |  |  |  | 
| 552 |  |  |  |  |  |  | Given a locale with no script passed in this method attempts to use the | 
| 553 |  |  |  |  |  |  | language and territory data to guess the locale's script. | 
| 554 |  |  |  |  |  |  |  | 
| 555 |  |  |  |  |  |  | =cut | 
| 556 |  |  |  |  |  |  |  | 
| 557 |  |  |  |  |  |  | has 'likely_script' => ( | 
| 558 |  |  |  |  |  |  | is			=> 'ro', | 
| 559 |  |  |  |  |  |  | isa			=> 'Str', | 
| 560 |  |  |  |  |  |  | init_arg	=> undef, | 
| 561 |  |  |  |  |  |  | lazy		=> 1, | 
| 562 |  |  |  |  |  |  | builder		=> '_build_likely_script', | 
| 563 |  |  |  |  |  |  | ); | 
| 564 |  |  |  |  |  |  |  | 
| 565 |  |  |  |  |  |  | sub _build_likely_script { | 
| 566 | 0 |  |  | 0 |  | 0 | my $self = shift; | 
| 567 |  |  |  |  |  |  |  | 
| 568 | 0 |  |  |  |  | 0 | my $script = $self->script(); | 
| 569 |  |  |  |  |  |  |  | 
| 570 | 0 | 0 |  |  |  | 0 | return $script if $script; | 
| 571 |  |  |  |  |  |  |  | 
| 572 | 0 |  | 0 |  |  | 0 | return $self->likely_subtag->script || ''; | 
| 573 |  |  |  |  |  |  | } | 
| 574 |  |  |  |  |  |  |  | 
| 575 |  |  |  |  |  |  | =item likely_territory() | 
| 576 |  |  |  |  |  |  |  | 
| 577 |  |  |  |  |  |  | Given a locale with no territory passed in this method attempts to use the | 
| 578 |  |  |  |  |  |  | language and script data to guess the locale's territory. | 
| 579 |  |  |  |  |  |  |  | 
| 580 |  |  |  |  |  |  | =back | 
| 581 |  |  |  |  |  |  |  | 
| 582 |  |  |  |  |  |  | =cut | 
| 583 |  |  |  |  |  |  |  | 
| 584 |  |  |  |  |  |  | has 'likely_territory' => ( | 
| 585 |  |  |  |  |  |  | is			=> 'ro', | 
| 586 |  |  |  |  |  |  | isa			=> 'Str', | 
| 587 |  |  |  |  |  |  | init_arg	=> undef, | 
| 588 |  |  |  |  |  |  | lazy		=> 1, | 
| 589 |  |  |  |  |  |  | builder		=> '_build_likely_territory', | 
| 590 |  |  |  |  |  |  | ); | 
| 591 |  |  |  |  |  |  |  | 
| 592 |  |  |  |  |  |  | sub _build_likely_territory { | 
| 593 | 0 |  |  | 0 |  | 0 | my $self = shift; | 
| 594 |  |  |  |  |  |  |  | 
| 595 | 0 |  |  |  |  | 0 | my $territory = $self->territory(); | 
| 596 |  |  |  |  |  |  |  | 
| 597 | 0 | 0 |  |  |  | 0 | return $territory if $territory; | 
| 598 |  |  |  |  |  |  |  | 
| 599 | 0 |  | 0 |  |  | 0 | return $self->likely_subtag->territory || ''; | 
| 600 |  |  |  |  |  |  | } | 
| 601 |  |  |  |  |  |  |  | 
| 602 |  |  |  |  |  |  | has 'module' => ( | 
| 603 |  |  |  |  |  |  | is			=> 'ro', | 
| 604 |  |  |  |  |  |  | isa			=> 'Object', | 
| 605 |  |  |  |  |  |  | init_arg	=> undef, | 
| 606 |  |  |  |  |  |  | lazy		=> 1, | 
| 607 |  |  |  |  |  |  | builder		=> '_build_module', | 
| 608 |  |  |  |  |  |  | ); | 
| 609 |  |  |  |  |  |  |  | 
| 610 |  |  |  |  |  |  | sub _build_module { | 
| 611 |  |  |  |  |  |  | # Create the new path | 
| 612 | 98 |  |  | 98 |  | 166 | my $self = shift; | 
| 613 |  |  |  |  |  |  |  | 
| 614 | 294 | 100 |  |  |  | 608 | my @path = map { ucfirst lc } | 
|  | 294 |  |  |  |  | 584 |  | 
| 615 | 98 |  |  |  |  | 426 | map { $_ ? $_ : 'Any' } ( | 
| 616 |  |  |  |  |  |  | $self->language_id, | 
| 617 |  |  |  |  |  |  | $self->script_id, | 
| 618 |  |  |  |  |  |  | $self->territory_id, | 
| 619 |  |  |  |  |  |  | ); | 
| 620 |  |  |  |  |  |  |  | 
| 621 | 294 |  |  |  |  | 506 | my @likely_path = | 
| 622 | 98 | 100 |  |  |  | 2680 | map { ucfirst lc } ( | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
| 623 |  |  |  |  |  |  | $self->has_likely_subtag ? $self->likely_subtag->language_id : 'Any', | 
| 624 |  |  |  |  |  |  | $self->has_likely_subtag ? $self->likely_subtag->script_id : 'Any', | 
| 625 |  |  |  |  |  |  | $self->has_likely_subtag ? $self->likely_subtag->territory_id : 'Any', | 
| 626 |  |  |  |  |  |  | ); | 
| 627 |  |  |  |  |  |  |  | 
| 628 | 98 |  |  |  |  | 412 | for (my $i = 0; $i < @path; $i++) { | 
| 629 | 294 | 100 | 66 |  |  | 1394 | $likely_path[$i] = $path[$i] unless $path[$i] eq 'und' or $path[$i] eq 'Any'; | 
| 630 |  |  |  |  |  |  | } | 
| 631 |  |  |  |  |  |  |  | 
| 632 |  |  |  |  |  |  | # Note the order we push these onto the stack is important | 
| 633 | 98 |  |  |  |  | 354 | @path = join '::', @likely_path; | 
| 634 | 98 |  |  |  |  | 255 | push @path, join '::', $likely_path[0], 'Any', $likely_path[2]; | 
| 635 | 98 |  |  |  |  | 283 | push @path, join '::', @likely_path[0 .. 1]; | 
| 636 | 98 |  |  |  |  | 194 | push @path, join '::', $likely_path[0]; | 
| 637 |  |  |  |  |  |  |  | 
| 638 |  |  |  |  |  |  | # Now we go through the path loading each module | 
| 639 |  |  |  |  |  |  | # And calling new on it. | 
| 640 | 98 |  |  |  |  | 123 | my $module; | 
| 641 | 98 |  |  |  |  | 187 | foreach my $module_name (@path) { | 
| 642 | 261 |  |  |  |  | 496 | $module_name = "Locale::CLDR::Locales::$module_name"; | 
| 643 | 261 | 100 |  |  |  | 1230 | if (Class::Load::try_load_class($module_name, { -version => $VERSION})) { | 
| 644 | 78 |  |  |  |  | 7921 | Class::Load::load_class($module_name, { -version => $VERSION}); | 
| 645 |  |  |  |  |  |  | } | 
| 646 |  |  |  |  |  |  | else { | 
| 647 | 182 |  |  |  |  | 54553 | next; | 
| 648 |  |  |  |  |  |  | } | 
| 649 | 78 |  |  |  |  | 8132 | $module = $module_name->new; | 
| 650 | 78 |  |  |  |  | 224 | last; | 
| 651 |  |  |  |  |  |  | } | 
| 652 |  |  |  |  |  |  |  | 
| 653 |  |  |  |  |  |  | # If we only have the root module then we have a problem as | 
| 654 |  |  |  |  |  |  | # none of the language specific data is in the root. So we | 
| 655 |  |  |  |  |  |  | # fall back to the en module | 
| 656 |  |  |  |  |  |  |  | 
| 657 | 97 | 50 |  |  |  | 419 | if ( ref $module eq 'Locale::CLDR::Locales::Root') { | 
| 658 | 0 |  |  |  |  | 0 | Class::Load::load_class('Locale::CLDR::Locales::En'); | 
| 659 | 0 |  |  |  |  | 0 | $module = Locale::CLDR::Locales::En->new | 
| 660 |  |  |  |  |  |  | } | 
| 661 |  |  |  |  |  |  |  | 
| 662 | 97 |  |  |  |  | 2262 | return $module; | 
| 663 |  |  |  |  |  |  | } | 
| 664 |  |  |  |  |  |  |  | 
| 665 |  |  |  |  |  |  | class_has 'method_cache' => ( | 
| 666 |  |  |  |  |  |  | is			=> 'rw', | 
| 667 |  |  |  |  |  |  | isa			=> 'HashRef[HashRef[ArrayRef[Object]]]', | 
| 668 |  |  |  |  |  |  | init_arg	=> undef, | 
| 669 |  |  |  |  |  |  | default		=> sub { return {}}, | 
| 670 |  |  |  |  |  |  | ); | 
| 671 |  |  |  |  |  |  |  | 
| 672 |  |  |  |  |  |  | has 'break_grapheme_cluster' => ( | 
| 673 |  |  |  |  |  |  | is => 'ro', | 
| 674 |  |  |  |  |  |  | isa => 'ArrayRef', | 
| 675 |  |  |  |  |  |  | init_arg => undef(), | 
| 676 |  |  |  |  |  |  | lazy => 1, | 
| 677 |  |  |  |  |  |  | default => sub {shift->_build_break('GraphemeClusterBreak')}, | 
| 678 |  |  |  |  |  |  | ); | 
| 679 |  |  |  |  |  |  |  | 
| 680 |  |  |  |  |  |  | has 'break_word' => ( | 
| 681 |  |  |  |  |  |  | is => 'ro', | 
| 682 |  |  |  |  |  |  | isa => 'ArrayRef', | 
| 683 |  |  |  |  |  |  | init_arg => undef(), | 
| 684 |  |  |  |  |  |  | lazy => 1, | 
| 685 |  |  |  |  |  |  | default => sub {shift->_build_break('WordBreak')}, | 
| 686 |  |  |  |  |  |  | ); | 
| 687 |  |  |  |  |  |  |  | 
| 688 |  |  |  |  |  |  | has 'break_line' => ( | 
| 689 |  |  |  |  |  |  | is => 'ro', | 
| 690 |  |  |  |  |  |  | isa => 'ArrayRef', | 
| 691 |  |  |  |  |  |  | init_arg => undef(), | 
| 692 |  |  |  |  |  |  | lazy => 1, | 
| 693 |  |  |  |  |  |  | default => sub {shift->_build_break('LineBreak')}, | 
| 694 |  |  |  |  |  |  | ); | 
| 695 |  |  |  |  |  |  |  | 
| 696 |  |  |  |  |  |  | has 'break_sentence' => ( | 
| 697 |  |  |  |  |  |  | is => 'ro', | 
| 698 |  |  |  |  |  |  | isa => 'ArrayRef', | 
| 699 |  |  |  |  |  |  | init_arg => undef(), | 
| 700 |  |  |  |  |  |  | lazy => 1, | 
| 701 |  |  |  |  |  |  | default => sub {shift->_build_break('SentenceBreak')}, | 
| 702 |  |  |  |  |  |  | ); | 
| 703 |  |  |  |  |  |  |  | 
| 704 |  |  |  |  |  |  | =head2 Meta Data | 
| 705 |  |  |  |  |  |  |  | 
| 706 |  |  |  |  |  |  | The following methods return, in English, the names if the various | 
| 707 |  |  |  |  |  |  | id's passed into the locales constructor. I.e. if you passed | 
| 708 |  |  |  |  |  |  | C<language =E<gt> 'fr'> to the constructor you would get back C<French> | 
| 709 |  |  |  |  |  |  | for the language. | 
| 710 |  |  |  |  |  |  |  | 
| 711 |  |  |  |  |  |  | =over 4 | 
| 712 |  |  |  |  |  |  |  | 
| 713 |  |  |  |  |  |  | =item name | 
| 714 |  |  |  |  |  |  |  | 
| 715 |  |  |  |  |  |  | The locale's name. This is usually built up out of the language, | 
| 716 |  |  |  |  |  |  | script, territory and variant of the locale | 
| 717 |  |  |  |  |  |  |  | 
| 718 |  |  |  |  |  |  | =item language | 
| 719 |  |  |  |  |  |  |  | 
| 720 |  |  |  |  |  |  | The name of the locale's language | 
| 721 |  |  |  |  |  |  |  | 
| 722 |  |  |  |  |  |  | =item script | 
| 723 |  |  |  |  |  |  |  | 
| 724 |  |  |  |  |  |  | The name of the locale's script | 
| 725 |  |  |  |  |  |  |  | 
| 726 |  |  |  |  |  |  | =item territory | 
| 727 |  |  |  |  |  |  |  | 
| 728 |  |  |  |  |  |  | The name of the locale's territory | 
| 729 |  |  |  |  |  |  |  | 
| 730 |  |  |  |  |  |  | =item variant | 
| 731 |  |  |  |  |  |  |  | 
| 732 |  |  |  |  |  |  | The name of the locale's variant | 
| 733 |  |  |  |  |  |  |  | 
| 734 |  |  |  |  |  |  | =back | 
| 735 |  |  |  |  |  |  |  | 
| 736 |  |  |  |  |  |  | =head2 Native Meta Data | 
| 737 |  |  |  |  |  |  |  | 
| 738 |  |  |  |  |  |  | Like Meta Data above this provides the names of the various id's | 
| 739 |  |  |  |  |  |  | passed into the locale's constructor. However in this case the | 
| 740 |  |  |  |  |  |  | names are formatted to match the locale. I.e. if you passed | 
| 741 |  |  |  |  |  |  | C<language =E<gt> 'fr'> to the constructor you would get back | 
| 742 |  |  |  |  |  |  | C<français> for the language. | 
| 743 |  |  |  |  |  |  |  | 
| 744 |  |  |  |  |  |  | =over 4 | 
| 745 |  |  |  |  |  |  |  | 
| 746 |  |  |  |  |  |  | =item native_name | 
| 747 |  |  |  |  |  |  |  | 
| 748 |  |  |  |  |  |  | The locale's name. This is usually built up out of the language, | 
| 749 |  |  |  |  |  |  | script, territory and variant of the locale. Returned in the locale's | 
| 750 |  |  |  |  |  |  | language and script | 
| 751 |  |  |  |  |  |  |  | 
| 752 |  |  |  |  |  |  | =item native_language | 
| 753 |  |  |  |  |  |  |  | 
| 754 |  |  |  |  |  |  | The name of the locale's language in the locale's language and script. | 
| 755 |  |  |  |  |  |  |  | 
| 756 |  |  |  |  |  |  | =item native_script | 
| 757 |  |  |  |  |  |  |  | 
| 758 |  |  |  |  |  |  | The name of the locale's script in the locale's language and script. | 
| 759 |  |  |  |  |  |  |  | 
| 760 |  |  |  |  |  |  | =item native_territory | 
| 761 |  |  |  |  |  |  |  | 
| 762 |  |  |  |  |  |  | The name of the locale's territory in the locale's language and script. | 
| 763 |  |  |  |  |  |  |  | 
| 764 |  |  |  |  |  |  | =item native_variant | 
| 765 |  |  |  |  |  |  |  | 
| 766 |  |  |  |  |  |  | The name of the locale's variant in the locale's language and script. | 
| 767 |  |  |  |  |  |  |  | 
| 768 |  |  |  |  |  |  | =back | 
| 769 |  |  |  |  |  |  |  | 
| 770 |  |  |  |  |  |  | =cut | 
| 771 |  |  |  |  |  |  |  | 
| 772 |  |  |  |  |  |  | foreach my $property (qw( name language script territory variant)) { | 
| 773 |  |  |  |  |  |  | has $property => ( | 
| 774 |  |  |  |  |  |  | is => 'ro', | 
| 775 |  |  |  |  |  |  | isa => 'Str', | 
| 776 |  |  |  |  |  |  | init_arg => undef, | 
| 777 |  |  |  |  |  |  | lazy => 1, | 
| 778 |  |  |  |  |  |  | builder => "_build_$property", | 
| 779 |  |  |  |  |  |  | ); | 
| 780 |  |  |  |  |  |  |  | 
| 781 | 20 |  |  | 20 |  | 105 | no strict 'refs'; | 
|  | 20 |  |  |  |  | 26 |  | 
|  | 20 |  |  |  |  | 11514 |  | 
| 782 |  |  |  |  |  |  | *{"native_$property"} = sub { | 
| 783 | 0 |  |  | 0 |  | 0 | my ($self, $for) = @_; | 
| 784 |  |  |  |  |  |  |  | 
| 785 | 0 |  | 0 |  |  | 0 | $for //= $self; | 
| 786 | 0 |  |  |  |  | 0 | my $build = "_build_native_$property"; | 
| 787 | 0 |  |  |  |  | 0 | return $self->$build($for); | 
| 788 |  |  |  |  |  |  | }; | 
| 789 |  |  |  |  |  |  | } | 
| 790 |  |  |  |  |  |  |  | 
| 791 |  |  |  |  |  |  | =head2 Calenders | 
| 792 |  |  |  |  |  |  |  | 
| 793 |  |  |  |  |  |  | The Calendar data is built to hook into L<DateTime::Locale> so that | 
| 794 |  |  |  |  |  |  | all Locale::CLDR objects can be used as replacements for DateTime::Locale's | 
| 795 |  |  |  |  |  |  | locale data. To use, say, the French data do | 
| 796 |  |  |  |  |  |  |  | 
| 797 |  |  |  |  |  |  | my $french_locale = Locale::CLDR->new('fr_FR'); | 
| 798 |  |  |  |  |  |  | my $french_dt = DateTime->now(locale => $french_locale); | 
| 799 |  |  |  |  |  |  | say "French month : ", $french_dt->month_name; # prints out the current month in French | 
| 800 |  |  |  |  |  |  |  | 
| 801 |  |  |  |  |  |  | =over 4 | 
| 802 |  |  |  |  |  |  |  | 
| 803 |  |  |  |  |  |  | =item month_format_wide | 
| 804 |  |  |  |  |  |  |  | 
| 805 |  |  |  |  |  |  | =item month_format_abbreviated | 
| 806 |  |  |  |  |  |  |  | 
| 807 |  |  |  |  |  |  | =item month_format_narrow | 
| 808 |  |  |  |  |  |  |  | 
| 809 |  |  |  |  |  |  | =item month_stand_alone_wide | 
| 810 |  |  |  |  |  |  |  | 
| 811 |  |  |  |  |  |  | =item month_stand_alone_abbreviated | 
| 812 |  |  |  |  |  |  |  | 
| 813 |  |  |  |  |  |  | =item month_stand_alone_narrow | 
| 814 |  |  |  |  |  |  |  | 
| 815 |  |  |  |  |  |  | All the above return an arrayref of month names in the requested style. | 
| 816 |  |  |  |  |  |  |  | 
| 817 |  |  |  |  |  |  | =item day_format_wide | 
| 818 |  |  |  |  |  |  |  | 
| 819 |  |  |  |  |  |  | =item day_format_abbreviated | 
| 820 |  |  |  |  |  |  |  | 
| 821 |  |  |  |  |  |  | =item day_format_narrow | 
| 822 |  |  |  |  |  |  |  | 
| 823 |  |  |  |  |  |  | =item day_stand_alone_wide | 
| 824 |  |  |  |  |  |  |  | 
| 825 |  |  |  |  |  |  | =item day_stand_alone_abbreviated | 
| 826 |  |  |  |  |  |  |  | 
| 827 |  |  |  |  |  |  | =item day_stand_alone_narrow | 
| 828 |  |  |  |  |  |  |  | 
| 829 |  |  |  |  |  |  | All the above return an array ref of day names in the requested style. | 
| 830 |  |  |  |  |  |  |  | 
| 831 |  |  |  |  |  |  | =item quarter_format_wide | 
| 832 |  |  |  |  |  |  |  | 
| 833 |  |  |  |  |  |  | =item quarter_format_abbreviated | 
| 834 |  |  |  |  |  |  |  | 
| 835 |  |  |  |  |  |  | =item quarter_format_narrow | 
| 836 |  |  |  |  |  |  |  | 
| 837 |  |  |  |  |  |  | =item quarter_stand_alone_wide | 
| 838 |  |  |  |  |  |  |  | 
| 839 |  |  |  |  |  |  | =item quarter_stand_alone_abbreviated | 
| 840 |  |  |  |  |  |  |  | 
| 841 |  |  |  |  |  |  | =item quarter_stand_alone_narrow | 
| 842 |  |  |  |  |  |  |  | 
| 843 |  |  |  |  |  |  | All the above return an arrayref of quarter names in the requested style. | 
| 844 |  |  |  |  |  |  |  | 
| 845 |  |  |  |  |  |  | =item am_pm_wide | 
| 846 |  |  |  |  |  |  |  | 
| 847 |  |  |  |  |  |  | =item am_pm_abbreviated | 
| 848 |  |  |  |  |  |  |  | 
| 849 |  |  |  |  |  |  | =item am_pm_narrow | 
| 850 |  |  |  |  |  |  |  | 
| 851 |  |  |  |  |  |  | All the above return the date period name for AM and PM | 
| 852 |  |  |  |  |  |  | in the requested style | 
| 853 |  |  |  |  |  |  |  | 
| 854 |  |  |  |  |  |  | =item era_wide | 
| 855 |  |  |  |  |  |  |  | 
| 856 |  |  |  |  |  |  | =item era_abbreviated | 
| 857 |  |  |  |  |  |  |  | 
| 858 |  |  |  |  |  |  | =item era_narrow | 
| 859 |  |  |  |  |  |  |  | 
| 860 |  |  |  |  |  |  | All the above return an array ref of era names. Note that these | 
| 861 |  |  |  |  |  |  | return the first two eras which is what you normally want for | 
| 862 |  |  |  |  |  |  | BC and AD etc. but won't work correctly for Japanese calendars. | 
| 863 |  |  |  |  |  |  |  | 
| 864 |  |  |  |  |  |  | =back | 
| 865 |  |  |  |  |  |  |  | 
| 866 |  |  |  |  |  |  | =cut | 
| 867 |  |  |  |  |  |  |  | 
| 868 |  |  |  |  |  |  | foreach my $property (qw( | 
| 869 |  |  |  |  |  |  | month_format_wide month_format_abbreviated month_format_narrow | 
| 870 |  |  |  |  |  |  | month_stand_alone_wide month_stand_alone_abbreviated month_stand_alone_narrow | 
| 871 |  |  |  |  |  |  | day_format_wide day_format_abbreviated day_format_narrow | 
| 872 |  |  |  |  |  |  | day_stand_alone_wide day_stand_alone_abbreviated day_stand_alone_narrow | 
| 873 |  |  |  |  |  |  | quarter_format_wide quarter_format_abbreviated quarter_format_narrow | 
| 874 |  |  |  |  |  |  | quarter_stand_alone_wide quarter_stand_alone_abbreviated quarter_stand_alone_narrow | 
| 875 |  |  |  |  |  |  | am_pm_wide am_pm_abbreviated am_pm_narrow | 
| 876 |  |  |  |  |  |  | era_wide era_abbreviated era_narrow | 
| 877 |  |  |  |  |  |  | era_format_wide era_format_abbreviated era_format_narrow | 
| 878 |  |  |  |  |  |  | era_stand_alone_wide era_stand_alone_abbreviated era_stand_alone_narrow | 
| 879 |  |  |  |  |  |  | )) { | 
| 880 |  |  |  |  |  |  | has $property => ( | 
| 881 |  |  |  |  |  |  | is => 'ro', | 
| 882 |  |  |  |  |  |  | isa => 'ArrayRef', | 
| 883 |  |  |  |  |  |  | init_arg => undef, | 
| 884 |  |  |  |  |  |  | lazy => 1, | 
| 885 |  |  |  |  |  |  | builder => "_build_$property", | 
| 886 |  |  |  |  |  |  | clearer => "_clear_$property", | 
| 887 |  |  |  |  |  |  | ); | 
| 888 |  |  |  |  |  |  | } | 
| 889 |  |  |  |  |  |  |  | 
| 890 |  |  |  |  |  |  | =pod | 
| 891 |  |  |  |  |  |  |  | 
| 892 |  |  |  |  |  |  | The next set of methods are not used by DateTime::Locale but CLDR provide | 
| 893 |  |  |  |  |  |  | the data and you might want it | 
| 894 |  |  |  |  |  |  |  | 
| 895 |  |  |  |  |  |  | =over 4 | 
| 896 |  |  |  |  |  |  |  | 
| 897 |  |  |  |  |  |  | =item am_pm_format_wide | 
| 898 |  |  |  |  |  |  |  | 
| 899 |  |  |  |  |  |  | =item am_pm_format_abbreviated | 
| 900 |  |  |  |  |  |  |  | 
| 901 |  |  |  |  |  |  | =item am_pm_format_narrow | 
| 902 |  |  |  |  |  |  |  | 
| 903 |  |  |  |  |  |  | =item am_pm_stand_alone_wide | 
| 904 |  |  |  |  |  |  |  | 
| 905 |  |  |  |  |  |  | =item am_pm_stand_alone_abbreviated | 
| 906 |  |  |  |  |  |  |  | 
| 907 |  |  |  |  |  |  | =item am_pm_stand_alone_narrow | 
| 908 |  |  |  |  |  |  |  | 
| 909 |  |  |  |  |  |  | All the above return a hashref keyed on date period | 
| 910 |  |  |  |  |  |  | with the value being the value for that date period | 
| 911 |  |  |  |  |  |  |  | 
| 912 |  |  |  |  |  |  | =item era_format_wide | 
| 913 |  |  |  |  |  |  |  | 
| 914 |  |  |  |  |  |  | =item era_format_abbreviated | 
| 915 |  |  |  |  |  |  |  | 
| 916 |  |  |  |  |  |  | =item era_format_narrow | 
| 917 |  |  |  |  |  |  |  | 
| 918 |  |  |  |  |  |  | =item era_stand_alone_wide | 
| 919 |  |  |  |  |  |  |  | 
| 920 |  |  |  |  |  |  | =item era_stand_alone_abbreviated | 
| 921 |  |  |  |  |  |  |  | 
| 922 |  |  |  |  |  |  | =item era_stand_alone_narrow | 
| 923 |  |  |  |  |  |  |  | 
| 924 |  |  |  |  |  |  | All the above return an array ref with I<all> the era data for the | 
| 925 |  |  |  |  |  |  | locale formatted to the requested width | 
| 926 |  |  |  |  |  |  |  | 
| 927 |  |  |  |  |  |  | =cut | 
| 928 |  |  |  |  |  |  |  | 
| 929 |  |  |  |  |  |  | foreach my $property (qw( | 
| 930 |  |  |  |  |  |  | am_pm_format_wide am_pm_format_abbreviated am_pm_format_narrow | 
| 931 |  |  |  |  |  |  | am_pm_stand_alone_wide am_pm_stand_alone_abbreviated am_pm_stand_alone_narrow | 
| 932 |  |  |  |  |  |  | )) { | 
| 933 |  |  |  |  |  |  | has $property => ( | 
| 934 |  |  |  |  |  |  | is => 'ro', | 
| 935 |  |  |  |  |  |  | isa => 'HashRef', | 
| 936 |  |  |  |  |  |  | init_arg => undef, | 
| 937 |  |  |  |  |  |  | lazy => 1, | 
| 938 |  |  |  |  |  |  | builder => "_build_$property", | 
| 939 |  |  |  |  |  |  | clearer => "_clear_$property", | 
| 940 |  |  |  |  |  |  | ); | 
| 941 |  |  |  |  |  |  | } | 
| 942 |  |  |  |  |  |  |  | 
| 943 |  |  |  |  |  |  | =item date_format_full | 
| 944 |  |  |  |  |  |  |  | 
| 945 |  |  |  |  |  |  | =item date_format_long | 
| 946 |  |  |  |  |  |  |  | 
| 947 |  |  |  |  |  |  | =item date_format_medium | 
| 948 |  |  |  |  |  |  |  | 
| 949 |  |  |  |  |  |  | =item date_format_short | 
| 950 |  |  |  |  |  |  |  | 
| 951 |  |  |  |  |  |  | =item time_format_full | 
| 952 |  |  |  |  |  |  |  | 
| 953 |  |  |  |  |  |  | =item time_format_long | 
| 954 |  |  |  |  |  |  |  | 
| 955 |  |  |  |  |  |  | =item time_format_medium | 
| 956 |  |  |  |  |  |  |  | 
| 957 |  |  |  |  |  |  | =item time_format_short | 
| 958 |  |  |  |  |  |  |  | 
| 959 |  |  |  |  |  |  | =item datetime_format_full | 
| 960 |  |  |  |  |  |  |  | 
| 961 |  |  |  |  |  |  | =item datetime_format_long | 
| 962 |  |  |  |  |  |  |  | 
| 963 |  |  |  |  |  |  | =item datetime_format_medium | 
| 964 |  |  |  |  |  |  |  | 
| 965 |  |  |  |  |  |  | =item datetime_format_short | 
| 966 |  |  |  |  |  |  |  | 
| 967 |  |  |  |  |  |  | All the above return the CLDR I<date format pattern> for the given | 
| 968 |  |  |  |  |  |  | element and width | 
| 969 |  |  |  |  |  |  |  | 
| 970 |  |  |  |  |  |  | =cut | 
| 971 |  |  |  |  |  |  |  | 
| 972 |  |  |  |  |  |  | foreach my $property (qw( | 
| 973 |  |  |  |  |  |  | id | 
| 974 |  |  |  |  |  |  | date_format_full date_format_long | 
| 975 |  |  |  |  |  |  | date_format_medium date_format_short | 
| 976 |  |  |  |  |  |  | time_format_full time_format_long | 
| 977 |  |  |  |  |  |  | time_format_medium time_format_short | 
| 978 |  |  |  |  |  |  | datetime_format_full datetime_format_long | 
| 979 |  |  |  |  |  |  | datetime_format_medium datetime_format_short | 
| 980 |  |  |  |  |  |  | )) { | 
| 981 |  |  |  |  |  |  | has $property => ( | 
| 982 |  |  |  |  |  |  | is => 'ro', | 
| 983 |  |  |  |  |  |  | isa => 'Str', | 
| 984 |  |  |  |  |  |  | init_arg => undef, | 
| 985 |  |  |  |  |  |  | lazy => 1, | 
| 986 |  |  |  |  |  |  | builder => "_build_$property", | 
| 987 |  |  |  |  |  |  | clearer => "_clear_$property", | 
| 988 |  |  |  |  |  |  | ); | 
| 989 |  |  |  |  |  |  | } | 
| 990 |  |  |  |  |  |  |  | 
| 991 |  |  |  |  |  |  | has '_available_formats' => ( | 
| 992 |  |  |  |  |  |  | traits => ['Array'], | 
| 993 |  |  |  |  |  |  | is => 'ro', | 
| 994 |  |  |  |  |  |  | isa => 'ArrayRef', | 
| 995 |  |  |  |  |  |  | init_arg => undef, | 
| 996 |  |  |  |  |  |  | lazy => 1, | 
| 997 |  |  |  |  |  |  | builder => "_build_available_formats", | 
| 998 |  |  |  |  |  |  | clearer => "_clear_available_formats", | 
| 999 |  |  |  |  |  |  | handles => { | 
| 1000 |  |  |  |  |  |  | available_formats => 'elements', | 
| 1001 |  |  |  |  |  |  | }, | 
| 1002 |  |  |  |  |  |  | ); | 
| 1003 |  |  |  |  |  |  |  | 
| 1004 |  |  |  |  |  |  | has 'format_data' => ( | 
| 1005 |  |  |  |  |  |  | is => 'ro', | 
| 1006 |  |  |  |  |  |  | isa => 'HashRef', | 
| 1007 |  |  |  |  |  |  | init_arg => undef, | 
| 1008 |  |  |  |  |  |  | lazy => 1, | 
| 1009 |  |  |  |  |  |  | builder => "_build_format_data", | 
| 1010 |  |  |  |  |  |  | clearer => "_clear_format_data", | 
| 1011 |  |  |  |  |  |  | ); | 
| 1012 |  |  |  |  |  |  |  | 
| 1013 |  |  |  |  |  |  | # default_calendar | 
| 1014 |  |  |  |  |  |  | foreach my $property (qw( | 
| 1015 |  |  |  |  |  |  | default_date_format_length default_time_format_length | 
| 1016 |  |  |  |  |  |  | )) { | 
| 1017 |  |  |  |  |  |  | has $property => ( | 
| 1018 |  |  |  |  |  |  | is => 'ro', | 
| 1019 |  |  |  |  |  |  | isa => 'Str', | 
| 1020 |  |  |  |  |  |  | init_arg => undef, | 
| 1021 |  |  |  |  |  |  | lazy => 1, | 
| 1022 |  |  |  |  |  |  | builder => "_build_$property", | 
| 1023 |  |  |  |  |  |  | writer => "set_$property" | 
| 1024 |  |  |  |  |  |  | ); | 
| 1025 |  |  |  |  |  |  | } | 
| 1026 |  |  |  |  |  |  |  | 
| 1027 |  |  |  |  |  |  | =item prefers_24_hour_time() | 
| 1028 |  |  |  |  |  |  |  | 
| 1029 |  |  |  |  |  |  | Returns a boolean value, true if the locale has a preference | 
| 1030 |  |  |  |  |  |  | for 24 hour time over 12 hour | 
| 1031 |  |  |  |  |  |  |  | 
| 1032 |  |  |  |  |  |  | =cut | 
| 1033 |  |  |  |  |  |  |  | 
| 1034 |  |  |  |  |  |  | has 'prefers_24_hour_time' => ( | 
| 1035 |  |  |  |  |  |  | is => 'ro', | 
| 1036 |  |  |  |  |  |  | isa => 'Bool', | 
| 1037 |  |  |  |  |  |  | init_arg => undef, | 
| 1038 |  |  |  |  |  |  | lazy => 1, | 
| 1039 |  |  |  |  |  |  | builder => "_build_prefers_24_hour_time", | 
| 1040 |  |  |  |  |  |  | ); | 
| 1041 |  |  |  |  |  |  |  | 
| 1042 |  |  |  |  |  |  | =item first_day_of_week() | 
| 1043 |  |  |  |  |  |  |  | 
| 1044 |  |  |  |  |  |  | Returns the numeric representation of the first day of the week | 
| 1045 |  |  |  |  |  |  | With 0 = Saturday | 
| 1046 |  |  |  |  |  |  |  | 
| 1047 |  |  |  |  |  |  | =item get_day_period($time, $type = 'default') | 
| 1048 |  |  |  |  |  |  |  | 
| 1049 |  |  |  |  |  |  | This method will calculate the correct | 
| 1050 |  |  |  |  |  |  | period for a given time and return the period name in | 
| 1051 |  |  |  |  |  |  | the locale's language and script | 
| 1052 |  |  |  |  |  |  |  | 
| 1053 |  |  |  |  |  |  | =item format_for($date_time_format) | 
| 1054 |  |  |  |  |  |  |  | 
| 1055 |  |  |  |  |  |  | This method takes a CLDR date time format and returns | 
| 1056 |  |  |  |  |  |  | the localised version of the format. | 
| 1057 |  |  |  |  |  |  |  | 
| 1058 |  |  |  |  |  |  | =cut | 
| 1059 |  |  |  |  |  |  |  | 
| 1060 |  |  |  |  |  |  | has 'first_day_of_week' => ( | 
| 1061 |  |  |  |  |  |  | is => 'ro', | 
| 1062 |  |  |  |  |  |  | isa => 'Int', | 
| 1063 |  |  |  |  |  |  | init_arg => undef, | 
| 1064 |  |  |  |  |  |  | lazy => 1, | 
| 1065 |  |  |  |  |  |  | builder => "_build_first_day_of_week", | 
| 1066 |  |  |  |  |  |  | ); | 
| 1067 |  |  |  |  |  |  |  | 
| 1068 |  |  |  |  |  |  | has 'likely_subtag' => ( | 
| 1069 |  |  |  |  |  |  | is => 'ro', | 
| 1070 |  |  |  |  |  |  | isa => __PACKAGE__, | 
| 1071 |  |  |  |  |  |  | init_arg => undef, | 
| 1072 |  |  |  |  |  |  | writer => '_set_likely_subtag', | 
| 1073 |  |  |  |  |  |  | predicate => 'has_likely_subtag', | 
| 1074 |  |  |  |  |  |  | ); | 
| 1075 |  |  |  |  |  |  |  | 
| 1076 |  |  |  |  |  |  | sub _build_break { | 
| 1077 | 4 |  |  | 4 |  | 10 | my ($self, $what) = @_; | 
| 1078 |  |  |  |  |  |  |  | 
| 1079 | 4 |  |  |  |  | 16 | my $vars = $self->_build_break_vars($what); | 
| 1080 | 4 |  |  |  |  | 19 | my $rules = $self->_build_break_rules($vars, $what); | 
| 1081 | 4 |  |  |  |  | 193 | return $rules; | 
| 1082 |  |  |  |  |  |  | } | 
| 1083 |  |  |  |  |  |  |  | 
| 1084 |  |  |  |  |  |  | sub _build_break_vars { | 
| 1085 | 4 |  |  | 4 |  | 7 | my ($self, $what) = @_; | 
| 1086 |  |  |  |  |  |  |  | 
| 1087 | 4 |  |  |  |  | 14 | my $name = "${what}_variables"; | 
| 1088 | 4 |  |  |  |  | 17 | my @bundles = $self->_find_bundle($name); | 
| 1089 | 4 |  |  |  |  | 7 | my @vars; | 
| 1090 | 4 |  |  |  |  | 11 | foreach my $bundle (reverse @bundles) { | 
| 1091 | 4 |  |  |  |  | 6 | push @vars, @{$bundle->$name}; | 
|  | 4 |  |  |  |  | 162 |  | 
| 1092 |  |  |  |  |  |  | } | 
| 1093 |  |  |  |  |  |  |  | 
| 1094 | 4 |  |  |  |  | 16 | my %vars = (); | 
| 1095 | 4 |  |  |  |  | 19 | while (my ($name, $value) = (shift @vars, shift @vars)) { | 
| 1096 | 146 | 100 |  |  |  | 181 | last unless defined $name; | 
| 1097 | 142 | 50 |  |  |  | 163 | if (! defined $value) { | 
| 1098 | 0 |  |  |  |  | 0 | delete $vars{$name}; | 
| 1099 | 0 |  |  |  |  | 0 | next; | 
| 1100 |  |  |  |  |  |  | } | 
| 1101 |  |  |  |  |  |  |  | 
| 1102 | 20 |  |  | 20 |  | 95 | $value =~ s{ ( \$ \p{ID_START} \p{ID_CONTINUE}* ) }{$vars{$1}}msxeg; | 
|  | 20 |  |  |  |  | 35 |  | 
|  | 20 |  |  |  |  | 216 |  | 
|  | 142 |  |  |  |  | 232 |  | 
|  | 148 |  |  |  |  | 366 |  | 
| 1103 | 142 |  |  |  |  | 470 | $vars{$name} = $value; | 
| 1104 |  |  |  |  |  |  | } | 
| 1105 |  |  |  |  |  |  |  | 
| 1106 | 4 |  |  |  |  | 21 | return \%vars; | 
| 1107 |  |  |  |  |  |  | } | 
| 1108 |  |  |  |  |  |  |  | 
| 1109 |  |  |  |  |  |  | sub _build_break_rules { | 
| 1110 | 4 |  |  | 4 |  | 6 | my ($self, $vars, $what) = @_; | 
| 1111 |  |  |  |  |  |  |  | 
| 1112 | 4 |  |  |  |  | 13 | my $name = "${what}_rules"; | 
| 1113 | 4 |  |  |  |  | 15 | my @bundles = $self->_find_bundle($name); | 
| 1114 |  |  |  |  |  |  |  | 
| 1115 | 4 |  |  |  |  | 10 | my %rules; | 
| 1116 | 4 |  |  |  |  | 12 | foreach my $bundle (reverse @bundles) { | 
| 1117 | 4 |  |  |  |  | 9 | %rules = (%rules, %{$bundle->$name}); | 
|  | 4 |  |  |  |  | 146 |  | 
| 1118 |  |  |  |  |  |  | } | 
| 1119 |  |  |  |  |  |  |  | 
| 1120 | 4 |  |  |  |  | 10 | my @rules; | 
| 1121 | 4 |  |  |  |  | 39 | foreach my $rule_number ( sort { $a <=> $b } keys %rules ) { | 
|  | 382 |  |  |  |  | 350 |  | 
| 1122 |  |  |  |  |  |  | # Test for deleted rules | 
| 1123 | 97 | 50 |  |  |  | 286 | next unless defined $rules{$rule_number}; | 
| 1124 |  |  |  |  |  |  |  | 
| 1125 | 97 |  |  |  |  | 725 | $rules{$rule_number} =~ s{ ( \$ \p{ID_START} \p{ID_CONTINUE}* ) }{$vars->{$1}}msxeg; | 
|  | 290 |  |  |  |  | 1041 |  | 
| 1126 | 97 |  |  |  |  | 861 | my ($first, $opp, $second) = split /(Ã|÷)/, $rules{$rule_number}; | 
| 1127 |  |  |  |  |  |  |  | 
| 1128 | 97 |  |  |  |  | 165 | foreach my $operand ($first, $second) { | 
| 1129 | 194 | 100 |  |  |  | 54021 | if ($operand =~ m{ \S }msx) { | 
| 1130 | 161 |  |  |  |  | 4559 | $operand = _unicode_to_perl($operand); | 
| 1131 |  |  |  |  |  |  | } | 
| 1132 |  |  |  |  |  |  | else { | 
| 1133 | 33 |  |  |  |  | 57 | $operand = '.'; | 
| 1134 |  |  |  |  |  |  | } | 
| 1135 |  |  |  |  |  |  | } | 
| 1136 |  |  |  |  |  |  |  | 
| 1137 | 20 |  |  | 20 |  | 286902 | no warnings 'deprecated'; | 
|  | 20 |  |  |  |  | 34 |  | 
|  | 20 |  |  |  |  | 21988 |  | 
| 1138 | 97 | 100 |  |  |  | 48955 | push @rules, [qr{$first}msx, qr{$second}msx, ($opp eq 'Ã' ? 1 : 0)]; | 
| 1139 |  |  |  |  |  |  | } | 
| 1140 |  |  |  |  |  |  |  | 
| 1141 | 4 |  |  |  |  | 28 | push @rules, [ '.', '.', 0 ]; | 
| 1142 |  |  |  |  |  |  |  | 
| 1143 | 4 |  |  |  |  | 84 | return \@rules; | 
| 1144 |  |  |  |  |  |  | } | 
| 1145 |  |  |  |  |  |  |  | 
| 1146 |  |  |  |  |  |  | sub BUILDARGS { | 
| 1147 | 90 |  |  | 90 | 1 | 1248 | my $self = shift; | 
| 1148 | 90 |  |  |  |  | 160 | my %args; | 
| 1149 |  |  |  |  |  |  |  | 
| 1150 |  |  |  |  |  |  | # Used for arguments when we call new from our own code | 
| 1151 | 90 |  |  |  |  | 204 | my %internal_args = (); | 
| 1152 | 90 | 50 | 66 |  |  | 458 | if (@_ > 1 && ref $_[-1] eq 'HASH') { | 
| 1153 | 0 |  |  |  |  | 0 | %internal_args = %{pop @_}; | 
|  | 0 |  |  |  |  | 0 |  | 
| 1154 |  |  |  |  |  |  | } | 
| 1155 |  |  |  |  |  |  |  | 
| 1156 | 90 | 100 | 66 |  |  | 519 | if (1 == @_ && ! ref $_[0]) { | 
| 1157 | 69 |  |  |  |  | 668 | my ($language, $script, $territory, $variant, $extensions) | 
| 1158 |  |  |  |  |  |  | = $_[0]=~/^ | 
| 1159 |  |  |  |  |  |  | ([a-zA-Z]+) | 
| 1160 |  |  |  |  |  |  | (?:[-_]([a-zA-Z]{4}))? | 
| 1161 |  |  |  |  |  |  | (?:[-_]([a-zA-Z]{2,3}))? | 
| 1162 |  |  |  |  |  |  | (?:[-_]([a-zA-Z0-9]+))? | 
| 1163 |  |  |  |  |  |  | (?:[-_]u[_-](.+))? | 
| 1164 |  |  |  |  |  |  | $/x; | 
| 1165 |  |  |  |  |  |  |  | 
| 1166 | 69 |  |  |  |  | 172 | foreach ($language, $script, $territory, $variant) { | 
| 1167 | 276 | 100 |  |  |  | 516 | $_ = '' unless defined $_; | 
| 1168 |  |  |  |  |  |  | } | 
| 1169 |  |  |  |  |  |  |  | 
| 1170 |  |  |  |  |  |  | %args = ( | 
| 1171 | 69 |  |  |  |  | 414 | language_id		=> $language, | 
| 1172 |  |  |  |  |  |  | script_id		=> $script, | 
| 1173 |  |  |  |  |  |  | territory_id	=> $territory, | 
| 1174 |  |  |  |  |  |  | variant_id		=> $variant, | 
| 1175 |  |  |  |  |  |  | extensions		=> $extensions, | 
| 1176 |  |  |  |  |  |  | ); | 
| 1177 |  |  |  |  |  |  | } | 
| 1178 |  |  |  |  |  |  |  | 
| 1179 | 90 | 100 |  |  |  | 300 | if (! keys %args ) { | 
| 1180 | 0 |  |  |  |  | 0 | %args = ref $_[0] | 
| 1181 | 21 | 50 |  |  |  | 95 | ? %{$_[0]} | 
| 1182 |  |  |  |  |  |  | : @_ | 
| 1183 |  |  |  |  |  |  | } | 
| 1184 |  |  |  |  |  |  |  | 
| 1185 |  |  |  |  |  |  | # Split up the extensions | 
| 1186 | 90 | 100 | 66 |  |  | 356 | if ( defined $args{extensions} && ! ref $args{extensions} ) { | 
| 1187 | 2 |  |  |  |  | 7 | $args{extensions} = { | 
| 1188 | 1 |  |  |  |  | 6 | map {lc} | 
| 1189 |  |  |  |  |  |  | split /[_-]/, $args{extensions} | 
| 1190 |  |  |  |  |  |  | }; | 
| 1191 |  |  |  |  |  |  | } | 
| 1192 |  |  |  |  |  |  |  | 
| 1193 |  |  |  |  |  |  | # Fix casing of args | 
| 1194 | 90 | 100 |  |  |  | 509 | $args{language_id}	= lc $args{language_id}			if defined $args{language_id}; | 
| 1195 | 90 | 100 |  |  |  | 333 | $args{script_id}	= ucfirst lc $args{script_id}	if defined $args{script_id}; | 
| 1196 | 90 | 100 |  |  |  | 353 | $args{territory_id}	= uc $args{territory_id}		if defined $args{territory_id}; | 
| 1197 | 90 | 100 |  |  |  | 324 | $args{variant_id}	= uc $args{variant_id}			if defined $args{variant_id}; | 
| 1198 |  |  |  |  |  |  |  | 
| 1199 |  |  |  |  |  |  | # Set up undefined language | 
| 1200 | 90 |  | 100 |  |  | 259 | $args{language_id} //= 'und'; | 
| 1201 |  |  |  |  |  |  |  | 
| 1202 | 90 |  |  |  |  | 561 | $self->SUPER::BUILDARGS(%args, %internal_args); | 
| 1203 |  |  |  |  |  |  | } | 
| 1204 |  |  |  |  |  |  |  | 
| 1205 |  |  |  |  |  |  | sub BUILD { | 
| 1206 |  |  |  |  |  |  | my ($self, $args) = @_; | 
| 1207 |  |  |  |  |  |  |  | 
| 1208 |  |  |  |  |  |  | # Check that the args are valid | 
| 1209 |  |  |  |  |  |  | # also check for aliases | 
| 1210 |  |  |  |  |  |  | $args->{language_id} = $self->language_aliases->{$args->{language_id}} | 
| 1211 |  |  |  |  |  |  | // $args->{language_id}; | 
| 1212 |  |  |  |  |  |  |  | 
| 1213 |  |  |  |  |  |  | die "Invalid language" if $args->{language_id} | 
| 1214 |  |  |  |  |  |  | && ! first { $args->{language_id} eq $_ } $self->valid_languages; | 
| 1215 |  |  |  |  |  |  |  | 
| 1216 |  |  |  |  |  |  | die "Invalid script" if $args->{script_id} | 
| 1217 |  |  |  |  |  |  | && ! first { ucfirst lc $args->{script_id} eq $_ } $self->valid_scripts; | 
| 1218 |  |  |  |  |  |  |  | 
| 1219 |  |  |  |  |  |  | die "Invalid territory" if $args->{territory_id} | 
| 1220 |  |  |  |  |  |  | &&  ( !  ( first { uc $args->{territory_id} eq $_ } $self->valid_territories ) | 
| 1221 |  |  |  |  |  |  | && ( ! $self->territory_aliases->{$self->{territory_id}} ) | 
| 1222 |  |  |  |  |  |  | ); | 
| 1223 |  |  |  |  |  |  |  | 
| 1224 |  |  |  |  |  |  | die "Invalid variant" if $args->{variant_id} | 
| 1225 |  |  |  |  |  |  | &&  ( !  ( first { uc $args->{variant_id} eq $_ } $self->valid_variants ) | 
| 1226 |  |  |  |  |  |  | && ( ! $self->variant_aliases->{lc $self->{variant_id}} ) | 
| 1227 |  |  |  |  |  |  | ); | 
| 1228 |  |  |  |  |  |  |  | 
| 1229 |  |  |  |  |  |  | if ($args->{extensions}) { | 
| 1230 |  |  |  |  |  |  | my %valid_keys = $self->valid_keys; | 
| 1231 |  |  |  |  |  |  | my %key_aliases = $self->key_names; | 
| 1232 |  |  |  |  |  |  | my @keys = keys %{$args->{extensions}}; | 
| 1233 |  |  |  |  |  |  |  | 
| 1234 |  |  |  |  |  |  | foreach my $key ( @keys ) { | 
| 1235 |  |  |  |  |  |  | my $canonical_key = $key_aliases{$key} if exists $key_aliases{$key}; | 
| 1236 |  |  |  |  |  |  | $canonical_key //= $key; | 
| 1237 |  |  |  |  |  |  | if ($canonical_key ne $key) { | 
| 1238 |  |  |  |  |  |  | $args->{extensions}{$canonical_key} = delete $args->{extensions}{$key}; | 
| 1239 |  |  |  |  |  |  | } | 
| 1240 |  |  |  |  |  |  |  | 
| 1241 |  |  |  |  |  |  | $key = $canonical_key; | 
| 1242 |  |  |  |  |  |  | die "Invalid extension name" unless exists $valid_keys{$key}; | 
| 1243 |  |  |  |  |  |  | die "Invalid extension value" unless | 
| 1244 |  |  |  |  |  |  | first { $_ eq $args->{extensions}{$key} } @{$valid_keys{$key}}; | 
| 1245 |  |  |  |  |  |  |  | 
| 1246 |  |  |  |  |  |  | $self->_set_extensions($args->{extensions}) | 
| 1247 |  |  |  |  |  |  | } | 
| 1248 |  |  |  |  |  |  | } | 
| 1249 |  |  |  |  |  |  |  | 
| 1250 |  |  |  |  |  |  | # Check for variant aliases | 
| 1251 |  |  |  |  |  |  | if ($args->{variant_id} && (my $variant_alias = $self->variant_aliases->{lc $self->variant_id})) { | 
| 1252 |  |  |  |  |  |  | delete $args->{variant_id}; | 
| 1253 |  |  |  |  |  |  | my ($what) = keys %{$variant_alias}; | 
| 1254 |  |  |  |  |  |  | my ($value) = values %{$variant_alias}; | 
| 1255 |  |  |  |  |  |  | $args->{$what} = $value; | 
| 1256 |  |  |  |  |  |  | } | 
| 1257 |  |  |  |  |  |  |  | 
| 1258 |  |  |  |  |  |  | # Now set up the module | 
| 1259 |  |  |  |  |  |  | $self->_build_module; | 
| 1260 |  |  |  |  |  |  | } | 
| 1261 |  |  |  |  |  |  |  | 
| 1262 |  |  |  |  |  |  | after 'BUILD' => sub { | 
| 1263 |  |  |  |  |  |  |  | 
| 1264 |  |  |  |  |  |  | my $self = shift; | 
| 1265 |  |  |  |  |  |  |  | 
| 1266 |  |  |  |  |  |  | # Fix up likely sub tags | 
| 1267 |  |  |  |  |  |  |  | 
| 1268 |  |  |  |  |  |  | my $likely_subtags = $self->likely_subtags; | 
| 1269 |  |  |  |  |  |  | my $likely_subtag; | 
| 1270 |  |  |  |  |  |  | my ($language_id, $script_id, $territory_id) = ($self->language_id, $self->script_id, $self->territory_id); | 
| 1271 |  |  |  |  |  |  |  | 
| 1272 |  |  |  |  |  |  | unless ($language_id ne 'und' && $script_id && $territory_id ) { | 
| 1273 |  |  |  |  |  |  | $likely_subtag = $likely_subtags->{join '_', grep { length() } ($language_id, $script_id, $territory_id)}; | 
| 1274 |  |  |  |  |  |  |  | 
| 1275 |  |  |  |  |  |  | if (! $likely_subtag ) { | 
| 1276 |  |  |  |  |  |  | $likely_subtag = $likely_subtags->{join '_', $language_id, $territory_id}; | 
| 1277 |  |  |  |  |  |  | } | 
| 1278 |  |  |  |  |  |  |  | 
| 1279 |  |  |  |  |  |  | if (! $likely_subtag ) { | 
| 1280 |  |  |  |  |  |  | $likely_subtag = $likely_subtags->{join '_', $language_id, $script_id}; | 
| 1281 |  |  |  |  |  |  | } | 
| 1282 |  |  |  |  |  |  |  | 
| 1283 |  |  |  |  |  |  | if (! $likely_subtag ) { | 
| 1284 |  |  |  |  |  |  | $likely_subtag = $likely_subtags->{$language_id}; | 
| 1285 |  |  |  |  |  |  | } | 
| 1286 |  |  |  |  |  |  |  | 
| 1287 |  |  |  |  |  |  | if (! $likely_subtag ) { | 
| 1288 |  |  |  |  |  |  | $likely_subtag = $likely_subtags->{join '_', 'und', $script_id}; | 
| 1289 |  |  |  |  |  |  | } | 
| 1290 |  |  |  |  |  |  | } | 
| 1291 |  |  |  |  |  |  |  | 
| 1292 |  |  |  |  |  |  | my ($likely_language_id, $likely_script_id, $likely_territory_id); | 
| 1293 |  |  |  |  |  |  | if ($likely_subtag) { | 
| 1294 |  |  |  |  |  |  | ($likely_language_id, $likely_script_id, $likely_territory_id) = split /_/, $likely_subtag; | 
| 1295 |  |  |  |  |  |  | $likely_language_id		= $language_id 	unless $language_id eq 'und'; | 
| 1296 |  |  |  |  |  |  | $likely_script_id		= $script_id	if length $script_id; | 
| 1297 |  |  |  |  |  |  | $likely_territory_id	= $territory_id	if length $territory_id; | 
| 1298 |  |  |  |  |  |  | $self->_set_likely_subtag(__PACKAGE__->new(join '_',$likely_language_id, $likely_script_id, $likely_territory_id)); | 
| 1299 |  |  |  |  |  |  | } | 
| 1300 |  |  |  |  |  |  |  | 
| 1301 |  |  |  |  |  |  | # Fix up extension overrides | 
| 1302 |  |  |  |  |  |  | my $extensions = $self->extensions; | 
| 1303 |  |  |  |  |  |  | if (exists $extensions->{ca}) { | 
| 1304 |  |  |  |  |  |  | $self->_set_default_ca(($territory_id // $likely_territory_id) => $extensions->{ca}); | 
| 1305 |  |  |  |  |  |  | } | 
| 1306 |  |  |  |  |  |  |  | 
| 1307 |  |  |  |  |  |  | if (exists $extensions->{nu}) { | 
| 1308 |  |  |  |  |  |  | $self->_clear_default_nu; | 
| 1309 |  |  |  |  |  |  | $self->_set_default_nu($extensions->{nu}); | 
| 1310 |  |  |  |  |  |  | } | 
| 1311 |  |  |  |  |  |  | }; | 
| 1312 |  |  |  |  |  |  |  | 
| 1313 |  |  |  |  |  |  | use overload | 
| 1314 | 40 |  |  | 40 |  | 104 | 'bool'	=> sub { 1 }, | 
| 1315 | 20 |  |  | 20 |  | 109 | '""'		=> sub {shift->id}; | 
|  | 20 |  |  | 1 |  | 23 |  | 
|  | 20 |  |  |  |  | 207 |  | 
|  | 1 |  |  |  |  | 121 |  | 
| 1316 |  |  |  |  |  |  |  | 
| 1317 |  |  |  |  |  |  | sub _build_id { | 
| 1318 | 29 |  |  | 29 |  | 43 | my $self = shift; | 
| 1319 | 29 |  |  |  |  | 88 | my $string = lc $self->language_id; | 
| 1320 |  |  |  |  |  |  |  | 
| 1321 | 29 | 100 |  |  |  | 604 | if ($self->script_id) { | 
| 1322 | 21 |  |  |  |  | 426 | $string.= '_' . ucfirst lc $self->script_id; | 
| 1323 |  |  |  |  |  |  | } | 
| 1324 |  |  |  |  |  |  |  | 
| 1325 | 29 | 100 |  |  |  | 92 | if ($self->territory_id) { | 
| 1326 | 21 |  |  |  |  | 68 | $string.= '_' . uc $self->territory_id; | 
| 1327 |  |  |  |  |  |  | } | 
| 1328 |  |  |  |  |  |  |  | 
| 1329 | 29 | 100 |  |  |  | 678 | if ($self->variant_id) { | 
| 1330 | 3 |  |  |  |  | 55 | $string.= '_' . uc $self->variant_id; | 
| 1331 |  |  |  |  |  |  | } | 
| 1332 |  |  |  |  |  |  |  | 
| 1333 | 29 | 50 |  |  |  | 579 | if (defined $self->extensions) { | 
| 1334 | 0 |  |  |  |  | 0 | $string.= '_u'; | 
| 1335 | 0 |  |  |  |  | 0 | foreach my $key (sort keys %{$self->extensions}) { | 
|  | 0 |  |  |  |  | 0 |  | 
| 1336 | 0 |  |  |  |  | 0 | my $value = $self->extensions->{$key}; | 
| 1337 | 0 |  |  |  |  | 0 | $string .= "_${key}_$value"; | 
| 1338 |  |  |  |  |  |  | } | 
| 1339 | 0 |  |  |  |  | 0 | $string =~ s/_u$//; | 
| 1340 |  |  |  |  |  |  | } | 
| 1341 |  |  |  |  |  |  |  | 
| 1342 | 29 |  |  |  |  | 552 | return $string; | 
| 1343 |  |  |  |  |  |  | } | 
| 1344 |  |  |  |  |  |  |  | 
| 1345 |  |  |  |  |  |  | sub _get_english { | 
| 1346 | 0 |  |  | 0 |  | 0 | my $self = shift; | 
| 1347 | 0 |  |  |  |  | 0 | my $english; | 
| 1348 | 0 | 0 |  |  |  | 0 | if ($self->language_id eq 'en') { | 
| 1349 | 0 |  |  |  |  | 0 | $english = $self; | 
| 1350 |  |  |  |  |  |  | } | 
| 1351 |  |  |  |  |  |  | else { | 
| 1352 | 0 |  |  |  |  | 0 | $english = Locale::CLDR->new('en_Latn_US'); | 
| 1353 |  |  |  |  |  |  | } | 
| 1354 |  |  |  |  |  |  |  | 
| 1355 | 0 |  |  |  |  | 0 | return $english; | 
| 1356 |  |  |  |  |  |  | } | 
| 1357 |  |  |  |  |  |  |  | 
| 1358 |  |  |  |  |  |  | sub _build_name { | 
| 1359 | 0 |  |  | 0 |  | 0 | my $self = shift; | 
| 1360 |  |  |  |  |  |  |  | 
| 1361 | 0 |  |  |  |  | 0 | return $self->_get_english->native_name($self); | 
| 1362 |  |  |  |  |  |  | } | 
| 1363 |  |  |  |  |  |  |  | 
| 1364 |  |  |  |  |  |  | sub _build_native_name { | 
| 1365 | 0 |  |  | 0 |  | 0 | my ($self, $for) = @_; | 
| 1366 |  |  |  |  |  |  |  | 
| 1367 | 0 |  |  |  |  | 0 | return $self->locale_name($for); | 
| 1368 |  |  |  |  |  |  | } | 
| 1369 |  |  |  |  |  |  |  | 
| 1370 |  |  |  |  |  |  | sub _build_language { | 
| 1371 | 0 |  |  | 0 |  | 0 | my $self = shift; | 
| 1372 |  |  |  |  |  |  |  | 
| 1373 | 0 |  |  |  |  | 0 | return $self->_get_english->native_language($self); | 
| 1374 |  |  |  |  |  |  | } | 
| 1375 |  |  |  |  |  |  |  | 
| 1376 |  |  |  |  |  |  | sub _build_native_language { | 
| 1377 | 0 |  |  | 0 |  | 0 | my ($self, $for) = @_; | 
| 1378 |  |  |  |  |  |  |  | 
| 1379 | 0 |  | 0 |  |  | 0 | return $self->language_name($for) // ''; | 
| 1380 |  |  |  |  |  |  | } | 
| 1381 |  |  |  |  |  |  |  | 
| 1382 |  |  |  |  |  |  | sub _build_script { | 
| 1383 | 0 |  |  | 0 |  | 0 | my $self = shift; | 
| 1384 |  |  |  |  |  |  |  | 
| 1385 | 0 |  |  |  |  | 0 | return $self->_get_english->native_script($self); | 
| 1386 |  |  |  |  |  |  | } | 
| 1387 |  |  |  |  |  |  |  | 
| 1388 |  |  |  |  |  |  | sub _build_native_script { | 
| 1389 | 0 |  |  | 0 |  | 0 | my ($self, $for) = @_; | 
| 1390 |  |  |  |  |  |  |  | 
| 1391 | 0 |  |  |  |  | 0 | return $self->script_name($for); | 
| 1392 |  |  |  |  |  |  | } | 
| 1393 |  |  |  |  |  |  |  | 
| 1394 |  |  |  |  |  |  | sub _build_territory { | 
| 1395 | 0 |  |  | 0 |  | 0 | my $self = shift; | 
| 1396 |  |  |  |  |  |  |  | 
| 1397 | 0 |  |  |  |  | 0 | return $self->_get_english->native_territory($self); | 
| 1398 |  |  |  |  |  |  | } | 
| 1399 |  |  |  |  |  |  |  | 
| 1400 |  |  |  |  |  |  | sub _build_native_territory { | 
| 1401 | 0 |  |  | 0 |  | 0 | my ($self, $for) = @_; | 
| 1402 |  |  |  |  |  |  |  | 
| 1403 | 0 |  |  |  |  | 0 | return $self->territory_name($for); | 
| 1404 |  |  |  |  |  |  | } | 
| 1405 |  |  |  |  |  |  |  | 
| 1406 |  |  |  |  |  |  | sub _build_variant { | 
| 1407 | 0 |  |  | 0 |  | 0 | my $self = shift; | 
| 1408 |  |  |  |  |  |  |  | 
| 1409 | 0 |  |  |  |  | 0 | return $self->_get_english->native_variant($self); | 
| 1410 |  |  |  |  |  |  | } | 
| 1411 |  |  |  |  |  |  |  | 
| 1412 |  |  |  |  |  |  | sub _build_native_variant { | 
| 1413 | 0 |  |  | 0 |  | 0 | my ($self, $for) = @_; | 
| 1414 |  |  |  |  |  |  |  | 
| 1415 | 0 |  |  |  |  | 0 | return $self->variant_name($for); | 
| 1416 |  |  |  |  |  |  | } | 
| 1417 |  |  |  |  |  |  |  | 
| 1418 |  |  |  |  |  |  | # Method to locate the resource bundle with the required data | 
| 1419 |  |  |  |  |  |  | sub _find_bundle { | 
| 1420 | 3188 |  |  | 3188 |  | 3017 | my ($self, $method_name) = @_; | 
| 1421 | 3188 | 50 |  |  |  | 80677 | my $id = $self->has_likely_subtag() | 
| 1422 |  |  |  |  |  |  | ? $self->likely_subtag()->id() | 
| 1423 |  |  |  |  |  |  | : $self->id(); | 
| 1424 |  |  |  |  |  |  |  | 
| 1425 |  |  |  |  |  |  |  | 
| 1426 | 3188 | 100 |  |  |  | 65155 | if ($self->method_cache->{$id}{$method_name}) { | 
| 1427 |  |  |  |  |  |  | return wantarray | 
| 1428 | 3111 | 100 |  |  |  | 18316 | ? @{$self->method_cache->{$id}{$method_name}} | 
|  | 2361 |  |  |  |  | 46185 |  | 
| 1429 |  |  |  |  |  |  | : $self->method_cache->{$id}{$method_name}[0]; | 
| 1430 |  |  |  |  |  |  | } | 
| 1431 |  |  |  |  |  |  |  | 
| 1432 | 77 |  |  |  |  | 1806 | foreach my $module ($self->module->meta->linearized_isa) { | 
| 1433 | 385 | 100 |  |  |  | 12156 | last if $module eq 'Moose::Object'; | 
| 1434 | 308 | 100 |  |  |  | 1386 | if ($module->meta->has_method($method_name)) { | 
| 1435 | 116 |  |  |  |  | 5070 | push @{$self->method_cache->{$id}{$method_name}}, $module->new; | 
|  | 116 |  |  |  |  | 3191 |  | 
| 1436 |  |  |  |  |  |  | } | 
| 1437 |  |  |  |  |  |  | } | 
| 1438 |  |  |  |  |  |  |  | 
| 1439 | 77 | 50 |  |  |  | 2175 | return unless $self->method_cache->{$id}{$method_name}; | 
| 1440 |  |  |  |  |  |  | return wantarray | 
| 1441 | 77 | 100 |  |  |  | 534 | ? @{$self->method_cache->{$id}{$method_name}} | 
|  | 64 |  |  |  |  | 1393 |  | 
| 1442 |  |  |  |  |  |  | : $self->method_cache->{$id}{$method_name}[0]; | 
| 1443 |  |  |  |  |  |  | } | 
| 1444 |  |  |  |  |  |  |  | 
| 1445 |  |  |  |  |  |  | =back | 
| 1446 |  |  |  |  |  |  |  | 
| 1447 |  |  |  |  |  |  | =head2 Names | 
| 1448 |  |  |  |  |  |  |  | 
| 1449 |  |  |  |  |  |  | These methods allow you to pass in a locale, either by C<id> or as a | 
| 1450 |  |  |  |  |  |  | Locale::CLDR object and return an name formatted in the locale of $self. | 
| 1451 |  |  |  |  |  |  | If you don't pass in a locale then it will use $self. | 
| 1452 |  |  |  |  |  |  |  | 
| 1453 |  |  |  |  |  |  | =over 4 | 
| 1454 |  |  |  |  |  |  |  | 
| 1455 |  |  |  |  |  |  | =item locale_name($name) | 
| 1456 |  |  |  |  |  |  |  | 
| 1457 |  |  |  |  |  |  | Returns the given locale name in the current locale's format. The name can be | 
| 1458 |  |  |  |  |  |  | a locale id or a locale object or non existent. If a name is not passed in | 
| 1459 |  |  |  |  |  |  | then the name of the current locale is returned. | 
| 1460 |  |  |  |  |  |  |  | 
| 1461 |  |  |  |  |  |  | =cut | 
| 1462 |  |  |  |  |  |  |  | 
| 1463 |  |  |  |  |  |  | sub locale_name { | 
| 1464 | 6 |  |  | 6 | 1 | 2939 | my ($self, $name) = @_; | 
| 1465 | 6 |  | 66 |  |  | 21 | $name //= $self; | 
| 1466 |  |  |  |  |  |  |  | 
| 1467 | 6 | 50 |  |  |  | 20 | my $code = ref $name | 
|  |  | 100 |  |  |  |  |  | 
| 1468 |  |  |  |  |  |  | ? join ( '_', $name->language_id, $name->territory_id ? $name->territory_id : () ) | 
| 1469 |  |  |  |  |  |  | : $name; | 
| 1470 |  |  |  |  |  |  |  | 
| 1471 | 6 |  |  |  |  | 24 | my @bundles = $self->_find_bundle('display_name_language'); | 
| 1472 |  |  |  |  |  |  |  | 
| 1473 | 6 |  |  |  |  | 14 | foreach my $bundle (@bundles) { | 
| 1474 | 6 |  |  |  |  | 155 | my $display_name = $bundle->display_name_language->($code); | 
| 1475 | 6 | 100 |  |  |  | 36 | return $display_name if defined $display_name; | 
| 1476 |  |  |  |  |  |  | } | 
| 1477 |  |  |  |  |  |  |  | 
| 1478 |  |  |  |  |  |  | # $name can be a string or a Locale::CLDR::Locales::* | 
| 1479 | 2 | 50 |  |  |  | 7 | if (! ref $name) { | 
| 1480 | 2 |  |  |  |  | 15 | $name = Locale::CLDR->new($name); | 
| 1481 |  |  |  |  |  |  | } | 
| 1482 |  |  |  |  |  |  |  | 
| 1483 |  |  |  |  |  |  | # Now we have to process each individual element | 
| 1484 |  |  |  |  |  |  | # to pass to the display name pattern | 
| 1485 | 2 |  |  |  |  | 38 | my $language = $self->language_name($name); | 
| 1486 | 2 |  |  |  |  | 10 | my $script = $self->script_name($name); | 
| 1487 | 2 |  |  |  |  | 10 | my $territory = $self->territory_name($name); | 
| 1488 | 2 |  |  |  |  | 9 | my $variant = $self->variant_name($name); | 
| 1489 |  |  |  |  |  |  |  | 
| 1490 | 2 |  |  |  |  | 7 | my $bundle = $self->_find_bundle('display_name_pattern'); | 
| 1491 | 2 |  |  |  |  | 12 | return $bundle | 
| 1492 |  |  |  |  |  |  | ->display_name_pattern($language, $territory, $script, $variant); | 
| 1493 |  |  |  |  |  |  | } | 
| 1494 |  |  |  |  |  |  |  | 
| 1495 |  |  |  |  |  |  | =item language_name($language) | 
| 1496 |  |  |  |  |  |  |  | 
| 1497 |  |  |  |  |  |  | Returns the language name in the current locale's format. The name can be | 
| 1498 |  |  |  |  |  |  | a locale language id or a locale object or non existent. If a name is not | 
| 1499 |  |  |  |  |  |  | passed in then the language name of the current locale is returned. | 
| 1500 |  |  |  |  |  |  |  | 
| 1501 |  |  |  |  |  |  | =cut | 
| 1502 |  |  |  |  |  |  |  | 
| 1503 |  |  |  |  |  |  | sub language_name { | 
| 1504 | 8 |  |  | 8 | 1 | 4301 | my ($self, $name) = @_; | 
| 1505 |  |  |  |  |  |  |  | 
| 1506 | 8 |  | 66 |  |  | 30 | $name //= $self; | 
| 1507 |  |  |  |  |  |  |  | 
| 1508 | 8 | 100 |  |  |  | 31 | my $code = ref $name ? $name->language_id : eval { Locale::CLDR->new(language_id => $name)->language_id }; | 
|  | 3 |  |  |  |  | 20 |  | 
| 1509 |  |  |  |  |  |  |  | 
| 1510 | 8 |  |  |  |  | 993 | my $language = undef; | 
| 1511 | 8 |  |  |  |  | 2720 | my @bundles = $self->_find_bundle('display_name_language'); | 
| 1512 | 8 | 100 |  |  |  | 23 | if ($code) { | 
| 1513 | 7 |  |  |  |  | 15 | foreach my $bundle (@bundles) { | 
| 1514 | 7 |  |  |  |  | 193 | my $display_name = $bundle->display_name_language->($code); | 
| 1515 | 7 | 50 |  |  |  | 21 | if (defined $display_name) { | 
| 1516 | 7 |  |  |  |  | 12 | $language = $display_name; | 
| 1517 | 7 |  |  |  |  | 15 | last; | 
| 1518 |  |  |  |  |  |  | } | 
| 1519 |  |  |  |  |  |  | } | 
| 1520 |  |  |  |  |  |  | } | 
| 1521 |  |  |  |  |  |  | # If we don't have a display name for the language we try again | 
| 1522 |  |  |  |  |  |  | # with the und tag | 
| 1523 | 8 | 100 |  |  |  | 25 | if (! defined $language ) { | 
| 1524 | 1 |  |  |  |  | 3 | foreach my $bundle (@bundles) { | 
| 1525 | 1 |  |  |  |  | 29 | my $display_name = $bundle->display_name_language->('und'); | 
| 1526 | 1 | 50 |  |  |  | 5 | if (defined $display_name) { | 
| 1527 | 1 |  |  |  |  | 2 | $language = $display_name; | 
| 1528 | 1 |  |  |  |  | 2 | last; | 
| 1529 |  |  |  |  |  |  | } | 
| 1530 |  |  |  |  |  |  | } | 
| 1531 |  |  |  |  |  |  | } | 
| 1532 |  |  |  |  |  |  |  | 
| 1533 | 8 |  |  |  |  | 41 | return $language; | 
| 1534 |  |  |  |  |  |  | } | 
| 1535 |  |  |  |  |  |  |  | 
| 1536 |  |  |  |  |  |  | =item all_languages() | 
| 1537 |  |  |  |  |  |  |  | 
| 1538 |  |  |  |  |  |  | Returns a hash ref keyed on language id of all the languages the system | 
| 1539 |  |  |  |  |  |  | knows about. The values are the language names for the corresponding id's | 
| 1540 |  |  |  |  |  |  |  | 
| 1541 |  |  |  |  |  |  | =cut | 
| 1542 |  |  |  |  |  |  |  | 
| 1543 |  |  |  |  |  |  | sub all_languages { | 
| 1544 | 1 |  |  | 1 | 1 | 2 | my $self = shift; | 
| 1545 |  |  |  |  |  |  |  | 
| 1546 | 1 |  |  |  |  | 2 | my @bundles = $self->_find_bundle('display_name_language'); | 
| 1547 | 1 |  |  |  |  | 1 | my %languages; | 
| 1548 | 1 |  |  |  |  | 2 | foreach my $bundle (@bundles) { | 
| 1549 | 1 |  |  |  |  | 24 | my $languages = $bundle->display_name_language->(); | 
| 1550 |  |  |  |  |  |  |  | 
| 1551 |  |  |  |  |  |  | # Remove existing languages | 
| 1552 | 1 |  |  |  |  | 2 | delete @{$languages}{keys %languages}; | 
|  | 1 |  |  |  |  | 2 |  | 
| 1553 |  |  |  |  |  |  |  | 
| 1554 |  |  |  |  |  |  | # Assign new ones to the hash | 
| 1555 | 1 |  |  |  |  | 252 | @languages{keys %$languages} = values %$languages; | 
| 1556 |  |  |  |  |  |  | } | 
| 1557 |  |  |  |  |  |  |  | 
| 1558 | 1 |  |  |  |  | 6 | return \%languages; | 
| 1559 |  |  |  |  |  |  | } | 
| 1560 |  |  |  |  |  |  |  | 
| 1561 |  |  |  |  |  |  | =item script_name($script) | 
| 1562 |  |  |  |  |  |  |  | 
| 1563 |  |  |  |  |  |  | Returns the script name in the current locale's format. The script can be | 
| 1564 |  |  |  |  |  |  | a locale script id or a locale object or non existent. If a script is not | 
| 1565 |  |  |  |  |  |  | passed in then the script name of the current locale is returned. | 
| 1566 |  |  |  |  |  |  |  | 
| 1567 |  |  |  |  |  |  | =cut | 
| 1568 |  |  |  |  |  |  |  | 
| 1569 |  |  |  |  |  |  | sub script_name { | 
| 1570 | 7 |  |  | 7 | 1 | 3147 | my ($self, $name) = @_; | 
| 1571 | 7 |  | 66 |  |  | 23 | $name //= $self; | 
| 1572 |  |  |  |  |  |  |  | 
| 1573 | 7 | 100 |  |  |  | 23 | if (! ref $name ) { | 
| 1574 | 3 |  |  |  |  | 4 | $name = eval {__PACKAGE__->new(script_id => $name)}; | 
|  | 3 |  |  |  |  | 20 |  | 
| 1575 |  |  |  |  |  |  | } | 
| 1576 |  |  |  |  |  |  |  | 
| 1577 | 7 | 100 | 100 |  |  | 1504 | if ( ref $name && ! $name->script_id ) { | 
| 1578 | 3 |  |  |  |  | 11 | return ''; | 
| 1579 |  |  |  |  |  |  | } | 
| 1580 |  |  |  |  |  |  |  | 
| 1581 | 4 |  |  |  |  | 11 | my $script = undef; | 
| 1582 | 4 |  |  |  |  | 19 | my @bundles = $self->_find_bundle('display_name_script'); | 
| 1583 | 4 | 100 |  |  |  | 19 | if ($name) { | 
| 1584 | 3 |  |  |  |  | 8 | foreach my $bundle (@bundles) { | 
| 1585 | 3 |  |  |  |  | 73 | $script = $bundle->display_name_script->($name->script_id); | 
| 1586 | 3 | 50 |  |  |  | 8 | if (defined $script) { | 
| 1587 | 3 |  |  |  |  | 7 | last; | 
| 1588 |  |  |  |  |  |  | } | 
| 1589 |  |  |  |  |  |  | } | 
| 1590 |  |  |  |  |  |  | } | 
| 1591 |  |  |  |  |  |  |  | 
| 1592 | 4 | 100 |  |  |  | 12 | if (! $script) { | 
| 1593 | 1 |  |  |  |  | 3 | foreach my $bundle (@bundles) { | 
| 1594 | 1 |  |  |  |  | 31 | $script = $bundle->display_name_script->('Zzzz'); | 
| 1595 | 1 | 50 |  |  |  | 4 | if (defined $script) { | 
| 1596 | 1 |  |  |  |  | 3 | last; | 
| 1597 |  |  |  |  |  |  | } | 
| 1598 |  |  |  |  |  |  | } | 
| 1599 |  |  |  |  |  |  | } | 
| 1600 |  |  |  |  |  |  |  | 
| 1601 | 4 |  |  |  |  | 24 | return $script; | 
| 1602 |  |  |  |  |  |  | } | 
| 1603 |  |  |  |  |  |  |  | 
| 1604 |  |  |  |  |  |  | =item all_scripts() | 
| 1605 |  |  |  |  |  |  |  | 
| 1606 |  |  |  |  |  |  | Returns a hash ref keyed on script id of all the scripts the system | 
| 1607 |  |  |  |  |  |  | knows about. The values are the script names for the corresponding id's | 
| 1608 |  |  |  |  |  |  |  | 
| 1609 |  |  |  |  |  |  | =cut | 
| 1610 |  |  |  |  |  |  |  | 
| 1611 |  |  |  |  |  |  | sub all_scripts { | 
| 1612 | 1 |  |  | 1 | 1 | 4442 | my $self = shift; | 
| 1613 |  |  |  |  |  |  |  | 
| 1614 | 1 |  |  |  |  | 134 | my @bundles = $self->_find_bundle('display_name_script'); | 
| 1615 | 1 |  |  |  |  | 4 | my %scripts; | 
| 1616 | 1 |  |  |  |  | 4 | foreach my $bundle (@bundles) { | 
| 1617 | 1 |  |  |  |  | 34 | my $scripts = $bundle->display_name_script->(); | 
| 1618 |  |  |  |  |  |  |  | 
| 1619 |  |  |  |  |  |  | # Remove existing scripts | 
| 1620 | 1 |  |  |  |  | 4 | delete @{$scripts}{keys %scripts}; | 
|  | 1 |  |  |  |  | 2 |  | 
| 1621 |  |  |  |  |  |  |  | 
| 1622 |  |  |  |  |  |  | # Assign new ones to the hash | 
| 1623 | 1 |  |  |  |  | 88 | @scripts{keys %$scripts} = values %$scripts; | 
| 1624 |  |  |  |  |  |  | } | 
| 1625 |  |  |  |  |  |  |  | 
| 1626 | 1 |  |  |  |  | 8 | return \%scripts; | 
| 1627 |  |  |  |  |  |  | } | 
| 1628 |  |  |  |  |  |  |  | 
| 1629 |  |  |  |  |  |  | =item territory_name($territory) | 
| 1630 |  |  |  |  |  |  |  | 
| 1631 |  |  |  |  |  |  | Returns the territory name in the current locale's format. The territory can be | 
| 1632 |  |  |  |  |  |  | a locale territory id or a locale object or non existent. If a territory is not | 
| 1633 |  |  |  |  |  |  | passed in then the territory name of the current locale is returned. | 
| 1634 |  |  |  |  |  |  |  | 
| 1635 |  |  |  |  |  |  | =cut | 
| 1636 |  |  |  |  |  |  |  | 
| 1637 |  |  |  |  |  |  | sub territory_name { | 
| 1638 | 9 |  |  | 9 | 1 | 6311 | my ($self, $name) = @_; | 
| 1639 | 9 |  | 66 |  |  | 37 | $name //= $self; | 
| 1640 |  |  |  |  |  |  |  | 
| 1641 | 9 | 100 |  |  |  | 34 | if (! ref $name ) { | 
| 1642 | 5 |  |  |  |  | 10 | $name = eval { __PACKAGE__->new(language_id => 'und', territory_id => $name); }; | 
|  | 5 |  |  |  |  | 34 |  | 
| 1643 |  |  |  |  |  |  | } | 
| 1644 |  |  |  |  |  |  |  | 
| 1645 | 9 | 50 | 66 |  |  | 2528 | if ( ref $name && ! $name->territory_id) { | 
| 1646 | 0 |  |  |  |  | 0 | return ''; | 
| 1647 |  |  |  |  |  |  | } | 
| 1648 |  |  |  |  |  |  |  | 
| 1649 | 9 |  |  |  |  | 19 | my $territory = undef; | 
| 1650 | 9 |  |  |  |  | 37 | my @bundles = $self->_find_bundle('display_name_territory'); | 
| 1651 | 9 | 100 |  |  |  | 99 | if ($name) { | 
| 1652 | 7 |  |  |  |  | 20 | foreach my $bundle (@bundles) { | 
| 1653 | 7 |  |  |  |  | 228 | $territory = $bundle->display_name_territory->{$name->territory_id}; | 
| 1654 | 7 | 50 |  |  |  | 29 | if (defined $territory) { | 
| 1655 | 7 |  |  |  |  | 21 | last; | 
| 1656 |  |  |  |  |  |  | } | 
| 1657 |  |  |  |  |  |  | } | 
| 1658 |  |  |  |  |  |  | } | 
| 1659 |  |  |  |  |  |  |  | 
| 1660 | 9 | 100 |  |  |  | 27 | if (! defined $territory) { | 
| 1661 | 2 |  |  |  |  | 5 | foreach my $bundle (@bundles) { | 
| 1662 | 2 |  |  |  |  | 60 | $territory = $bundle->display_name_territory->{'ZZ'}; | 
| 1663 | 2 | 50 |  |  |  | 6 | if (defined $territory) { | 
| 1664 | 2 |  |  |  |  | 5 | last; | 
| 1665 |  |  |  |  |  |  | } | 
| 1666 |  |  |  |  |  |  | } | 
| 1667 |  |  |  |  |  |  | } | 
| 1668 |  |  |  |  |  |  |  | 
| 1669 | 9 |  |  |  |  | 51 | return $territory; | 
| 1670 |  |  |  |  |  |  | } | 
| 1671 |  |  |  |  |  |  |  | 
| 1672 |  |  |  |  |  |  | =item all_territories | 
| 1673 |  |  |  |  |  |  |  | 
| 1674 |  |  |  |  |  |  | Returns a hash ref keyed on territory id of all the territory the system | 
| 1675 |  |  |  |  |  |  | knows about. The values are the territory names for the corresponding ids | 
| 1676 |  |  |  |  |  |  |  | 
| 1677 |  |  |  |  |  |  | =cut | 
| 1678 |  |  |  |  |  |  |  | 
| 1679 |  |  |  |  |  |  | sub all_territories { | 
| 1680 | 1 |  |  | 1 | 1 | 3585 | my $self = shift; | 
| 1681 |  |  |  |  |  |  |  | 
| 1682 | 1 |  |  |  |  | 5 | my @bundles = $self->_find_bundle('display_name_territory'); | 
| 1683 | 1 |  |  |  |  | 2 | my %territories; | 
| 1684 | 1 |  |  |  |  | 3 | foreach my $bundle (@bundles) { | 
| 1685 | 1 |  |  |  |  | 30 | my $territories = $bundle->display_name_territory; | 
| 1686 |  |  |  |  |  |  |  | 
| 1687 |  |  |  |  |  |  | # Remove existing territories | 
| 1688 | 1 |  |  |  |  | 3 | delete @{$territories}{keys %territories}; | 
|  | 1 |  |  |  |  | 2 |  | 
| 1689 |  |  |  |  |  |  |  | 
| 1690 |  |  |  |  |  |  | # Assign new ones to the hash | 
| 1691 | 1 |  |  |  |  | 209 | @territories{keys %$territories} = values %$territories; | 
| 1692 |  |  |  |  |  |  | } | 
| 1693 |  |  |  |  |  |  |  | 
| 1694 | 1 |  |  |  |  | 7 | return \%territories; | 
| 1695 |  |  |  |  |  |  | } | 
| 1696 |  |  |  |  |  |  |  | 
| 1697 |  |  |  |  |  |  | =item variant_name($variant) | 
| 1698 |  |  |  |  |  |  |  | 
| 1699 |  |  |  |  |  |  | Returns the variant name in the current locale's format. The variant can be | 
| 1700 |  |  |  |  |  |  | a locale variant id or a locale object or non existent. If a variant is not | 
| 1701 |  |  |  |  |  |  | passed in then the variant name of the current locale is returned. | 
| 1702 |  |  |  |  |  |  |  | 
| 1703 |  |  |  |  |  |  | =cut | 
| 1704 |  |  |  |  |  |  |  | 
| 1705 |  |  |  |  |  |  | sub variant_name { | 
| 1706 | 7 |  |  | 7 | 1 | 2836 | my ($self, $name) = @_; | 
| 1707 | 7 |  | 66 |  |  | 27 | $name //= $self; | 
| 1708 |  |  |  |  |  |  |  | 
| 1709 | 7 | 100 |  |  |  | 23 | if (! ref $name ) { | 
| 1710 | 4 |  |  |  |  | 29 | $name = __PACKAGE__->new(language_id=> 'und', variant_id => $name); | 
| 1711 |  |  |  |  |  |  | } | 
| 1712 |  |  |  |  |  |  |  | 
| 1713 | 6 | 100 |  |  |  | 212 | return '' unless $name->variant_id; | 
| 1714 | 3 |  |  |  |  | 8 | my $variant = undef; | 
| 1715 | 3 | 50 |  |  |  | 101 | if ($name->has_variant) { | 
| 1716 | 3 |  |  |  |  | 13 | my @bundles = $self->_find_bundle('display_name_variant'); | 
| 1717 | 3 |  |  |  |  | 8 | foreach my $bundle (@bundles) { | 
| 1718 | 3 |  |  |  |  | 84 | $variant= $bundle->display_name_variant->{$name->variant_id}; | 
| 1719 | 3 | 100 |  |  |  | 10 | if (defined $variant) { | 
| 1720 | 2 |  |  |  |  | 6 | last; | 
| 1721 |  |  |  |  |  |  | } | 
| 1722 |  |  |  |  |  |  | } | 
| 1723 |  |  |  |  |  |  | } | 
| 1724 |  |  |  |  |  |  |  | 
| 1725 | 3 |  | 100 |  |  | 27 | return $variant // ''; | 
| 1726 |  |  |  |  |  |  | } | 
| 1727 |  |  |  |  |  |  |  | 
| 1728 |  |  |  |  |  |  | =item key_name($key) | 
| 1729 |  |  |  |  |  |  |  | 
| 1730 |  |  |  |  |  |  | Returns the key name in the current locale's format. The key must be | 
| 1731 |  |  |  |  |  |  | a locale key id as a string | 
| 1732 |  |  |  |  |  |  |  | 
| 1733 |  |  |  |  |  |  | =cut | 
| 1734 |  |  |  |  |  |  |  | 
| 1735 |  |  |  |  |  |  | sub key_name { | 
| 1736 | 3 |  |  | 3 | 1 | 6689 | my ($self, $key) = @_; | 
| 1737 |  |  |  |  |  |  |  | 
| 1738 | 3 |  |  |  |  | 9 | $key = lc $key; | 
| 1739 |  |  |  |  |  |  |  | 
| 1740 | 3 |  |  |  |  | 104 | my %key_aliases = $self->key_aliases; | 
| 1741 | 3 |  |  |  |  | 83 | my %key_names	= $self->key_names; | 
| 1742 | 3 |  |  |  |  | 86 | my %valid_keys	= $self->valid_keys; | 
| 1743 |  |  |  |  |  |  |  | 
| 1744 | 3 |  | 100 |  |  | 19 | my $alias = $key_aliases{$key} // ''; | 
| 1745 | 3 |  | 100 |  |  | 10 | my $name  = $key_names{$key} // ''; | 
| 1746 |  |  |  |  |  |  |  | 
| 1747 | 3 | 50 | 66 |  |  | 25 | return '' unless exists $valid_keys{$key} || exists $valid_keys{$alias} || exists $valid_keys{$name}; | 
|  |  |  | 66 |  |  |  |  | 
| 1748 | 3 |  |  |  |  | 12 | my @bundles = $self->_find_bundle('display_name_key'); | 
| 1749 | 3 |  |  |  |  | 9 | foreach my $bundle (@bundles) { | 
| 1750 | 3 |  |  |  |  | 83 | my $return = $bundle->display_name_key->{$key}; | 
| 1751 | 3 |  | 66 |  |  | 34 | $return //= $bundle->display_name_key->{$alias}; | 
| 1752 | 3 |  | 33 |  |  | 8 | $return //= $bundle->display_name_key->{$name}; | 
| 1753 |  |  |  |  |  |  |  | 
| 1754 | 3 | 50 | 33 |  |  | 72 | return $return if defined $return && length $return; | 
| 1755 |  |  |  |  |  |  | } | 
| 1756 |  |  |  |  |  |  |  | 
| 1757 | 0 |  | 0 |  |  | 0 | return ucfirst ($key_names{$name} || $key_names{$alias} || $key_names{$key} || $key); | 
| 1758 |  |  |  |  |  |  | } | 
| 1759 |  |  |  |  |  |  |  | 
| 1760 |  |  |  |  |  |  | =item type_name($key, $type) | 
| 1761 |  |  |  |  |  |  |  | 
| 1762 |  |  |  |  |  |  | Returns the type name in the current locale's format. The key and type must be | 
| 1763 |  |  |  |  |  |  | a locale key id and type id as a string | 
| 1764 |  |  |  |  |  |  |  | 
| 1765 |  |  |  |  |  |  | =cut | 
| 1766 |  |  |  |  |  |  |  | 
| 1767 |  |  |  |  |  |  | sub type_name { | 
| 1768 | 3 |  |  | 3 | 1 | 8 | my ($self, $key, $type) = @_; | 
| 1769 |  |  |  |  |  |  |  | 
| 1770 | 3 |  |  |  |  | 9 | $key	= lc $key; | 
| 1771 | 3 |  |  |  |  | 5 | $type	= lc $type; | 
| 1772 |  |  |  |  |  |  |  | 
| 1773 | 3 |  |  |  |  | 106 | my %key_aliases = $self->key_aliases; | 
| 1774 | 3 |  |  |  |  | 90 | my %valid_keys	= $self->valid_keys; | 
| 1775 | 3 |  |  |  |  | 82 | my %key_names	= $self->key_names; | 
| 1776 |  |  |  |  |  |  |  | 
| 1777 | 3 |  | 100 |  |  | 19 | my $alias = $key_aliases{$key} // ''; | 
| 1778 | 3 |  | 100 |  |  | 12 | my $name  = $key_names{$key}   // ''; | 
| 1779 |  |  |  |  |  |  |  | 
| 1780 | 3 | 50 | 66 |  |  | 21 | return '' unless exists $valid_keys{$key} || $valid_keys{$alias} || $valid_keys{$name}; | 
|  |  |  | 66 |  |  |  |  | 
| 1781 | 3 | 100 |  | 20 |  | 15 | return '' unless first { $_ eq $type } @{$valid_keys{$key} || []}, @{$valid_keys{$alias} || []}, @{$valid_keys{$name} || []}; | 
|  | 20 | 50 |  |  |  | 32 |  | 
|  | 3 | 100 |  |  |  | 15 |  | 
|  | 3 | 50 |  |  |  | 16 |  | 
|  | 3 |  |  |  |  | 20 |  | 
| 1782 |  |  |  |  |  |  |  | 
| 1783 | 3 |  |  |  |  | 15 | my @bundles = $self->_find_bundle('display_name_type'); | 
| 1784 | 3 |  |  |  |  | 9 | foreach my $bundle (@bundles) { | 
| 1785 | 3 |  | 66 |  |  | 86 | my $types = $bundle->display_name_type->{$key} // $bundle->display_name_type->{$alias} // $bundle->display_name_type->{$name}; | 
|  |  |  | 33 |  |  |  |  | 
| 1786 | 3 |  |  |  |  | 10 | my $type = $types->{$type}; | 
| 1787 | 3 | 50 |  |  |  | 73 | return $type if defined $type; | 
| 1788 |  |  |  |  |  |  | } | 
| 1789 |  |  |  |  |  |  |  | 
| 1790 | 0 |  |  |  |  | 0 | return ''; | 
| 1791 |  |  |  |  |  |  | } | 
| 1792 |  |  |  |  |  |  |  | 
| 1793 |  |  |  |  |  |  | =item measurement_system_name($measurement_system) | 
| 1794 |  |  |  |  |  |  |  | 
| 1795 |  |  |  |  |  |  | Returns the measurement system name in the current locale's format. The measurement system must be | 
| 1796 |  |  |  |  |  |  | a measurement system id as a string | 
| 1797 |  |  |  |  |  |  |  | 
| 1798 |  |  |  |  |  |  | =cut | 
| 1799 |  |  |  |  |  |  |  | 
| 1800 |  |  |  |  |  |  | sub measurement_system_name { | 
| 1801 | 6 |  |  | 6 | 1 | 33 | my ($self, $name) = @_; | 
| 1802 |  |  |  |  |  |  |  | 
| 1803 |  |  |  |  |  |  | # Fix case of code | 
| 1804 | 6 |  |  |  |  | 15 | $name = uc $name; | 
| 1805 | 6 | 100 |  |  |  | 21 | $name = 'metric' if $name eq 'METRIC'; | 
| 1806 |  |  |  |  |  |  |  | 
| 1807 | 6 |  |  |  |  | 20 | my @bundles = $self->_find_bundle('display_name_measurement_system'); | 
| 1808 | 6 |  |  |  |  | 12 | foreach my $bundle (@bundles) { | 
| 1809 | 6 |  |  |  |  | 156 | my $system = $bundle->display_name_measurement_system->{$name}; | 
| 1810 | 6 | 50 |  |  |  | 35 | return $system if defined $system; | 
| 1811 |  |  |  |  |  |  | } | 
| 1812 |  |  |  |  |  |  |  | 
| 1813 | 0 |  |  |  |  | 0 | return ''; | 
| 1814 |  |  |  |  |  |  | } | 
| 1815 |  |  |  |  |  |  |  | 
| 1816 |  |  |  |  |  |  | =item transform_name($name) | 
| 1817 |  |  |  |  |  |  |  | 
| 1818 |  |  |  |  |  |  | Returns the transform (transliteration) name in the current locale's format. The transform must be | 
| 1819 |  |  |  |  |  |  | a transform id as a string | 
| 1820 |  |  |  |  |  |  |  | 
| 1821 |  |  |  |  |  |  | =cut | 
| 1822 |  |  |  |  |  |  |  | 
| 1823 |  |  |  |  |  |  | sub transform_name { | 
| 1824 | 1 |  |  | 1 | 1 | 3 | my ($self, $name) = @_; | 
| 1825 |  |  |  |  |  |  |  | 
| 1826 | 1 |  |  |  |  | 3 | $name = lc $name; | 
| 1827 |  |  |  |  |  |  |  | 
| 1828 | 1 |  |  |  |  | 3 | my @bundles = $self->_find_bundle('display_name_transform_name'); | 
| 1829 | 1 |  |  |  |  | 3 | foreach my $bundle (@bundles) { | 
| 1830 | 1 |  |  |  |  | 38 | my $key = $bundle->display_name_transform_name->{$name}; | 
| 1831 | 1 | 50 |  |  |  | 16 | return $key if length $key; | 
| 1832 |  |  |  |  |  |  | } | 
| 1833 |  |  |  |  |  |  |  | 
| 1834 | 0 |  |  |  |  | 0 | return ''; | 
| 1835 |  |  |  |  |  |  | } | 
| 1836 |  |  |  |  |  |  |  | 
| 1837 |  |  |  |  |  |  | =item code_pattern($type, $locale) | 
| 1838 |  |  |  |  |  |  |  | 
| 1839 |  |  |  |  |  |  | This method formats a language, script or territory name, given as C<$type> | 
| 1840 |  |  |  |  |  |  | from C<$locale> in a way expected by the current locale. If $locale is | 
| 1841 |  |  |  |  |  |  | not passed in or is undef() the method uses the current locale. | 
| 1842 |  |  |  |  |  |  |  | 
| 1843 |  |  |  |  |  |  | =cut | 
| 1844 |  |  |  |  |  |  |  | 
| 1845 |  |  |  |  |  |  | sub code_pattern { | 
| 1846 | 3 |  |  | 3 | 1 | 30 | my ($self, $type, $locale) = @_; | 
| 1847 | 3 |  |  |  |  | 7 | $type = lc $type; | 
| 1848 |  |  |  |  |  |  |  | 
| 1849 |  |  |  |  |  |  | # If locale is not passed in then we are using ourself | 
| 1850 | 3 |  | 33 |  |  | 10 | $locale //= $self; | 
| 1851 |  |  |  |  |  |  |  | 
| 1852 |  |  |  |  |  |  | # If locale is not an object then inflate it | 
| 1853 | 3 | 50 |  |  |  | 15 | $locale = __PACKAGE__->new($locale) unless blessed $locale; | 
| 1854 |  |  |  |  |  |  |  | 
| 1855 | 3 | 50 |  |  |  | 18 | return '' unless $type =~ m{ \A (?: language | script | territory ) \z }xms; | 
| 1856 |  |  |  |  |  |  |  | 
| 1857 | 3 |  |  |  |  | 6 | my $method = $type . '_name'; | 
| 1858 | 3 |  |  |  |  | 15 | my $substitute = $self->$method($locale); | 
| 1859 |  |  |  |  |  |  |  | 
| 1860 | 3 |  |  |  |  | 11 | my @bundles = $self->_find_bundle('display_name_code_patterns'); | 
| 1861 | 3 |  |  |  |  | 6 | foreach my $bundle (@bundles) { | 
| 1862 | 3 |  |  |  |  | 84 | my $text = $bundle->display_name_code_patterns->{$type}; | 
| 1863 | 3 | 50 |  |  |  | 7 | next unless defined $text; | 
| 1864 | 3 |  |  |  |  | 10 | my $match = qr{ \{ 0 \} }xms; | 
| 1865 | 3 |  |  |  |  | 42 | $text=~ s{ $match }{$substitute}gxms; | 
| 1866 | 3 |  |  |  |  | 24 | return $text; | 
| 1867 |  |  |  |  |  |  | } | 
| 1868 |  |  |  |  |  |  |  | 
| 1869 | 0 |  |  |  |  | 0 | return ''; | 
| 1870 |  |  |  |  |  |  | } | 
| 1871 |  |  |  |  |  |  |  | 
| 1872 |  |  |  |  |  |  | =item text_orientation($type) | 
| 1873 |  |  |  |  |  |  |  | 
| 1874 |  |  |  |  |  |  | Gets the text orientation for the locale. Type must be one of | 
| 1875 |  |  |  |  |  |  | C<lines> or C<characters> | 
| 1876 |  |  |  |  |  |  |  | 
| 1877 |  |  |  |  |  |  | =cut | 
| 1878 |  |  |  |  |  |  |  | 
| 1879 |  |  |  |  |  |  | sub text_orientation { | 
| 1880 | 2 |  |  | 2 | 1 | 19 | my $self = shift; | 
| 1881 | 2 |  |  |  |  | 2 | my $type = shift; | 
| 1882 |  |  |  |  |  |  |  | 
| 1883 | 2 |  |  |  |  | 8 | my @bundles = $self->_find_bundle('text_orientation'); | 
| 1884 | 2 |  |  |  |  | 4 | foreach my $bundle (@bundles) { | 
| 1885 | 2 |  |  |  |  | 47 | my $orientation = $bundle->text_orientation; | 
| 1886 | 2 | 50 |  |  |  | 4 | next unless defined $orientation; | 
| 1887 | 2 |  |  |  |  | 12 | return $orientation->{$type}; | 
| 1888 |  |  |  |  |  |  | } | 
| 1889 |  |  |  |  |  |  |  | 
| 1890 | 0 |  |  |  |  | 0 | return; | 
| 1891 |  |  |  |  |  |  | } | 
| 1892 |  |  |  |  |  |  |  | 
| 1893 |  |  |  |  |  |  | sub _set_casing { | 
| 1894 | 0 |  |  | 0 |  | 0 | my ($self, $casing, $string) = @_; | 
| 1895 |  |  |  |  |  |  |  | 
| 1896 | 0 |  |  |  |  | 0 | my @words = $self->split_words($string); | 
| 1897 |  |  |  |  |  |  |  | 
| 1898 | 0 | 0 |  |  |  | 0 | if ($casing eq 'titlecase-firstword') { | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 1899 |  |  |  |  |  |  | # Check to see whether $words[0] is white space or not | 
| 1900 | 0 |  |  |  |  | 0 | my $firstword_location = 0; | 
| 1901 | 0 | 0 |  |  |  | 0 | if ($words[0] =~ m{ \A \s }msx) { | 
| 1902 | 0 |  |  |  |  | 0 | $firstword_location = 1; | 
| 1903 |  |  |  |  |  |  | } | 
| 1904 |  |  |  |  |  |  |  | 
| 1905 | 0 |  |  |  |  | 0 | $words[$firstword_location] = ucfirst $words[$firstword_location]; | 
| 1906 |  |  |  |  |  |  | } | 
| 1907 |  |  |  |  |  |  | elsif ($casing eq 'titlecase-words') { | 
| 1908 | 0 |  |  |  |  | 0 | @words = map{ ucfirst } @words; | 
|  | 0 |  |  |  |  | 0 |  | 
| 1909 |  |  |  |  |  |  | } | 
| 1910 |  |  |  |  |  |  | elsif ($casing eq 'lowercase-words') { | 
| 1911 | 0 |  |  |  |  | 0 | @words = map{ lc } @words; | 
|  | 0 |  |  |  |  | 0 |  | 
| 1912 |  |  |  |  |  |  | } | 
| 1913 |  |  |  |  |  |  |  | 
| 1914 | 0 |  |  |  |  | 0 | return join '', @words; | 
| 1915 |  |  |  |  |  |  | } | 
| 1916 |  |  |  |  |  |  |  | 
| 1917 |  |  |  |  |  |  | =back | 
| 1918 |  |  |  |  |  |  |  | 
| 1919 |  |  |  |  |  |  | =head2 Segmentation | 
| 1920 |  |  |  |  |  |  |  | 
| 1921 |  |  |  |  |  |  | This group of methods allow you to split a string in various ways | 
| 1922 |  |  |  |  |  |  | Note you need Perl 5.18 or above for this | 
| 1923 |  |  |  |  |  |  |  | 
| 1924 |  |  |  |  |  |  | =over 4 | 
| 1925 |  |  |  |  |  |  |  | 
| 1926 |  |  |  |  |  |  | =item split_grapheme_clusters($string) | 
| 1927 |  |  |  |  |  |  |  | 
| 1928 |  |  |  |  |  |  | Splits a string on grapheme clusters using the locale's segmentation rules. | 
| 1929 |  |  |  |  |  |  | Returns a list of grapheme clusters. | 
| 1930 |  |  |  |  |  |  |  | 
| 1931 |  |  |  |  |  |  | =cut | 
| 1932 |  |  |  |  |  |  | # Need 5.18 and above | 
| 1933 |  |  |  |  |  |  | sub _new_perl { | 
| 1934 | 10 | 50 |  | 10 |  | 121 | die "You need Perl 5.18 or later for this functionality\n" | 
| 1935 |  |  |  |  |  |  | if $^V lt v5.18.0; | 
| 1936 |  |  |  |  |  |  | } | 
| 1937 |  |  |  |  |  |  |  | 
| 1938 |  |  |  |  |  |  | sub split_grapheme_clusters { | 
| 1939 | 1 |  |  | 1 | 1 | 49 | _new_perl(); | 
| 1940 |  |  |  |  |  |  |  | 
| 1941 | 1 |  |  |  |  | 3 | my ($self, $string) = @_; | 
| 1942 |  |  |  |  |  |  |  | 
| 1943 | 1 |  |  |  |  | 43 | my $rules = $self->break_grapheme_cluster; | 
| 1944 | 1 |  |  |  |  | 6 | my @clusters = $self->_split($rules, $string, 1); | 
| 1945 |  |  |  |  |  |  |  | 
| 1946 | 1 |  |  |  |  | 17 | return @clusters; | 
| 1947 |  |  |  |  |  |  | } | 
| 1948 |  |  |  |  |  |  |  | 
| 1949 |  |  |  |  |  |  | =item split_words($string) | 
| 1950 |  |  |  |  |  |  |  | 
| 1951 |  |  |  |  |  |  | Splits a string on word boundaries using the locale's segmentation rules. | 
| 1952 |  |  |  |  |  |  | Returns a list of words. | 
| 1953 |  |  |  |  |  |  |  | 
| 1954 |  |  |  |  |  |  | =cut | 
| 1955 |  |  |  |  |  |  |  | 
| 1956 |  |  |  |  |  |  | sub split_words { | 
| 1957 | 1 |  |  | 1 | 1 | 1258 | _new_perl(); | 
| 1958 |  |  |  |  |  |  |  | 
| 1959 | 1 |  |  |  |  | 3 | my ($self, $string) = @_; | 
| 1960 |  |  |  |  |  |  |  | 
| 1961 | 1 |  |  |  |  | 51 | my $rules = $self->break_word; | 
| 1962 | 1 |  |  |  |  | 4 | my @words = $self->_split($rules, $string); | 
| 1963 |  |  |  |  |  |  |  | 
| 1964 | 1 |  |  |  |  | 7 | return @words; | 
| 1965 |  |  |  |  |  |  | } | 
| 1966 |  |  |  |  |  |  |  | 
| 1967 |  |  |  |  |  |  | =item split_sentences($string) | 
| 1968 |  |  |  |  |  |  |  | 
| 1969 |  |  |  |  |  |  | Splits a string on on all points where a sentence could | 
| 1970 |  |  |  |  |  |  | end using the locale's segmentation rules. Returns a list | 
| 1971 |  |  |  |  |  |  | the end of each list element is the point where a sentence | 
| 1972 |  |  |  |  |  |  | could end. | 
| 1973 |  |  |  |  |  |  |  | 
| 1974 |  |  |  |  |  |  | =cut | 
| 1975 |  |  |  |  |  |  |  | 
| 1976 |  |  |  |  |  |  | sub split_sentences { | 
| 1977 | 1 |  |  | 1 | 1 | 823 | _new_perl(); | 
| 1978 |  |  |  |  |  |  |  | 
| 1979 | 1 |  |  |  |  | 4 | my ($self, $string) = @_; | 
| 1980 |  |  |  |  |  |  |  | 
| 1981 | 1 |  |  |  |  | 38 | my $rules = $self->break_sentence; | 
| 1982 | 1 |  |  |  |  | 5 | my @sentences = $self->_split($rules, $string); | 
| 1983 |  |  |  |  |  |  |  | 
| 1984 | 1 |  |  |  |  | 8 | return @sentences; | 
| 1985 |  |  |  |  |  |  | } | 
| 1986 |  |  |  |  |  |  |  | 
| 1987 |  |  |  |  |  |  | =item split_lines($string) | 
| 1988 |  |  |  |  |  |  |  | 
| 1989 |  |  |  |  |  |  | Splits a string on on all points where a line could | 
| 1990 |  |  |  |  |  |  | end using the locale's segmentation rules. Returns a list | 
| 1991 |  |  |  |  |  |  | the end of each list element is the point where a line | 
| 1992 |  |  |  |  |  |  | could end. | 
| 1993 |  |  |  |  |  |  |  | 
| 1994 |  |  |  |  |  |  | =cut | 
| 1995 |  |  |  |  |  |  |  | 
| 1996 |  |  |  |  |  |  | sub split_lines { | 
| 1997 | 1 |  |  | 1 | 1 | 1112 | _new_perl(); | 
| 1998 |  |  |  |  |  |  |  | 
| 1999 | 1 |  |  |  |  | 5 | my ($self, $string) = @_; | 
| 2000 |  |  |  |  |  |  |  | 
| 2001 | 1 |  |  |  |  | 61 | my $rules = $self->break_line; | 
| 2002 | 1 |  |  |  |  | 7 | my @lines = $self->_split($rules, $string); | 
| 2003 |  |  |  |  |  |  |  | 
| 2004 | 1 |  |  |  |  | 6 | return @lines; | 
| 2005 |  |  |  |  |  |  | } | 
| 2006 |  |  |  |  |  |  |  | 
| 2007 |  |  |  |  |  |  | sub _split { | 
| 2008 | 4 |  |  | 4 |  | 11 | my ($self, $rules, $string, $grapheme_split) = @_; | 
| 2009 |  |  |  |  |  |  |  | 
| 2010 | 4 |  |  |  |  | 27 | my @split = (scalar @$rules) x (length($string) - 1); | 
| 2011 |  |  |  |  |  |  |  | 
| 2012 | 4 |  |  |  |  | 13 | pos($string)=0; | 
| 2013 |  |  |  |  |  |  | # The Unicode Consortium has deprecated LB=Surrogate but the CLDR still | 
| 2014 |  |  |  |  |  |  | # uses it, at last in this version. | 
| 2015 | 20 |  |  | 20 |  | 57884 | no warnings 'deprecated'; | 
|  | 20 |  |  |  |  | 35 |  | 
|  | 20 |  |  |  |  | 56257 |  | 
| 2016 | 4 |  |  |  |  | 19 | while (length($string) -1 != pos $string) { | 
| 2017 | 161 |  |  |  |  | 260 | my $rule_number = 0; | 
| 2018 | 161 |  |  |  |  | 138 | my $first; | 
| 2019 | 161 |  |  |  |  | 427 | foreach my $rule (@$rules) { | 
| 2020 | 2656 | 100 |  |  |  | 38675 | unless( ($first) = $string =~ m{ | 
| 2021 |  |  |  |  |  |  | \G | 
| 2022 |  |  |  |  |  |  | ($rule->[0]) | 
| 2023 |  |  |  |  |  |  | $rule->[1] | 
| 2024 |  |  |  |  |  |  | }msx) { | 
| 2025 | 2495 |  |  |  |  | 1466245 | $rule_number++; | 
| 2026 | 2495 |  |  |  |  | 16557 | next; | 
| 2027 |  |  |  |  |  |  | } | 
| 2028 | 161 |  |  |  |  | 117333 | my $location = pos($string) + length($first) -1; | 
| 2029 | 161 |  |  |  |  | 314 | $split[$location] = $rule_number; | 
| 2030 |  |  |  |  |  |  |  | 
| 2031 |  |  |  |  |  |  | # If the left hand side was part of a grapheme cluster | 
| 2032 |  |  |  |  |  |  | # we have to jump past the entire cluster | 
| 2033 | 161 |  |  |  |  | 257 | my $length = length $first; | 
| 2034 | 161 |  |  |  |  | 674 | my ($gc) = $string =~ /\G(\X)/; | 
| 2035 | 161 | 100 | 66 |  |  | 2167 | $length = (! $grapheme_split && length($gc)) > $length ? length($gc) : $length; | 
| 2036 | 161 |  |  |  |  | 474 | pos($string)+= $length; | 
| 2037 | 161 |  |  |  |  | 949 | last; | 
| 2038 |  |  |  |  |  |  | } | 
| 2039 |  |  |  |  |  |  | } | 
| 2040 |  |  |  |  |  |  |  | 
| 2041 | 4 |  |  |  |  | 15 | push @$rules,[undef,undef,1]; | 
| 2042 | 4 | 100 |  |  |  | 14 | @split = map {$rules->[$_][2] ? 1 : 0} @split; | 
|  | 164 |  |  |  |  | 254 |  | 
| 2043 | 4 |  |  |  |  | 13 | my $count = 0; | 
| 2044 | 4 |  |  |  |  | 10 | my @sections = ('.'); | 
| 2045 | 4 |  |  |  |  | 13 | foreach my $split (@split) { | 
| 2046 | 164 | 100 |  |  |  | 184 | $count++ unless $split; | 
| 2047 | 164 |  |  |  |  | 141 | $sections[$count] .= '.'; | 
| 2048 |  |  |  |  |  |  | } | 
| 2049 |  |  |  |  |  |  |  | 
| 2050 | 4 |  |  |  |  | 21 | my $regex = '(' . join(')(', @sections) . ')'; | 
| 2051 | 4 |  |  |  |  | 101 | $regex = qr{ \A $regex \z}msx; | 
| 2052 | 4 |  |  |  |  | 61 | @split = $string =~ $regex; | 
| 2053 |  |  |  |  |  |  |  | 
| 2054 | 4 |  |  |  |  | 41 | return @split; | 
| 2055 |  |  |  |  |  |  | } | 
| 2056 |  |  |  |  |  |  |  | 
| 2057 |  |  |  |  |  |  | =back | 
| 2058 |  |  |  |  |  |  |  | 
| 2059 |  |  |  |  |  |  | =head2 Characters | 
| 2060 |  |  |  |  |  |  |  | 
| 2061 |  |  |  |  |  |  | =over 4 | 
| 2062 |  |  |  |  |  |  |  | 
| 2063 |  |  |  |  |  |  | =item is_exemplar_character( $type, $character) | 
| 2064 |  |  |  |  |  |  |  | 
| 2065 |  |  |  |  |  |  | =item is_exemplar_character($character) | 
| 2066 |  |  |  |  |  |  |  | 
| 2067 |  |  |  |  |  |  | Tests if the given character is used in the locale. There are | 
| 2068 |  |  |  |  |  |  | three possible types; C<main>, C<auxiliary> and C<punctuation>. | 
| 2069 |  |  |  |  |  |  | If no type is given C<main> is assumed. Unless the C<index> type | 
| 2070 |  |  |  |  |  |  | is given you will have to have a Perl version of 5.18 or above | 
| 2071 |  |  |  |  |  |  | to use this method | 
| 2072 |  |  |  |  |  |  |  | 
| 2073 |  |  |  |  |  |  | =cut | 
| 2074 |  |  |  |  |  |  |  | 
| 2075 |  |  |  |  |  |  | sub is_exemplar_character { | 
| 2076 | 6 |  |  | 6 | 1 | 48 | my ($self, @parameters) = @_; | 
| 2077 | 6 | 100 |  |  |  | 18 | unshift @parameters, 'main' if @parameters == 1; | 
| 2078 |  |  |  |  |  |  |  | 
| 2079 | 6 | 50 |  |  |  | 18 | _new_perl() unless $parameters[0] eq 'index'; | 
| 2080 |  |  |  |  |  |  |  | 
| 2081 | 6 |  |  |  |  | 20 | my @bundles = $self->_find_bundle('characters'); | 
| 2082 | 6 |  |  |  |  | 9 | foreach my $bundle (@bundles) { | 
| 2083 | 9 |  |  |  |  | 206 | my $characters = $bundle->characters->{lc $parameters[0]}; | 
| 2084 | 9 | 100 |  |  |  | 15 | next unless defined $characters; | 
| 2085 | 7 | 100 |  |  |  | 49 | return 1 if fc($parameters[1])=~$characters; | 
| 2086 |  |  |  |  |  |  | } | 
| 2087 |  |  |  |  |  |  |  | 
| 2088 | 3 |  |  |  |  | 12 | return; | 
| 2089 |  |  |  |  |  |  | } | 
| 2090 |  |  |  |  |  |  |  | 
| 2091 |  |  |  |  |  |  | =item index_characters() | 
| 2092 |  |  |  |  |  |  |  | 
| 2093 |  |  |  |  |  |  | Returns an array ref of characters normally used when creating | 
| 2094 |  |  |  |  |  |  | an index and ordered appropriately. | 
| 2095 |  |  |  |  |  |  |  | 
| 2096 |  |  |  |  |  |  | =cut | 
| 2097 |  |  |  |  |  |  |  | 
| 2098 |  |  |  |  |  |  | sub index_characters { | 
| 2099 | 1 |  |  | 1 | 1 | 286 | my $self = shift; | 
| 2100 |  |  |  |  |  |  |  | 
| 2101 | 1 |  |  |  |  | 3 | my @bundles = $self->_find_bundle('characters'); | 
| 2102 | 1 |  |  |  |  | 3 | foreach my $bundle (@bundles) { | 
| 2103 | 1 |  |  |  |  | 23 | my $characters = $bundle->characters->{index}; | 
| 2104 | 1 | 50 |  |  |  | 4 | next unless defined $characters; | 
| 2105 | 1 |  |  |  |  | 11 | return $characters; | 
| 2106 |  |  |  |  |  |  | } | 
| 2107 | 0 |  |  |  |  | 0 | return []; | 
| 2108 |  |  |  |  |  |  | } | 
| 2109 |  |  |  |  |  |  |  | 
| 2110 |  |  |  |  |  |  | sub _truncated { | 
| 2111 | 6 |  |  | 6 |  | 13 | my ($self, $type, @params) = @_; | 
| 2112 |  |  |  |  |  |  |  | 
| 2113 | 6 |  |  |  |  | 13 | my @bundles = $self->_find_bundle('ellipsis'); | 
| 2114 | 6 |  |  |  |  | 10 | foreach my $bundle (@bundles) { | 
| 2115 | 6 |  |  |  |  | 134 | my $ellipsis = $bundle->ellipsis->{$type}; | 
| 2116 | 6 | 50 |  |  |  | 9 | next unless defined $ellipsis; | 
| 2117 | 6 |  |  |  |  | 25 | $ellipsis=~s{ \{ 0 \} }{$params[0]}msx; | 
| 2118 | 6 |  |  |  |  | 9 | $ellipsis=~s{ \{ 1 \} }{$params[1]}msx; | 
| 2119 | 6 |  |  |  |  | 28 | return $ellipsis; | 
| 2120 |  |  |  |  |  |  | } | 
| 2121 |  |  |  |  |  |  | } | 
| 2122 |  |  |  |  |  |  |  | 
| 2123 |  |  |  |  |  |  | =back | 
| 2124 |  |  |  |  |  |  |  | 
| 2125 |  |  |  |  |  |  | =head2 Truncation | 
| 2126 |  |  |  |  |  |  |  | 
| 2127 |  |  |  |  |  |  | These methods format a string to show where part of the string has been removed | 
| 2128 |  |  |  |  |  |  |  | 
| 2129 |  |  |  |  |  |  | =over 4 | 
| 2130 |  |  |  |  |  |  |  | 
| 2131 |  |  |  |  |  |  | =item truncated_beginning($string) | 
| 2132 |  |  |  |  |  |  |  | 
| 2133 |  |  |  |  |  |  | Adds the locale specific marking to show that the | 
| 2134 |  |  |  |  |  |  | string has been truncated at the beginning. | 
| 2135 |  |  |  |  |  |  |  | 
| 2136 |  |  |  |  |  |  | =cut | 
| 2137 |  |  |  |  |  |  |  | 
| 2138 |  |  |  |  |  |  | sub truncated_beginning { | 
| 2139 | 1 |  |  | 1 | 1 | 20 | shift->_truncated(initial => @_); | 
| 2140 |  |  |  |  |  |  | } | 
| 2141 |  |  |  |  |  |  |  | 
| 2142 |  |  |  |  |  |  | =item truncated_between($string, $string) | 
| 2143 |  |  |  |  |  |  |  | 
| 2144 |  |  |  |  |  |  | Adds the locale specific marking to show that something | 
| 2145 |  |  |  |  |  |  | has been truncated between the two strings. Returns a | 
| 2146 |  |  |  |  |  |  | string comprising of the concatenation of the first string, | 
| 2147 |  |  |  |  |  |  | the mark and the second string | 
| 2148 |  |  |  |  |  |  |  | 
| 2149 |  |  |  |  |  |  | =cut | 
| 2150 |  |  |  |  |  |  |  | 
| 2151 |  |  |  |  |  |  | sub truncated_between { | 
| 2152 | 1 |  |  | 1 | 1 | 3 | shift->_truncated(medial => @_); | 
| 2153 |  |  |  |  |  |  | } | 
| 2154 |  |  |  |  |  |  |  | 
| 2155 |  |  |  |  |  |  | =item truncated_end($string) | 
| 2156 |  |  |  |  |  |  |  | 
| 2157 |  |  |  |  |  |  | Adds the locale specific marking to show that the | 
| 2158 |  |  |  |  |  |  | string has been truncated at the end. | 
| 2159 |  |  |  |  |  |  |  | 
| 2160 |  |  |  |  |  |  | =cut | 
| 2161 |  |  |  |  |  |  |  | 
| 2162 |  |  |  |  |  |  | sub truncated_end { | 
| 2163 | 1 |  |  | 1 | 1 | 3 | shift->_truncated(final => @_); | 
| 2164 |  |  |  |  |  |  | } | 
| 2165 |  |  |  |  |  |  |  | 
| 2166 |  |  |  |  |  |  | =item truncated_word_beginning($string) | 
| 2167 |  |  |  |  |  |  |  | 
| 2168 |  |  |  |  |  |  | Adds the locale specific marking to show that the | 
| 2169 |  |  |  |  |  |  | string has been truncated at the beginning. This | 
| 2170 |  |  |  |  |  |  | should be used in preference to C<truncated_beginning> | 
| 2171 |  |  |  |  |  |  | when the truncation occurs on a word boundary. | 
| 2172 |  |  |  |  |  |  |  | 
| 2173 |  |  |  |  |  |  | =cut | 
| 2174 |  |  |  |  |  |  |  | 
| 2175 |  |  |  |  |  |  | sub truncated_word_beginning { | 
| 2176 | 1 |  |  | 1 | 1 | 3 | shift->_truncated('word-initial' => @_); | 
| 2177 |  |  |  |  |  |  | } | 
| 2178 |  |  |  |  |  |  |  | 
| 2179 |  |  |  |  |  |  | =item truncated_word_between($string, $string) | 
| 2180 |  |  |  |  |  |  |  | 
| 2181 |  |  |  |  |  |  | Adds the locale specific marking to show that something | 
| 2182 |  |  |  |  |  |  | has been truncated between the two strings. Returns a | 
| 2183 |  |  |  |  |  |  | string comprising of the concatenation of the first string, | 
| 2184 |  |  |  |  |  |  | the mark and the second string. This should be used in | 
| 2185 |  |  |  |  |  |  | preference to C<truncated_between> when the truncation | 
| 2186 |  |  |  |  |  |  | occurs on a word boundary. | 
| 2187 |  |  |  |  |  |  |  | 
| 2188 |  |  |  |  |  |  | =cut | 
| 2189 |  |  |  |  |  |  |  | 
| 2190 |  |  |  |  |  |  | sub truncated_word_between { | 
| 2191 | 1 |  |  | 1 | 1 | 3 | shift->_truncated('word-medial' => @_); | 
| 2192 |  |  |  |  |  |  | } | 
| 2193 |  |  |  |  |  |  |  | 
| 2194 |  |  |  |  |  |  | =item truncated_word_end($string) | 
| 2195 |  |  |  |  |  |  |  | 
| 2196 |  |  |  |  |  |  | Adds the locale specific marking to show that the | 
| 2197 |  |  |  |  |  |  | string has been truncated at the end. This should be | 
| 2198 |  |  |  |  |  |  | used in preference to C<truncated_end> when the | 
| 2199 |  |  |  |  |  |  | truncation occurs on a word boundary. | 
| 2200 |  |  |  |  |  |  |  | 
| 2201 |  |  |  |  |  |  | =cut | 
| 2202 |  |  |  |  |  |  |  | 
| 2203 |  |  |  |  |  |  | sub truncated_word_end { | 
| 2204 | 1 |  |  | 1 | 1 | 3 | shift->_truncated('word-final' => @_); | 
| 2205 |  |  |  |  |  |  | } | 
| 2206 |  |  |  |  |  |  |  | 
| 2207 |  |  |  |  |  |  | =back | 
| 2208 |  |  |  |  |  |  |  | 
| 2209 |  |  |  |  |  |  | =head2 Quoting | 
| 2210 |  |  |  |  |  |  |  | 
| 2211 |  |  |  |  |  |  | =over 4 | 
| 2212 |  |  |  |  |  |  |  | 
| 2213 |  |  |  |  |  |  | =item quote($string) | 
| 2214 |  |  |  |  |  |  |  | 
| 2215 |  |  |  |  |  |  | Adds the locale's primary quotation marks to the ends of the string. | 
| 2216 |  |  |  |  |  |  | Also scans the string for paired primary and auxiliary quotation | 
| 2217 |  |  |  |  |  |  | marks and flips them. | 
| 2218 |  |  |  |  |  |  |  | 
| 2219 |  |  |  |  |  |  | eg passing C<z âabcâ z> to this method for the C<en_GB> locale | 
| 2220 |  |  |  |  |  |  | gives C<âz âabcâ zâ> | 
| 2221 |  |  |  |  |  |  |  | 
| 2222 |  |  |  |  |  |  | =cut | 
| 2223 |  |  |  |  |  |  |  | 
| 2224 |  |  |  |  |  |  | sub quote { | 
| 2225 | 3 |  |  | 3 | 1 | 1012 | my ($self, $text) = @_; | 
| 2226 |  |  |  |  |  |  |  | 
| 2227 | 3 |  |  |  |  | 4 | my %quote; | 
| 2228 | 3 |  |  |  |  | 10 | my @bundles = $self->_find_bundle('quote_start'); | 
| 2229 | 3 |  |  |  |  | 4 | foreach my $bundle (@bundles) { | 
| 2230 | 3 |  |  |  |  | 72 | my $quote = $bundle->quote_start; | 
| 2231 | 3 | 50 |  |  |  | 5 | next unless defined $quote; | 
| 2232 | 3 |  |  |  |  | 11 | $quote{start} = $quote; | 
| 2233 | 3 |  |  |  |  | 5 | last; | 
| 2234 |  |  |  |  |  |  | } | 
| 2235 |  |  |  |  |  |  |  | 
| 2236 | 3 |  |  |  |  | 8 | @bundles = $self->_find_bundle('quote_end'); | 
| 2237 | 3 |  |  |  |  | 4 | foreach my $bundle (@bundles) { | 
| 2238 | 3 |  |  |  |  | 71 | my $quote = $bundle->quote_end; | 
| 2239 | 3 | 50 |  |  |  | 11 | next unless defined $quote; | 
| 2240 | 3 |  |  |  |  | 6 | $quote{end} = $quote; | 
| 2241 | 3 |  |  |  |  | 5 | last; | 
| 2242 |  |  |  |  |  |  | } | 
| 2243 |  |  |  |  |  |  |  | 
| 2244 | 3 |  |  |  |  | 7 | @bundles = $self->_find_bundle('alternate_quote_start'); | 
| 2245 | 3 |  |  |  |  | 5 | foreach my $bundle (@bundles) { | 
| 2246 | 3 |  |  |  |  | 74 | my $quote = $bundle->alternate_quote_start; | 
| 2247 | 3 | 50 |  |  |  | 6 | next unless defined $quote; | 
| 2248 | 3 |  |  |  |  | 5 | $quote{alternate_start} = $quote; | 
| 2249 | 3 |  |  |  |  | 3 | last; | 
| 2250 |  |  |  |  |  |  | } | 
| 2251 |  |  |  |  |  |  |  | 
| 2252 | 3 |  |  |  |  | 6 | @bundles = $self->_find_bundle('alternate_quote_end'); | 
| 2253 | 3 |  |  |  |  | 6 | foreach my $bundle (@bundles) { | 
| 2254 | 3 |  |  |  |  | 80 | my $quote = $bundle->alternate_quote_end; | 
| 2255 | 3 | 50 |  |  |  | 5 | next unless defined $quote; | 
| 2256 | 3 |  |  |  |  | 5 | $quote{alternate_end} = $quote; | 
| 2257 | 3 |  |  |  |  | 3 | last; | 
| 2258 |  |  |  |  |  |  | } | 
| 2259 |  |  |  |  |  |  |  | 
| 2260 |  |  |  |  |  |  | # Check to see if we need to switch quotes | 
| 2261 | 3 |  |  |  |  | 4 | foreach (qw( start end alternate_start alternate_end)) { | 
| 2262 | 12 |  | 50 |  |  | 21 | $quote{$_} //= ''; | 
| 2263 |  |  |  |  |  |  | } | 
| 2264 |  |  |  |  |  |  |  | 
| 2265 | 3 |  |  |  |  | 8 | my $from = join ' | ', map {quotemeta} @quote{qw( start end alternate_start alternate_end)}; | 
|  | 12 |  |  |  |  | 18 |  | 
| 2266 | 3 |  |  |  |  | 4 | my %to; | 
| 2267 | 3 |  |  |  |  | 12 | @to{@quote{qw( start end alternate_start alternate_end)}} | 
| 2268 |  |  |  |  |  |  | = @quote{qw( alternate_start alternate_end start end)}; | 
| 2269 |  |  |  |  |  |  |  | 
| 2270 | 3 |  |  |  |  | 8 | my $outer = index($text, $quote{start}); | 
| 2271 | 3 |  |  |  |  | 3 | my $inner = index($text, $quote{alternate_start}); | 
| 2272 |  |  |  |  |  |  |  | 
| 2273 | 3 | 50 | 33 |  |  | 18 | if ($inner == -1 || ($outer > -1 && $inner > -1 && $outer < $inner)) { | 
|  |  |  | 33 |  |  |  |  | 
|  |  |  | 66 |  |  |  |  | 
| 2274 | 3 |  |  |  |  | 59 | $text =~ s{ ( $from ) }{ $to{$1} }msxeg; | 
|  | 6 |  |  |  |  | 15 |  | 
| 2275 |  |  |  |  |  |  | } | 
| 2276 |  |  |  |  |  |  |  | 
| 2277 | 3 |  |  |  |  | 15 | return "$quote{start}$text$quote{end}"; | 
| 2278 |  |  |  |  |  |  | } | 
| 2279 |  |  |  |  |  |  |  | 
| 2280 |  |  |  |  |  |  | =back | 
| 2281 |  |  |  |  |  |  |  | 
| 2282 |  |  |  |  |  |  | =head2 Miscellaneous | 
| 2283 |  |  |  |  |  |  |  | 
| 2284 |  |  |  |  |  |  | =over 4 | 
| 2285 |  |  |  |  |  |  |  | 
| 2286 |  |  |  |  |  |  | =item more_information() | 
| 2287 |  |  |  |  |  |  |  | 
| 2288 |  |  |  |  |  |  | The more information string is one that can be displayed | 
| 2289 |  |  |  |  |  |  | in an interface to indicate that more information is | 
| 2290 |  |  |  |  |  |  | available. | 
| 2291 |  |  |  |  |  |  |  | 
| 2292 |  |  |  |  |  |  | =cut | 
| 2293 |  |  |  |  |  |  |  | 
| 2294 |  |  |  |  |  |  | sub more_information { | 
| 2295 | 1 |  |  | 1 | 1 | 2 | my $self = shift; | 
| 2296 |  |  |  |  |  |  |  | 
| 2297 | 1 |  |  |  |  | 3 | my @bundles = $self->_find_bundle('more_information'); | 
| 2298 | 1 |  |  |  |  | 3 | foreach my $bundle (@bundles) { | 
| 2299 | 1 |  |  |  |  | 25 | my $info = $bundle->more_information; | 
| 2300 | 1 | 50 |  |  |  | 2 | next unless defined $info; | 
| 2301 | 1 |  |  |  |  | 4 | return $info; | 
| 2302 |  |  |  |  |  |  | } | 
| 2303 | 0 |  |  |  |  | 0 | return ''; | 
| 2304 |  |  |  |  |  |  | } | 
| 2305 |  |  |  |  |  |  |  | 
| 2306 |  |  |  |  |  |  |  | 
| 2307 |  |  |  |  |  |  | =item measurement() | 
| 2308 |  |  |  |  |  |  |  | 
| 2309 |  |  |  |  |  |  | Returns the measurement type for the locale | 
| 2310 |  |  |  |  |  |  |  | 
| 2311 |  |  |  |  |  |  | =cut | 
| 2312 |  |  |  |  |  |  |  | 
| 2313 |  |  |  |  |  |  | sub measurement { | 
| 2314 | 1 |  |  | 1 | 1 | 16 | my $self = shift; | 
| 2315 |  |  |  |  |  |  |  | 
| 2316 | 1 |  |  |  |  | 25 | my $measurement_data = $self->measurement_system; | 
| 2317 | 1 |  | 50 |  |  | 3 | my $territory = $self->territory_id || '001'; | 
| 2318 |  |  |  |  |  |  |  | 
| 2319 | 1 |  |  |  |  | 2 | my $data = $measurement_data->{$territory}; | 
| 2320 |  |  |  |  |  |  |  | 
| 2321 | 1 |  |  |  |  | 3 | until (defined $data) { | 
| 2322 | 0 |  |  |  |  | 0 | $territory = $self->territory_contained_by->{$territory}; | 
| 2323 | 0 |  |  |  |  | 0 | $data = $measurement_data->{$territory}; | 
| 2324 |  |  |  |  |  |  | } | 
| 2325 |  |  |  |  |  |  |  | 
| 2326 | 1 |  |  |  |  | 6 | return $data; | 
| 2327 |  |  |  |  |  |  | } | 
| 2328 |  |  |  |  |  |  |  | 
| 2329 |  |  |  |  |  |  | =item paper() | 
| 2330 |  |  |  |  |  |  |  | 
| 2331 |  |  |  |  |  |  | Returns the paper type for the locale | 
| 2332 |  |  |  |  |  |  |  | 
| 2333 |  |  |  |  |  |  | =cut | 
| 2334 |  |  |  |  |  |  |  | 
| 2335 |  |  |  |  |  |  | sub paper { | 
| 2336 | 1 |  |  | 1 | 1 | 1 | my $self = shift; | 
| 2337 |  |  |  |  |  |  |  | 
| 2338 | 1 |  |  |  |  | 32 | my $paper_size = $self->paper_size; | 
| 2339 | 1 |  | 50 |  |  | 4 | my $territory = $self->territory_id || '001'; | 
| 2340 |  |  |  |  |  |  |  | 
| 2341 | 1 |  |  |  |  | 3 | my $data = $paper_size->{$territory}; | 
| 2342 |  |  |  |  |  |  |  | 
| 2343 | 1 |  |  |  |  | 4 | until (defined $data) { | 
| 2344 | 0 |  |  |  |  | 0 | $territory = $self->territory_contained_by->{$territory}; | 
| 2345 | 0 |  |  |  |  | 0 | $data = $paper_size->{$territory}; | 
| 2346 |  |  |  |  |  |  | } | 
| 2347 |  |  |  |  |  |  |  | 
| 2348 | 1 |  |  |  |  | 3 | return $data; | 
| 2349 |  |  |  |  |  |  | } | 
| 2350 |  |  |  |  |  |  |  | 
| 2351 |  |  |  |  |  |  | =back | 
| 2352 |  |  |  |  |  |  |  | 
| 2353 |  |  |  |  |  |  | =head2 Units | 
| 2354 |  |  |  |  |  |  |  | 
| 2355 |  |  |  |  |  |  | =over 4 | 
| 2356 |  |  |  |  |  |  |  | 
| 2357 |  |  |  |  |  |  | =item all_units() | 
| 2358 |  |  |  |  |  |  |  | 
| 2359 |  |  |  |  |  |  | Returns a list of all the unit identifiers for the locale | 
| 2360 |  |  |  |  |  |  |  | 
| 2361 |  |  |  |  |  |  | =cut | 
| 2362 |  |  |  |  |  |  |  | 
| 2363 |  |  |  |  |  |  | sub all_units { | 
| 2364 | 0 |  |  | 0 | 1 | 0 | my $self = shift; | 
| 2365 | 0 |  |  |  |  | 0 | my @bundles = $self->_find_bundle('units'); | 
| 2366 |  |  |  |  |  |  |  | 
| 2367 | 0 |  |  |  |  | 0 | my %units; | 
| 2368 | 0 |  |  |  |  | 0 | foreach my $bundle (reverse @bundles) { | 
| 2369 | 0 |  |  |  |  | 0 | %units = %units, $bundle->units; | 
| 2370 |  |  |  |  |  |  | } | 
| 2371 |  |  |  |  |  |  |  | 
| 2372 | 0 |  |  |  |  | 0 | return keys %units; | 
| 2373 |  |  |  |  |  |  | } | 
| 2374 |  |  |  |  |  |  |  | 
| 2375 |  |  |  |  |  |  | =item unit($number, $unit, $width) | 
| 2376 |  |  |  |  |  |  |  | 
| 2377 |  |  |  |  |  |  | Returns the localised string for the given number and unit formatted for the | 
| 2378 |  |  |  |  |  |  | required width. The number must not be the localized version of the number. | 
| 2379 |  |  |  |  |  |  | The returned string will be in the locale's format, including the number. | 
| 2380 |  |  |  |  |  |  |  | 
| 2381 |  |  |  |  |  |  | =cut | 
| 2382 |  |  |  |  |  |  |  | 
| 2383 |  |  |  |  |  |  | sub unit { | 
| 2384 | 738 |  |  | 738 | 1 | 1379 | my ($self, $number, $what, $type) = @_; | 
| 2385 | 738 |  | 100 |  |  | 1931 | $type //= 'long'; | 
| 2386 |  |  |  |  |  |  |  | 
| 2387 | 738 |  |  |  |  | 1895 | my $plural = $self->plural($number); | 
| 2388 |  |  |  |  |  |  |  | 
| 2389 | 738 |  |  |  |  | 1519 | my @bundles = $self->_find_bundle('units'); | 
| 2390 | 738 |  |  |  |  | 716 | my $format; | 
| 2391 | 738 |  |  |  |  | 781 | foreach my $bundle (@bundles) { | 
| 2392 | 748 | 100 |  |  |  | 16944 | if (exists $bundle->units()->{$type}{$what}{$plural}) { | 
| 2393 | 728 |  |  |  |  | 15631 | $format = $bundle->units()->{$type}{$what}{$plural}; | 
| 2394 | 728 |  |  |  |  | 838 | last; | 
| 2395 |  |  |  |  |  |  | } | 
| 2396 |  |  |  |  |  |  |  | 
| 2397 | 20 | 50 |  |  |  | 421 | if (exists $bundle->units()->{$type}{$what}{other}) { | 
| 2398 | 0 |  |  |  |  | 0 | $format = $bundle->units()->{$type}{$what}{other}; | 
| 2399 | 0 |  |  |  |  | 0 | last; | 
| 2400 |  |  |  |  |  |  | } | 
| 2401 |  |  |  |  |  |  | } | 
| 2402 |  |  |  |  |  |  |  | 
| 2403 |  |  |  |  |  |  | # Check for aliases | 
| 2404 | 738 | 100 |  |  |  | 984 | unless ($format) { | 
| 2405 | 10 |  |  |  |  | 7 | my $original_type = $type; | 
| 2406 | 10 |  |  |  |  | 18 | my @aliases = $self->_find_bundle('unit_alias'); | 
| 2407 | 10 |  |  |  |  | 16 | foreach my $alias (@aliases) { | 
| 2408 | 10 |  |  |  |  | 233 | $type = $alias->unit_alias()->{$original_type}; | 
| 2409 | 10 | 100 |  |  |  | 16 | next unless $type; | 
| 2410 | 8 |  |  |  |  | 10 | foreach my $bundle (@bundles) { | 
| 2411 | 12 | 100 |  |  |  | 262 | if (exists $bundle->units()->{$type}{$what}{$plural}) { | 
| 2412 | 4 |  |  |  |  | 85 | $format = $bundle->units()->{$type}{$what}{$plural}; | 
| 2413 | 4 |  |  |  |  | 7 | last; | 
| 2414 |  |  |  |  |  |  | } | 
| 2415 |  |  |  |  |  |  |  | 
| 2416 | 8 | 50 |  |  |  | 172 | if (exists $bundle->units()->{$type}{$what}{other}) { | 
| 2417 | 0 |  |  |  |  | 0 | $format = $bundle->units()->{$type}{$what}{other}; | 
| 2418 | 0 |  |  |  |  | 0 | last; | 
| 2419 |  |  |  |  |  |  | } | 
| 2420 |  |  |  |  |  |  | } | 
| 2421 |  |  |  |  |  |  | } | 
| 2422 | 10 |  |  |  |  | 15 | $type = $original_type; | 
| 2423 |  |  |  |  |  |  | } | 
| 2424 |  |  |  |  |  |  |  | 
| 2425 |  |  |  |  |  |  | # Check for a compound unit that we don't specifically have | 
| 2426 | 738 | 100 | 66 |  |  | 1334 | if (! $format && (my ($dividend, $divisor) = $what =~ /^(.+)-per-(.+)$/)) { | 
| 2427 | 6 |  |  |  |  | 10 | return $self->_unit_compound($number, $dividend, $divisor, $type); | 
| 2428 |  |  |  |  |  |  | } | 
| 2429 |  |  |  |  |  |  |  | 
| 2430 | 732 |  |  |  |  | 1706 | $number = $self->format_number($number); | 
| 2431 | 732 | 50 |  |  |  | 1061 | return $number unless $format; | 
| 2432 |  |  |  |  |  |  |  | 
| 2433 | 732 |  |  |  |  | 1623 | $format =~ s/\{0\}/$number/g; | 
| 2434 |  |  |  |  |  |  |  | 
| 2435 | 732 |  |  |  |  | 3144 | return $format; | 
| 2436 |  |  |  |  |  |  | } | 
| 2437 |  |  |  |  |  |  |  | 
| 2438 |  |  |  |  |  |  | sub _unit_compound { | 
| 2439 | 6 |  |  | 6 |  | 7 | my ($self, $number, $dividend_what, $divisor_what, $type) = @_; | 
| 2440 |  |  |  |  |  |  |  | 
| 2441 | 6 |  | 50 |  |  | 12 | $type //= 'long'; | 
| 2442 |  |  |  |  |  |  |  | 
| 2443 | 6 |  |  |  |  | 10 | my $dividend = $self->unit($number, $dividend_what, $type); | 
| 2444 | 6 |  |  |  |  | 14 | my $divisor = $self->_unit_per($divisor_what, $type); | 
| 2445 | 6 | 50 |  |  |  | 10 | if ($divisor) { | 
| 2446 | 6 |  |  |  |  | 5 | my $format = $divisor; | 
| 2447 | 6 |  |  |  |  | 12 | $format =~ s/\{0\}/$dividend/; | 
| 2448 | 6 |  |  |  |  | 28 | return $format; | 
| 2449 |  |  |  |  |  |  | } | 
| 2450 |  |  |  |  |  |  |  | 
| 2451 | 0 |  |  |  |  | 0 | $divisor = $self->unit(1, $divisor_what, $type); | 
| 2452 |  |  |  |  |  |  |  | 
| 2453 | 0 |  |  |  |  | 0 | my $one = $self->format_number(1); | 
| 2454 | 0 |  |  |  |  | 0 | $divisor =~ s/\s*$one\s*//; | 
| 2455 |  |  |  |  |  |  |  | 
| 2456 | 0 |  |  |  |  | 0 | my @bundles = $self->_find_bundle('units'); | 
| 2457 | 0 |  |  |  |  | 0 | my $format; | 
| 2458 | 0 |  |  |  |  | 0 | foreach my $bundle (@bundles) { | 
| 2459 | 0 | 0 |  |  |  | 0 | if (exists $bundle->units()->{$type}{per}{''}) { | 
| 2460 | 0 |  |  |  |  | 0 | $format = $bundle->units()->{$type}{per}{''}; | 
| 2461 | 0 |  |  |  |  | 0 | last; | 
| 2462 |  |  |  |  |  |  | } | 
| 2463 |  |  |  |  |  |  | } | 
| 2464 |  |  |  |  |  |  |  | 
| 2465 |  |  |  |  |  |  | # Check for aliases | 
| 2466 | 0 | 0 |  |  |  | 0 | unless ($format) { | 
| 2467 | 0 |  |  |  |  | 0 | my $original_type = $type; | 
| 2468 | 0 |  |  |  |  | 0 | my @aliases = $self->_find_bundle('unit_alias'); | 
| 2469 | 0 |  |  |  |  | 0 | foreach my $alias (@aliases) { | 
| 2470 | 0 |  |  |  |  | 0 | $type = $alias->unit_alias()->{$original_type}; | 
| 2471 | 0 |  |  |  |  | 0 | foreach my $bundle (@bundles) { | 
| 2472 | 0 | 0 |  |  |  | 0 | if (exists $bundle->units()->{$type}{per}{1}) { | 
| 2473 | 0 |  |  |  |  | 0 | $format = $bundle->units()->{$type}{per}{1}; | 
| 2474 | 0 |  |  |  |  | 0 | last; | 
| 2475 |  |  |  |  |  |  | } | 
| 2476 |  |  |  |  |  |  | } | 
| 2477 |  |  |  |  |  |  | } | 
| 2478 |  |  |  |  |  |  | } | 
| 2479 |  |  |  |  |  |  |  | 
| 2480 | 0 |  |  |  |  | 0 | $format =~ s/\{0\}/$dividend/g; | 
| 2481 | 0 |  |  |  |  | 0 | $format =~ s/\{1\}/$divisor/g; | 
| 2482 |  |  |  |  |  |  |  | 
| 2483 | 0 |  |  |  |  | 0 | return $format; | 
| 2484 |  |  |  |  |  |  | } | 
| 2485 |  |  |  |  |  |  |  | 
| 2486 |  |  |  |  |  |  | =item unit_name($unit_identifier) | 
| 2487 |  |  |  |  |  |  |  | 
| 2488 |  |  |  |  |  |  | This method returns the localised name of the unit | 
| 2489 |  |  |  |  |  |  |  | 
| 2490 |  |  |  |  |  |  | =cut | 
| 2491 |  |  |  |  |  |  |  | 
| 2492 |  |  |  |  |  |  | sub unit_name { | 
| 2493 | 0 |  |  | 0 | 1 | 0 | my ($self, $what) = @_; | 
| 2494 |  |  |  |  |  |  |  | 
| 2495 | 0 |  |  |  |  | 0 | my @bundles = $self->_find_bundle('units'); | 
| 2496 | 0 |  |  |  |  | 0 | my $name; | 
| 2497 | 0 |  |  |  |  | 0 | foreach my $bundle (@bundles) { | 
| 2498 | 0 | 0 |  |  |  | 0 | if (exists $bundle->units()->{long}{$what}{name}) { | 
| 2499 | 0 |  |  |  |  | 0 | return $bundle->units()->{long}{$what}{name}; | 
| 2500 |  |  |  |  |  |  | } | 
| 2501 |  |  |  |  |  |  | } | 
| 2502 |  |  |  |  |  |  |  | 
| 2503 |  |  |  |  |  |  | # Check for aliases | 
| 2504 | 0 |  |  |  |  | 0 | my $type = 'long'; | 
| 2505 | 0 |  |  |  |  | 0 | my @aliases = $self->_find_bundle('unit_alias'); | 
| 2506 | 0 |  |  |  |  | 0 | foreach my $alias (@aliases) { | 
| 2507 | 0 |  |  |  |  | 0 | $type = $alias->unit_alias()->{$type}; | 
| 2508 | 0 | 0 |  |  |  | 0 | next unless $type; | 
| 2509 | 0 |  |  |  |  | 0 | foreach my $bundle (@bundles) { | 
| 2510 | 0 | 0 |  |  |  | 0 | if (exists $bundle->units()->{$type}{$what}{name}) { | 
| 2511 | 0 |  |  |  |  | 0 | return $bundle->units()->{$type}{$what}{name}; | 
| 2512 |  |  |  |  |  |  | } | 
| 2513 |  |  |  |  |  |  | } | 
| 2514 |  |  |  |  |  |  | } | 
| 2515 |  |  |  |  |  |  |  | 
| 2516 | 0 |  |  |  |  | 0 | return ''; | 
| 2517 |  |  |  |  |  |  | } | 
| 2518 |  |  |  |  |  |  |  | 
| 2519 |  |  |  |  |  |  | sub _unit_per { | 
| 2520 | 6 |  |  | 6 |  | 6 | my ($self, $what, $type) = @_; | 
| 2521 |  |  |  |  |  |  |  | 
| 2522 | 6 |  |  |  |  | 12 | my @bundles = $self->_find_bundle('units'); | 
| 2523 | 6 |  |  |  |  | 7 | my $name; | 
| 2524 | 6 |  |  |  |  | 7 | foreach my $bundle (@bundles) { | 
| 2525 | 6 | 50 |  |  |  | 160 | if (exists $bundle->units()->{$type}{$what}{per}) { | 
| 2526 | 6 |  |  |  |  | 128 | return $bundle->units()->{$type}{$what}{per}; | 
| 2527 |  |  |  |  |  |  | } | 
| 2528 |  |  |  |  |  |  | } | 
| 2529 |  |  |  |  |  |  |  | 
| 2530 |  |  |  |  |  |  | # Check for aliases | 
| 2531 | 0 |  |  |  |  | 0 | my @aliases = $self->_find_bundle('unit_alias'); | 
| 2532 | 0 |  |  |  |  | 0 | foreach my $alias (@aliases) { | 
| 2533 | 0 |  |  |  |  | 0 | $type = $alias->unit_alias()->{$type}; | 
| 2534 | 0 | 0 |  |  |  | 0 | next unless $type; | 
| 2535 | 0 |  |  |  |  | 0 | foreach my $bundle (@bundles) { | 
| 2536 | 0 | 0 |  |  |  | 0 | if (exists $bundle->units()->{$type}{$what}{per}) { | 
| 2537 | 0 |  |  |  |  | 0 | return $bundle->units()->{$type}{$what}{per}; | 
| 2538 |  |  |  |  |  |  | } | 
| 2539 |  |  |  |  |  |  | } | 
| 2540 |  |  |  |  |  |  | } | 
| 2541 |  |  |  |  |  |  |  | 
| 2542 | 0 |  |  |  |  | 0 | return ''; | 
| 2543 |  |  |  |  |  |  | } | 
| 2544 |  |  |  |  |  |  |  | 
| 2545 |  |  |  |  |  |  | sub _get_time_separator { | 
| 2546 | 12 |  |  | 12 |  | 16 | my $self = shift; | 
| 2547 |  |  |  |  |  |  |  | 
| 2548 | 12 |  |  |  |  | 25 | my @number_symbols_bundles = $self->_find_bundle('number_symbols'); | 
| 2549 | 12 |  |  |  |  | 53 | my $symbols_type = $self->default_numbering_system; | 
| 2550 |  |  |  |  |  |  |  | 
| 2551 | 12 |  |  |  |  | 26 | foreach my $bundle (@number_symbols_bundles) { | 
| 2552 | 24 | 50 |  |  |  | 565 | if (exists $bundle->number_symbols()->{$symbols_type}{alias}) { | 
| 2553 | 0 |  |  |  |  | 0 | $symbols_type = $bundle->number_symbols()->{$symbols_type}{alias}; | 
| 2554 | 0 |  |  |  |  | 0 | redo; | 
| 2555 |  |  |  |  |  |  | } | 
| 2556 |  |  |  |  |  |  |  | 
| 2557 | 24 | 100 |  |  |  | 510 | return $bundle->number_symbols()->{$symbols_type}{timeSeparator} | 
| 2558 |  |  |  |  |  |  | if exists $bundle->number_symbols()->{$symbols_type}{timeSeparator}; | 
| 2559 |  |  |  |  |  |  | } | 
| 2560 | 0 |  |  |  |  | 0 | return ':'; | 
| 2561 |  |  |  |  |  |  | } | 
| 2562 |  |  |  |  |  |  |  | 
| 2563 |  |  |  |  |  |  | =item duration_unit($format, @data) | 
| 2564 |  |  |  |  |  |  |  | 
| 2565 |  |  |  |  |  |  | This method formats a duration. The format must be one of | 
| 2566 |  |  |  |  |  |  | C<hm>, C<hms> or C<ms> corresponding to C<hour minute>, | 
| 2567 |  |  |  |  |  |  | C<hour minute second> and C<minute second> respectively. | 
| 2568 |  |  |  |  |  |  | The data must correspond to the given format. | 
| 2569 |  |  |  |  |  |  |  | 
| 2570 |  |  |  |  |  |  | =cut | 
| 2571 |  |  |  |  |  |  |  | 
| 2572 |  |  |  |  |  |  | sub duration_unit { | 
| 2573 |  |  |  |  |  |  | # data in hh,mm; hh,mm,ss or mm,ss | 
| 2574 | 3 |  |  | 3 | 1 | 7 | my ($self, $format, @data) = @_; | 
| 2575 |  |  |  |  |  |  |  | 
| 2576 | 3 |  |  |  |  | 7 | my $bundle = $self->_find_bundle('duration_units'); | 
| 2577 | 3 |  |  |  |  | 73 | my $parsed = $bundle->duration_units()->{$format}; | 
| 2578 |  |  |  |  |  |  |  | 
| 2579 | 3 |  |  |  |  | 5 | my $num_format = '#'; | 
| 2580 | 3 |  |  |  |  | 15 | foreach my $entry ( qr/(hh?)/, qr/(mm?)/, qr/(ss?)/) { | 
| 2581 | 9 | 100 |  |  |  | 40 | $num_format = '00' if $parsed =~ s/$entry/$self->format_number(shift(@data), $num_format)/e; | 
|  | 7 |  |  |  |  | 21 |  | 
| 2582 |  |  |  |  |  |  | } | 
| 2583 |  |  |  |  |  |  |  | 
| 2584 | 3 |  |  |  |  | 14 | my $time_separator = $self->_get_time_separator; | 
| 2585 |  |  |  |  |  |  |  | 
| 2586 | 3 |  |  |  |  | 11 | $parsed =~ s/:/$time_separator/g; | 
| 2587 |  |  |  |  |  |  |  | 
| 2588 | 3 |  |  |  |  | 14 | return $parsed; | 
| 2589 |  |  |  |  |  |  | } | 
| 2590 |  |  |  |  |  |  |  | 
| 2591 |  |  |  |  |  |  | =back | 
| 2592 |  |  |  |  |  |  |  | 
| 2593 |  |  |  |  |  |  | =head2 Yes or No? | 
| 2594 |  |  |  |  |  |  |  | 
| 2595 |  |  |  |  |  |  | =over 4 | 
| 2596 |  |  |  |  |  |  |  | 
| 2597 |  |  |  |  |  |  | =item is_yes($string) | 
| 2598 |  |  |  |  |  |  |  | 
| 2599 |  |  |  |  |  |  | Returns true if the passed in string matches the locale's | 
| 2600 |  |  |  |  |  |  | idea of a string designating yes. Note that under POSIX | 
| 2601 |  |  |  |  |  |  | rules unless the locale's word for yes starts with C<Y> | 
| 2602 |  |  |  |  |  |  | (U+0079) then a single 'y' will also be accepted as yes. | 
| 2603 |  |  |  |  |  |  | The string will be matched case insensitive. | 
| 2604 |  |  |  |  |  |  |  | 
| 2605 |  |  |  |  |  |  | =cut | 
| 2606 |  |  |  |  |  |  |  | 
| 2607 |  |  |  |  |  |  | sub is_yes { | 
| 2608 | 2 |  |  | 2 | 1 | 4 | my ($self, $test_str) = @_; | 
| 2609 |  |  |  |  |  |  |  | 
| 2610 | 2 |  |  |  |  | 6 | my $bundle = $self->_find_bundle('yesstr'); | 
| 2611 | 2 | 100 |  |  |  | 50 | return $test_str =~ $bundle->yesstr ? 1 : 0; | 
| 2612 |  |  |  |  |  |  | } | 
| 2613 |  |  |  |  |  |  |  | 
| 2614 |  |  |  |  |  |  | =item is_no($string) | 
| 2615 |  |  |  |  |  |  |  | 
| 2616 |  |  |  |  |  |  | Returns true if the passed in string matches the locale's | 
| 2617 |  |  |  |  |  |  | idea of a string designating no. Note that under POSIX | 
| 2618 |  |  |  |  |  |  | rules unless the locale's word for no starts with C<n> | 
| 2619 |  |  |  |  |  |  | (U+006E) then a single 'n' will also be accepted as no | 
| 2620 |  |  |  |  |  |  | The string will be matched case insensitive. | 
| 2621 |  |  |  |  |  |  |  | 
| 2622 |  |  |  |  |  |  | =cut | 
| 2623 |  |  |  |  |  |  |  | 
| 2624 |  |  |  |  |  |  | sub is_no { | 
| 2625 | 2 |  |  | 2 | 1 | 4 | my ($self, $test_str) = @_; | 
| 2626 |  |  |  |  |  |  |  | 
| 2627 | 2 |  |  |  |  | 6 | my $bundle = $self->_find_bundle('nostr'); | 
| 2628 | 2 | 100 |  |  |  | 50 | return $test_str =~ $bundle->nostr ? 1 : 0; | 
| 2629 |  |  |  |  |  |  | } | 
| 2630 |  |  |  |  |  |  |  | 
| 2631 |  |  |  |  |  |  | =back | 
| 2632 |  |  |  |  |  |  |  | 
| 2633 |  |  |  |  |  |  | =head2 Transliteration | 
| 2634 |  |  |  |  |  |  |  | 
| 2635 |  |  |  |  |  |  | This method requires Perl version 5.18 or above to use and for you to have | 
| 2636 |  |  |  |  |  |  | installed the optional C<Bundle::CLDR::Transformations> | 
| 2637 |  |  |  |  |  |  |  | 
| 2638 |  |  |  |  |  |  | =over 4 | 
| 2639 |  |  |  |  |  |  |  | 
| 2640 |  |  |  |  |  |  | =item transform(from => $from, to => $to, variant => $variant, text => $text) | 
| 2641 |  |  |  |  |  |  |  | 
| 2642 |  |  |  |  |  |  | This method returns the transliterated string of C<text> from script C<from> | 
| 2643 |  |  |  |  |  |  | to script C<to> using variant C<variant>. If C<from> is not given then the | 
| 2644 |  |  |  |  |  |  | current locale's script is used. If C<text> is not given then it defaults to an | 
| 2645 |  |  |  |  |  |  | empty string. The C<variant> is optional. | 
| 2646 |  |  |  |  |  |  |  | 
| 2647 |  |  |  |  |  |  | =cut | 
| 2648 |  |  |  |  |  |  |  | 
| 2649 |  |  |  |  |  |  | sub transform { | 
| 2650 | 0 |  |  | 0 | 1 | 0 | _new_perl(); | 
| 2651 |  |  |  |  |  |  |  | 
| 2652 | 0 |  |  |  |  | 0 | my ($self, %params) = @_; | 
| 2653 |  |  |  |  |  |  |  | 
| 2654 | 0 |  | 0 |  |  | 0 | my $from 	= $params{from} // $self; | 
| 2655 | 0 |  |  |  |  | 0 | my $to 		= $params{to}; | 
| 2656 | 0 |  | 0 |  |  | 0 | my $variant	= $params{variant} // 'Any'; | 
| 2657 | 0 |  | 0 |  |  | 0 | my $text	= $params{text} // ''; | 
| 2658 |  |  |  |  |  |  |  | 
| 2659 | 0 | 0 |  |  |  | 0 | ($from, $to) = map {ref $_ ? $_->likely_script() : $_} ($from, $to); | 
|  | 0 |  |  |  |  | 0 |  | 
| 2660 | 0 |  |  |  |  | 0 | $_ = ucfirst(lc $_) foreach ($from, $to, $variant); | 
| 2661 |  |  |  |  |  |  |  | 
| 2662 | 0 |  |  |  |  | 0 | my $package = __PACKAGE__ . "::Transformations::${variant}::${from}::${to}"; | 
| 2663 | 0 |  |  |  |  | 0 | eval { Class::Load::load_class($package); }; | 
|  | 0 |  |  |  |  | 0 |  | 
| 2664 | 0 | 0 |  |  |  | 0 | warn $@ if $@; | 
| 2665 | 0 | 0 |  |  |  | 0 | return $text if $@; # Can't load transform module so return original text | 
| 2666 | 20 |  |  | 20 |  | 139 | use feature 'state'; | 
|  | 20 |  |  |  |  | 27 |  | 
|  | 20 |  |  |  |  | 118099 |  | 
| 2667 | 0 |  |  |  |  | 0 | state $transforms; | 
| 2668 | 0 |  | 0 |  |  | 0 | $transforms->{$variant}{$from}{$to} //= $package->new(); | 
| 2669 | 0 |  |  |  |  | 0 | my $rules = $transforms->{$variant}{$from}{$to}->transforms(); | 
| 2670 |  |  |  |  |  |  |  | 
| 2671 |  |  |  |  |  |  | # First get the filter rule | 
| 2672 | 0 |  |  |  |  | 0 | my $filter = $rules->[0]; | 
| 2673 |  |  |  |  |  |  |  | 
| 2674 |  |  |  |  |  |  | # Break up the input on the filter | 
| 2675 | 0 |  |  |  |  | 0 | my @text; | 
| 2676 | 0 |  |  |  |  | 0 | pos($text) = 0; | 
| 2677 | 0 |  |  |  |  | 0 | while (pos($text) < length($text)) { | 
| 2678 | 0 |  |  |  |  | 0 | my $characters = ''; | 
| 2679 | 0 |  |  |  |  | 0 | while (my ($char) = $text =~ /($filter)/) { | 
| 2680 | 0 |  |  |  |  | 0 | $characters .= $char; | 
| 2681 | 0 |  |  |  |  | 0 | pos($text) = pos($text) + length $char; | 
| 2682 |  |  |  |  |  |  | } | 
| 2683 | 0 |  |  |  |  | 0 | push @text, $characters; | 
| 2684 | 0 | 0 |  |  |  | 0 | last unless pos($text) < length $text; | 
| 2685 |  |  |  |  |  |  |  | 
| 2686 | 0 |  |  |  |  | 0 | $characters = ''; | 
| 2687 | 0 |  |  |  |  | 0 | while ($text !~ /$filter/) { | 
| 2688 | 0 |  |  |  |  | 0 | my ($char) = $text =~ /\G(\X)/; | 
| 2689 | 0 |  |  |  |  | 0 | $characters .= $char; | 
| 2690 | 0 |  |  |  |  | 0 | pos($text) = pos($text) + length $char; | 
| 2691 |  |  |  |  |  |  | } | 
| 2692 | 0 |  |  |  |  | 0 | push @text, $characters; | 
| 2693 |  |  |  |  |  |  | } | 
| 2694 |  |  |  |  |  |  |  | 
| 2695 | 0 |  |  |  |  | 0 | my $to_transform = 1; | 
| 2696 |  |  |  |  |  |  |  | 
| 2697 | 0 |  |  |  |  | 0 | foreach my $characters (@text) { | 
| 2698 | 0 | 0 |  |  |  | 0 | if ($to_transform) { | 
| 2699 | 0 |  |  |  |  | 0 | foreach my $rule (@$rules[1 .. @$rules -1 ]) { | 
| 2700 | 0 | 0 |  |  |  | 0 | if ($rule->{type} eq 'transform') { | 
| 2701 | 0 |  |  |  |  | 0 | $characters = $self->_transformation_transform($characters, $rule->{data}, $variant); | 
| 2702 |  |  |  |  |  |  | } | 
| 2703 |  |  |  |  |  |  | else { | 
| 2704 | 0 |  |  |  |  | 0 | $characters = $self->_transform_convert($characters, $rule->{data}); | 
| 2705 |  |  |  |  |  |  | } | 
| 2706 |  |  |  |  |  |  | } | 
| 2707 |  |  |  |  |  |  | } | 
| 2708 | 0 |  |  |  |  | 0 | $to_transform = ! $to_transform; | 
| 2709 |  |  |  |  |  |  | } | 
| 2710 |  |  |  |  |  |  |  | 
| 2711 | 0 |  |  |  |  | 0 | return join '', @text; | 
| 2712 |  |  |  |  |  |  | } | 
| 2713 |  |  |  |  |  |  |  | 
| 2714 |  |  |  |  |  |  | sub _transformation_transform { | 
| 2715 | 0 |  |  | 0 |  | 0 | my ($self, $text, $rules, $variant) = @_; | 
| 2716 |  |  |  |  |  |  |  | 
| 2717 | 0 |  |  |  |  | 0 | foreach my $rule (@$rules) { | 
| 2718 | 0 |  |  |  |  | 0 | for (lc $rule->{to}) { | 
| 2719 | 0 | 0 |  |  |  | 0 | if ($_ eq 'nfc') { | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 2720 | 0 |  |  |  |  | 0 | $text = Unicode::Normalize::NFC($text); | 
| 2721 |  |  |  |  |  |  | } | 
| 2722 |  |  |  |  |  |  | elsif($_ eq 'nfd') { | 
| 2723 | 0 |  |  |  |  | 0 | $text = Unicode::Normalize::NFD($text); | 
| 2724 |  |  |  |  |  |  | } | 
| 2725 |  |  |  |  |  |  | elsif($_ eq 'nfkd') { | 
| 2726 | 0 |  |  |  |  | 0 | $text = Unicode::Normalize::NFKD($text); | 
| 2727 |  |  |  |  |  |  | } | 
| 2728 |  |  |  |  |  |  | elsif($_ eq 'nfkc') { | 
| 2729 | 0 |  |  |  |  | 0 | $text = Unicode::Normalize::NFKC($text); | 
| 2730 |  |  |  |  |  |  | } | 
| 2731 |  |  |  |  |  |  | elsif($_ eq 'lower') { | 
| 2732 | 0 |  |  |  |  | 0 | $text = lc($text); | 
| 2733 |  |  |  |  |  |  | } | 
| 2734 |  |  |  |  |  |  | elsif($_ eq 'upper') { | 
| 2735 | 0 |  |  |  |  | 0 | $text = uc($text); | 
| 2736 |  |  |  |  |  |  | } | 
| 2737 |  |  |  |  |  |  | elsif($_ eq 'title') { | 
| 2738 | 0 |  |  |  |  | 0 | $text =~ s/(\X)/\u$1/g; | 
| 2739 |  |  |  |  |  |  | } | 
| 2740 |  |  |  |  |  |  | elsif($_ eq 'null') { | 
| 2741 |  |  |  |  |  |  | } | 
| 2742 |  |  |  |  |  |  | elsif($_ eq 'remove') { | 
| 2743 | 0 |  |  |  |  | 0 | $text = ''; | 
| 2744 |  |  |  |  |  |  | } | 
| 2745 |  |  |  |  |  |  | else { | 
| 2746 | 0 |  |  |  |  | 0 | $text = $self->transform($text, $variant, $rule->{from}, $rule->to); | 
| 2747 |  |  |  |  |  |  | } | 
| 2748 |  |  |  |  |  |  | } | 
| 2749 |  |  |  |  |  |  | } | 
| 2750 | 0 |  |  |  |  | 0 | return $text; | 
| 2751 |  |  |  |  |  |  | } | 
| 2752 |  |  |  |  |  |  |  | 
| 2753 |  |  |  |  |  |  | sub _transform_convert { | 
| 2754 | 0 |  |  | 0 |  | 0 | my ($self, $text, $rules) = @_; | 
| 2755 |  |  |  |  |  |  |  | 
| 2756 | 0 |  |  |  |  | 0 | pos($text) = 0; # Make sure we start scanning at the beginning of the text | 
| 2757 |  |  |  |  |  |  |  | 
| 2758 | 0 |  |  |  |  | 0 | CHARACTER: while (pos($text) < length($text)) { | 
| 2759 | 0 |  |  |  |  | 0 | foreach my $rule (@$rules) { | 
| 2760 | 0 | 0 | 0 |  |  | 0 | next if length $rule->{before} && $text !~ /$rule->{before}\G/; | 
| 2761 | 0 |  |  |  |  | 0 | my $regex = $rule->{replace}; | 
| 2762 | 0 | 0 |  |  |  | 0 | $regex .= '(' . $rule->{after} . ')' if length $rule->{after}; | 
| 2763 | 0 |  |  |  |  | 0 | my $result = 'q(' . $rule->{result} . ')'; | 
| 2764 | 0 | 0 |  |  |  | 0 | $result .= '. $1' if length $rule->{after}; | 
| 2765 | 0 | 0 |  |  |  | 0 | if ($text =~ s/\G$regex/eval $result/e) { | 
|  | 0 |  |  |  |  | 0 |  | 
| 2766 | 0 |  |  |  |  | 0 | pos($text) += length($rule->{result}) - $rule->{revisit}; | 
| 2767 | 0 |  |  |  |  | 0 | next CHARACTER; | 
| 2768 |  |  |  |  |  |  | } | 
| 2769 |  |  |  |  |  |  | } | 
| 2770 |  |  |  |  |  |  |  | 
| 2771 | 0 |  |  |  |  | 0 | pos($text)++; | 
| 2772 |  |  |  |  |  |  | } | 
| 2773 |  |  |  |  |  |  |  | 
| 2774 | 0 |  |  |  |  | 0 | return $text; | 
| 2775 |  |  |  |  |  |  | } | 
| 2776 |  |  |  |  |  |  |  | 
| 2777 |  |  |  |  |  |  | =back | 
| 2778 |  |  |  |  |  |  |  | 
| 2779 |  |  |  |  |  |  | =head2 Lists | 
| 2780 |  |  |  |  |  |  |  | 
| 2781 |  |  |  |  |  |  | =over 4 | 
| 2782 |  |  |  |  |  |  |  | 
| 2783 |  |  |  |  |  |  | =item list(@data) | 
| 2784 |  |  |  |  |  |  |  | 
| 2785 |  |  |  |  |  |  | Returns C<data> as a string formatted by the locales idea of producing a list | 
| 2786 |  |  |  |  |  |  | of elements. What is returned can be effected by the locale and the number | 
| 2787 |  |  |  |  |  |  | of items in C<data>. Note that C<data> can contain 0 or more items. | 
| 2788 |  |  |  |  |  |  |  | 
| 2789 |  |  |  |  |  |  | =cut | 
| 2790 |  |  |  |  |  |  |  | 
| 2791 |  |  |  |  |  |  | sub list { | 
| 2792 | 5 |  |  | 5 | 1 | 29 | my ($self, @data) = @_; | 
| 2793 |  |  |  |  |  |  |  | 
| 2794 |  |  |  |  |  |  | # Short circuit on 0 or 1 entries | 
| 2795 | 5 | 100 |  |  |  | 16 | return '' unless @data; | 
| 2796 | 4 | 100 |  |  |  | 9 | return $data[0] if 1 == @data; | 
| 2797 |  |  |  |  |  |  |  | 
| 2798 | 3 |  |  |  |  | 10 | my @bundles = $self->_find_bundle('listPatterns'); | 
| 2799 |  |  |  |  |  |  |  | 
| 2800 | 3 |  |  |  |  | 4 | my %list_data; | 
| 2801 | 3 |  |  |  |  | 4 | foreach my $bundle (reverse @bundles) { | 
| 2802 | 6 |  |  |  |  | 4 | my %listPatterns = %{$bundle->listPatterns}; | 
|  | 6 |  |  |  |  | 148 |  | 
| 2803 | 6 |  |  |  |  | 23 | @list_data{keys %listPatterns} = values %listPatterns; | 
| 2804 |  |  |  |  |  |  | } | 
| 2805 |  |  |  |  |  |  |  | 
| 2806 | 3 | 100 |  |  |  | 9 | if (my $pattern = $list_data{scalar @data}) { | 
| 2807 | 1 |  |  |  |  | 6 | $pattern=~s/\{([0-9]+)\}/$data[$1]/eg; | 
|  | 2 |  |  |  |  | 7 |  | 
| 2808 | 1 |  |  |  |  | 10 | return $pattern; | 
| 2809 |  |  |  |  |  |  | } | 
| 2810 |  |  |  |  |  |  |  | 
| 2811 | 2 |  |  |  |  | 4 | my ($start, $middle, $end) = @list_data{qw( start middle end )}; | 
| 2812 |  |  |  |  |  |  |  | 
| 2813 |  |  |  |  |  |  | # First do the end | 
| 2814 | 2 |  |  |  |  | 3 | my $pattern = $end; | 
| 2815 | 2 |  |  |  |  | 5 | $pattern=~s/\{1\}/pop @data/e; | 
|  | 2 |  |  |  |  | 4 |  | 
| 2816 | 2 |  |  |  |  | 5 | $pattern=~s/\{0\}/pop @data/e; | 
|  | 2 |  |  |  |  | 3 |  | 
| 2817 |  |  |  |  |  |  |  | 
| 2818 |  |  |  |  |  |  | # If there is any data left do the middle | 
| 2819 | 2 |  |  |  |  | 4 | while (@data > 1) { | 
| 2820 | 1 |  |  |  |  | 2 | my $current = $pattern; | 
| 2821 | 1 |  |  |  |  | 1 | $pattern = $middle; | 
| 2822 | 1 |  |  |  |  | 3 | $pattern=~s/\{1\}/$current/; | 
| 2823 | 1 |  |  |  |  | 2 | $pattern=~s/\{0\}/pop @data/e; | 
|  | 1 |  |  |  |  | 3 |  | 
| 2824 |  |  |  |  |  |  | } | 
| 2825 |  |  |  |  |  |  |  | 
| 2826 |  |  |  |  |  |  | # Now do the start | 
| 2827 | 2 |  |  |  |  | 3 | my $current = $pattern; | 
| 2828 | 2 |  |  |  |  | 3 | $pattern = $start; | 
| 2829 | 2 |  |  |  |  | 4 | $pattern=~s/\{1\}/$current/; | 
| 2830 | 2 |  |  |  |  | 4 | $pattern=~s/\{0\}/pop @data/e; | 
|  | 2 |  |  |  |  | 3 |  | 
| 2831 |  |  |  |  |  |  |  | 
| 2832 | 2 |  |  |  |  | 9 | return $pattern; | 
| 2833 |  |  |  |  |  |  | } | 
| 2834 |  |  |  |  |  |  |  | 
| 2835 |  |  |  |  |  |  | =back | 
| 2836 |  |  |  |  |  |  |  | 
| 2837 |  |  |  |  |  |  | =head2 Pluralisation | 
| 2838 |  |  |  |  |  |  |  | 
| 2839 |  |  |  |  |  |  | =over 4 | 
| 2840 |  |  |  |  |  |  |  | 
| 2841 |  |  |  |  |  |  | =item plural($number) | 
| 2842 |  |  |  |  |  |  |  | 
| 2843 |  |  |  |  |  |  | This method takes a number and uses the locale's pluralisation | 
| 2844 |  |  |  |  |  |  | rules to calculate the type of pluralisation required for | 
| 2845 |  |  |  |  |  |  | units, currencies and other data that changes depending on | 
| 2846 |  |  |  |  |  |  | the plural state of the number | 
| 2847 |  |  |  |  |  |  |  | 
| 2848 |  |  |  |  |  |  | =item plural_range($start, $end) | 
| 2849 |  |  |  |  |  |  |  | 
| 2850 |  |  |  |  |  |  | This method returns the plural type for the range $start to $end | 
| 2851 |  |  |  |  |  |  | $start and $end can either be numbers or one of the plural types | 
| 2852 |  |  |  |  |  |  | C<zero one two few many other> | 
| 2853 |  |  |  |  |  |  |  | 
| 2854 |  |  |  |  |  |  | =cut | 
| 2855 |  |  |  |  |  |  |  | 
| 2856 |  |  |  |  |  |  | sub _clear_calendar_data { | 
| 2857 | 0 |  |  | 0 |  | 0 | my $self = shift; | 
| 2858 |  |  |  |  |  |  |  | 
| 2859 | 0 |  |  |  |  | 0 | foreach my $property (qw( | 
| 2860 |  |  |  |  |  |  | month_format_wide month_format_abbreviated month_format_narrow | 
| 2861 |  |  |  |  |  |  | month_stand_alone_wide month_stand_alone_abbreviated | 
| 2862 |  |  |  |  |  |  | month_stand_alone_narrow day_format_wide day_format_abbreviated | 
| 2863 |  |  |  |  |  |  | day_format_narrow day_stand_alone_wide day_stand_alone_abreviated | 
| 2864 |  |  |  |  |  |  | day_stand_alone_narrow quater_format_wide quater_format_abbreviated | 
| 2865 |  |  |  |  |  |  | quater_format_narrow quater_stand_alone_wide | 
| 2866 |  |  |  |  |  |  | quater_stand_alone_abreviated quater_stand_alone_narrow | 
| 2867 |  |  |  |  |  |  | am_pm_wide am_pm_abbreviated am_pm_narrow am_pm_format_wide | 
| 2868 |  |  |  |  |  |  | am_pm_format_abbreviated am_pm_format_narrow am_pm_stand_alone_wide | 
| 2869 |  |  |  |  |  |  | am_pm_stand_alone_abbreviated am_pm_stand_alone_narrow era_wide | 
| 2870 |  |  |  |  |  |  | era_abbreviated era_narrow date_format_full date_format_long date_format_medium | 
| 2871 |  |  |  |  |  |  | date_format_short time_format_full | 
| 2872 |  |  |  |  |  |  | time_format_long time_format_medium time_format_short | 
| 2873 |  |  |  |  |  |  | datetime_format_full datetime_format_long | 
| 2874 |  |  |  |  |  |  | datetime_format_medium datetime_format_short | 
| 2875 |  |  |  |  |  |  | available_formats format_data | 
| 2876 |  |  |  |  |  |  | )) { | 
| 2877 | 0 |  |  |  |  | 0 | my $method = "_clear_$property"; | 
| 2878 | 0 |  |  |  |  | 0 | $self->$method; | 
| 2879 |  |  |  |  |  |  | } | 
| 2880 |  |  |  |  |  |  | } | 
| 2881 |  |  |  |  |  |  |  | 
| 2882 |  |  |  |  |  |  | sub _build_any_month { | 
| 2883 | 8 |  |  | 8 |  | 15 | my ($self, $type, $width) = @_; | 
| 2884 | 8 |  |  |  |  | 52 | my $default_calendar = $self->default_calendar(); | 
| 2885 | 8 |  |  |  |  | 35 | my @bundles = $self->_find_bundle('calendar_months'); | 
| 2886 |  |  |  |  |  |  | BUNDLES: { | 
| 2887 | 8 |  |  |  |  | 15 | foreach my $bundle (@bundles) { | 
|  | 12 |  |  |  |  | 18 |  | 
| 2888 | 16 |  |  |  |  | 471 | my $months = $bundle->calendar_months; | 
| 2889 | 16 | 50 |  |  |  | 46 | if (exists $months->{$default_calendar}{alias}) { | 
| 2890 | 0 |  |  |  |  | 0 | $default_calendar = $months->{$default_calendar}{alias}; | 
| 2891 | 0 |  |  |  |  | 0 | redo BUNDLES; | 
| 2892 |  |  |  |  |  |  | } | 
| 2893 |  |  |  |  |  |  |  | 
| 2894 | 16 | 100 |  |  |  | 60 | if (exists $months->{$default_calendar}{$type}{$width}{alias}) { | 
| 2895 | 4 |  |  |  |  | 7 | ($type, $width) = @{$months->{$default_calendar}{$type}{$width}{alias}}{qw(context type)}; | 
|  | 4 |  |  |  |  | 21 |  | 
| 2896 | 4 |  |  |  |  | 15 | redo BUNDLES; | 
| 2897 |  |  |  |  |  |  | } | 
| 2898 |  |  |  |  |  |  |  | 
| 2899 | 12 |  |  |  |  | 25 | my $result = $months->{$default_calendar}{$type}{$width}{nonleap}; | 
| 2900 | 12 | 100 |  |  |  | 224 | return $result if defined $result; | 
| 2901 |  |  |  |  |  |  | } | 
| 2902 | 0 | 0 |  |  |  | 0 | if ($default_calendar ne 'gregorian') { | 
| 2903 | 0 |  |  |  |  | 0 | $default_calendar = 'gregorian'; | 
| 2904 | 0 |  |  |  |  | 0 | redo BUNDLES; | 
| 2905 |  |  |  |  |  |  | } | 
| 2906 |  |  |  |  |  |  | } | 
| 2907 | 0 |  |  |  |  | 0 | return []; | 
| 2908 |  |  |  |  |  |  | } | 
| 2909 |  |  |  |  |  |  |  | 
| 2910 |  |  |  |  |  |  | sub _build_month_format_wide { | 
| 2911 | 2 |  |  | 2 |  | 4 | my $self = shift; | 
| 2912 | 2 |  |  |  |  | 5 | my ($type, $width) = (qw(format wide)); | 
| 2913 |  |  |  |  |  |  |  | 
| 2914 | 2 |  |  |  |  | 8 | return $self->_build_any_month($type, $width); | 
| 2915 |  |  |  |  |  |  | } | 
| 2916 |  |  |  |  |  |  |  | 
| 2917 |  |  |  |  |  |  | sub _build_month_format_abbreviated { | 
| 2918 | 1 |  |  | 1 |  | 3 | my $self = shift; | 
| 2919 | 1 |  |  |  |  | 3 | my ($type, $width) = (qw(format abbreviated)); | 
| 2920 |  |  |  |  |  |  |  | 
| 2921 | 1 |  |  |  |  | 12 | return $self->_build_any_month($type, $width); | 
| 2922 |  |  |  |  |  |  | } | 
| 2923 |  |  |  |  |  |  |  | 
| 2924 |  |  |  |  |  |  | sub _build_month_format_narrow { | 
| 2925 | 1 |  |  | 1 |  | 2 | my $self = shift; | 
| 2926 | 1 |  |  |  |  | 3 | my ($type, $width) = (qw(format narrow)); | 
| 2927 |  |  |  |  |  |  |  | 
| 2928 | 1 |  |  |  |  | 4 | return $self->_build_any_month($type, $width); | 
| 2929 |  |  |  |  |  |  | } | 
| 2930 |  |  |  |  |  |  |  | 
| 2931 |  |  |  |  |  |  | sub _build_month_stand_alone_wide { | 
| 2932 | 1 |  |  | 1 |  | 14 | my $self = shift; | 
| 2933 | 1 |  |  |  |  | 4 | my ($type, $width) = ('stand-alone', 'wide'); | 
| 2934 |  |  |  |  |  |  |  | 
| 2935 | 1 |  |  |  |  | 5 | return $self->_build_any_month($type, $width); | 
| 2936 |  |  |  |  |  |  | } | 
| 2937 |  |  |  |  |  |  |  | 
| 2938 |  |  |  |  |  |  | sub _build_month_stand_alone_abbreviated { | 
| 2939 | 2 |  |  | 2 |  | 5 | my $self = shift; | 
| 2940 | 2 |  |  |  |  | 6 | my ($type, $width) = ('stand-alone', 'abbreviated'); | 
| 2941 |  |  |  |  |  |  |  | 
| 2942 | 2 |  |  |  |  | 9 | return $self->_build_any_month($type, $width); | 
| 2943 |  |  |  |  |  |  | } | 
| 2944 |  |  |  |  |  |  |  | 
| 2945 |  |  |  |  |  |  | sub _build_month_stand_alone_narrow { | 
| 2946 | 1 |  |  | 1 |  | 2 | my $self = shift; | 
| 2947 | 1 |  |  |  |  | 5 | my ($type, $width) = ('stand-alone', 'narrow'); | 
| 2948 |  |  |  |  |  |  |  | 
| 2949 | 1 |  |  |  |  | 3 | return $self->_build_any_month($type, $width); | 
| 2950 |  |  |  |  |  |  | } | 
| 2951 |  |  |  |  |  |  |  | 
| 2952 |  |  |  |  |  |  | sub _build_any_day { | 
| 2953 | 7 |  |  | 7 |  | 13 | my ($self, $type, $width) = @_; | 
| 2954 |  |  |  |  |  |  |  | 
| 2955 | 7 |  |  |  |  | 37 | my $default_calendar = $self->default_calendar(); | 
| 2956 |  |  |  |  |  |  |  | 
| 2957 | 7 |  |  |  |  | 30 | my @bundles = $self->_find_bundle('calendar_days'); | 
| 2958 |  |  |  |  |  |  | BUNDLES: { | 
| 2959 | 7 |  |  |  |  | 12 | foreach my $bundle (@bundles) { | 
|  | 10 |  |  |  |  | 17 |  | 
| 2960 | 13 |  |  |  |  | 398 | my $days= $bundle->calendar_days; | 
| 2961 |  |  |  |  |  |  |  | 
| 2962 | 13 | 50 |  |  |  | 38 | if (exists $days->{$default_calendar}{alias}) { | 
| 2963 | 0 |  |  |  |  | 0 | $default_calendar = $days->{$default_calendar}{alias}; | 
| 2964 | 0 |  |  |  |  | 0 | redo BUNDLES; | 
| 2965 |  |  |  |  |  |  | } | 
| 2966 |  |  |  |  |  |  |  | 
| 2967 | 13 | 100 |  |  |  | 55 | if (exists $days->{$default_calendar}{$type}{$width}{alias}) { | 
| 2968 | 3 |  |  |  |  | 6 | ($type, $width) = @{$days->{$default_calendar}{$type}{$width}{alias}}{qw(context type)}; | 
|  | 3 |  |  |  |  | 15 |  | 
| 2969 | 3 |  |  |  |  | 9 | redo BUNDLES; | 
| 2970 |  |  |  |  |  |  | } | 
| 2971 | 10 |  |  |  |  | 19 | my $result = $days->{$default_calendar}{$type}{$width}; | 
| 2972 | 10 | 100 |  |  |  | 26 | return [ @{$result}{qw( mon tue wed thu fri sat sun )} ] if keys %$result; | 
|  | 7 |  |  |  |  | 210 |  | 
| 2973 |  |  |  |  |  |  | } | 
| 2974 | 0 | 0 |  |  |  | 0 | if ($default_calendar ne 'gregorian') { | 
| 2975 | 0 |  |  |  |  | 0 | $default_calendar = 'gregorian'; | 
| 2976 | 0 |  |  |  |  | 0 | redo BUNDLES; | 
| 2977 |  |  |  |  |  |  | } | 
| 2978 |  |  |  |  |  |  | } | 
| 2979 |  |  |  |  |  |  |  | 
| 2980 | 0 |  |  |  |  | 0 | return []; | 
| 2981 |  |  |  |  |  |  | } | 
| 2982 |  |  |  |  |  |  |  | 
| 2983 |  |  |  |  |  |  | sub _build_day_format_wide { | 
| 2984 | 2 |  |  | 2 |  | 3 | my $self = shift; | 
| 2985 | 2 |  |  |  |  | 5 | my ($type, $width) = (qw(format wide)); | 
| 2986 |  |  |  |  |  |  |  | 
| 2987 | 2 |  |  |  |  | 9 | return $self->_build_any_day($type, $width); | 
| 2988 |  |  |  |  |  |  | } | 
| 2989 |  |  |  |  |  |  |  | 
| 2990 |  |  |  |  |  |  | sub _build_day_format_abbreviated { | 
| 2991 | 1 |  |  | 1 |  | 1 | my $self = shift; | 
| 2992 | 1 |  |  |  |  | 3 | my ($type, $width) = (qw(format abbreviated)); | 
| 2993 |  |  |  |  |  |  |  | 
| 2994 | 1 |  |  |  |  | 4 | return $self->_build_any_day($type, $width); | 
| 2995 |  |  |  |  |  |  | } | 
| 2996 |  |  |  |  |  |  |  | 
| 2997 |  |  |  |  |  |  | sub _build_day_format_narrow { | 
| 2998 | 1 |  |  | 1 |  | 2 | my $self = shift; | 
| 2999 | 1 |  |  |  |  | 4 | my ($type, $width) = (qw(format narrow)); | 
| 3000 |  |  |  |  |  |  |  | 
| 3001 | 1 |  |  |  |  | 3 | return $self->_build_any_day($type, $width); | 
| 3002 |  |  |  |  |  |  | } | 
| 3003 |  |  |  |  |  |  |  | 
| 3004 |  |  |  |  |  |  | sub _build_day_stand_alone_wide { | 
| 3005 | 1 |  |  | 1 |  | 2 | my $self = shift; | 
| 3006 | 1 |  |  |  |  | 4 | my ($type, $width) = ('stand-alone', 'wide'); | 
| 3007 |  |  |  |  |  |  |  | 
| 3008 | 1 |  |  |  |  | 5 | return $self->_build_any_day($type, $width); | 
| 3009 |  |  |  |  |  |  | } | 
| 3010 |  |  |  |  |  |  |  | 
| 3011 |  |  |  |  |  |  | sub _build_day_stand_alone_abbreviated { | 
| 3012 | 1 |  |  | 1 |  | 3 | my $self = shift; | 
| 3013 | 1 |  |  |  |  | 4 | my ($type, $width) = ('stand-alone', 'abbreviated'); | 
| 3014 |  |  |  |  |  |  |  | 
| 3015 | 1 |  |  |  |  | 5 | return $self->_build_any_day($type, $width); | 
| 3016 |  |  |  |  |  |  | } | 
| 3017 |  |  |  |  |  |  |  | 
| 3018 |  |  |  |  |  |  | sub _build_day_stand_alone_narrow { | 
| 3019 | 1 |  |  | 1 |  | 3 | my $self = shift; | 
| 3020 | 1 |  |  |  |  | 3 | my ($type, $width) = ('stand-alone', 'narrow'); | 
| 3021 |  |  |  |  |  |  |  | 
| 3022 | 1 |  |  |  |  | 4 | return $self->_build_any_day($type, $width); | 
| 3023 |  |  |  |  |  |  | } | 
| 3024 |  |  |  |  |  |  |  | 
| 3025 |  |  |  |  |  |  | sub _build_any_quarter { | 
| 3026 | 6 |  |  | 6 |  | 7 | my ($self, $type, $width) = @_; | 
| 3027 |  |  |  |  |  |  |  | 
| 3028 | 6 |  |  |  |  | 20 | my $default_calendar = $self->default_calendar(); | 
| 3029 |  |  |  |  |  |  |  | 
| 3030 | 6 |  |  |  |  | 20 | my @bundles = $self->_find_bundle('calendar_quarters'); | 
| 3031 |  |  |  |  |  |  | BUNDLES: { | 
| 3032 | 6 |  |  |  |  | 5 | foreach my $bundle (@bundles) { | 
|  | 9 |  |  |  |  | 12 |  | 
| 3033 | 12 |  |  |  |  | 273 | my $quarters= $bundle->calendar_quarters; | 
| 3034 |  |  |  |  |  |  |  | 
| 3035 | 12 | 50 |  |  |  | 25 | if (exists $quarters->{$default_calendar}{alias}) { | 
| 3036 | 0 |  |  |  |  | 0 | $default_calendar = $quarters->{$default_calendar}{alias}; | 
| 3037 | 0 |  |  |  |  | 0 | redo BUNDLES; | 
| 3038 |  |  |  |  |  |  | } | 
| 3039 |  |  |  |  |  |  |  | 
| 3040 | 12 | 100 |  |  |  | 31 | if (exists $quarters->{$default_calendar}{$type}{$width}{alias}) { | 
| 3041 | 3 |  |  |  |  | 4 | ($type, $width) = @{$quarters->{$default_calendar}{$type}{$width}{alias}}{qw(context type)}; | 
|  | 3 |  |  |  |  | 9 |  | 
| 3042 | 3 |  |  |  |  | 7 | redo BUNDLES; | 
| 3043 |  |  |  |  |  |  | } | 
| 3044 |  |  |  |  |  |  |  | 
| 3045 | 9 |  |  |  |  | 10 | my $result = $quarters->{$default_calendar}{$type}{$width}; | 
| 3046 | 9 | 100 |  |  |  | 19 | return [ @{$result}{qw( 0 1 2 3 )} ] if keys %$result; | 
|  | 6 |  |  |  |  | 144 |  | 
| 3047 |  |  |  |  |  |  | } | 
| 3048 | 0 | 0 |  |  |  | 0 | if ($default_calendar ne 'gregorian') { | 
| 3049 | 0 |  |  |  |  | 0 | $default_calendar = 'gregorian'; | 
| 3050 | 0 |  |  |  |  | 0 | redo BUNDLES; | 
| 3051 |  |  |  |  |  |  | } | 
| 3052 |  |  |  |  |  |  | } | 
| 3053 |  |  |  |  |  |  |  | 
| 3054 | 0 |  |  |  |  | 0 | return []; | 
| 3055 |  |  |  |  |  |  | } | 
| 3056 |  |  |  |  |  |  |  | 
| 3057 |  |  |  |  |  |  | sub _build_quarter_format_wide { | 
| 3058 | 1 |  |  | 1 |  | 2 | my $self = shift; | 
| 3059 | 1 |  |  |  |  | 4 | my ($type, $width) = (qw( format wide )); | 
| 3060 |  |  |  |  |  |  |  | 
| 3061 | 1 |  |  |  |  | 5 | return $self->_build_any_quarter($type, $width); | 
| 3062 |  |  |  |  |  |  | } | 
| 3063 |  |  |  |  |  |  |  | 
| 3064 |  |  |  |  |  |  | sub _build_quarter_format_abbreviated { | 
| 3065 | 1 |  |  | 1 |  | 2 | my $self = shift; | 
| 3066 | 1 |  |  |  |  | 2 | my ($type, $width) = (qw(format abbreviated)); | 
| 3067 |  |  |  |  |  |  |  | 
| 3068 | 1 |  |  |  |  | 6 | return $self->_build_any_quarter($type, $width); | 
| 3069 |  |  |  |  |  |  | } | 
| 3070 |  |  |  |  |  |  |  | 
| 3071 |  |  |  |  |  |  | sub _build_quarter_format_narrow { | 
| 3072 | 1 |  |  | 1 |  | 2 | my $self = shift; | 
| 3073 | 1 |  |  |  |  | 3 | my ($type, $width) = (qw(format narrow)); | 
| 3074 |  |  |  |  |  |  |  | 
| 3075 | 1 |  |  |  |  | 3 | return $self->_build_any_quarter($type, $width); | 
| 3076 |  |  |  |  |  |  | } | 
| 3077 |  |  |  |  |  |  |  | 
| 3078 |  |  |  |  |  |  | sub _build_quarter_stand_alone_wide { | 
| 3079 | 1 |  |  | 1 |  | 2 | my $self = shift; | 
| 3080 | 1 |  |  |  |  | 2 | my ($type, $width) = ('stand-alone', 'wide'); | 
| 3081 |  |  |  |  |  |  |  | 
| 3082 | 1 |  |  |  |  | 4 | return $self->_build_any_quarter($type, $width); | 
| 3083 |  |  |  |  |  |  | } | 
| 3084 |  |  |  |  |  |  |  | 
| 3085 |  |  |  |  |  |  | sub _build_quarter_stand_alone_abbreviated { | 
| 3086 | 1 |  |  | 1 |  | 1 | my $self = shift; | 
| 3087 | 1 |  |  |  |  | 3 | my ($type, $width) = ('stand-alone', 'abbreviated'); | 
| 3088 |  |  |  |  |  |  |  | 
| 3089 | 1 |  |  |  |  | 3 | return $self->_build_any_quarter($type, $width); | 
| 3090 |  |  |  |  |  |  | } | 
| 3091 |  |  |  |  |  |  |  | 
| 3092 |  |  |  |  |  |  | sub _build_quarter_stand_alone_narrow { | 
| 3093 | 1 |  |  | 1 |  | 2 | my $self = shift; | 
| 3094 | 1 |  |  |  |  | 2 | my ($type, $width) = ('stand-alone', 'narrow'); | 
| 3095 |  |  |  |  |  |  |  | 
| 3096 | 1 |  |  |  |  | 4 | return $self->_build_any_quarter($type, $width); | 
| 3097 |  |  |  |  |  |  | } | 
| 3098 |  |  |  |  |  |  |  | 
| 3099 |  |  |  |  |  |  | sub get_day_period { | 
| 3100 |  |  |  |  |  |  | # Time in hhmm | 
| 3101 | 3 |  |  | 3 | 1 | 1245 | my ($self, $time, $type) = @_; | 
| 3102 | 3 |  | 50 |  |  | 12 | $type //= 'default'; | 
| 3103 |  |  |  |  |  |  |  | 
| 3104 | 3 |  |  |  |  | 11 | my $default_calendar = $self->default_calendar(); | 
| 3105 |  |  |  |  |  |  |  | 
| 3106 | 3 |  |  |  |  | 11 | my $bundle = $self->_find_bundle('day_period_data'); | 
| 3107 |  |  |  |  |  |  |  | 
| 3108 | 3 |  |  |  |  | 74 | my $day_period = $bundle->day_period_data; | 
| 3109 | 3 |  |  |  |  | 8 | $day_period = $self->$day_period($default_calendar, $time, $type); | 
| 3110 |  |  |  |  |  |  |  | 
| 3111 | 3 |  |  |  |  | 70 | my $am_pm = $self->am_pm_format_abbreviated; | 
| 3112 |  |  |  |  |  |  |  | 
| 3113 | 3 |  |  |  |  | 12 | return $am_pm->{$day_period}; | 
| 3114 |  |  |  |  |  |  | } | 
| 3115 |  |  |  |  |  |  |  | 
| 3116 |  |  |  |  |  |  | sub _build_any_am_pm { | 
| 3117 | 10 |  |  | 10 |  | 13 | my ($self, $type, $width) = @_; | 
| 3118 |  |  |  |  |  |  |  | 
| 3119 | 10 |  |  |  |  | 37 | my $default_calendar = $self->default_calendar(); | 
| 3120 | 10 |  |  |  |  | 14 | my @result; | 
| 3121 | 10 |  |  |  |  | 24 | my @bundles = $self->_find_bundle('day_periods'); | 
| 3122 | 10 |  |  |  |  | 15 | my %return; | 
| 3123 |  |  |  |  |  |  |  | 
| 3124 |  |  |  |  |  |  | BUNDLES: { | 
| 3125 | 10 |  |  |  |  | 11 | foreach my $bundle (@bundles) { | 
|  | 17 |  |  |  |  | 21 |  | 
| 3126 | 34 |  |  |  |  | 811 | my $am_pm = $bundle->day_periods; | 
| 3127 |  |  |  |  |  |  |  | 
| 3128 | 34 | 50 |  |  |  | 62 | if (exists $am_pm->{$default_calendar}{alias}) { | 
| 3129 | 0 |  |  |  |  | 0 | $default_calendar = $am_pm->{$default_calendar}{alias}; | 
| 3130 | 0 |  |  |  |  | 0 | redo BUNDLES; | 
| 3131 |  |  |  |  |  |  | } | 
| 3132 |  |  |  |  |  |  |  | 
| 3133 | 34 | 100 |  |  |  | 62 | if (exists $am_pm->{$default_calendar}{$type}{alias}) { | 
| 3134 | 3 |  |  |  |  | 8 | $type = $am_pm->{$default_calendar}{$type}{alias}; | 
| 3135 | 3 |  |  |  |  | 7 | redo BUNDLES; | 
| 3136 |  |  |  |  |  |  | } | 
| 3137 |  |  |  |  |  |  |  | 
| 3138 | 31 | 100 |  |  |  | 56 | if (exists $am_pm->{$default_calendar}{$type}{$width}{alias}) { | 
| 3139 | 4 |  |  |  |  | 12 | $width = $am_pm->{$default_calendar}{$type}{$width}{alias}; | 
| 3140 | 4 |  |  |  |  | 10 | redo BUNDLES; | 
| 3141 |  |  |  |  |  |  | } | 
| 3142 |  |  |  |  |  |  |  | 
| 3143 | 27 |  |  |  |  | 30 | my $result = $am_pm->{$default_calendar}{$type}{$width}; | 
| 3144 |  |  |  |  |  |  |  | 
| 3145 | 27 |  |  |  |  | 52 | foreach (keys %$result) { | 
| 3146 | 60 | 100 |  |  |  | 120 | $return{$_} = $result->{$_} unless exists $return{$_}; | 
| 3147 |  |  |  |  |  |  | } | 
| 3148 |  |  |  |  |  |  | } | 
| 3149 |  |  |  |  |  |  | } | 
| 3150 |  |  |  |  |  |  |  | 
| 3151 | 10 |  |  |  |  | 140 | return \%return; | 
| 3152 |  |  |  |  |  |  | } | 
| 3153 |  |  |  |  |  |  |  | 
| 3154 |  |  |  |  |  |  | # The first 3 are to link in with Date::Time::Locale | 
| 3155 |  |  |  |  |  |  | sub _build_am_pm_wide { | 
| 3156 | 1 |  |  | 1 |  | 2 | my $self = shift; | 
| 3157 | 1 |  |  |  |  | 3 | my ($type, $width) = (qw( format wide )); | 
| 3158 |  |  |  |  |  |  |  | 
| 3159 | 1 |  |  |  |  | 3 | my $result = $self->_build_any_am_pm($type, $width); | 
| 3160 |  |  |  |  |  |  |  | 
| 3161 | 1 |  |  |  |  | 29 | return [ @$result{qw( am pm )} ]; | 
| 3162 |  |  |  |  |  |  | } | 
| 3163 |  |  |  |  |  |  |  | 
| 3164 |  |  |  |  |  |  | sub _build_am_pm_abbreviated { | 
| 3165 | 2 |  |  | 2 |  | 4 | my $self = shift; | 
| 3166 | 2 |  |  |  |  | 5 | my ($type, $width) = (qw( format abbreviated )); | 
| 3167 |  |  |  |  |  |  |  | 
| 3168 | 2 |  |  |  |  | 9 | my $result = $self->_build_any_am_pm($type, $width); | 
| 3169 |  |  |  |  |  |  |  | 
| 3170 | 2 |  |  |  |  | 49 | return [ @$result{qw( am pm )} ]; | 
| 3171 |  |  |  |  |  |  | } | 
| 3172 |  |  |  |  |  |  |  | 
| 3173 |  |  |  |  |  |  | sub _build_am_pm_narrow { | 
| 3174 | 1 |  |  | 1 |  | 2 | my $self = shift; | 
| 3175 | 1 |  |  |  |  | 2 | my ($type, $width) = (qw( format narrow )); | 
| 3176 |  |  |  |  |  |  |  | 
| 3177 | 1 |  |  |  |  | 3 | my $result = $self->_build_any_am_pm($type, $width); | 
| 3178 |  |  |  |  |  |  |  | 
| 3179 | 1 |  |  |  |  | 24 | return [ @$result{qw( am pm )} ]; | 
| 3180 |  |  |  |  |  |  | } | 
| 3181 |  |  |  |  |  |  |  | 
| 3182 |  |  |  |  |  |  | # Now we do the full set of data | 
| 3183 |  |  |  |  |  |  | sub _build_am_pm_format_wide { | 
| 3184 | 1 |  |  | 1 |  | 2 | my $self = shift; | 
| 3185 | 1 |  |  |  |  | 2 | my ($type, $width) = (qw( format wide )); | 
| 3186 |  |  |  |  |  |  |  | 
| 3187 | 1 |  |  |  |  | 6 | return $self->_build_any_am_pm($type, $width); | 
| 3188 |  |  |  |  |  |  | } | 
| 3189 |  |  |  |  |  |  |  | 
| 3190 |  |  |  |  |  |  | sub _build_am_pm_format_abbreviated { | 
| 3191 | 1 |  |  | 1 |  | 2 | my $self = shift; | 
| 3192 | 1 |  |  |  |  | 2 | my ($type, $width) = (qw( format abbreviated )); | 
| 3193 |  |  |  |  |  |  |  | 
| 3194 | 1 |  |  |  |  | 3 | return $self->_build_any_am_pm($type, $width); | 
| 3195 |  |  |  |  |  |  | } | 
| 3196 |  |  |  |  |  |  |  | 
| 3197 |  |  |  |  |  |  | sub _build_am_pm_format_narrow { | 
| 3198 | 1 |  |  | 1 |  | 2 | my $self = shift; | 
| 3199 | 1 |  |  |  |  | 2 | my ($type, $width) = (qw( format narrow )); | 
| 3200 |  |  |  |  |  |  |  | 
| 3201 | 1 |  |  |  |  | 11 | return $self->_build_any_am_pm($type, $width); | 
| 3202 |  |  |  |  |  |  | } | 
| 3203 |  |  |  |  |  |  |  | 
| 3204 |  |  |  |  |  |  | sub _build_am_pm_stand_alone_wide { | 
| 3205 | 1 |  |  | 1 |  | 2 | my $self = shift; | 
| 3206 | 1 |  |  |  |  | 2 | my ($type, $width) = ('stand-alone', 'wide'); | 
| 3207 |  |  |  |  |  |  |  | 
| 3208 | 1 |  |  |  |  | 3 | return $self->_build_any_am_pm($type, $width); | 
| 3209 |  |  |  |  |  |  | } | 
| 3210 |  |  |  |  |  |  |  | 
| 3211 |  |  |  |  |  |  | sub _build_am_pm_stand_alone_abbreviated { | 
| 3212 | 1 |  |  | 1 |  | 2 | my $self = shift; | 
| 3213 | 1 |  |  |  |  | 2 | my ($type, $width) = ('stand-alone', 'abbreviated'); | 
| 3214 |  |  |  |  |  |  |  | 
| 3215 | 1 |  |  |  |  | 8 | return $self->_build_any_am_pm($type, $width); | 
| 3216 |  |  |  |  |  |  | } | 
| 3217 |  |  |  |  |  |  |  | 
| 3218 |  |  |  |  |  |  | sub _build_am_pm_stand_alone_narrow { | 
| 3219 | 1 |  |  | 1 |  | 2 | my $self = shift; | 
| 3220 | 1 |  |  |  |  | 2 | my ($type, $width) = ('stand-alone', 'narrow'); | 
| 3221 |  |  |  |  |  |  |  | 
| 3222 | 1 |  |  |  |  | 3 | return $self->_build_any_am_pm($type, $width); | 
| 3223 |  |  |  |  |  |  | } | 
| 3224 |  |  |  |  |  |  |  | 
| 3225 |  |  |  |  |  |  | sub _build_any_era { | 
| 3226 | 9 |  |  | 9 |  | 16 | my ($self, $width) = @_; | 
| 3227 |  |  |  |  |  |  |  | 
| 3228 | 9 |  |  |  |  | 37 | my $default_calendar = $self->default_calendar(); | 
| 3229 | 9 |  |  |  |  | 20 | my @bundles = $self->_find_bundle('eras'); | 
| 3230 |  |  |  |  |  |  | BUNDLES: { | 
| 3231 | 9 |  |  |  |  | 8 | foreach my $bundle (@bundles) { | 
|  | 9 |  |  |  |  | 12 |  | 
| 3232 | 9 |  |  |  |  | 232 | my $eras = $bundle->eras; | 
| 3233 |  |  |  |  |  |  |  | 
| 3234 | 9 | 50 |  |  |  | 23 | if (exists $eras->{$default_calendar}{alias}) { | 
| 3235 | 0 |  |  |  |  | 0 | $default_calendar = $eras->{$default_calendar}{alias}; | 
| 3236 | 0 |  |  |  |  | 0 | redo BUNDLES; | 
| 3237 |  |  |  |  |  |  | } | 
| 3238 |  |  |  |  |  |  |  | 
| 3239 | 9 | 50 |  |  |  | 20 | if (exists $eras->{$default_calendar}{$width}{alias}) { | 
| 3240 | 0 |  |  |  |  | 0 | $width = $eras->{$default_calendar}{$width}{alias}; | 
| 3241 | 0 |  |  |  |  | 0 | redo BUNDLES; | 
| 3242 |  |  |  |  |  |  | } | 
| 3243 |  |  |  |  |  |  |  | 
| 3244 | 9 |  |  |  |  | 8 | my $result = $eras->{$default_calendar}{$width}; | 
| 3245 |  |  |  |  |  |  |  | 
| 3246 | 9 |  |  |  |  | 10 | my @result; | 
| 3247 | 9 |  |  |  |  | 42 | @result[keys %$result] = values %$result; | 
| 3248 |  |  |  |  |  |  |  | 
| 3249 | 9 | 50 |  |  |  | 158 | return \@result if keys %$result; | 
| 3250 |  |  |  |  |  |  | } | 
| 3251 | 0 | 0 |  |  |  | 0 | if ($default_calendar ne 'gregorian') { | 
| 3252 | 0 |  |  |  |  | 0 | $default_calendar = 'gregorian'; | 
| 3253 | 0 |  |  |  |  | 0 | redo BUNDLES; | 
| 3254 |  |  |  |  |  |  | } | 
| 3255 |  |  |  |  |  |  | } | 
| 3256 |  |  |  |  |  |  |  | 
| 3257 | 0 |  |  |  |  | 0 | return []; | 
| 3258 |  |  |  |  |  |  | } | 
| 3259 |  |  |  |  |  |  |  | 
| 3260 |  |  |  |  |  |  | # The next three are for DateDime::Locale | 
| 3261 |  |  |  |  |  |  | sub _build_era_wide { | 
| 3262 | 1 |  |  | 1 |  | 2 | my $self = shift; | 
| 3263 | 1 |  |  |  |  | 3 | my ($width) = (qw( wide )); | 
| 3264 |  |  |  |  |  |  |  | 
| 3265 | 1 |  |  |  |  | 4 | my $result = $self->_build_any_era($width); | 
| 3266 |  |  |  |  |  |  |  | 
| 3267 | 1 |  |  |  |  | 28 | return [@$result[0, 1]]; | 
| 3268 |  |  |  |  |  |  | } | 
| 3269 |  |  |  |  |  |  |  | 
| 3270 |  |  |  |  |  |  | sub _build_era_abbreviated { | 
| 3271 | 1 |  |  | 1 |  | 2 | my $self = shift; | 
| 3272 | 1 |  |  |  |  | 2 | my ($width) = (qw( abbreviated )); | 
| 3273 |  |  |  |  |  |  |  | 
| 3274 | 1 |  |  |  |  | 4 | my $result = $self->_build_any_era($width); | 
| 3275 |  |  |  |  |  |  |  | 
| 3276 | 1 |  |  |  |  | 23 | return [@$result[0, 1]]; | 
| 3277 |  |  |  |  |  |  | } | 
| 3278 |  |  |  |  |  |  |  | 
| 3279 |  |  |  |  |  |  | sub _build_era_narrow { | 
| 3280 | 1 |  |  | 1 |  | 2 | my $self = shift; | 
| 3281 | 1 |  |  |  |  | 3 | my ($width) = (qw( narrow )); | 
| 3282 |  |  |  |  |  |  |  | 
| 3283 | 1 |  |  |  |  | 2 | my $result = $self->_build_any_era($width); | 
| 3284 |  |  |  |  |  |  |  | 
| 3285 | 1 |  |  |  |  | 22 | return [@$result[0, 1]]; | 
| 3286 |  |  |  |  |  |  | } | 
| 3287 |  |  |  |  |  |  |  | 
| 3288 |  |  |  |  |  |  | # Now get all the era data | 
| 3289 |  |  |  |  |  |  | sub _build_era_format_wide { | 
| 3290 | 2 |  |  | 2 |  | 5 | my $self = shift; | 
| 3291 | 2 |  |  |  |  | 4 | my ($width) = (qw( wide )); | 
| 3292 |  |  |  |  |  |  |  | 
| 3293 | 2 |  |  |  |  | 5 | return $self->_build_any_era($width); | 
| 3294 |  |  |  |  |  |  | } | 
| 3295 |  |  |  |  |  |  |  | 
| 3296 |  |  |  |  |  |  | sub _build_era_format_abbreviated { | 
| 3297 | 2 |  |  | 2 |  | 4 | my $self = shift; | 
| 3298 | 2 |  |  |  |  | 3 | my ($width) = (qw( abbreviated )); | 
| 3299 |  |  |  |  |  |  |  | 
| 3300 | 2 |  |  |  |  | 6 | return $self->_build_any_era($width); | 
| 3301 |  |  |  |  |  |  | } | 
| 3302 |  |  |  |  |  |  |  | 
| 3303 |  |  |  |  |  |  | sub _build_era_format_narrow { | 
| 3304 | 2 |  |  | 2 |  | 3 | my $self = shift; | 
| 3305 | 2 |  |  |  |  | 4 | my ($type, $width) = (qw( narrow )); | 
| 3306 |  |  |  |  |  |  |  | 
| 3307 | 2 |  |  |  |  | 6 | return $self->_build_any_era($type, $width); | 
| 3308 |  |  |  |  |  |  | } | 
| 3309 |  |  |  |  |  |  |  | 
| 3310 |  |  |  |  |  |  | *_build_era_stand_alone_wide = \&_build_era_format_wide; | 
| 3311 |  |  |  |  |  |  | *_build_era_stand_alone_abbreviated = \&_build_era_format_abbreviated; | 
| 3312 |  |  |  |  |  |  | *_build_era_stand_alone_narrow = \&_build_era_format_narrow; | 
| 3313 |  |  |  |  |  |  |  | 
| 3314 |  |  |  |  |  |  | sub _build_any_date_format { | 
| 3315 | 9 |  |  | 9 |  | 17 | my ($self, $width) = @_; | 
| 3316 | 9 |  |  |  |  | 33 | my $default_calendar = $self->default_calendar(); | 
| 3317 |  |  |  |  |  |  |  | 
| 3318 | 9 |  |  |  |  | 23 | my @bundles = $self->_find_bundle('date_formats'); | 
| 3319 |  |  |  |  |  |  |  | 
| 3320 |  |  |  |  |  |  | BUNDLES: { | 
| 3321 | 9 |  |  |  |  | 13 | foreach my $bundle (@bundles) { | 
|  | 9 |  |  |  |  | 16 |  | 
| 3322 | 9 |  |  |  |  | 208 | my $date_formats = $bundle->date_formats; | 
| 3323 | 9 | 50 |  |  |  | 22 | if (exists $date_formats->{alias}) { | 
| 3324 | 0 |  |  |  |  | 0 | $default_calendar = $date_formats->{alias}; | 
| 3325 | 0 |  |  |  |  | 0 | redo BUNDLES; | 
| 3326 |  |  |  |  |  |  | } | 
| 3327 |  |  |  |  |  |  |  | 
| 3328 | 9 |  |  |  |  | 19 | my $result = $date_formats->{$default_calendar}{$width}; | 
| 3329 | 9 | 50 |  |  |  | 116 | return $result if $result; | 
| 3330 |  |  |  |  |  |  | } | 
| 3331 | 0 | 0 |  |  |  | 0 | if ($default_calendar ne 'gregorian') { | 
| 3332 | 0 |  |  |  |  | 0 | $default_calendar = 'gregorian'; | 
| 3333 | 0 |  |  |  |  | 0 | redo BUNDLES; | 
| 3334 |  |  |  |  |  |  | } | 
| 3335 |  |  |  |  |  |  | } | 
| 3336 |  |  |  |  |  |  |  | 
| 3337 | 0 |  |  |  |  | 0 | return ''; | 
| 3338 |  |  |  |  |  |  | } | 
| 3339 |  |  |  |  |  |  |  | 
| 3340 |  |  |  |  |  |  | sub _build_date_format_full { | 
| 3341 | 1 |  |  | 1 |  | 2 | my $self = shift; | 
| 3342 |  |  |  |  |  |  |  | 
| 3343 | 1 |  |  |  |  | 3 | my ($width) = ('full'); | 
| 3344 | 1 |  |  |  |  | 4 | return $self->_build_any_date_format($width); | 
| 3345 |  |  |  |  |  |  | } | 
| 3346 |  |  |  |  |  |  |  | 
| 3347 |  |  |  |  |  |  | sub _build_date_format_long { | 
| 3348 | 1 |  |  | 1 |  | 2 | my $self = shift; | 
| 3349 |  |  |  |  |  |  |  | 
| 3350 | 1 |  |  |  |  | 2 | my ($width) = ('long'); | 
| 3351 | 1 |  |  |  |  | 3 | return $self->_build_any_date_format($width); | 
| 3352 |  |  |  |  |  |  | } | 
| 3353 |  |  |  |  |  |  |  | 
| 3354 |  |  |  |  |  |  | sub _build_date_format_medium { | 
| 3355 | 1 |  |  | 1 |  | 2 | my $self = shift; | 
| 3356 |  |  |  |  |  |  |  | 
| 3357 | 1 |  |  |  |  | 3 | my ($width) = ('medium'); | 
| 3358 | 1 |  |  |  |  | 3 | return $self->_build_any_date_format($width); | 
| 3359 |  |  |  |  |  |  | } | 
| 3360 |  |  |  |  |  |  |  | 
| 3361 |  |  |  |  |  |  | sub _build_date_format_short { | 
| 3362 | 1 |  |  | 1 |  | 2 | my $self = shift; | 
| 3363 |  |  |  |  |  |  |  | 
| 3364 | 1 |  |  |  |  | 3 | my ($width) = ('short'); | 
| 3365 | 1 |  |  |  |  | 2 | return $self->_build_any_date_format($width); | 
| 3366 |  |  |  |  |  |  | } | 
| 3367 |  |  |  |  |  |  |  | 
| 3368 |  |  |  |  |  |  | sub _build_any_time_format { | 
| 3369 | 9 |  |  | 9 |  | 12 | my ($self, $width) = @_; | 
| 3370 | 9 |  |  |  |  | 32 | my $default_calendar = $self->default_calendar(); | 
| 3371 |  |  |  |  |  |  |  | 
| 3372 | 9 |  |  |  |  | 29 | my @bundles = $self->_find_bundle('time_formats'); | 
| 3373 |  |  |  |  |  |  |  | 
| 3374 |  |  |  |  |  |  | BUNDLES: { | 
| 3375 | 9 |  |  |  |  | 11 | foreach my $bundle (@bundles) { | 
|  | 9 |  |  |  |  | 16 |  | 
| 3376 | 9 |  |  |  |  | 208 | my $time_formats = $bundle->time_formats; | 
| 3377 | 9 | 50 |  |  |  | 29 | if (exists $time_formats->{$default_calendar}{alias}) { | 
| 3378 | 0 |  |  |  |  | 0 | $default_calendar = $time_formats->{$default_calendar}{alias}; | 
| 3379 | 0 |  |  |  |  | 0 | redo BUNDLES; | 
| 3380 |  |  |  |  |  |  | } | 
| 3381 |  |  |  |  |  |  |  | 
| 3382 | 9 |  |  |  |  | 18 | my $result = $time_formats->{$default_calendar}{$width}; | 
| 3383 | 9 | 50 |  |  |  | 14 | if ($result) { | 
| 3384 | 9 |  |  |  |  | 30 | my $time_separator = $self->_get_time_separator; | 
| 3385 | 9 |  |  |  |  | 36 | $result =~ s/:/$time_separator/g; | 
| 3386 | 9 |  |  |  |  | 100 | return $result; | 
| 3387 |  |  |  |  |  |  | } | 
| 3388 |  |  |  |  |  |  | } | 
| 3389 | 0 | 0 |  |  |  | 0 | if ($default_calendar ne 'gregorian') { | 
| 3390 | 0 |  |  |  |  | 0 | $default_calendar = 'gregorian'; | 
| 3391 | 0 |  |  |  |  | 0 | redo BUNDLES; | 
| 3392 |  |  |  |  |  |  | } | 
| 3393 |  |  |  |  |  |  | } | 
| 3394 | 0 |  |  |  |  | 0 | return ''; | 
| 3395 |  |  |  |  |  |  | } | 
| 3396 |  |  |  |  |  |  |  | 
| 3397 |  |  |  |  |  |  | sub _build_time_format_full { | 
| 3398 | 1 |  |  | 1 |  | 3 | my $self = shift; | 
| 3399 | 1 |  |  |  |  | 1 | my $width = 'full'; | 
| 3400 |  |  |  |  |  |  |  | 
| 3401 | 1 |  |  |  |  | 4 | return $self->_build_any_time_format($width); | 
| 3402 |  |  |  |  |  |  | } | 
| 3403 |  |  |  |  |  |  |  | 
| 3404 |  |  |  |  |  |  | sub _build_time_format_long { | 
| 3405 | 1 |  |  | 1 |  | 3 | my $self = shift; | 
| 3406 |  |  |  |  |  |  |  | 
| 3407 | 1 |  |  |  |  | 2 | my $width = 'long'; | 
| 3408 | 1 |  |  |  |  | 5 | return $self->_build_any_time_format($width); | 
| 3409 |  |  |  |  |  |  | } | 
| 3410 |  |  |  |  |  |  |  | 
| 3411 |  |  |  |  |  |  | sub _build_time_format_medium { | 
| 3412 | 1 |  |  | 1 |  | 2 | my $self = shift; | 
| 3413 |  |  |  |  |  |  |  | 
| 3414 | 1 |  |  |  |  | 1 | my $width = 'medium'; | 
| 3415 | 1 |  |  |  |  | 6 | return $self->_build_any_time_format($width); | 
| 3416 |  |  |  |  |  |  | } | 
| 3417 |  |  |  |  |  |  |  | 
| 3418 |  |  |  |  |  |  | sub _build_time_format_short { | 
| 3419 | 1 |  |  | 1 |  | 2 | my $self = shift; | 
| 3420 |  |  |  |  |  |  |  | 
| 3421 | 1 |  |  |  |  | 2 | my $width = 'short'; | 
| 3422 | 1 |  |  |  |  | 3 | return $self->_build_any_time_format($width); | 
| 3423 |  |  |  |  |  |  | } | 
| 3424 |  |  |  |  |  |  |  | 
| 3425 |  |  |  |  |  |  | sub _build_any_datetime_format { | 
| 3426 | 5 |  |  | 5 |  | 9 | my ($self, $width) = @_; | 
| 3427 | 5 |  |  |  |  | 15 | my $default_calendar = $self->default_calendar(); | 
| 3428 |  |  |  |  |  |  |  | 
| 3429 | 5 |  |  |  |  | 14 | my @bundles = $self->_find_bundle('datetime_formats'); | 
| 3430 |  |  |  |  |  |  |  | 
| 3431 |  |  |  |  |  |  | BUNDLES: { | 
| 3432 | 5 |  |  |  |  | 7 | foreach my $bundle (@bundles) { | 
|  | 5 |  |  |  |  | 8 |  | 
| 3433 | 5 |  |  |  |  | 120 | my $datetime_formats = $bundle->datetime_formats; | 
| 3434 | 5 | 50 |  |  |  | 15 | if (exists $datetime_formats->{$default_calendar}{alias}) { | 
| 3435 | 0 |  |  |  |  | 0 | $default_calendar = $datetime_formats->{$default_calendar}{alias}; | 
| 3436 | 0 |  |  |  |  | 0 | redo BUNDLES; | 
| 3437 |  |  |  |  |  |  | } | 
| 3438 |  |  |  |  |  |  |  | 
| 3439 | 5 |  |  |  |  | 8 | my $result = $datetime_formats->{$default_calendar}{$width}; | 
| 3440 | 5 | 50 |  |  |  | 18 | return $result if $result; | 
| 3441 |  |  |  |  |  |  | } | 
| 3442 | 0 | 0 |  |  |  | 0 | if ($default_calendar ne 'gregorian') { | 
| 3443 | 0 |  |  |  |  | 0 | $default_calendar = 'gregorian'; | 
| 3444 | 0 |  |  |  |  | 0 | redo BUNDLES; | 
| 3445 |  |  |  |  |  |  | } | 
| 3446 |  |  |  |  |  |  | } | 
| 3447 |  |  |  |  |  |  |  | 
| 3448 | 0 |  |  |  |  | 0 | return ''; | 
| 3449 |  |  |  |  |  |  | } | 
| 3450 |  |  |  |  |  |  |  | 
| 3451 |  |  |  |  |  |  | sub _build_datetime_format_full { | 
| 3452 | 2 |  |  | 2 |  | 3 | my $self = shift; | 
| 3453 |  |  |  |  |  |  |  | 
| 3454 | 2 |  |  |  |  | 4 | my $width = 'full'; | 
| 3455 | 2 |  |  |  |  | 8 | my $format = $self->_build_any_datetime_format($width); | 
| 3456 |  |  |  |  |  |  |  | 
| 3457 | 2 |  |  |  |  | 9 | my $date = $self->_build_any_date_format($width); | 
| 3458 | 2 |  |  |  |  | 8 | my $time = $self->_build_any_time_format($width); | 
| 3459 |  |  |  |  |  |  |  | 
| 3460 | 2 |  |  |  |  | 7 | $format =~ s/\{0\}/$time/; | 
| 3461 | 2 |  |  |  |  | 8 | $format =~ s/\{1\}/$date/; | 
| 3462 |  |  |  |  |  |  |  | 
| 3463 | 2 |  |  |  |  | 45 | return $format; | 
| 3464 |  |  |  |  |  |  | } | 
| 3465 |  |  |  |  |  |  |  | 
| 3466 |  |  |  |  |  |  | sub _build_datetime_format_long { | 
| 3467 | 1 |  |  | 1 |  | 2 | my $self = shift; | 
| 3468 |  |  |  |  |  |  |  | 
| 3469 | 1 |  |  |  |  | 2 | my $width = 'long'; | 
| 3470 | 1 |  |  |  |  | 4 | my $format = $self->_build_any_datetime_format($width); | 
| 3471 |  |  |  |  |  |  |  | 
| 3472 | 1 |  |  |  |  | 5 | my $date = $self->_build_any_date_format($width); | 
| 3473 | 1 |  |  |  |  | 5 | my $time = $self->_build_any_time_format($width); | 
| 3474 |  |  |  |  |  |  |  | 
| 3475 | 1 |  |  |  |  | 5 | $format =~ s/\{0\}/$time/; | 
| 3476 | 1 |  |  |  |  | 4 | $format =~ s/\{1\}/$date/; | 
| 3477 |  |  |  |  |  |  |  | 
| 3478 | 1 |  |  |  |  | 21 | return $format; | 
| 3479 |  |  |  |  |  |  | } | 
| 3480 |  |  |  |  |  |  |  | 
| 3481 |  |  |  |  |  |  | sub _build_datetime_format_medium { | 
| 3482 | 1 |  |  | 1 |  | 2 | my $self = shift; | 
| 3483 |  |  |  |  |  |  |  | 
| 3484 | 1 |  |  |  |  | 2 | my $width = 'medium'; | 
| 3485 | 1 |  |  |  |  | 4 | my $format = $self->_build_any_datetime_format($width); | 
| 3486 |  |  |  |  |  |  |  | 
| 3487 | 1 |  |  |  |  | 3 | my $date = $self->_build_any_date_format($width); | 
| 3488 | 1 |  |  |  |  | 4 | my $time = $self->_build_any_time_format($width); | 
| 3489 |  |  |  |  |  |  |  | 
| 3490 | 1 |  |  |  |  | 4 | $format =~ s/\{0\}/$time/; | 
| 3491 | 1 |  |  |  |  | 3 | $format =~ s/\{1\}/$date/; | 
| 3492 |  |  |  |  |  |  |  | 
| 3493 | 1 |  |  |  |  | 22 | return $format; | 
| 3494 |  |  |  |  |  |  | } | 
| 3495 |  |  |  |  |  |  |  | 
| 3496 |  |  |  |  |  |  | sub _build_datetime_format_short { | 
| 3497 | 1 |  |  | 1 |  | 2 | my $self = shift; | 
| 3498 |  |  |  |  |  |  |  | 
| 3499 | 1 |  |  |  |  | 6 | my $width = 'short'; | 
| 3500 | 1 |  |  |  |  | 3 | my $format = $self->_build_any_datetime_format($width); | 
| 3501 |  |  |  |  |  |  |  | 
| 3502 | 1 |  |  |  |  | 2 | my $date = $self->_build_any_date_format($width); | 
| 3503 | 1 |  |  |  |  | 4 | my $time = $self->_build_any_time_format($width); | 
| 3504 |  |  |  |  |  |  |  | 
| 3505 | 1 |  |  |  |  | 4 | $format =~ s/\{0\}/$time/; | 
| 3506 | 1 |  |  |  |  | 3 | $format =~ s/\{1\}/$date/; | 
| 3507 |  |  |  |  |  |  |  | 
| 3508 | 1 |  |  |  |  | 22 | return $format; | 
| 3509 |  |  |  |  |  |  | } | 
| 3510 |  |  |  |  |  |  |  | 
| 3511 |  |  |  |  |  |  | sub _build_format_data { | 
| 3512 | 0 |  |  | 0 |  | 0 | my $self = shift; | 
| 3513 | 0 |  |  |  |  | 0 | my $default_calendar = $self->default_calendar(); | 
| 3514 |  |  |  |  |  |  |  | 
| 3515 | 0 |  |  |  |  | 0 | my @bundles = $self->_find_bundle('datetime_formats_available_formats'); | 
| 3516 | 0 |  |  |  |  | 0 | foreach my $calendar ($default_calendar, 'gregorian') { | 
| 3517 | 0 |  |  |  |  | 0 | foreach my $bundle (@bundles) { | 
| 3518 | 0 |  |  |  |  | 0 | my $datetime_formats_available_formats = $bundle->datetime_formats_available_formats; | 
| 3519 | 0 |  |  |  |  | 0 | my $result = $datetime_formats_available_formats->{$calendar}; | 
| 3520 | 0 | 0 |  |  |  | 0 | return $result if $result; | 
| 3521 |  |  |  |  |  |  | } | 
| 3522 |  |  |  |  |  |  | } | 
| 3523 |  |  |  |  |  |  |  | 
| 3524 | 0 |  |  |  |  | 0 | return {}; | 
| 3525 |  |  |  |  |  |  | } | 
| 3526 |  |  |  |  |  |  |  | 
| 3527 |  |  |  |  |  |  | sub format_for { | 
| 3528 | 0 |  |  | 0 | 1 | 0 | my ($self, $format) = @_; | 
| 3529 |  |  |  |  |  |  |  | 
| 3530 | 0 |  |  |  |  | 0 | my $format_data = $self->format_data; | 
| 3531 |  |  |  |  |  |  |  | 
| 3532 | 0 |  | 0 |  |  | 0 | return $format_data->{$format} // ''; | 
| 3533 |  |  |  |  |  |  | } | 
| 3534 |  |  |  |  |  |  |  | 
| 3535 |  |  |  |  |  |  | sub _build_available_formats { | 
| 3536 | 0 |  |  | 0 |  | 0 | my $self = shift; | 
| 3537 |  |  |  |  |  |  |  | 
| 3538 | 0 |  |  |  |  | 0 | my $format_data = $self->format_data; | 
| 3539 |  |  |  |  |  |  |  | 
| 3540 | 0 |  |  |  |  | 0 | return [keys %$format_data]; | 
| 3541 |  |  |  |  |  |  | } | 
| 3542 |  |  |  |  |  |  |  | 
| 3543 |  |  |  |  |  |  | sub _build_default_date_format_length { | 
| 3544 | 0 |  |  | 0 |  | 0 | my $self = shift; | 
| 3545 |  |  |  |  |  |  |  | 
| 3546 | 0 |  |  |  |  | 0 | my $default_calendar = $self->default_calendar(); | 
| 3547 |  |  |  |  |  |  |  | 
| 3548 | 0 |  |  |  |  | 0 | my @bundles = $self->_find_bundle('date_formats'); | 
| 3549 | 0 |  |  |  |  | 0 | foreach my $calendar ($default_calendar, 'gregorian') { | 
| 3550 | 0 |  |  |  |  | 0 | foreach my $bundle (@bundles) { | 
| 3551 | 0 |  |  |  |  | 0 | my $date_formats = $bundle->date_formats; | 
| 3552 | 0 |  |  |  |  | 0 | my $result = $date_formats->{$calendar}{default}; | 
| 3553 | 0 | 0 |  |  |  | 0 | return $result if $result; | 
| 3554 |  |  |  |  |  |  | } | 
| 3555 |  |  |  |  |  |  | } | 
| 3556 |  |  |  |  |  |  | } | 
| 3557 |  |  |  |  |  |  |  | 
| 3558 |  |  |  |  |  |  | sub _build_default_time_format_length { | 
| 3559 | 0 |  |  | 0 |  | 0 | my $self = shift; | 
| 3560 |  |  |  |  |  |  |  | 
| 3561 | 0 |  |  |  |  | 0 | my $default_calendar = $self->default_calendar(); | 
| 3562 |  |  |  |  |  |  |  | 
| 3563 | 0 |  |  |  |  | 0 | my @bundles = $self->_find_bundle('time_formats'); | 
| 3564 | 0 |  |  |  |  | 0 | foreach my $calendar ($default_calendar, 'gregorian') { | 
| 3565 | 0 |  |  |  |  | 0 | foreach my $bundle (@bundles) { | 
| 3566 | 0 |  |  |  |  | 0 | my $time_formats = $bundle->time_formats; | 
| 3567 | 0 |  |  |  |  | 0 | my $result = $time_formats->{$calendar}{default}; | 
| 3568 | 0 | 0 |  |  |  | 0 | return $result if $result; | 
| 3569 |  |  |  |  |  |  | } | 
| 3570 |  |  |  |  |  |  | } | 
| 3571 |  |  |  |  |  |  | } | 
| 3572 |  |  |  |  |  |  |  | 
| 3573 |  |  |  |  |  |  | sub _build_prefers_24_hour_time { | 
| 3574 | 1 |  |  | 1 |  | 2 | my $self = shift; | 
| 3575 |  |  |  |  |  |  |  | 
| 3576 | 1 | 50 |  |  |  | 25 | return $self->time_format_short() =~ /h|K/ ? 0 : 1; | 
| 3577 |  |  |  |  |  |  | } | 
| 3578 |  |  |  |  |  |  |  | 
| 3579 |  |  |  |  |  |  | { | 
| 3580 |  |  |  |  |  |  | my %days_2_number = ( | 
| 3581 |  |  |  |  |  |  | mon => 1, | 
| 3582 |  |  |  |  |  |  | tue => 2, | 
| 3583 |  |  |  |  |  |  | wen => 3, | 
| 3584 |  |  |  |  |  |  | thu => 4, | 
| 3585 |  |  |  |  |  |  | fri => 5, | 
| 3586 |  |  |  |  |  |  | sat => 6, | 
| 3587 |  |  |  |  |  |  | sun => 7, | 
| 3588 |  |  |  |  |  |  | ); | 
| 3589 |  |  |  |  |  |  |  | 
| 3590 |  |  |  |  |  |  | sub _build_first_day_of_week { | 
| 3591 |  |  |  |  |  |  |  | 
| 3592 | 1 |  |  | 1 |  | 2 | my $self = shift; | 
| 3593 |  |  |  |  |  |  |  | 
| 3594 | 1 |  |  |  |  | 3 | my $first_day = $self->week_data_first_day; | 
| 3595 |  |  |  |  |  |  |  | 
| 3596 | 1 |  |  |  |  | 22 | return $days_2_number{$first_day}; | 
| 3597 |  |  |  |  |  |  | } | 
| 3598 |  |  |  |  |  |  | } | 
| 3599 |  |  |  |  |  |  |  | 
| 3600 |  |  |  |  |  |  | # Sub to mangle Unicode regex to Perl regex | 
| 3601 |  |  |  |  |  |  | # Backwards compatibility hack | 
| 3602 | 20 | 50 |  | 20 |  | 135 | *_unicode_to_perl = eval <<'EOT' || \&_new_perl; | 
|  | 20 |  |  | 20 |  | 28 |  | 
|  | 20 |  |  | 161 |  | 812 |  | 
|  | 20 |  |  |  |  | 70 |  | 
|  | 20 |  |  |  |  | 30 |  | 
|  | 20 |  |  |  |  | 730 |  | 
|  | 161 |  |  |  |  | 226 |  | 
|  | 161 |  |  |  |  | 419 |  | 
|  | 161 |  |  |  |  | 767 |  | 
|  | 98 |  |  |  |  | 1996 |  | 
|  | 161 |  |  |  |  | 2227 |  | 
| 3603 |  |  |  |  |  |  | sub { | 
| 3604 |  |  |  |  |  |  | my $regex = shift; | 
| 3605 |  |  |  |  |  |  |  | 
| 3606 |  |  |  |  |  |  | return '' unless length $regex; | 
| 3607 |  |  |  |  |  |  | $regex =~ s/ | 
| 3608 |  |  |  |  |  |  | (?:\\\\)*+               	# Pairs of \ | 
| 3609 |  |  |  |  |  |  | (?!\\)                   	# Not followed by \ | 
| 3610 |  |  |  |  |  |  | \K                       	# But we don't want to keep that | 
| 3611 |  |  |  |  |  |  | (?<set>                     # Capture this | 
| 3612 |  |  |  |  |  |  | \[                      # Start a set | 
| 3613 |  |  |  |  |  |  | (?: | 
| 3614 |  |  |  |  |  |  | [^\[\]\\]+     	# One or more of not []\ | 
| 3615 |  |  |  |  |  |  | |               # or | 
| 3616 |  |  |  |  |  |  | (?: | 
| 3617 |  |  |  |  |  |  | (?:\\\\)*+	# One or more pairs of \ without back tracking | 
| 3618 |  |  |  |  |  |  | \\.         # Followed by an escaped character | 
| 3619 |  |  |  |  |  |  | ) | 
| 3620 |  |  |  |  |  |  | |				# or | 
| 3621 |  |  |  |  |  |  | (?&set)			# An inner set | 
| 3622 |  |  |  |  |  |  | )++                 # Do the inside set stuff one or more times without backtracking | 
| 3623 |  |  |  |  |  |  | \]						# End the set | 
| 3624 |  |  |  |  |  |  | ) | 
| 3625 |  |  |  |  |  |  | / _convert($1) /xeg; | 
| 3626 |  |  |  |  |  |  | no warnings "experimental::regex_sets"; | 
| 3627 |  |  |  |  |  |  | no warnings "deprecated"; # Because CLDR uses surrogates | 
| 3628 |  |  |  |  |  |  | return qr/$regex/x; | 
| 3629 |  |  |  |  |  |  | }; | 
| 3630 |  |  |  |  |  |  |  | 
| 3631 |  |  |  |  |  |  | EOT | 
| 3632 |  |  |  |  |  |  |  | 
| 3633 |  |  |  |  |  |  | # Backwards compatibility hack | 
| 3634 | 98 | 50 |  | 98 |  | 281 | *_convert = eval <<'EOT' || \&_new_perl; | 
|  | 98 | 50 |  |  |  | 237 |  | 
|  | 98 |  |  |  |  | 190 |  | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 98 |  |  |  |  | 93 |  | 
|  | 98 |  |  |  |  | 977 |  | 
|  | 98 |  |  |  |  | 143 |  | 
|  | 98 |  |  |  |  | 169 |  | 
|  | 98 |  |  |  |  | 2499 |  | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
| 3635 |  |  |  |  |  |  | sub { | 
| 3636 |  |  |  |  |  |  | my $set = shift; | 
| 3637 |  |  |  |  |  |  |  | 
| 3638 |  |  |  |  |  |  | # Some definitions | 
| 3639 |  |  |  |  |  |  | my $posix = qr/(?(DEFINE) | 
| 3640 |  |  |  |  |  |  | (?<posix> (?> \[: .+? :\] ) ) | 
| 3641 |  |  |  |  |  |  | )/x; | 
| 3642 |  |  |  |  |  |  |  | 
| 3643 |  |  |  |  |  |  | # Convert Unicode escapes \u1234 to characters | 
| 3644 |  |  |  |  |  |  | $set =~ s/\\u(\p{Ahex}+)/chr(hex($1))/egx; | 
| 3645 |  |  |  |  |  |  |  | 
| 3646 |  |  |  |  |  |  | # Check to see if this is a normal character set | 
| 3647 |  |  |  |  |  |  | my $normal = 0; | 
| 3648 |  |  |  |  |  |  |  | 
| 3649 |  |  |  |  |  |  | $normal = 1 if $set =~ /^ | 
| 3650 |  |  |  |  |  |  | \s* 					# Possible white space | 
| 3651 |  |  |  |  |  |  | \[  					# Opening set | 
| 3652 |  |  |  |  |  |  | ^?  					# Possible negation | 
| 3653 |  |  |  |  |  |  | (?:           			# One of | 
| 3654 |  |  |  |  |  |  | [^\[\]]++			# Not an open or close set | 
| 3655 |  |  |  |  |  |  | |					# Or | 
| 3656 |  |  |  |  |  |  | (?<=\\)[\[\]]       # An open or close set preceded by \ | 
| 3657 |  |  |  |  |  |  | |                   # Or | 
| 3658 |  |  |  |  |  |  | (?: | 
| 3659 |  |  |  |  |  |  | \s*      		# Possible white space | 
| 3660 |  |  |  |  |  |  | (?&posix)		# A posix class | 
| 3661 |  |  |  |  |  |  | (?!         	# Not followed by | 
| 3662 |  |  |  |  |  |  | \s*			# Possible white space | 
| 3663 |  |  |  |  |  |  | [&-]    	# A Unicode regex op | 
| 3664 |  |  |  |  |  |  | \s*     	# Possible white space | 
| 3665 |  |  |  |  |  |  | \[      	# A set opener | 
| 3666 |  |  |  |  |  |  | ) | 
| 3667 |  |  |  |  |  |  | ) | 
| 3668 |  |  |  |  |  |  | )+ | 
| 3669 |  |  |  |  |  |  | \] 						# Close the set | 
| 3670 |  |  |  |  |  |  | \s*						# Possible white space | 
| 3671 |  |  |  |  |  |  | $ | 
| 3672 |  |  |  |  |  |  | $posix | 
| 3673 |  |  |  |  |  |  | /x; | 
| 3674 |  |  |  |  |  |  |  | 
| 3675 |  |  |  |  |  |  | # Convert posix to perl | 
| 3676 |  |  |  |  |  |  | $set =~ s/\[:(.*?):\]/\\p{$1}/g; | 
| 3677 |  |  |  |  |  |  |  | 
| 3678 |  |  |  |  |  |  | if ($normal) { | 
| 3679 |  |  |  |  |  |  | return "$set"; | 
| 3680 |  |  |  |  |  |  | } | 
| 3681 |  |  |  |  |  |  |  | 
| 3682 |  |  |  |  |  |  | # Fix up [abc[de]] to [[abc][de]] | 
| 3683 |  |  |  |  |  |  | $set =~ s/\[ ( (?>\^? \s*) [^\]]+? ) \s* \[/[[$1][/gx; | 
| 3684 |  |  |  |  |  |  |  | 
| 3685 |  |  |  |  |  |  | # Fix up [[ab]cde] to [[ab][cde]] | 
| 3686 |  |  |  |  |  |  | $set =~ s/\[ \^?+ \s* \[ [^\]]+? \] \K \s* ( [^\[]+ ) \]/[$1]]/gx; | 
| 3687 |  |  |  |  |  |  |  | 
| 3688 |  |  |  |  |  |  | # Unicode uses ^ to compliment the set where as Perl uses ! | 
| 3689 |  |  |  |  |  |  | $set =~ s/\[ \^ \s*/[!/gx; | 
| 3690 |  |  |  |  |  |  |  | 
| 3691 |  |  |  |  |  |  | # The above can leave us with empty sets. Strip them out | 
| 3692 |  |  |  |  |  |  | $set =~ s/\[\]//g; | 
| 3693 |  |  |  |  |  |  |  | 
| 3694 |  |  |  |  |  |  | # Fixup inner sets with no operator | 
| 3695 |  |  |  |  |  |  | 1 while $set =~ s/ \] \s* \[ /] + [/gx; | 
| 3696 |  |  |  |  |  |  | 1 while $set =~ s/ \] \s * (\\p\{.*?\}) /] + $1/xg; | 
| 3697 |  |  |  |  |  |  | 1 while $set =~ s/ \\p\{.*?\} \s* \K \[ / + [/xg; | 
| 3698 |  |  |  |  |  |  | 1 while $set =~ s/ \\p\{.*?\} \s* \K (\\p\{.*?\}) / + $1/xg; | 
| 3699 |  |  |  |  |  |  |  | 
| 3700 |  |  |  |  |  |  | # Unicode uses [] for grouping as well as starting an inner set | 
| 3701 |  |  |  |  |  |  | # Perl uses ( ) So fix that up now | 
| 3702 |  |  |  |  |  |  |  | 
| 3703 |  |  |  |  |  |  | $set =~ s/. \K \[ (?> (!?) \s*) \[ /($1\[/gx; | 
| 3704 |  |  |  |  |  |  | $set =~ s/ \] \s* \] (.) /])$1/gx; | 
| 3705 |  |  |  |  |  |  |  | 
| 3706 |  |  |  |  |  |  | return "(?$set)"; | 
| 3707 |  |  |  |  |  |  | } | 
| 3708 |  |  |  |  |  |  |  | 
| 3709 |  |  |  |  |  |  | EOT | 
| 3710 |  |  |  |  |  |  |  | 
| 3711 |  |  |  |  |  |  | # The following pod is for methods defined in the Moose Role | 
| 3712 |  |  |  |  |  |  | # files that are automatically generated from the data | 
| 3713 |  |  |  |  |  |  | =back | 
| 3714 |  |  |  |  |  |  |  | 
| 3715 |  |  |  |  |  |  | =head2 Valid codes | 
| 3716 |  |  |  |  |  |  |  | 
| 3717 |  |  |  |  |  |  | =over 4 | 
| 3718 |  |  |  |  |  |  |  | 
| 3719 |  |  |  |  |  |  | =item valid_languages() | 
| 3720 |  |  |  |  |  |  |  | 
| 3721 |  |  |  |  |  |  | This method returns a list containing all the valid language codes | 
| 3722 |  |  |  |  |  |  |  | 
| 3723 |  |  |  |  |  |  | =item valid_scripts() | 
| 3724 |  |  |  |  |  |  |  | 
| 3725 |  |  |  |  |  |  | This method returns a list containing all the valid script codes | 
| 3726 |  |  |  |  |  |  |  | 
| 3727 |  |  |  |  |  |  | =item valid_territories() | 
| 3728 |  |  |  |  |  |  |  | 
| 3729 |  |  |  |  |  |  | This method returns a list containing all the valid territory codes | 
| 3730 |  |  |  |  |  |  |  | 
| 3731 |  |  |  |  |  |  | =item valid_variants() | 
| 3732 |  |  |  |  |  |  |  | 
| 3733 |  |  |  |  |  |  | This method returns a list containing all the valid variant codes | 
| 3734 |  |  |  |  |  |  |  | 
| 3735 |  |  |  |  |  |  | =item key_aliases() | 
| 3736 |  |  |  |  |  |  |  | 
| 3737 |  |  |  |  |  |  | This method returns a hash that maps valid keys to their valid aliases | 
| 3738 |  |  |  |  |  |  |  | 
| 3739 |  |  |  |  |  |  | =item key_names() | 
| 3740 |  |  |  |  |  |  |  | 
| 3741 |  |  |  |  |  |  | This method returns a hash that maps valid key aliases to their valid keys | 
| 3742 |  |  |  |  |  |  |  | 
| 3743 |  |  |  |  |  |  | =item valid_keys() | 
| 3744 |  |  |  |  |  |  |  | 
| 3745 |  |  |  |  |  |  | This method returns a hash of valid keys and the valid type codes you | 
| 3746 |  |  |  |  |  |  | can have with each key | 
| 3747 |  |  |  |  |  |  |  | 
| 3748 |  |  |  |  |  |  | =item language_aliases() | 
| 3749 |  |  |  |  |  |  |  | 
| 3750 |  |  |  |  |  |  | This method returns a hash that maps valid language codes to their valid aliases | 
| 3751 |  |  |  |  |  |  |  | 
| 3752 |  |  |  |  |  |  | =item territory_aliases() | 
| 3753 |  |  |  |  |  |  |  | 
| 3754 |  |  |  |  |  |  | This method returns a hash that maps valid territory codes to their valid aliases | 
| 3755 |  |  |  |  |  |  |  | 
| 3756 |  |  |  |  |  |  | =item variant_aliases() | 
| 3757 |  |  |  |  |  |  |  | 
| 3758 |  |  |  |  |  |  | This method returns a hash that maps valid variant codes to their valid aliases | 
| 3759 |  |  |  |  |  |  |  | 
| 3760 |  |  |  |  |  |  | =back | 
| 3761 |  |  |  |  |  |  |  | 
| 3762 |  |  |  |  |  |  | =head2 Information about weeks | 
| 3763 |  |  |  |  |  |  |  | 
| 3764 |  |  |  |  |  |  | There are no standard codes for the days of the weeks so CLDR uses the following | 
| 3765 |  |  |  |  |  |  | three letter codes to represent unlocalised days | 
| 3766 |  |  |  |  |  |  |  | 
| 3767 |  |  |  |  |  |  | =over 4 | 
| 3768 |  |  |  |  |  |  |  | 
| 3769 |  |  |  |  |  |  | =item sun | 
| 3770 |  |  |  |  |  |  |  | 
| 3771 |  |  |  |  |  |  | Sunday | 
| 3772 |  |  |  |  |  |  |  | 
| 3773 |  |  |  |  |  |  | =item mon | 
| 3774 |  |  |  |  |  |  |  | 
| 3775 |  |  |  |  |  |  | Monday | 
| 3776 |  |  |  |  |  |  |  | 
| 3777 |  |  |  |  |  |  | =item tue | 
| 3778 |  |  |  |  |  |  |  | 
| 3779 |  |  |  |  |  |  | Tuesday | 
| 3780 |  |  |  |  |  |  |  | 
| 3781 |  |  |  |  |  |  | =item wed | 
| 3782 |  |  |  |  |  |  |  | 
| 3783 |  |  |  |  |  |  | Wednesday | 
| 3784 |  |  |  |  |  |  |  | 
| 3785 |  |  |  |  |  |  | =item thu | 
| 3786 |  |  |  |  |  |  |  | 
| 3787 |  |  |  |  |  |  | Thursday | 
| 3788 |  |  |  |  |  |  |  | 
| 3789 |  |  |  |  |  |  | =item fri | 
| 3790 |  |  |  |  |  |  |  | 
| 3791 |  |  |  |  |  |  | Friday | 
| 3792 |  |  |  |  |  |  |  | 
| 3793 |  |  |  |  |  |  | =item sat | 
| 3794 |  |  |  |  |  |  |  | 
| 3795 |  |  |  |  |  |  | Saturday | 
| 3796 |  |  |  |  |  |  |  | 
| 3797 |  |  |  |  |  |  | =back | 
| 3798 |  |  |  |  |  |  |  | 
| 3799 |  |  |  |  |  |  | =cut | 
| 3800 |  |  |  |  |  |  |  | 
| 3801 |  |  |  |  |  |  | sub _week_data { | 
| 3802 | 5 |  |  | 5 |  | 6 | my ($self, $territory_id, $week_data_hash) = @_; | 
| 3803 |  |  |  |  |  |  |  | 
| 3804 | 5 |  | 33 |  |  | 21 | $territory_id //= ( $self->territory_id || $self->likely_subtag->territory_id ); | 
|  |  |  | 33 |  |  |  |  | 
| 3805 |  |  |  |  |  |  |  | 
| 3806 | 5 | 100 |  |  |  | 20 | return $week_data_hash->{$territory_id} if exists $week_data_hash->{$territory_id}; | 
| 3807 |  |  |  |  |  |  |  | 
| 3808 | 2 |  |  |  |  | 2 | while (1) { | 
| 3809 | 8 |  |  |  |  | 172 | $territory_id = $self->territory_contained_by()->{$territory_id}; | 
| 3810 | 8 | 50 |  |  |  | 10 | return unless defined $territory_id; | 
| 3811 | 8 | 100 |  |  |  | 22 | return $week_data_hash->{$territory_id} if exists $week_data_hash->{$territory_id}; | 
| 3812 |  |  |  |  |  |  | } | 
| 3813 |  |  |  |  |  |  | } | 
| 3814 |  |  |  |  |  |  |  | 
| 3815 |  |  |  |  |  |  | =over 4 | 
| 3816 |  |  |  |  |  |  |  | 
| 3817 |  |  |  |  |  |  | =item week_data_min_days($territory_id) | 
| 3818 |  |  |  |  |  |  |  | 
| 3819 |  |  |  |  |  |  | This method takes an optional territory id and returns a the minimum number of days | 
| 3820 |  |  |  |  |  |  | a week must have to count as the starting week of the new year. It uses the current | 
| 3821 |  |  |  |  |  |  | locale's territory if no territory id is passed in. | 
| 3822 |  |  |  |  |  |  |  | 
| 3823 |  |  |  |  |  |  | =cut | 
| 3824 |  |  |  |  |  |  |  | 
| 3825 |  |  |  |  |  |  | sub week_data_min_days { | 
| 3826 | 1 |  |  | 1 | 1 | 3 | my ($self, $territory_id) = @_; | 
| 3827 |  |  |  |  |  |  |  | 
| 3828 | 1 |  |  |  |  | 33 | my $week_data_hash = $self->_week_data_min_days(); | 
| 3829 | 1 |  |  |  |  | 3 | return _week_data($self, $territory_id, $week_data_hash); | 
| 3830 |  |  |  |  |  |  | } | 
| 3831 |  |  |  |  |  |  |  | 
| 3832 |  |  |  |  |  |  | =item week_data_first_day($territory_id) | 
| 3833 |  |  |  |  |  |  |  | 
| 3834 |  |  |  |  |  |  | This method takes an optional territory id and returns the three letter code of the | 
| 3835 |  |  |  |  |  |  | first day of the week for that territory. If no territory id is passed in then it | 
| 3836 |  |  |  |  |  |  | uses the current locale's territory. | 
| 3837 |  |  |  |  |  |  |  | 
| 3838 |  |  |  |  |  |  | =cut | 
| 3839 |  |  |  |  |  |  |  | 
| 3840 |  |  |  |  |  |  | sub week_data_first_day { | 
| 3841 | 2 |  |  | 2 | 1 | 3 | my ($self, $territory_id) = @_; | 
| 3842 |  |  |  |  |  |  |  | 
| 3843 | 2 |  |  |  |  | 54 | my $week_data_hash = $self->_week_data_first_day(); | 
| 3844 | 2 |  |  |  |  | 5 | return _week_data($self, $territory_id, $week_data_hash); | 
| 3845 |  |  |  |  |  |  | } | 
| 3846 |  |  |  |  |  |  |  | 
| 3847 |  |  |  |  |  |  | =item week_data_weekend_start() | 
| 3848 |  |  |  |  |  |  |  | 
| 3849 |  |  |  |  |  |  | This method takes an optional territory id and returns the three letter code of the | 
| 3850 |  |  |  |  |  |  | first day of the week end for that territory. If no territory id is passed in then it | 
| 3851 |  |  |  |  |  |  | uses the current locale's territory. | 
| 3852 |  |  |  |  |  |  |  | 
| 3853 |  |  |  |  |  |  | =cut | 
| 3854 |  |  |  |  |  |  |  | 
| 3855 |  |  |  |  |  |  | sub week_data_weekend_start { | 
| 3856 | 1 |  |  | 1 | 1 | 2 | my ($self, $territory_id) = @_; | 
| 3857 | 1 |  |  |  |  | 34 | my $week_data_hash = $self->_week_data_weekend_start(); | 
| 3858 |  |  |  |  |  |  |  | 
| 3859 | 1 |  |  |  |  | 3 | return _week_data($self, $territory_id, $week_data_hash); | 
| 3860 |  |  |  |  |  |  | } | 
| 3861 |  |  |  |  |  |  |  | 
| 3862 |  |  |  |  |  |  | =item week_data_weekend_end() | 
| 3863 |  |  |  |  |  |  |  | 
| 3864 |  |  |  |  |  |  | This method takes an optional territory id and returns the three letter code of the | 
| 3865 |  |  |  |  |  |  | first day of the week end for that territory. If no territory id is passed in then it | 
| 3866 |  |  |  |  |  |  | uses the current locale's territory. | 
| 3867 |  |  |  |  |  |  |  | 
| 3868 |  |  |  |  |  |  | =cut | 
| 3869 |  |  |  |  |  |  |  | 
| 3870 |  |  |  |  |  |  | sub week_data_weekend_end { | 
| 3871 | 1 |  |  | 1 | 1 | 3 | my ($self, $territory_id) = @_; | 
| 3872 | 1 |  |  |  |  | 30 | my $week_data_hash = $self->_week_data_weekend_end(); | 
| 3873 |  |  |  |  |  |  |  | 
| 3874 | 1 |  |  |  |  | 3 | return _week_data($self, $territory_id, $week_data_hash); | 
| 3875 |  |  |  |  |  |  | } | 
| 3876 |  |  |  |  |  |  |  | 
| 3877 |  |  |  |  |  |  | =item month_patterns($context, $width, $type) | 
| 3878 |  |  |  |  |  |  |  | 
| 3879 |  |  |  |  |  |  | The Chinese lunar calendar can insert a leap month after nearly any month of its year; | 
| 3880 |  |  |  |  |  |  | when this happens, the month takes the name of the preceding month plus a special marker. | 
| 3881 |  |  |  |  |  |  | The Hindu lunar calendars can insert a leap month before any one or two months of the year; | 
| 3882 |  |  |  |  |  |  | when this happens, not only does the leap month take the name of the following month plus a | 
| 3883 |  |  |  |  |  |  | special marker, the following month also takes a special marker. Moreover, in the Hindu | 
| 3884 |  |  |  |  |  |  | calendar sometimes a month is skipped, in which case the preceding month takes a special marker | 
| 3885 |  |  |  |  |  |  | plus the names of both months. The monthPatterns() method returns an array ref of month names | 
| 3886 |  |  |  |  |  |  | with the marker added. | 
| 3887 |  |  |  |  |  |  |  | 
| 3888 |  |  |  |  |  |  | =cut | 
| 3889 |  |  |  |  |  |  |  | 
| 3890 |  |  |  |  |  |  | my %month_functions = ( | 
| 3891 |  |  |  |  |  |  | format => { | 
| 3892 |  |  |  |  |  |  | wide		=> 'month_format_wide', | 
| 3893 |  |  |  |  |  |  | abbreviated	=> 'month_format_abbreviated', | 
| 3894 |  |  |  |  |  |  | narrow		=> 'month_format_narrow', | 
| 3895 |  |  |  |  |  |  | }, | 
| 3896 |  |  |  |  |  |  | 'stand-alone' => { | 
| 3897 |  |  |  |  |  |  | wide		=> 'month_stand_alone_wide', | 
| 3898 |  |  |  |  |  |  | abbreviated	=> 'month_stand_alone_abbreviated', | 
| 3899 |  |  |  |  |  |  | narrow		=> 'month_stand_alone_narrow', | 
| 3900 |  |  |  |  |  |  | } | 
| 3901 |  |  |  |  |  |  | ); | 
| 3902 |  |  |  |  |  |  |  | 
| 3903 |  |  |  |  |  |  | sub month_patterns { | 
| 3904 | 1 |  |  | 1 | 1 | 1181 | my ($self, $context, $width, $type) = @_; | 
| 3905 |  |  |  |  |  |  |  | 
| 3906 | 1 |  |  |  |  | 2 | my @months; | 
| 3907 | 1 | 50 |  |  |  | 5 | if ($context eq 'numeric') { | 
| 3908 | 0 |  |  |  |  | 0 | @months = ( 1 .. 14 ); | 
| 3909 |  |  |  |  |  |  | } | 
| 3910 |  |  |  |  |  |  | else { | 
| 3911 | 1 |  |  |  |  | 5 | my $months_method = $month_functions{$context}{$width}; | 
| 3912 | 1 |  |  |  |  | 41 | my $months = $self->$months_method; | 
| 3913 | 1 |  |  |  |  | 5 | @months = @$months; | 
| 3914 |  |  |  |  |  |  | } | 
| 3915 |  |  |  |  |  |  |  | 
| 3916 | 1 |  |  |  |  | 6 | my $default_calendar = $self->default_calendar(); | 
| 3917 |  |  |  |  |  |  |  | 
| 3918 | 1 |  |  |  |  | 4 | my @bundles = $self->_find_bundle('month_patterns'); | 
| 3919 |  |  |  |  |  |  |  | 
| 3920 | 1 |  |  |  |  | 2 | my $result; | 
| 3921 |  |  |  |  |  |  | BUNDLES: { | 
| 3922 | 1 |  |  |  |  | 2 | foreach my $bundle (@bundles) { | 
|  | 2 |  |  |  |  | 4 |  | 
| 3923 | 2 |  |  |  |  | 48 | my $month_patterns = $bundle->month_patterns; | 
| 3924 | 2 | 50 |  |  |  | 7 | if (exists $month_patterns->{$default_calendar}{alias}) { | 
| 3925 | 0 |  |  |  |  | 0 | $default_calendar = $month_patterns->{$default_calendar}{alias}; | 
| 3926 | 0 |  |  |  |  | 0 | redo BUNDLES; | 
| 3927 |  |  |  |  |  |  | } | 
| 3928 |  |  |  |  |  |  |  | 
| 3929 |  |  |  |  |  |  | # Check for width alias | 
| 3930 | 2 | 100 |  |  |  | 8 | if (exists $month_patterns->{$default_calendar}{$context}{$width}{alias}) { | 
| 3931 | 1 |  |  |  |  | 3 | $context = $month_patterns->{$default_calendar}{$context}{$width}{alias}{context}; | 
| 3932 | 1 |  |  |  |  | 3 | $width = $month_patterns->{$default_calendar}{$context}{$width}{alias}{width}; | 
| 3933 | 1 |  |  |  |  | 5 | redo BUNDLES; | 
| 3934 |  |  |  |  |  |  | } | 
| 3935 |  |  |  |  |  |  |  | 
| 3936 | 1 |  |  |  |  | 5 | $result = $month_patterns->{$default_calendar}{$context}{$width}{$type}; | 
| 3937 | 1 | 50 |  |  |  | 4 | last BUNDLES if $result; | 
| 3938 |  |  |  |  |  |  | } | 
| 3939 | 0 | 0 |  |  |  | 0 | if ($default_calendar ne 'gregorian') { | 
| 3940 | 0 |  |  |  |  | 0 | $default_calendar = 'gregorian'; | 
| 3941 | 0 |  |  |  |  | 0 | redo BUNDLES; | 
| 3942 |  |  |  |  |  |  | } | 
| 3943 |  |  |  |  |  |  | } | 
| 3944 |  |  |  |  |  |  |  | 
| 3945 | 1 | 50 |  |  |  | 4 | if ($result) { | 
| 3946 | 1 |  |  |  |  | 3 | foreach my $month (@months) { | 
| 3947 | 12 |  |  |  |  | 17 | (my $fixed_month = $result) =~ s/\{0\}/$month/g; | 
| 3948 | 12 |  |  |  |  | 13 | $month = $fixed_month; | 
| 3949 |  |  |  |  |  |  | } | 
| 3950 |  |  |  |  |  |  | } | 
| 3951 |  |  |  |  |  |  |  | 
| 3952 | 1 |  |  |  |  | 13 | return \@months; | 
| 3953 |  |  |  |  |  |  | } | 
| 3954 |  |  |  |  |  |  |  | 
| 3955 |  |  |  |  |  |  | =item cyclic_name_sets($context, $width, $type) | 
| 3956 |  |  |  |  |  |  |  | 
| 3957 |  |  |  |  |  |  | This method returns an arrayref containing the cyclic names for the locale's | 
| 3958 |  |  |  |  |  |  | default calendar using the given context, width and type. | 
| 3959 |  |  |  |  |  |  |  | 
| 3960 |  |  |  |  |  |  | Context can can currently only be c<format> | 
| 3961 |  |  |  |  |  |  |  | 
| 3962 |  |  |  |  |  |  | Width is one of C<abbreviated>, C<narrow> or C<wide> | 
| 3963 |  |  |  |  |  |  |  | 
| 3964 |  |  |  |  |  |  | Type is one of C<dayParts>, C<days>, C<months>, C<solarTerms>, C<years> or C<zodiacs> | 
| 3965 |  |  |  |  |  |  |  | 
| 3966 |  |  |  |  |  |  | =cut | 
| 3967 |  |  |  |  |  |  |  | 
| 3968 |  |  |  |  |  |  | sub cyclic_name_sets { | 
| 3969 | 1 |  |  | 1 | 1 | 3 | my ($self, $context, $width, $type) = @_; | 
| 3970 |  |  |  |  |  |  |  | 
| 3971 | 1 |  |  |  |  | 4 | my @bundles = $self->_find_bundle('cyclic_name_sets'); | 
| 3972 | 1 |  |  |  |  | 7 | my $default_calendar = $self->default_calendar(); | 
| 3973 | 1 |  |  |  |  | 2 | foreach my $bundle (@bundles) { | 
| 3974 | 2 |  |  |  |  | 56 | my $cyclic_name_set = $bundle->cyclic_name_sets(); | 
| 3975 |  |  |  |  |  |  | NAME_SET: { | 
| 3976 | 2 | 50 |  |  |  | 3 | if (my $alias_calendar = $cyclic_name_set->{$default_calendar}{alias}) { | 
|  | 3 |  |  |  |  | 9 |  | 
| 3977 | 0 |  |  |  |  | 0 | $default_calendar = $alias_calendar; | 
| 3978 | 0 |  |  |  |  | 0 | redo NAME_SET; | 
| 3979 |  |  |  |  |  |  | } | 
| 3980 |  |  |  |  |  |  |  | 
| 3981 | 3 | 50 |  |  |  | 11 | if (my $type_alias = $cyclic_name_set->{$default_calendar}{$type}{alias}) { | 
| 3982 | 0 |  |  |  |  | 0 | $type = $type_alias; | 
| 3983 | 0 |  |  |  |  | 0 | redo NAME_SET; | 
| 3984 |  |  |  |  |  |  | } | 
| 3985 |  |  |  |  |  |  |  | 
| 3986 | 3 | 100 |  |  |  | 11 | if (my $width_alias = $cyclic_name_set->{$default_calendar}{$type}{$context}{$width}{alias}) { | 
| 3987 | 1 |  |  |  |  | 2 | $context = $width_alias->{context}; | 
| 3988 | 1 |  |  |  |  | 3 | $type = $width_alias->{name_set}; | 
| 3989 | 1 |  |  |  |  | 2 | $width = $width_alias->{type}; | 
| 3990 | 1 |  |  |  |  | 2 | redo NAME_SET; | 
| 3991 |  |  |  |  |  |  | } | 
| 3992 |  |  |  |  |  |  |  | 
| 3993 | 2 |  |  |  |  | 9 | my $return = [ | 
| 3994 | 28 |  |  |  |  | 21 | @{ $cyclic_name_set->{$default_calendar}{$type}{$context}{$width} } | 
| 3995 | 2 |  |  |  |  | 3 | {sort { $a <=> $b } keys %{ $cyclic_name_set->{$default_calendar}{$type}{$context}{$width} }} | 
|  | 2 |  |  |  |  | 12 |  | 
| 3996 |  |  |  |  |  |  | ]; | 
| 3997 |  |  |  |  |  |  |  | 
| 3998 | 2 | 100 |  |  |  | 17 | return $return if @$return; | 
| 3999 |  |  |  |  |  |  | } | 
| 4000 |  |  |  |  |  |  | } | 
| 4001 | 0 |  |  |  |  | 0 | return []; | 
| 4002 |  |  |  |  |  |  | } | 
| 4003 |  |  |  |  |  |  |  | 
| 4004 |  |  |  |  |  |  | =back | 
| 4005 |  |  |  |  |  |  |  | 
| 4006 |  |  |  |  |  |  | =head2 Territory Containment | 
| 4007 |  |  |  |  |  |  |  | 
| 4008 |  |  |  |  |  |  | =over 4 | 
| 4009 |  |  |  |  |  |  |  | 
| 4010 |  |  |  |  |  |  | =item territory_contains() | 
| 4011 |  |  |  |  |  |  |  | 
| 4012 |  |  |  |  |  |  | This method returns a hash ref keyed on territory id. The value is an array ref. | 
| 4013 |  |  |  |  |  |  | Each element of the array ref is a territory id of a territory immediately | 
| 4014 |  |  |  |  |  |  | contained in the territory used as the key | 
| 4015 |  |  |  |  |  |  |  | 
| 4016 |  |  |  |  |  |  | =item territory_contained_by() | 
| 4017 |  |  |  |  |  |  |  | 
| 4018 |  |  |  |  |  |  | This method returns a hash ref keyed on territory id. The value of the hash | 
| 4019 |  |  |  |  |  |  | is the territory id of the immediately containing territory. | 
| 4020 |  |  |  |  |  |  |  | 
| 4021 |  |  |  |  |  |  | =back | 
| 4022 |  |  |  |  |  |  |  | 
| 4023 |  |  |  |  |  |  | =head2 Numbering Systems | 
| 4024 |  |  |  |  |  |  |  | 
| 4025 |  |  |  |  |  |  | =over 4 | 
| 4026 |  |  |  |  |  |  |  | 
| 4027 |  |  |  |  |  |  | =item numbering_system() | 
| 4028 |  |  |  |  |  |  |  | 
| 4029 |  |  |  |  |  |  | This method returns a hash ref keyed on numbering system id which, for a given | 
| 4030 |  |  |  |  |  |  | locale, can be got by calling the default_numbering_system() method. The values | 
| 4031 |  |  |  |  |  |  | of the hash are a two element hash ref the keys being C<type> and C<data>. If the | 
| 4032 |  |  |  |  |  |  | type is C<numeric> then the data is an array ref of characters. The position in the | 
| 4033 |  |  |  |  |  |  | array matches the numeric value of the character. If the type is C<algorithmic> | 
| 4034 |  |  |  |  |  |  | then data is the name of the algorithm used to display numbers in that format. | 
| 4035 |  |  |  |  |  |  |  | 
| 4036 |  |  |  |  |  |  | =back | 
| 4037 |  |  |  |  |  |  |  | 
| 4038 |  |  |  |  |  |  | =head2 Number Formatting | 
| 4039 |  |  |  |  |  |  |  | 
| 4040 |  |  |  |  |  |  | =over 4 | 
| 4041 |  |  |  |  |  |  |  | 
| 4042 |  |  |  |  |  |  | =item format_number($number, $format, $currency, $for_cash) | 
| 4043 |  |  |  |  |  |  |  | 
| 4044 |  |  |  |  |  |  | This method formats the number $number using the format $format. If the format contains | 
| 4045 |  |  |  |  |  |  | the currency symbol C<¤> then the currency symbol for the currency code in $currency | 
| 4046 |  |  |  |  |  |  | will be used. If $currency is undef() then the default currency code for the locale | 
| 4047 |  |  |  |  |  |  | will be used. | 
| 4048 |  |  |  |  |  |  |  | 
| 4049 |  |  |  |  |  |  | Note that currency codes are based on territory so if you do not pass in a currency | 
| 4050 |  |  |  |  |  |  | and your locale did not get passed a territory in the constructor you are going | 
| 4051 |  |  |  |  |  |  | to end up with the L<likely sub tag's|/likely_subtags> idea of the currency. This | 
| 4052 |  |  |  |  |  |  | functionality may be removed or at least changed to emit a warning in future | 
| 4053 |  |  |  |  |  |  | releases. | 
| 4054 |  |  |  |  |  |  |  | 
| 4055 |  |  |  |  |  |  | $for_cash is only used during currency formatting. If true then cash rounding | 
| 4056 |  |  |  |  |  |  | will be used otherwise financial rounding will be used. | 
| 4057 |  |  |  |  |  |  |  | 
| 4058 |  |  |  |  |  |  | This function also handles rule based number formatting. If $format is string equivalent | 
| 4059 |  |  |  |  |  |  | to one of the current locale's public rule based number formats then $number will be | 
| 4060 |  |  |  |  |  |  | formatted according to that rule. | 
| 4061 |  |  |  |  |  |  |  | 
| 4062 |  |  |  |  |  |  | =item add_currency_symbol($format, $symbol) | 
| 4063 |  |  |  |  |  |  |  | 
| 4064 |  |  |  |  |  |  | This method returns the format with the currency symbol $symbol correctly inserted | 
| 4065 |  |  |  |  |  |  | into the format | 
| 4066 |  |  |  |  |  |  |  | 
| 4067 |  |  |  |  |  |  | =item parse_number_format($format, $currency, $currency_data, $for_cash) | 
| 4068 |  |  |  |  |  |  |  | 
| 4069 |  |  |  |  |  |  | This method parses a CLDR numeric format string into a hash ref containing data used to | 
| 4070 |  |  |  |  |  |  | format a number. If a currency is being formatted then $currency contains the | 
| 4071 |  |  |  |  |  |  | currency code, $currency_data is a hashref containing the currency rounding | 
| 4072 |  |  |  |  |  |  | information and $for_cash is a flag to signal cash or financial rounding. | 
| 4073 |  |  |  |  |  |  |  | 
| 4074 |  |  |  |  |  |  | This should probably be a private function. | 
| 4075 |  |  |  |  |  |  |  | 
| 4076 |  |  |  |  |  |  | =item round($number, $increment, $decimal_digits) | 
| 4077 |  |  |  |  |  |  |  | 
| 4078 |  |  |  |  |  |  | This method returns $number rounded to the nearest $increment with $decimal_digits | 
| 4079 |  |  |  |  |  |  | digits after the decimal point | 
| 4080 |  |  |  |  |  |  |  | 
| 4081 |  |  |  |  |  |  | =item get_formatted_number($number, $format, $currency_data, $for_cash) | 
| 4082 |  |  |  |  |  |  |  | 
| 4083 |  |  |  |  |  |  | This method takes the $format produced by parse_number_format() and uses it to | 
| 4084 |  |  |  |  |  |  | parse $number. It returns a string containing the parsed number. If a currency | 
| 4085 |  |  |  |  |  |  | is being formatted then $currency_data is a hashref containing the currency | 
| 4086 |  |  |  |  |  |  | rounding information and $for_cash is a flag to signal cash or financial rounding. | 
| 4087 |  |  |  |  |  |  |  | 
| 4088 |  |  |  |  |  |  | =item get_digits() | 
| 4089 |  |  |  |  |  |  |  | 
| 4090 |  |  |  |  |  |  | This method returns an array containing the digits used by the locale, The order of the | 
| 4091 |  |  |  |  |  |  | array is the order of the digits. It the locale's numbering system is C<algorithmic> it | 
| 4092 |  |  |  |  |  |  | will return C<[0,1,2,3,4,5,6,7,8,9]> | 
| 4093 |  |  |  |  |  |  |  | 
| 4094 |  |  |  |  |  |  | =item default_numbering_system() | 
| 4095 |  |  |  |  |  |  |  | 
| 4096 |  |  |  |  |  |  | This method returns the numbering system id for the locale. | 
| 4097 |  |  |  |  |  |  |  | 
| 4098 |  |  |  |  |  |  | =back | 
| 4099 |  |  |  |  |  |  |  | 
| 4100 |  |  |  |  |  |  | =head2 Measurement Information | 
| 4101 |  |  |  |  |  |  |  | 
| 4102 |  |  |  |  |  |  | =over 4 | 
| 4103 |  |  |  |  |  |  |  | 
| 4104 |  |  |  |  |  |  | =item measurement_system() | 
| 4105 |  |  |  |  |  |  |  | 
| 4106 |  |  |  |  |  |  | This method returns a hash ref keyed on territory, the value being the measurement system | 
| 4107 |  |  |  |  |  |  | id for the territory. If the territory you are interested in is not listed use the | 
| 4108 |  |  |  |  |  |  | territory_contained_by() method until you find an entry. | 
| 4109 |  |  |  |  |  |  |  | 
| 4110 |  |  |  |  |  |  | =item paper_size() | 
| 4111 |  |  |  |  |  |  |  | 
| 4112 |  |  |  |  |  |  | This method returns a hash ref keyed on territory, the value being the paper size used | 
| 4113 |  |  |  |  |  |  | in that territory. If the territory you are interested in is not listed use the | 
| 4114 |  |  |  |  |  |  | territory_contained_by() method until you find an entry. | 
| 4115 |  |  |  |  |  |  |  | 
| 4116 |  |  |  |  |  |  | =back | 
| 4117 |  |  |  |  |  |  |  | 
| 4118 |  |  |  |  |  |  | =head2 Likely Tags | 
| 4119 |  |  |  |  |  |  |  | 
| 4120 |  |  |  |  |  |  | =over 4 | 
| 4121 |  |  |  |  |  |  |  | 
| 4122 |  |  |  |  |  |  | =item likely_subtags() | 
| 4123 |  |  |  |  |  |  |  | 
| 4124 |  |  |  |  |  |  | A full locale tag requires, as a minimum, a language, script and territory code. However for | 
| 4125 |  |  |  |  |  |  | some locales it is possible to infer the missing element if the other two are given, e.g. | 
| 4126 |  |  |  |  |  |  | given C<en_GB> you can infer the script will be latn. It is also possible to fill in the | 
| 4127 |  |  |  |  |  |  | missing elements of a locale with sensible defaults given sufficient knowledge of the layout | 
| 4128 |  |  |  |  |  |  | of the CLDR data and usage patterns of locales around the world. | 
| 4129 |  |  |  |  |  |  |  | 
| 4130 |  |  |  |  |  |  | This function returns a hash ref keyed on partial locale id's with the value being the locale | 
| 4131 |  |  |  |  |  |  | id for the most likely language, script and territory code for the key. | 
| 4132 |  |  |  |  |  |  |  | 
| 4133 |  |  |  |  |  |  | =back | 
| 4134 |  |  |  |  |  |  |  | 
| 4135 |  |  |  |  |  |  | =head2 Currency Information | 
| 4136 |  |  |  |  |  |  |  | 
| 4137 |  |  |  |  |  |  | =over 4 | 
| 4138 |  |  |  |  |  |  |  | 
| 4139 |  |  |  |  |  |  | =item currency_fractions() | 
| 4140 |  |  |  |  |  |  |  | 
| 4141 |  |  |  |  |  |  | This method returns a hash ref keyed on currency id. The value is a hash ref containing four keys. | 
| 4142 |  |  |  |  |  |  | The keys are | 
| 4143 |  |  |  |  |  |  |  | 
| 4144 |  |  |  |  |  |  | =over 8 | 
| 4145 |  |  |  |  |  |  |  | 
| 4146 |  |  |  |  |  |  | =item digits | 
| 4147 |  |  |  |  |  |  |  | 
| 4148 |  |  |  |  |  |  | The number of decimal digits normally formatted. | 
| 4149 |  |  |  |  |  |  |  | 
| 4150 |  |  |  |  |  |  | =item rounding | 
| 4151 |  |  |  |  |  |  |  | 
| 4152 |  |  |  |  |  |  | The rounding increment, in units of 10^-digits. | 
| 4153 |  |  |  |  |  |  |  | 
| 4154 |  |  |  |  |  |  | =item cashdigits | 
| 4155 |  |  |  |  |  |  |  | 
| 4156 |  |  |  |  |  |  | The number of decimal digits to be used when formatting quantities used in cash transactions (as opposed | 
| 4157 |  |  |  |  |  |  | to a quantity that would appear in a more formal setting, such as on a bank statement). | 
| 4158 |  |  |  |  |  |  |  | 
| 4159 |  |  |  |  |  |  | =item cashrounding | 
| 4160 |  |  |  |  |  |  |  | 
| 4161 |  |  |  |  |  |  | The cash rounding increment, in units of 10^-cashdigits. | 
| 4162 |  |  |  |  |  |  |  | 
| 4163 |  |  |  |  |  |  | =back | 
| 4164 |  |  |  |  |  |  |  | 
| 4165 |  |  |  |  |  |  | =item default_currency($territory_id) | 
| 4166 |  |  |  |  |  |  |  | 
| 4167 |  |  |  |  |  |  | This method returns the default currency id for the territory id. | 
| 4168 |  |  |  |  |  |  | If no territory id is given then the current locale's is used | 
| 4169 |  |  |  |  |  |  |  | 
| 4170 |  |  |  |  |  |  | =cut | 
| 4171 |  |  |  |  |  |  |  | 
| 4172 |  |  |  |  |  |  | sub default_currency { | 
| 4173 | 1 |  |  | 1 | 1 | 1 | my ($self, $territory_id) = @_; | 
| 4174 |  |  |  |  |  |  |  | 
| 4175 | 1 |  | 33 |  |  | 10 | $territory_id //= $self->territory_id; | 
| 4176 |  |  |  |  |  |  |  | 
| 4177 | 1 | 50 |  |  |  | 3 | if (! $territory_id) { | 
| 4178 | 0 |  |  |  |  | 0 | $territory_id = $self->likely_subtag->territory_id; | 
| 4179 | 0 |  |  |  |  | 0 | warn "Locale::CLDR::default_currency:- No territory given using $territory_id at "; | 
| 4180 |  |  |  |  |  |  | } | 
| 4181 |  |  |  |  |  |  |  | 
| 4182 | 1 |  |  |  |  | 25 | my $default_currencies = $self->_default_currency; | 
| 4183 |  |  |  |  |  |  |  | 
| 4184 | 1 | 50 |  |  |  | 6 | return $default_currencies->{$territory_id} if exists $default_currencies->{$territory_id}; | 
| 4185 |  |  |  |  |  |  |  | 
| 4186 | 0 |  |  |  |  | 0 | while (1) { | 
| 4187 | 0 |  |  |  |  | 0 | $territory_id = $self->territory_contained_by($territory_id); | 
| 4188 | 0 | 0 |  |  |  | 0 | last unless $territory_id; | 
| 4189 | 0 | 0 |  |  |  | 0 | return $default_currencies->{$territory_id} if exists $default_currencies->{$territory_id}; | 
| 4190 |  |  |  |  |  |  | } | 
| 4191 |  |  |  |  |  |  | } | 
| 4192 |  |  |  |  |  |  |  | 
| 4193 |  |  |  |  |  |  | =item currency_symbol($currency_id) | 
| 4194 |  |  |  |  |  |  |  | 
| 4195 |  |  |  |  |  |  | This method returns the currency symbol for the given currency id in the current locale. | 
| 4196 |  |  |  |  |  |  | If no currency id is given it uses the locale's default currency | 
| 4197 |  |  |  |  |  |  |  | 
| 4198 |  |  |  |  |  |  | =cut | 
| 4199 |  |  |  |  |  |  |  | 
| 4200 |  |  |  |  |  |  | sub currency_symbol { | 
| 4201 | 1 |  |  | 1 | 1 | 1 | my ($self, $currency_id) = @_; | 
| 4202 |  |  |  |  |  |  |  | 
| 4203 | 1 |  | 33 |  |  | 7 | $currency_id //= $self->default_currency; | 
| 4204 |  |  |  |  |  |  |  | 
| 4205 | 1 |  |  |  |  | 5 | my @bundles = reverse $self->_find_bundle('curriencies'); | 
| 4206 | 1 |  |  |  |  | 4 | foreach my $bundle (@bundles) { | 
| 4207 | 1 |  |  |  |  | 26 | my $symbol = $bundle->curriencies()->{$currency_id}{symbol}; | 
| 4208 | 1 | 50 |  |  |  | 8 | return $symbol if $symbol; | 
| 4209 |  |  |  |  |  |  | } | 
| 4210 |  |  |  |  |  |  |  | 
| 4211 | 0 |  |  |  |  |  | return ''; | 
| 4212 |  |  |  |  |  |  | } | 
| 4213 |  |  |  |  |  |  |  | 
| 4214 |  |  |  |  |  |  | =back | 
| 4215 |  |  |  |  |  |  |  | 
| 4216 |  |  |  |  |  |  | =head2 Calendar Information | 
| 4217 |  |  |  |  |  |  |  | 
| 4218 |  |  |  |  |  |  | =over 4 | 
| 4219 |  |  |  |  |  |  |  | 
| 4220 |  |  |  |  |  |  | =item calendar_preferences() | 
| 4221 |  |  |  |  |  |  |  | 
| 4222 |  |  |  |  |  |  | This method returns a hash ref keyed on territory id. The values are array refs containing the preferred | 
| 4223 |  |  |  |  |  |  | calendar id's in order of preference. | 
| 4224 |  |  |  |  |  |  |  | 
| 4225 |  |  |  |  |  |  | =item  default_calendar($territory) | 
| 4226 |  |  |  |  |  |  |  | 
| 4227 |  |  |  |  |  |  | This method returns the default calendar id for the given territory. If no territory id given it | 
| 4228 |  |  |  |  |  |  | used the territory of the current locale. | 
| 4229 |  |  |  |  |  |  |  | 
| 4230 |  |  |  |  |  |  | =back | 
| 4231 |  |  |  |  |  |  |  | 
| 4232 |  |  |  |  |  |  | =begin comment | 
| 4233 |  |  |  |  |  |  |  | 
| 4234 |  |  |  |  |  |  | =head2 Collation | 
| 4235 |  |  |  |  |  |  |  | 
| 4236 |  |  |  |  |  |  | =over 4 | 
| 4237 |  |  |  |  |  |  |  | 
| 4238 |  |  |  |  |  |  | =item collation() | 
| 4239 |  |  |  |  |  |  |  | 
| 4240 |  |  |  |  |  |  | This method returns a Locale::CLDR::Collator object. This is still in development. Future releases will | 
| 4241 |  |  |  |  |  |  | try and match the API from L<Unicode::Collate> as much as possible and add tailoring for locales. | 
| 4242 |  |  |  |  |  |  |  | 
| 4243 |  |  |  |  |  |  | =back | 
| 4244 |  |  |  |  |  |  |  | 
| 4245 |  |  |  |  |  |  | =end comment | 
| 4246 |  |  |  |  |  |  |  | 
| 4247 |  |  |  |  |  |  | =cut | 
| 4248 |  |  |  |  |  |  |  | 
| 4249 |  |  |  |  |  |  | =begin comment | 
| 4250 |  |  |  |  |  |  |  | 
| 4251 |  |  |  |  |  |  | sub collation { | 
| 4252 |  |  |  |  |  |  | my ($self, %params) = @_; | 
| 4253 |  |  |  |  |  |  |  | 
| 4254 |  |  |  |  |  |  | $params{type} //= $self->_default_collation; | 
| 4255 |  |  |  |  |  |  | $params{strength} //= $self->_default_collation_strength; | 
| 4256 |  |  |  |  |  |  |  | 
| 4257 |  |  |  |  |  |  | return Locale::CLDR::Collator->new(locale => $self, %params); | 
| 4258 |  |  |  |  |  |  | } | 
| 4259 |  |  |  |  |  |  |  | 
| 4260 |  |  |  |  |  |  | sub collation_overrides { | 
| 4261 |  |  |  |  |  |  | my ($self, $type) = @_; | 
| 4262 |  |  |  |  |  |  |  | 
| 4263 |  |  |  |  |  |  | my @bundles = reverse $self->_find_bundle('collation'); | 
| 4264 |  |  |  |  |  |  |  | 
| 4265 |  |  |  |  |  |  | my $override = ''; | 
| 4266 |  |  |  |  |  |  | foreach my $bundle (@bundles) { | 
| 4267 |  |  |  |  |  |  | last if $override = $bundle->collation()->{$type}; | 
| 4268 |  |  |  |  |  |  | } | 
| 4269 |  |  |  |  |  |  |  | 
| 4270 |  |  |  |  |  |  | if ($type ne 'standard' && ! $override) { | 
| 4271 |  |  |  |  |  |  | foreach my $bundle (@bundles) { | 
| 4272 |  |  |  |  |  |  | last if $override = $bundle->collation()->{standard}; | 
| 4273 |  |  |  |  |  |  | } | 
| 4274 |  |  |  |  |  |  | } | 
| 4275 |  |  |  |  |  |  |  | 
| 4276 |  |  |  |  |  |  | return $override || []; | 
| 4277 |  |  |  |  |  |  | } | 
| 4278 |  |  |  |  |  |  |  | 
| 4279 |  |  |  |  |  |  | sub _default_collation { | 
| 4280 |  |  |  |  |  |  | return 'standard'; | 
| 4281 |  |  |  |  |  |  | } | 
| 4282 |  |  |  |  |  |  |  | 
| 4283 |  |  |  |  |  |  | sub _default_collation_strength { | 
| 4284 |  |  |  |  |  |  | return 3; | 
| 4285 |  |  |  |  |  |  | } | 
| 4286 |  |  |  |  |  |  |  | 
| 4287 |  |  |  |  |  |  | =end comment | 
| 4288 |  |  |  |  |  |  |  | 
| 4289 |  |  |  |  |  |  | =head1 Locales | 
| 4290 |  |  |  |  |  |  |  | 
| 4291 |  |  |  |  |  |  | Other locales can be found on CPAN. You can install Language packs from the | 
| 4292 |  |  |  |  |  |  | Locale::CLDR::Locales::* packages. You will in future be able to install language | 
| 4293 |  |  |  |  |  |  | packs for a given territory by looking for a Bundle::Locale::CLDR::* package. | 
| 4294 |  |  |  |  |  |  |  | 
| 4295 |  |  |  |  |  |  | If you are looking for a language pack that is not yet published then get hold of | 
| 4296 |  |  |  |  |  |  | the version 0.25.4 from http://search.cpan.org/CPAN/authors/id/J/JG/JGNI/Locale-CLDR-v0.25.4.tar.gz | 
| 4297 |  |  |  |  |  |  | which has data for all locals alternatively you can get hold of the latest version of the | 
| 4298 |  |  |  |  |  |  | code from git hub at https://github.com/ThePilgrim/perlcldr | 
| 4299 |  |  |  |  |  |  |  | 
| 4300 |  |  |  |  |  |  | =head1 AUTHOR | 
| 4301 |  |  |  |  |  |  |  | 
| 4302 |  |  |  |  |  |  | John Imrie, C<< <JGNI at cpan dot org> >> | 
| 4303 |  |  |  |  |  |  |  | 
| 4304 |  |  |  |  |  |  | =head1 BUGS | 
| 4305 |  |  |  |  |  |  |  | 
| 4306 |  |  |  |  |  |  | Please report any bugs or feature requests to C<bug-locale-cldr at rt.cpan.org>, or through | 
| 4307 |  |  |  |  |  |  | the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Locale-CLDR>.  I will be notified, and then you'll | 
| 4308 |  |  |  |  |  |  | automatically be notified of progress on your bug as I make changes. | 
| 4309 |  |  |  |  |  |  |  | 
| 4310 |  |  |  |  |  |  | =head1 SUPPORT | 
| 4311 |  |  |  |  |  |  |  | 
| 4312 |  |  |  |  |  |  | You can find documentation for this module with the perldoc command. | 
| 4313 |  |  |  |  |  |  |  | 
| 4314 |  |  |  |  |  |  | perldoc Locale::CLDR | 
| 4315 |  |  |  |  |  |  |  | 
| 4316 |  |  |  |  |  |  | You can also look for information at: | 
| 4317 |  |  |  |  |  |  |  | 
| 4318 |  |  |  |  |  |  | =over 4 | 
| 4319 |  |  |  |  |  |  |  | 
| 4320 |  |  |  |  |  |  | =item * RT: CPAN's request tracker | 
| 4321 |  |  |  |  |  |  |  | 
| 4322 |  |  |  |  |  |  | L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Locale-CLDR> | 
| 4323 |  |  |  |  |  |  |  | 
| 4324 |  |  |  |  |  |  | =item * AnnoCPAN: Annotated CPAN documentation | 
| 4325 |  |  |  |  |  |  |  | 
| 4326 |  |  |  |  |  |  | L<http://annocpan.org/dist/Locale-CLDR> | 
| 4327 |  |  |  |  |  |  |  | 
| 4328 |  |  |  |  |  |  | =item * CPAN Ratings | 
| 4329 |  |  |  |  |  |  |  | 
| 4330 |  |  |  |  |  |  | L<http://cpanratings.perl.org/d/Locale-CLDR> | 
| 4331 |  |  |  |  |  |  |  | 
| 4332 |  |  |  |  |  |  | =item * Search CPAN | 
| 4333 |  |  |  |  |  |  |  | 
| 4334 |  |  |  |  |  |  | L<http://search.cpan.org/dist/Locale-CLDR/> | 
| 4335 |  |  |  |  |  |  |  | 
| 4336 |  |  |  |  |  |  | =back | 
| 4337 |  |  |  |  |  |  |  | 
| 4338 |  |  |  |  |  |  |  | 
| 4339 |  |  |  |  |  |  | =head1 ACKNOWLEDGEMENTS | 
| 4340 |  |  |  |  |  |  |  | 
| 4341 |  |  |  |  |  |  | Everyone at the Unicode Consortium for providing the data. | 
| 4342 |  |  |  |  |  |  |  | 
| 4343 |  |  |  |  |  |  | Karl Williams for his tireless work on Unicode in the Perl | 
| 4344 |  |  |  |  |  |  | regex engine. | 
| 4345 |  |  |  |  |  |  |  | 
| 4346 |  |  |  |  |  |  | =head1 COPYRIGHT & LICENSE | 
| 4347 |  |  |  |  |  |  |  | 
| 4348 |  |  |  |  |  |  | Copyright 2009-2015 John Imrie. | 
| 4349 |  |  |  |  |  |  |  | 
| 4350 |  |  |  |  |  |  | This program is free software; you can redistribute it and/or modify it | 
| 4351 |  |  |  |  |  |  | under the terms of either: the GNU General Public License as published | 
| 4352 |  |  |  |  |  |  | by the Free Software Foundation; or the Artistic License. | 
| 4353 |  |  |  |  |  |  |  | 
| 4354 |  |  |  |  |  |  | See http://dev.perl.org/licenses/ for more information. | 
| 4355 |  |  |  |  |  |  |  | 
| 4356 |  |  |  |  |  |  | =cut | 
| 4357 |  |  |  |  |  |  |  | 
| 4358 |  |  |  |  |  |  | 1; # End of Locale::CLDR |