File Coverage

blib/lib/Locale/CLDR.pm
Criterion Covered Total %
statement 1199 1545 77.6
branch 289 544 53.1
condition 116 259 44.7
subroutine 173 202 85.6
pod 55 57 96.4
total 1832 2607 70.2


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