File Coverage

lib/Locale/Intl.pm
Criterion Covered Total %
statement 389 595 65.3
branch 116 280 41.4
condition 85 277 30.6
subroutine 67 104 64.4
pod 27 28 96.4
total 684 1284 53.2


line stmt bran cond sub pod time code
1             ##----------------------------------------------------------------------------
2             ## Locale Intl - ~/lib/Locale/Intl.pm
3             ## Version v0.3.0
4             ## Copyright(c) 2025 DEGUEST Pte. Ltd.
5             ## Author: Jacques Deguest <jack@deguest.jp>
6             ## Created 2024/09/16
7             ## Modified 2025/10/16
8             ## All rights reserved
9             ##
10             ##
11             ## This program is free software; you can redistribute it and/or modify it
12             ## under the same terms as Perl itself.
13             ##----------------------------------------------------------------------------
14             package Locale::Intl;
15             BEGIN
16             {
17 2     2   263814 use v5.10.1;
  2         9  
18 2     2   16 use strict;
  2         4  
  2         102  
19 2     2   22 use warnings;
  2         16  
  2         136  
20 2     2   13 use warnings::register;
  2         4  
  2         178  
21 2     2   1173 use parent qw( Locale::Unicode );
  2         774  
  2         15  
22 2     2   126476 use vars qw( $VERSION $ERROR $DEBUG );
  2         4  
  2         123  
23 2     2   10357 use Locale::Unicode::Data;
  2         262984  
  2         99  
24 2     2   15 use Wanted;
  2         13  
  2         153  
25 2     2   48 our $VERSION = 'v0.3.0';
26             };
27              
28 2     2   8 use strict;
  2         4  
  2         35  
29 2     2   5 use warnings;
  2         2  
  2         7795  
30              
31             sub new
32             {
33 125     125 1 445906 my $this = shift( @_ );
34 125         264 my $locale = shift( @_ );
35 125         552 my $opts = $this->_get_args_as_hash( @_ );
36 125   50     2121 my $self = $this->Locale::Unicode::new( $locale, %$opts ) ||
37             return( $this->pass_error( $this->error ) );
38             # We have to handle 'language' and 'region' specially
39 125 100       13627 if( exists( $opts->{language} ) )
40             {
41 2         5 my $lang = delete( $opts->{language} );
42 2 100 66     17 if( defined( $lang ) &&
43             length( $lang ) )
44             {
45 1   50     6 my $loc = Locale::Unicode->new( $lang ) ||
46             return( $this->pass_error( Locale::Unicode->error ) );
47 1 50       24 if( my $locale2 = $loc->locale )
    0          
48             {
49 1         101 $self->locale( $locale2 );
50 1         113 $self->locale3( undef );
51             }
52             elsif( my $locale3 = $loc->locale3 )
53             {
54 0         0 $self->locale( undef );
55 0         0 $self->locale3( $locale3 );
56             }
57             }
58             # This is not good, but if this is what the user wants...
59             else
60             {
61 1         5 $self->locale( undef );
62 1         101 $self->locale3( undef );
63             }
64             }
65              
66 125 100       568 if( exists( $opts->{region} ) )
67             {
68 2         8 my $region = delete( $opts->{region} );
69 2 50 33     16 if( defined( $region ) &&
70             length( $region ) )
71             {
72             # A country code
73 2 50       13 if( $region =~ /^[a-zA-Z]{2}$/ )
    0          
74             {
75 2         9 $self->country_code( $region );
76 2         305 $self->SUPER::region( undef );
77             }
78             # A world region
79             elsif( $region =~ /^\d{3}$/ )
80             {
81 0         0 $self->country_code( undef );
82 0         0 $self->SUPER::region( $region );
83             }
84             else
85             {
86 0   0     0 return( $self->error( "Unknown region value '", ( $region // 'undef' ), "' provided." ) );
87             }
88             }
89             else
90             {
91 0         0 $self->country_code( undef );
92 0         0 $self->SUPER::region( undef );
93             }
94             }
95             my $map =
96             {
97 3     3   11 calendar => sub{ $self->SUPER::calendar( @_ ); },
98 3     3   11 caseFirst => sub{ $self->colCaseFirst( @_ ); },
99 0     0   0 collation => sub{ $self->SUPER::collation( @_ ); },
100 4     4   15 hourCycle => sub{ $self->hour_cycle( @_ ); },
101 1     1   6 numberingSystem => sub{ $self->number( @_ ); },
102 2     2   8 numeric => sub{ $self->colNumeric( @_ ); },
103 0     0   0 script => sub{ $self->SUPER::script( @_ ) },
104 125         2877 };
105 125         453 foreach my $prop ( keys( %$opts ) )
106             {
107 13 50       45 if( exists( $map->{ $prop } ) )
108             {
109 13         40 my $rv = $map->{ $prop }->( $opts->{ $prop } );
110 13         1609 delete( $opts->{ $prop } );
111 13 50 66     65 if( !defined( $rv ) && $self->error )
112             {
113 0         0 return( $this->pass_error( $self->error ) );
114             }
115             }
116             }
117              
118 125 50       355 if( scalar( keys( %$opts ) ) )
119             {
120 0 0       0 warn( "Unknow option parameters provided: '", join( "', '", map( overload::StrVal( $_ ), sort( keys( %$opts ) ) ) ), "'" ) if( warnings::enabled() );
121             }
122 125         754 $self->{_cldr} = Locale::Unicode::Data->new;
123 125         54557 return( $self );
124             }
125              
126             sub baseName
127             {
128 5     5 1 3268 my $self = shift( @_ );
129 5 50       26 if( my $core = $self->core )
130             {
131 5         763 return( $core );
132             }
133             # Otherwise, as per the specs, we return undef
134 0 0       0 if( want( 'OBJECT' ) )
135             {
136 0         0 return( Locale::Intl::NullObject->new );
137             }
138 0         0 return;
139             }
140              
141             sub calendar
142             {
143 60     60 1 17780 my $self = shift( @_ );
144             # This is a property, so it is read-only, but we need to ensure our parent package method keeps working
145 60 100       197 if( @_ )
146             {
147 8         35 return( $self->SUPER::calendar( @_ ) );
148             }
149              
150 52 100       256 if( my $col = $self->SUPER::calendar )
151             {
152 7         938 return( $col );
153             }
154             # Otherwise, as per the specs, we return undef
155 45 50       4935 if( want( 'OBJECT' ) )
156             {
157 0         0 return( Locale::Intl::NullObject->new );
158             }
159 45         3604 return;
160             }
161              
162             sub caseFirst
163             {
164 6     6 1 2365 my $self = shift( @_ );
165 6 100       29 if( my $cf = $self->colCaseFirst )
166             {
167 3         385 return( $cf );
168             }
169             # Otherwise, as per the specs, we return undef
170 3 50       390 if( want( 'OBJECT' ) )
171             {
172 0         0 return( Locale::Intl::NullObject->new );
173             }
174 3         197 return;
175             }
176              
177             sub collation
178             {
179 104     104 1 44393 my $self = shift( @_ );
180             # This is a property, so it is read-only, but we need to ensure our parent package method keeps working
181 104 100       327 if( @_ )
182             {
183 1         6 return( $self->SUPER::collation( @_ ) );
184             }
185              
186 103 50       439 if( my $col = $self->SUPER::collation )
187             {
188 0         0 return( $col );
189             }
190             # Otherwise, as per the specs, we return undef
191 103 50       12885 if( want( 'OBJECT' ) )
192             {
193 0         0 return( Locale::Intl::NullObject->new );
194             }
195 103         6876 return;
196             }
197              
198             sub error
199             {
200 10     10 1 74 my $self = shift( @_ );
201 10 50       33 if( @_ )
202             {
203 0 0       0 my $msg = join( '', map( ( ref( $_ ) eq 'CODE' ) ? $_->() : $_, @_ ) );
204 0         0 $self->{error} = $ERROR = Locale::Intl::Exception->new({
205             skip_frames => 1,
206             message => $msg,
207             });
208 0 0       0 if( $self->fatal )
209             {
210 0         0 die( $self->{error} );
211             }
212             else
213             {
214 0 0       0 warn( $msg ) if( warnings::enabled() );
215 0 0       0 if( want( 'ARRAY' ) )
    0          
216             {
217 0         0 rreturn( [] );
218             }
219             elsif( want( 'OBJECT' ) )
220             {
221 0         0 rreturn( Locale::Intl::NullObject->new );
222             }
223 0         0 return;
224             }
225             }
226 10 50       89 return( ref( $self ) ? $self->{error} : $ERROR );
227             }
228              
229             sub getAllCalendars
230             {
231 1     1 1 4614 my $self = shift( @_ );
232 1   50     6 my $cldr = $self->_cldr || return( $self->pass_error );
233 1         6 my $all = $cldr->calendars;
234 1         1204 my @cals = map( $_->{calendar}, @$all );
235 1         20 return( \@cals );
236             }
237              
238             sub getAllNumberingSystems
239             {
240 1     1 1 5298 my $self = shift( @_ );
241 1   50     5 my $cldr = $self->_cldr || return( $self->pass_error );
242 1         7 my $all = $cldr->number_systems;
243 1         9822 my @ids = map( $_->{number_system}, @$all );
244 1         121 return( \@ids );
245             }
246              
247             sub getAllTimeZones
248             {
249 1     1 1 5451 my $self = shift( @_ );
250 1   50     6 my $cldr = $self->_cldr || return( $self->pass_error );
251 1         7 my $all = $cldr->timezones;
252 1         31734 my @tzs = map( $_->{timezone}, @$all );
253 1         884 return( \@tzs );
254             }
255              
256             sub getCalendars
257             {
258 4     4 1 24 my $self = shift( @_ );
259 4   50     16 my $cldr = $self->_cldr || return( $self->pass_error );
260 4         8 my $cc;
261             # This is how the algorithm works.
262             # If the locale set has no country code associated, we find out with the maximize() method
263             # Then, we get the preferred calendars, or by default, 'gregory'
264 4 100       18 unless( $cc = $self->country_code )
265             {
266 3         381 my $lang = $self->maximize;
267 3   50     15 my $new = $self->new( $lang ) || return( $self->pass_error );
268 3   50     31 $cc = $new->country_code || return( $self->error( "Unable to find out a country code for this locale '", $self->core, "', or '${lang}'" ) );
269             }
270 4   50     611 my $ref = $cldr->territory( territory => $cc ) ||
271             return( $self->error( "Unknown territory code '${cc}'" ) );
272 4         4884 my $cals = $ref->{calendars};
273             # If there are no calendars identified for this territory, by standard, we must look it up in the 'World' territory, i.e. '001'
274 4 50 66     39 unless( $cals && ref( $cals ) eq 'ARRAY' && scalar( @$cals ) )
      100        
275             {
276 1   50     6 $ref = $cldr->territory( territory => '001' ) ||
277             return( $self->error( "Unknown territory code '001' used for World ! This should not be happening." ) );
278 1 50 33     2689 if( $ref &&
      50        
      33        
      50        
279             $ref->{calendars} &&
280             ref( $ref->{calendars} // '' ) eq 'ARRAY' &&
281 1         6 scalar( @{$ref->{calendars}} ) )
282             {
283 1         3 $cals = $ref->{calendars};
284             }
285             else
286             {
287 0         0 return( $self->error( "Unable to find the calendars data for the territory '001' (World). This should not be happening." ) );
288             }
289             }
290 4         38 return( $cals );
291             }
292              
293             sub getCollations
294             {
295 3     3 1 22 my $self = shift( @_ );
296 3   50     15 my $cldr = $self->_cldr || return( $self->pass_error );
297 3         20 my $core = $self->core;
298 3   50     353 my $tree = $cldr->make_inheritance_tree( $core ) ||
299             return( $self->pass_error( $cldr->error ) );
300 3         26555 my $collations;
301 3         11 foreach my $loc ( @$tree )
302             {
303 4         44 my $ref = $cldr->locale(
304             locale => $loc,
305             );
306 4 50 33     4335 return( $self->pass_error( $cldr->error ) ) if( !defined( $ref ) && $cldr->error );
307 4 50 66     59 if( $ref &&
      66        
      100        
308             defined( $ref->{collations} ) &&
309             ref( $ref->{collations} ) eq 'ARRAY' &&
310 3         17 scalar( @{$ref->{collations}} ) )
311             {
312 3         10 $collations = $ref->{collations};
313 3         17 last;
314             }
315             }
316 3         20 return( $collations );
317             }
318              
319             sub getHourCycles
320             {
321 3     3 1 20 my $self = shift( @_ );
322 3   50     12 my $cldr = $self->_cldr || return( $self->pass_error );
323             # If an hour cycle has been set, return it, as per the specs.
324 3 100       16 if( my $hc = $self->hour_cycle )
325             {
326 1         107 return( [$hc] );
327             }
328 2         227 my $core = $self->core;
329             # Maybe something like fr-CA ?
330 2         513 my $ref = $cldr->time_format( region => $core );
331 2 50       1734 if( !$ref )
332             {
333 2   33     11 my $cc = ( $self->country_code || $self->SUPER::region );
334 2 50       300 unless( $cc )
335             {
336 0   0     0 my $full = $self->maximize || return( $self->pass_error );
337 0   0     0 my $loc = $self->new( $full ) || return( $self->pass_error );
338 0   0     0 $cc = ( $self->country_code || $self->SUPER::region );
339             }
340 2 50       7 return( [] ) if( !$cc );
341 2         11 my $all = $cldr->time_formats( territory => $cc );
342 2 50 33     2751 return( $self->pass_error( $cldr->error ) ) if( !defined( $all ) && $cldr->error );
343 2 50 33     22 $ref = $all->[0] if( $all && ref( $all ) eq 'ARRAY' );
344             }
345 2 50 33     20 if( $ref &&
      33        
346             exists( $ref->{time_format} ) &&
347             $ref->{time_format} )
348             {
349 2         16 my $map =
350             {
351             h => 'h12',
352             H => 'h23',
353             k => 'h24',
354             K => 'h11',
355             };
356 2 50       11 my @rv = map{ $map->{ $_ } || $_ } split( //, $ref->{time_format} );
  2         40  
357 2         20 return( \@rv );
358             }
359 0         0 return( [] );
360             }
361              
362             sub getNumberingSystems
363             {
364 2     2 1 16 my $self = shift( @_ );
365             # "If the Locale already has a numberingSystem, then the returned array contains that single value."
366 2 50       18 if( my $nu = $self->number )
367             {
368 0         0 return( [$nu] );
369             }
370 2   50     325 my $cldr = $self->_cldr || return( $self->pass_error );
371 2         13 my $core = $self->core;
372 2   50     500 my $tree = $cldr->make_inheritance_tree( $core ) ||
373             return( $self->pass_error( $cldr->error ) );
374 2         15070 my $num_sys;
375 2         7 foreach my $loc ( @$tree )
376             {
377 3         20 my $ref = $cldr->locale_number_system(
378             locale => $loc,
379             );
380 3 50 33     2077 return( $self->pass_error( $cldr->error ) ) if( !defined( $ref ) && $cldr->error );
381 3 100 100     38 if( $ref &&
      66        
382             length( $ref->{number_system} // '' ) )
383             {
384 2         6 $num_sys = $ref->{number_system};
385 2         11 last;
386             }
387             }
388             # Although we return an array, in reality, there is only one element in the array.
389 2 50       17 return( [$num_sys] ) if( defined( $num_sys ) );
390 0         0 return( [] );
391             }
392              
393             sub getTextInfo
394             {
395 2     2 1 13 my $self = shift( @_ );
396 2   50     11 my $cldr = $self->_cldr || return( $self->pass_error );
397 2         15 my $core = $self->core;
398 2   50     269 my $tree = $cldr->make_inheritance_tree( $core ) ||
399             return( $self->pass_error( $cldr->error ) );
400 2         13662 my $orientation;
401 2         8 foreach my $loc ( @$tree )
402             {
403 3         15 my $ref = $cldr->locales_info(
404             locale => $loc,
405             property => 'char_orientation',
406             );
407 3 50 66     12364 return( $self->pass_error( $cldr->error ) ) if( !defined( $ref ) && $cldr->error );
408 3 100 50     68 if( $ref &&
      66        
409             length( $ref->{value} // '' ) )
410             {
411 2         7 $orientation = $ref->{value};
412 2         8 last;
413             }
414             }
415 2         12 my $map =
416             {
417             'right-to-left' => 'rtl',
418             'left-to-right' => 'ltr',
419             };
420 2 50       7 if( defined( $orientation ) )
421             {
422 2 50       9 return( $self->error( "Unsupported value '${orientation}' found for locale '${core}'" ) ) if( !exists( $map->{ $orientation } ) );
423 2         17 return( $map->{ $orientation } );
424             }
425 0         0 return( 'ltr' );
426             }
427              
428             sub getTimeZones
429             {
430 4     4 1 54 my $self = shift( @_ );
431 4   50     20 my $cldr = $self->_cldr || return( $self->pass_error );
432 4         17 my $cc = $self->country_code;
433 4 100       494 unless( $cc )
434             {
435 1         6 my $full = $self->maximize;
436 1   50     6 my $loc = $self->new( $full ) || return( $self->error );
437 1         11 $cc = $loc->country_code;
438             }
439 4 50       184 if( $cc )
440             {
441 4   50     23 my $all = $cldr->timezones( territory => $cc, is_canonical => 1 ) ||
442             return( $self->pass_error( $cldr->error ) );
443 4         3828 my @timezones = map( $_->{timezone}, @$all );
444 4         35 return( \@timezones );
445             }
446             else
447             {
448 0         0 return( [] );
449             }
450             }
451              
452             sub getWeekInfo
453             {
454 4     4 1 23 my $self = shift( @_ );
455 4   50     16 my $cldr = $self->_cldr || return( $self->pass_error );
456 4         19 my $core = $self->core;
457 4         737 my $cc;
458 4 100       14 unless( $cc = $self->country_code )
459             {
460 2   50     237 my $full = $self->maximize || return( $self->pass_error );
461 2   50     21 my $locale = $self->new( $full ) || return( $self->pass_error );
462 2   50     20 $cc = $locale->country_code || return( $self->error( "No country code could be derived for this locale ${core}" ) );
463             }
464 4         613 my $info = $cldr->territory( territory => $cc );
465 4         2046 my $fallback;
466 4         9 my $def = {};
467             # Firt day of the week
468 4 50 50     26 if( length( $info->{first_day} // '' ) )
469             {
470 4         17 $def->{firstDay} = $info->{first_day};
471             }
472             else
473             {
474             # 001 is the code for World, acting as the default fallback value
475 0 0       0 $fallback = $cldr->territory( territory => '001' ) if( !defined( $fallback ) );
476 0 0       0 $def->{firstDay} = $fallback->{first_day} if( $fallback );
477             }
478             # Minimum number of days for calendar display
479 4 100 100     29 if( length( $info->{min_days} // '' ) )
480             {
481 1         3 $def->{minimalDays} = $info->{min_days};
482             }
483             else
484             {
485             # 001 is the code for World, acting as the default fallback value
486 3 50       19 $fallback = $cldr->territory( territory => '001' ) if( !defined( $fallback ) );
487 3 50       1375 $def->{minimalDays} = $fallback->{min_days} if( $fallback );
488             }
489             # Week-end start, end
490             # The value is already an array reference in the database
491 4 100 100     28 if( length( $info->{weekend} // '' ) )
492             {
493 1         3 $def->{weekend} = $info->{weekend};
494             }
495             else
496             {
497             # 001 is the code for World, acting as the default fallback value
498 3 100       80 $fallback = $cldr->territory( territory => '001' ) if( !defined( $fallback ) );
499 3 50       469 $def->{weekend} = $fallback->{weekend} if( $fallback );
500             }
501 4         54 return( $def );
502             }
503              
504             sub hourCycle
505             {
506 7     7 1 256 my $self = shift( @_ );
507             # If hour cycle has been set as component of the locale, or as an object option
508             # we return it
509 7 100       33 if( my $hc = $self->hour_cycle )
510             {
511 2         229 return( $hc );
512             }
513             # Otherwise, as per the specs, we return undef
514 5 50       522 if( want( 'OBJECT' ) )
515             {
516 0         0 return( Locale::Intl::NullObject->new );
517             }
518 5         338 return;
519             }
520              
521             sub language
522             {
523 294     294 1 433750 my $self = shift( @_ );
524 294 100       1023 if( @_ )
525             {
526 196         351 my $val = shift( @_ );
527 196 100       646 if( !defined( $val ) )
    50          
528             {
529 1         6 $self->SUPER::language( undef );
530 1         158 $self->SUPER::language3( undef );
531             }
532             elsif( length( $val ) == 2 )
533             {
534 195         747 $self->SUPER::language( $val );
535             }
536             else
537             {
538 0         0 $self->SUPER::language3( $val );
539             }
540             }
541 294 100 100     31516 if( my $loc = ( $self->SUPER::language || $self->SUPER::language3 ) )
542             {
543 292         37832 return( $loc );
544             }
545 2 50       711 if( want( 'OBJECT' ) )
546             {
547 0         0 return( Locale::Intl::NullObject->new );
548             }
549 2         143 return;
550             }
551              
552 0     0 1 0 sub maximise { return( shift->maximize( @_ ) ); }
553              
554             sub maximize
555             {
556 19     19 1 72 my $self = shift( @_ );
557 19   50     59 my $cldr = $self->_cldr || return( $self->pass_error );
558 19         71 my $core = $self->core;
559 19   50     2076 my $tree = $cldr->make_inheritance_tree( $core ) ||
560             return( $self->pass_error( $cldr->error ) );
561 19         131959 my $full;
562 19         62 foreach my $loc ( @$tree )
563             {
564 19         145 my $ref = $cldr->likely_subtag( locale => $loc );
565 19 50 33     18862 if( $ref && $ref->{target} )
566             {
567 19         73 $full = $ref->{target};
568 19         64 last;
569             }
570             }
571              
572 19 50       51 if( defined( $full ) )
573             {
574 19         88 my $new = $self->new( $full );
575 19         128 my $clone = $self->clone;
576 19 50       258 if( my $locale = $new->locale )
    0          
577             {
578 19         1988 $clone->locale( $locale );
579             }
580             elsif( my $locale3 = $new->locale3 )
581             {
582 0         0 $clone->locale3( $locale3 );
583             }
584              
585 19 50       1923 if( my $script = $new->script )
586             {
587 19         55 $clone->script( $script );
588             }
589              
590 19 50       1987 if( my $cc = $new->country_code )
    0          
591             {
592 19         2128 $clone->country_code( $cc );
593             }
594             elsif( my $code = $new->region )
595             {
596 0         0 $clone->region( $code );
597             }
598              
599 19 50       2752 if( my $variant = $new->variant )
600             {
601 0         0 $clone->variant( $variant );
602             }
603 19         5066 return( $clone );
604             }
605             else
606             {
607 0         0 return( $self );
608             }
609             }
610              
611 0     0 1 0 sub minimise { return( shift->minimize( @_ ) ); }
612              
613             sub minimize
614             {
615 7     7 1 43 my $self = shift( @_ );
616 7   50     45 my $cldr = $self->_cldr || return( $self->pass_error );
617 7         25 my $core = $self->core;
618 7         1239 my $locale = $self->locale;
619 7         579 my $locale3 = $self->locale3;
620 7         585 my $script = $self->script;
621 7         22 my $cc = $self->country_code;
622 7         744 my $clone = $self->clone;
623 7         70 $clone->locale( undef );
624 7         589 $clone->locale3( undef );
625 7         499 $clone->script( undef );
626 7         636 $clone->country_code( undef );
627 7         649 $clone->SUPER::region( undef );
628 7 100 66     654 if( !defined( $locale ) || !length( $locale ) )
629             {
630             # If und, this should become, with maximize(), en-Latn-US
631 1   50     5 $locale3 //= 'und';
632 1         6 my $test = $self->new( "${locale3}" )->maximize;
633 1         11 $core = $test->core;
634             # Maybe the locale3 provided is an invalid locale3, such as xyz. If so we would return it.
635 1 50       249 if( $core eq $locale3 )
636             {
637 0         0 return( $self );
638             }
639 1         5 $locale = $test->locale;
640 1         112 $locale3 = $test->locale3;
641 1         100 $script = $test->script;
642 1         5 $cc = $test->country_code;
643 1         119 $clone->locale( $locale );
644             }
645              
646             # First check if there is nothing to do
647             # Even if it is an unknown language, such as xy, we still return it.
648 7 50 33     160 if( defined( $locale ) &&
      33        
649             length( $locale ) &&
650             $core eq $locale )
651             {
652 0         0 return( $self );
653             }
654              
655 7         69 my $test = $self->new( "$locale" )->maximize;
656 7         65 my $test_locale = $test->locale;
657             # Maybe the same as our initial locale
658             # For example: fr-FR -> fr-Latn-FR
659             # but
660             # und-Latn -> en-Latn-US
661 7 50       671 if( $test_locale )
662             {
663 7         22 $clone->locale( $test_locale );
664             }
665             # Should not happen
666             else
667             {
668 0         0 return( $self->error( "Unable to get a locale language by maximising \"${core}\"" ) );
669             }
670             # First check if we have a country code, and maybe if this country code is the authority for this language
671             # such as fr -> fr-FR
672             # We get the maximised version derived from the 2-characters language and if it bears the same country code,
673             # this means, this is the authoritative country for this language, and there is no need to add the country code.
674             # Next, we check if the script, if any, can be removed. For that we use $CLDR_LANGUAGE_SCRIPTS and if found, we check
675             # if it is the sole entry for this language. If not found, this means the script is the default 'Latn'
676 7         614 my $test_cc = $test->country_code;
677 7         649 my $test_script = $test->script;
678             # Our country code is different than the default one for this locale, so we keep it
679 7 50       26 if( $cc )
    0          
680             {
681 7 100       32 if( $cc ne $test_cc )
682             {
683 1         5 $clone->country_code( $cc );
684             }
685             }
686             elsif( $test_cc )
687             {
688 0         0 $clone->country_code( $test_cc );
689             }
690 7 50       156 if( $script )
691             {
692 7         41 my $info = $cldr->language( language => $test_locale );
693 7         7497 my $lang_scripts;
694 7 50 33     90 if( $info &&
      50        
      33        
      50        
695             exists( $info->{scripts} ) &&
696             ref( $info->{scripts} // '' ) eq 'ARRAY' &&
697 7         30 scalar( @{$info->{scripts}} ) )
698             {
699 7         13 $lang_scripts = $info->{scripts};
700             }
701             else
702             {
703 0         0 $lang_scripts = ['Latn'];
704             }
705             # There could be more than 1 script, but if our script is the first, i.e.
706             # preferred one, it becomes superflous.
707 7 100       64 if( $script ne $lang_scripts->[0] )
708             {
709 1         6 $clone->script( $script );
710             }
711             }
712 7         256 return( $clone );
713             }
714              
715             sub numberingSystem
716             {
717 4     4 1 188 my $self = shift( @_ );
718 4 100       19 if( my $num = $self->number )
719             {
720 2         233 return( $num );
721             }
722              
723 2 50       205 if( want( 'OBJECT' ) )
724             {
725 0         0 return( Locale::Intl::NullObject->new );
726             }
727 2         128 return;
728             }
729              
730             sub numeric
731             {
732 5     5 1 459 my $self = shift( @_ );
733 5 100       22 if( defined( my $bool = $self->colNumeric ) )
734             {
735 2 100       298 return( $bool ? Locale::Intl::Boolean->true : Locale::Intl::Boolean->false );
736             }
737              
738 3 50       354 if( want( 'OBJECT' ) )
739             {
740 0         0 return( Locale::Intl::NullObject->new );
741             }
742 3         228 return;
743             }
744              
745             sub pass_error
746             {
747 0     0 0 0 my $self = shift( @_ );
748 0   0     0 my $pack = ref( $self ) || $self;
749 0         0 my $opts = {};
750 0         0 my( $err, $class, $code );
751 2     2   18 no strict 'refs';
  2         2  
  2         2755  
752 0 0       0 if( scalar( @_ ) )
753             {
754             # Either an hash defining a new error and this will be passed along to error(); or
755             # an hash with a single property: { class => 'Some::ExceptionClass' }
756 0 0 0     0 if( scalar( @_ ) == 1 && ref( $_[0] ) eq 'HASH' )
757             {
758 0         0 $opts = $_[0];
759             }
760             else
761             {
762 0 0 0     0 if( scalar( @_ ) > 1 && ref( $_[-1] ) eq 'HASH' )
763             {
764 0         0 $opts = pop( @_ );
765             }
766 0         0 $err = $_[0];
767             }
768             }
769 0 0 0     0 $err = $opts->{error} if( !defined( $err ) && CORE::exists( $opts->{error} ) && defined( $opts->{error} ) && CORE::length( $opts->{error} ) );
      0        
      0        
770             # We set $class only if the hash provided is a one-element hash and not an error-defining hash
771 0 0 0     0 $class = $opts->{class} if( CORE::exists( $opts->{class} ) && defined( $opts->{class} ) && CORE::length( $opts->{class} ) );
      0        
772 0 0 0     0 $code = $opts->{code} if( CORE::exists( $opts->{code} ) && defined( $opts->{code} ) && CORE::length( $opts->{code} ) );
      0        
773            
774             # called with no argument, most likely from the same class to pass on an error
775             # set up earlier by another method; or
776             # with an hash containing just one argument class => 'Some::ExceptionClass'
777 0 0 0     0 if( !defined( $err ) && ( !scalar( @_ ) || defined( $class ) ) )
    0 0        
      0        
      0        
      0        
778             {
779             # $error is a previous erro robject
780 0 0       0 my $error = ref( $self ) ? $self->{error} : length( ${ $pack . '::ERROR' } ) ? ${ $pack . '::ERROR' } : undef;
  0 0       0  
  0         0  
781 0 0       0 if( !defined( $error ) )
782             {
783 0         0 warn( "No error object provided and no previous error set either! It seems the previous method call returned a simple undef" );
784             }
785             else
786             {
787 0 0       0 $err = ( defined( $class ) ? bless( $error => $class ) : $error );
788 0 0       0 $err->code( $code ) if( defined( $code ) );
789             }
790             }
791             elsif( defined( $err ) &&
792             Scalar::Util::blessed( $err ) &&
793             ( scalar( @_ ) == 1 ||
794             ( scalar( @_ ) == 2 && defined( $class ) )
795             ) )
796             {
797 0 0       0 $self->{error} = ${ $pack . '::ERROR' } = ( defined( $class ) ? bless( $err => $class ) : $err );
  0         0  
798 0 0 0     0 $self->{error}->code( $code ) if( defined( $code ) && $self->{error}->can( 'code' ) );
799            
800 0 0 0     0 if( $self->{fatal} || ( defined( ${"${class}\::FATAL_EXCEPTIONS"} ) && ${"${class}\::FATAL_EXCEPTIONS"} ) )
  0   0     0  
  0         0  
801             {
802 0         0 die( $self->{error} );
803             }
804             }
805             # If the error provided is not an object, we call error to create one
806             else
807             {
808 0         0 return( $self->error( @_ ) );
809             }
810            
811 0 0       0 if( want( 'OBJECT' ) )
812             {
813 0         0 rreturn( Locale::Intl::NullObject->new );
814             }
815 0         0 return;
816             }
817              
818             # NOTE: Locale::Unicode makes a distinction between a country code (a 2-letters code) and a region (a 3-digits numeric code)
819             sub region
820             {
821 67     67 1 9807 my $self = shift( @_ );
822 67 100       243 if( @_ )
823             {
824 3         15 return( $self->SUPER::region( @_ ) );
825             }
826 64 100 100     179 if( my $rg = ( $self->country_code || $self->SUPER::region ) )
827             {
828 3         504 return( $rg );
829             }
830              
831 61 50       14129 if( want( 'OBJECT' ) )
832             {
833 0         0 return( Locale::Intl::NullObject->new );
834             }
835 61         4226 return;
836             }
837              
838             sub script
839             {
840 211     211 1 20865 my $self = shift( @_ );
841             # This is a property, so it is read-only, but we need to ensure our parent package method keeps working
842 211 100       653 if( @_ )
843             {
844 82         328 return( $self->SUPER::script( @_ ) );
845             }
846              
847 129 100       386 if( my $script = $self->SUPER::script )
848             {
849 66         6174 return( $script );
850             }
851              
852 63 50       6032 if( want( 'OBJECT' ) )
853             {
854 0         0 return( Locale::Intl::NullObject->new );
855             }
856 63         4108 return;
857             }
858              
859 3     3 1 30 sub toString { return( shift->as_string ); }
860              
861             sub _cldr
862             {
863 51     51   145 my $self = shift( @_ );
864 51         95 my $cldr;
865 51 100       161 if( ref( $self ) )
866             {
867             $cldr = $self->{_cldr} ||
868 48   50     187 return( $self->error( "The Locale::Unicode::Data object is gone!" ) );
869             }
870             else
871             {
872 3   50     19 $cldr = Locale::Unicode::Data->new ||
873             return( $self->pass_error( Locale::Unicode::Data->error ) );
874             }
875 51         940 return( $cldr );
876             }
877              
878             # NOTE: Locale::Intl::Exception class
879             package Locale::Intl::Exception;
880             BEGIN
881             {
882 2     2   20 use strict;
  2         4  
  2         49  
883 2     2   6 use warnings;
  2         2  
  2         146  
884 2     2   12 use vars qw( $VERSION );
  2         3  
  2         187  
885             use overload (
886             '""' => 'as_string',
887 0     0   0 bool => sub{ $_[0] },
888 2         22 fallback => 1,
889 2     2   12 );
  2         15  
890 2     2   230 our $VERSION = 'v0.1.0';
891             };
892 2     2   7 use strict;
  2         2  
  2         40  
893 2     2   5 use warnings;
  2         3  
  2         745  
894              
895             sub new
896             {
897 0     0   0 my $this = shift( @_ );
898 0   0     0 my $self = bless( {} => ( ref( $this ) || $this ) );
899 0         0 my @info = caller;
900 0         0 @$self{ qw( package file line ) } = @info[0..2];
901 0         0 my $args = {};
902 0 0       0 if( scalar( @_ ) == 1 )
903             {
904 0 0 0     0 if( ( ref( $_[0] ) || '' ) eq 'HASH' )
    0 0        
905             {
906 0         0 $args = shift( @_ );
907 0 0       0 if( $args->{skip_frames} )
908             {
909 0         0 @info = caller( int( $args->{skip_frames} ) );
910 0         0 @$self{ qw( package file line ) } = @info[0..2];
911             }
912 0   0     0 $args->{message} ||= '';
913 0         0 foreach my $k ( qw( package file line message code type retry_after ) )
914             {
915 0 0       0 $self->{ $k } = $args->{ $k } if( CORE::exists( $args->{ $k } ) );
916             }
917             }
918             elsif( ref( $_[0] ) && $_[0]->isa( 'Locale::Intl::Exception' ) )
919             {
920 0         0 my $o = $args->{object} = shift( @_ );
921 0         0 $self->{message} = $o->message;
922 0         0 $self->{code} = $o->code;
923 0         0 $self->{type} = $o->type;
924 0         0 $self->{retry_after} = $o->retry_after;
925             }
926             else
927             {
928 0         0 die( "Unknown argument provided: '", overload::StrVal( $_[0] ), "'" );
929             }
930             }
931             else
932             {
933 0 0       0 $args->{message} = join( '', map( ref( $_ ) eq 'CODE' ? $_->() : $_, @_ ) );
934             }
935 0         0 return( $self );
936             }
937              
938             # This is important as stringification is called by die, so as per the manual page, we need to end with new line
939             # And will add the stack trace
940             sub as_string
941             {
942 2     2   14 no overloading;
  2         3  
  2         1571  
943 0     0   0 my $self = shift( @_ );
944 0 0 0     0 return( $self->{_cache_value} ) if( $self->{_cache_value} && !CORE::length( $self->{_reset} ) );
945 0         0 my $str = $self->message;
946 0         0 $str = "$str";
947 0         0 $str =~ s/\r?\n$//g;
948 0   0     0 $str .= sprintf( " within package %s at line %d in file %s", ( $self->{package} // 'undef' ), ( $self->{line} // 'undef' ), ( $self->{file} // 'undef' ) );
      0        
      0        
949 0         0 $self->{_cache_value} = $str;
950 0         0 CORE::delete( $self->{_reset} );
951 0         0 return( $str );
952             }
953              
954 0     0   0 sub code { return( shift->reset(@_)->_set_get_prop( 'code', @_ ) ); }
955              
956 0     0   0 sub file { return( shift->reset(@_)->_set_get_prop( 'file', @_ ) ); }
957              
958 0     0   0 sub line { return( shift->reset(@_)->_set_get_prop( 'line', @_ ) ); }
959              
960 0     0   0 sub message { return( shift->reset(@_)->_set_get_prop( 'message', @_ ) ); }
961              
962 0     0   0 sub package { return( shift->reset(@_)->_set_get_prop( 'package', @_ ) ); }
963              
964             # From perlfunc docmentation on "die":
965             # "If LIST was empty or made an empty string, and $@ contains an
966             # object reference that has a "PROPAGATE" method, that method will
967             # be called with additional file and line number parameters. The
968             # return value replaces the value in $@; i.e., as if "$@ = eval {
969             # $@->PROPAGATE(__FILE__, __LINE__) };" were called."
970             sub PROPAGATE
971             {
972 0     0   0 my( $self, $file, $line ) = @_;
973 0 0 0     0 if( defined( $file ) && defined( $line ) )
974             {
975 0         0 my $clone = $self->clone;
976 0         0 $clone->file( $file );
977 0         0 $clone->line( $line );
978 0         0 return( $clone );
979             }
980 0         0 return( $self );
981             }
982              
983             sub reset
984             {
985 0     0   0 my $self = shift( @_ );
986 0 0 0     0 if( !CORE::length( $self->{_reset} ) && scalar( @_ ) )
987             {
988 0         0 $self->{_reset} = scalar( @_ );
989             }
990 0         0 return( $self );
991             }
992              
993             sub rethrow
994             {
995 0     0   0 my $self = shift( @_ );
996 0 0       0 return if( !ref( $self ) );
997 0         0 die( $self );
998             }
999              
1000 0     0   0 sub retry_after { return( shift->_set_get_prop( 'retry_after', @_ ) ); }
1001              
1002             sub throw
1003             {
1004 0     0   0 my $self = shift( @_ );
1005 0         0 my $e;
1006 0 0       0 if( @_ )
1007             {
1008 0         0 my $msg = shift( @_ );
1009 0         0 $e = $self->new({
1010             skip_frames => 1,
1011             message => $msg,
1012             });
1013             }
1014             else
1015             {
1016 0         0 $e = $self;
1017             }
1018 0         0 die( $e );
1019             }
1020              
1021 0     0   0 sub type { return( shift->reset(@_)->_set_get_prop( 'type', @_ ) ); }
1022              
1023             sub _set_get_prop
1024             {
1025 0     0   0 my $self = shift( @_ );
1026 0   0     0 my $prop = shift( @_ ) || die( "No object property was provided." );
1027 0 0       0 $self->{ $prop } = shift( @_ ) if( @_ );
1028 0         0 return( $self->{ $prop } );
1029             }
1030              
1031             sub FREEZE
1032             {
1033 0     0   0 my $self = CORE::shift( @_ );
1034 0   0     0 my $serialiser = CORE::shift( @_ ) // '';
1035 0         0 my $class = CORE::ref( $self );
1036 0         0 my %hash = %$self;
1037             # Return an array reference rather than a list so this works with Sereal and CBOR
1038             # On or before Sereal version 4.023, Sereal did not support multiple values returned
1039 0 0 0     0 CORE::return( [$class, \%hash] ) if( $serialiser eq 'Sereal' && Sereal::Encoder->VERSION <= version->parse( '4.023' ) );
1040             # But Storable want a list with the first element being the serialised element
1041 0         0 CORE::return( $class, \%hash );
1042             }
1043              
1044 0     0   0 sub STORABLE_freeze { return( shift->FREEZE( @_ ) ); }
1045              
1046 0     0   0 sub STORABLE_thaw { return( shift->THAW( @_ ) ); }
1047              
1048             # NOTE: CBOR will call the THAW method with the stored classname as first argument, the constant string CBOR as second argument, and all values returned by FREEZE as remaining arguments.
1049             # NOTE: Storable calls it with a blessed object it created followed with $cloning and any other arguments initially provided by STORABLE_freeze
1050             sub THAW
1051             {
1052 0     0   0 my( $self, undef, @args ) = @_;
1053 0 0 0     0 my $ref = ( CORE::scalar( @args ) == 1 && CORE::ref( $args[0] ) eq 'ARRAY' ) ? CORE::shift( @args ) : \@args;
1054 0 0 0     0 my $class = ( CORE::defined( $ref ) && CORE::ref( $ref ) eq 'ARRAY' && CORE::scalar( @$ref ) > 1 ) ? CORE::shift( @$ref ) : ( CORE::ref( $self ) || $self );
      0        
1055 0 0       0 my $hash = CORE::ref( $ref ) eq 'ARRAY' ? CORE::shift( @$ref ) : {};
1056 0         0 my $new;
1057             # Storable pattern requires to modify the object it created rather than returning a new one
1058 0 0       0 if( CORE::ref( $self ) )
1059             {
1060 0         0 foreach( CORE::keys( %$hash ) )
1061             {
1062 0         0 $self->{ $_ } = CORE::delete( $hash->{ $_ } );
1063             }
1064 0         0 $new = $self;
1065             }
1066             else
1067             {
1068 0         0 $new = CORE::bless( $hash => $class );
1069             }
1070 0         0 CORE::return( $new );
1071             }
1072              
1073 0     0   0 sub TO_JSON { return( shift->as_string ); }
1074              
1075             # NOTE: Locale::Intl::Boolean class
1076             package Locale::Intl::Boolean;
1077             BEGIN
1078             {
1079 2     2   12 use strict;
  2         3  
  2         45  
1080 2     2   5 use warnings;
  2         3  
  2         76  
1081 2     2   6 use vars qw( $true $false );
  2         3  
  2         190  
1082             use overload
1083 4     4   1190 "0+" => sub{ ${$_[0]} },
  4         28  
1084 0     0   0 "++" => sub{ $_[0] = ${$_[0]} + 1 },
  0         0  
1085 0     0   0 "--" => sub{ $_[0] = ${$_[0]} - 1 },
  0         0  
1086 2     2   8 fallback => 1;
  2         2  
  2         14  
1087 2     2   269 $true = do{ bless( \( my $dummy = 1 ) => 'Locale::Intl::Boolean' ) };
  2         6  
1088 2         2 $false = do{ bless( \( my $dummy = 0 ) => 'Locale::Intl::Boolean' ) };
  2         3  
1089 2         42 our( $VERSION ) = 'v0.1.0';
1090             };
1091              
1092 2     2   8 use strict;
  2         3  
  2         41  
1093 2     2   5 use warnings;
  2         2  
  2         643  
1094              
1095 0 0   0   0 sub new { return( $_[1] ? $true : $false ); }
1096              
1097 1     1   23 sub false () { $false }
1098              
1099 1     1   19 sub true () { $true }
1100              
1101             sub FREEZE
1102             {
1103 0     0     my $self = CORE::shift( @_ );
1104 0   0       my $serialiser = CORE::shift( @_ ) // '';
1105 0           my $class = CORE::ref( $self );
1106             # Return an array reference rather than a list so this works with Sereal and CBOR
1107             # On or before Sereal version 4.023, Sereal did not support multiple values returned
1108 0 0 0       CORE::return( [$class, $$self] ) if( $serialiser eq 'Sereal' && Sereal::Encoder->VERSION <= version->parse( '4.023' ) );
1109             # But Storable want a list with the first element being the serialised element
1110 0           CORE::return( $$self );
1111             }
1112              
1113 0     0     sub STORABLE_freeze { CORE::return( CORE::shift->FREEZE( @_ ) ); }
1114              
1115 0     0     sub STORABLE_thaw { CORE::return( CORE::shift->THAW( @_ ) ); }
1116              
1117             # NOTE: CBOR will call the THAW method with the stored classname as first argument, the constant string CBOR as second argument, and all values returned by FREEZE as remaining arguments.
1118             # NOTE: Storable calls it with a blessed object it created followed with $cloning and any other arguments initially provided by STORABLE_freeze
1119             sub THAW
1120             {
1121 0     0     my( $self, undef, @args ) = @_;
1122 0           my( $class, $str );
1123 0 0 0       if( CORE::scalar( @args ) == 1 && CORE::ref( $args[0] ) eq 'ARRAY' )
1124             {
1125 0           ( $class, $str ) = @{$args[0]};
  0            
1126             }
1127             else
1128             {
1129 0   0       $class = CORE::ref( $self ) || $self;
1130 0           $str = CORE::shift( @args );
1131             }
1132             # Storable pattern requires to modify the object it created rather than returning a new one
1133 0 0         if( CORE::ref( $self ) )
1134             {
1135 0           $$self = $str;
1136 0           CORE::return( $self );
1137             }
1138             else
1139             {
1140 0           CORE::return( $class->new( $str ) );
1141             }
1142             }
1143              
1144             sub TO_JSON
1145             {
1146             # JSON does not check that the value is a proper true or false. It stupidly assumes this is a string
1147             # The only way to make it understand is to return a scalar ref of 1 or 0
1148             # return( $_[0] ? 'true' : 'false' );
1149 0 0   0     return( $_[0] ? \1 : \0 );
1150             }
1151              
1152             {
1153             # NOTE: Locale::Intl::NullObject class
1154             package
1155             Locale::Intl::NullObject;
1156             BEGIN
1157 0         0 {
1158 2     2   13 use strict;
  2         3  
  2         55  
1159 2     2   9 use warnings;
  2         2  
  2         105  
1160             use overload (
1161 0     0   0 '""' => sub{ '' },
1162 2         22 fallback => 1,
1163 2     2   24 );
  2         3  
1164 2     2   103 use Wanted;
  2     0   2  
  2         127  
1165             };
1166 2     2   6 use strict;
  2         2  
  2         27  
1167 2     2   5 use warnings;
  2         1  
  2         412  
1168              
1169             sub new
1170             {
1171 0     0     my $this = shift( @_ );
1172 0 0         my $ref = @_ ? { @_ } : {};
1173 0   0       return( bless( $ref => ( ref( $this ) || $this ) ) );
1174             }
1175              
1176             sub AUTOLOAD
1177             {
1178 0     0     my( $method ) = our $AUTOLOAD =~ /([^:]+)$/;
1179 0           my $self = shift( @_ );
1180 0 0         if( want( 'OBJECT' ) )
1181             {
1182 0           rreturn( $self );
1183             }
1184             # Otherwise, we return undef; Empty return returns undef in scalar context and empty list in list context
1185 0           return;
1186             };
1187             }
1188              
1189             1;
1190             # NOTE: POD
1191             __END__
1192              
1193             =encoding utf-8
1194              
1195             =head1 NAME
1196              
1197             Locale::Intl - A Web Intl.Locale Class Implementation
1198              
1199             =head1 SYNOPSIS
1200              
1201             use Locale::Intl;
1202             my $locale = Locale::Intl->new( 'ja-Kana-t-it' ) ||
1203             die( Locale::Intl->error );
1204              
1205             my $korean = new Locale::Intl('ko', {
1206             script => 'Kore',
1207             region => 'KR',
1208             hourCycle => 'h23',
1209             calendar => 'gregory',
1210             });
1211            
1212             my $japanese = new Locale::Intl('ja-Jpan-JP-u-ca-japanese-hc-h12');
1213              
1214             say $korean->baseName;
1215             say $japanese->baseName;
1216             # Expected output:
1217             # ko-Kore-KR
1218             # ja-Jpan-JP
1219              
1220             say $korean->hourCycle;
1221             say $japanese->hourCycle;
1222             # Expected output
1223             # h23
1224             # h12
1225              
1226             =head1 VERSION
1227              
1228             v0.3.0
1229              
1230             =head1 DESCRIPTION
1231              
1232             This class inherits from L<Locale::Unicode>.
1233              
1234             Make sure to check the API of L<Locale::Unicode> for its constructor and its methods.
1235              
1236             It also accesses the Unicode CLDR (Common Locale Data Repository) data using L<Locale::Unicode::Data>
1237              
1238             It requires perl v5.10.1 minimum to run.
1239              
1240             =head1 CONSTRUCTOR
1241              
1242             # American English
1243             my $us = Locale::Intl->new( 'en-US' );
1244             # Japanese Katakana
1245             my $ja = Locale::Intl->new( 'ja-Kana' );
1246             # Swiss German as spoken in subdivision of Zurich
1247             my $ch = Locale::Intl->new( 'gsw-u-sd-chzh' );
1248             # Hebrew as spoken in Israel with Hebrew calendar and Jerusalem time zone
1249             my $he = Locale::Intl->new( 'he-IL-u-ca-hebrew-tz-jeruslm' );
1250             # Japanese with Japanese calendar and Tokyo time zone with Japanese Finance numbering
1251             # translated from Austrian German by an unidentified vendor with private extension 'private-subtag'
1252             my $ja = Locale::Intl->new( 'ja-t-de-AT-t0-und-u-ca-japanese-tz-jptyo-nu-jpanfin-x-private-subtag' );
1253              
1254             Passing some overriding options:
1255              
1256             my $locale = new Locale::Intl( 'en-US', { hourCycle => 'h12' });
1257             say $locale->hourCycle; # h12
1258              
1259             =head2 new
1260              
1261             This takes a L<Unicode locale identifier|Locale::Unicode> and an optional hash or hash reference of options, and returns a new instance of L<Locale::Intl>. For the syntax of L<locale identifier|Locale::Unicode> strings, see the L<Unicode documentation|https://www.unicode.org/reports/tr35/>.
1262              
1263             A C<locale> is composed of a C<language>, such as C<fr> (French) or C<ja> (Japanese) or C<gsw> (Swiss German), an optional C<script>, such as C<Latn> (Latin) or C<Kana> (Katanaka), a C<region>, which can be a L<country code|Locale::Unicode/country_code>, such as C<US> (United States) or a world region, such as C<150> (Europe) and a C<variant>, such as C<valencia> as in C<ca-ES-valencia>. Only the C<language> part is required.
1264              
1265             The supported options are:
1266              
1267             =over 4
1268              
1269             =item * C<calendar>
1270              
1271             Any syntactically valid string following the L<Unicode type grammar|https://unicode.org/reports/tr35/#Unicode_locale_identifier> (one or more segments of 3–8 alphanumerals, joined by hyphens) is accepted. See L<getAllCalendars()|/getAllCalendars> for all the supported calendars.
1272              
1273             See also L<Locale::Unicode/calendar>
1274              
1275             =item * C<caseFirst>
1276              
1277             This is the case-first sort option. Possible values are C<upper>, C<lower>, or a false value, such as C<undef> or C<0>.
1278              
1279             See also L<Locale::Unicode/colCaseFirst>
1280              
1281             =item * C<collation>
1282              
1283             Any syntactically valid string following the L<Unicode type grammar|https://unicode.org/reports/tr35/#Unicode_locale_identifier> is accepted. See L<getCollations|/getCollations> for a list of supported collations.
1284              
1285             See also L<Locale::Unicode/collation>
1286              
1287             =item * C<hourCycle>
1288              
1289             Possible values are C<h23>, C<h12>, C<h11>, or the practically unused C<h24>, which are explained in L<getHourCycles|/getHourCycles>
1290              
1291             See also L<Locale::Unicode/hour_cycle>
1292              
1293             =item * C<language>
1294              
1295             Not to be confused, this is a part of a broader C<locale>. Any syntactically valid string following the L<Unicode language subtag grammar|https://unicode.org/reports/tr35/#unicode_language_subtag> (2–3 or 5–8 letters) is accepted.
1296              
1297             =item * C<numberingSystem>
1298              
1299             Any syntactically valid string following the L<Unicode type grammar|https://unicode.org/reports/tr35/#Unicode_locale_identifier> is accepted. See L<getNumberingSystems|/getNumberingSystems> for the numbering systems supported for the C<locale> set in the object, or L<getAllNumberingSystems|/getAllNumberingSystems> for the list of all supported numbering systems.
1300              
1301             See also L<Locale::Unicode/number>
1302              
1303             =item * C<numeric>
1304              
1305             The numeric sort option. This takes a boolean value.
1306              
1307             See also L<Locale::Unicode/colNumeric>
1308              
1309             =item * C<region>
1310              
1311             Any syntactically valid string following the L<Unicode region subtag grammar|https://unicode.org/reports/tr35/#unicode_region_subtag> (either 2 letters or 3 digits) is accepted.
1312              
1313             =item * C<script>
1314              
1315             Any syntactically valid string following the L<Unicode script subtag|https://unicode.org/reports/tr35/#unicode_script_subtag> grammar (4 letters) is accepted, but the implementation only recognizes certain kinds.
1316              
1317             See also L<Locale::Unicode/script>
1318              
1319             =back
1320              
1321             =head1 METHODS
1322              
1323             =head2 getAllCalendars
1324              
1325             This is a read-only method that returns an array of all possible calendar values supported by the current version of L<LDML (Locale Data Markup Language)|https://unicode.org/reports/tr35/>.
1326              
1327             =head2 getAllNumberingSystems
1328              
1329             This is a read-only method that returns an array of all possible numbering system values supported by the current version of L<LDML (Locale Data Markup Language)|https://unicode.org/reports/tr35/>.
1330              
1331             =head2 getAllTimeZones
1332              
1333             This is a read-only method that returns an array of all possible time zone values supported by the current version of L<LDML (Locale Data Markup Language)|https://unicode.org/reports/tr35/>. Please note that to ensure consistency, the LDML supports some values that are either outdated or removed from IANA's time zone database.
1334              
1335             =head2 getCalendars
1336              
1337             my $jaJP = new Locale::Intl( 'ja-JP' );
1338             say $jaJP->getCalendars(); # ["gregory", "japanese"]
1339              
1340             This method returns an array of one or more unique L<calendar|Locale::Unicode/calendar> identifiers for this C<locale>.
1341              
1342             See the L<Unicode Locale BCP47 extensions|Locale::Unicode/"BCP47 EXTENSIONS"> for the list of valid calendar values.
1343              
1344             =head2 getCollations
1345              
1346             my $locale = Locale::Intl->new( 'zh' );
1347             say $locale->getCollations(); # ["pinyin", "stroke", "zhuyin", "emoji", "eor"]
1348              
1349             The C<getCollations()> method returns an array of one or more collation types commonly used for this L<locale|Locale::Unicode>. If the L<Locale|Locale::Unicode> already has a C<collation>, then the returned array contains that single value.
1350              
1351             If the L<locale identifier|Locale::Unicode> object does not have a C<collation> already, C<getCollations()> lists all commonly-used collation types for the given L<locale identifier|Locale::Unicode>.
1352              
1353             See the L<Unicode Locale BCP47 extensions|Locale::Unicode/"BCP47 EXTENSIONS"> for the list of valid collation values.
1354              
1355             =head2 getHourCycles
1356              
1357             my $jaJP = Locale::Intl->new( 'ja-JP' );
1358             say $jaJP->getHourCycles(); # ["h23"]
1359              
1360             my $arEG = Locale::Intl->new( 'ar-EG' );
1361             say $arEG->getHourCycles(); # ["h12"]
1362              
1363             This method returns an array of one or more unique hour cycle identifiers commonly used for this L<locale|Locale::Unicode>, sorted in descending preference. If the Locale already has an hourCycle, then the returned array contains that single value.
1364              
1365             If the L<locale identifier|Locale::Unicode> object does not have a C<hourCycle> already, this method lists all commonly-used hour cycle identifiers for the given L<locale|Locale::Unicode>.
1366              
1367             Below are the valid values:
1368              
1369             =over 4
1370              
1371             =item * C<h12>
1372              
1373             Hour system using C<1–12>; corresponds to C<h> in patterns. The 12 hour clock, with midnight starting at C<12:00> am. As used, for example, in the United States.
1374              
1375             =item * C<h23>
1376              
1377             Hour system using C<0–23>; corresponds to C<H> in patterns. The 24 hour clock, with midnight starting at C<0:00>.
1378              
1379             =item * C<h11>
1380              
1381             Hour system using C<0–11>; corresponds to C<K> in patterns. The 12 hour clock, with midnight starting at C<0:00> am. Mostly used in Japan.
1382              
1383             =item * C<h24>
1384              
1385             Hour system using C<1–24>; corresponds to C<k> in pattern. The 24 hour clock, with midnight starting at C<24:00>. Not used anywhere.
1386              
1387             =back
1388              
1389             Hour cycles usage in the world are:
1390              
1391             =over 4
1392              
1393             =item * C<h12 h23>
1394              
1395             115 locales
1396              
1397             =item * C<h23 h12>
1398              
1399             95 locales
1400              
1401             =item * C<h23>
1402              
1403             60 locales
1404              
1405             =item * C<h23 h11 h12>
1406              
1407             1 locale
1408              
1409             =back
1410              
1411             See also the property L<hourCycle|/hourCycle>
1412              
1413             =head2 getNumberingSystems
1414              
1415             my $ja = Locale::Intl->new( 'ja' );
1416             say $ja->getNumberingSystems(); # ["latn"]
1417              
1418             my $arEG = Locale::Intl->new( 'ar-EG' );
1419             say $arEG->getNumberingSystems(); # ["arab"]
1420              
1421             This method returns an array of one or more unique numbering system identifiers commonly used for this L<locale|Locale::Unicode>, sorted in descending preference. If the Locale already has a numberingSystem, then the returned array contains that single value.
1422              
1423             See the L<Unicode Locale BCP47 extensions|Locale::Unicode/"BCP47 EXTENSIONS"> for the list of valid numbering system values.
1424              
1425             =head2 getTextInfo
1426              
1427             my $ar = Locale::Intl->new( 'ar' );
1428             say $ar->getTextInfo(); # rtl
1429              
1430             my $es = Locale::Intl->new( 'es' );
1431             say $es->getTextInfo(); # ltr
1432              
1433             This method returns a string representing the ordering of characters indicated by either C<ltr> (left-to-right) or by C<rtl> (right-to-left) for this L<locale|Locale::Unicode> as specified in L<UTS 35 Layouts Elements|https://www.unicode.org/reports/tr35/tr35-general.html#Layout_Elements>.
1434              
1435             =head2 getTimeZones
1436              
1437             my $jaJP = Locale::Intl->new( 'ja-JP' );
1438             say $jaJP->getTimeZones(); # ["Asia/Tokyo"]
1439              
1440             my $ar = Locale::Intl->new( 'ar' );
1441             # This will resolve to Africa/Cairo, because the locale 'ar'
1442             3 will maximize to ar-Arab-EG and from there to Egypt
1443             say $ar->getTimeZones(); # ["Africa/Cairo"]
1444              
1445             This method returns an array of supported time zones for this L<locale|Locale::Unicode>.
1446              
1447             ach value is an L<IANA time zone canonical name|https://en.wikipedia.org/wiki/Daylight_saving_time#IANA_time_zone_database>, sorted in alphabetical order. If the L<locale identifier|Locale::Unicode> does not contain a C<region> subtag, the returned value is C<undef>.
1448              
1449             Keep in mind that the values do not necessarily match the IANA database that changes from time to time. The Unicode LDML L<keeps old time zones for stability purpose|https://unicode.org/reports/tr35/#Time_Zone_Identifiers>.
1450              
1451             Also note that this method behaves slightly differently from its JavaScript counter part, as the L<JavaScript getTimeZones() method|https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Intl/Locale/getTimeZones> will return C<undef> if only a C<language> subtag is provided and not a C<locale> tha would include a C<country code>. This method, instead, will L<maximize|/maximize> the 2-letters C<locale> provided and from there will returns the time zone for the default country for that language.
1452              
1453             See also L<getAllTimeZones|/getAllTimeZones> to get a list of all available time zones.
1454              
1455             =head2 getWeekInfo
1456              
1457             const he = Locale::Intl->new( 'he' );
1458             say $he->getWeekInfo();
1459             # { firstDay => 7, weekend => [5, 6], minimalDays => 1 }
1460              
1461             const af = Locale::Intl->new( 'af' );
1462             say $af->getWeekInfo();
1463             # { firstDay => 7, weekend => [6, 7], minimalDays => 1 }
1464              
1465             const enGB = Locale::Intl->new( 'en-GB' );
1466             say $enGB->getWeekInfo();
1467             # { firstDay => 1, weekend => [6, 7], minimalDays => 4 }
1468              
1469             const msBN = Locale::Intl->new( 'ms-BN' );
1470             say $msBN->getWeekInfo();
1471             # { firstDay => 7, weekend => [5, 7], minimalDays => 1 }
1472             # Brunei weekend is Friday and Sunday but not Saturday
1473              
1474             This method returns an hash reference with the properties C<firstDay>, C<weekend> and C<minimalDays> for this L<locale|Locale::Unicode>, as specified in L<UTS 35 Week Elements|https://www.unicode.org/reports/tr35/tr35-dates.html#Date_Patterns_Week_Elements>.
1475              
1476             =over 4
1477              
1478             =item * C<firstDay>
1479              
1480             An integer indicating the first day of the week for the locale. Can be either C<1> (Monday) or C<7> (Sunday).
1481              
1482             =item * C<weekend>
1483              
1484             An array of integers indicating the weekend days for the locale, where C<1> is Monday and C<7> is Sunday.
1485              
1486             =item * C<minimalDays>
1487              
1488             An integer between C<1> and C<7> indicating the minimal days required in the first week of a month or year, for calendar purposes.
1489              
1490             =back
1491              
1492             See also the L<Unicode LDML specifications|https://unicode-org.github.io/cldr/ldml/tr35-dates.html#Date_Patterns_Week_Elements>
1493              
1494             =head2 maximise
1495              
1496             This is an alias for L<maximise|/maximise>
1497              
1498             =head2 maximize
1499              
1500             my $english = Locale::Intl->new( 'en' );
1501             my $korean = Locale::Intl->new( 'ko' );
1502             my $arabic = Locale::Intl->new( 'ar' );
1503            
1504             say $english->maximize()->baseName;
1505             # en-Latn-US
1506            
1507             say $korean->maximize()->baseName;
1508             # ko-Kore-KR
1509            
1510             say $arabic->maximize()->baseName;
1511             # ar-Arab-EG
1512              
1513             This method gets L<the most likely values|https://github.com/unicode-org/cldr-json/blob/main/cldr-json/cldr-core/supplemental/likelySubtags.json> for the C<language>, C<script>, and C<region> of this L<locale|Locale::Unicode> based on existing values and returns a new L<Locale::Intl> object.
1514              
1515             Sometimes, it is convenient to be able to identify the most likely L<locale language identifier|Locale::Unicode> subtags based on an incomplete C<language> ID. The L<Add Likely Subtags algorithm|https://www.unicode.org/reports/tr35/#Likely_Subtags> gives us this functionality. For instance, given the C<language> ID C<en>, the algorithm would return C<en-Latn-US>, since English can only be written in the Latin script, and is most likely to be used in the United States, as it is the largest English-speaking country in the world. This functionality is provided via this C<maximize()> method. C<maximize()> only affects the main subtags that comprise the C<language> identifier: C<language>, C<script>, and C<region> subtags. Other subtags after the C<-u> in the C<locale> identifier are L<called extension subtags|Locale::Unicode/"BCP47 EXTENSIONS"> and are not affected by the C<maximize()> method. Examples of these subtags include L<hourCycle|/hourCycle>, L<calendar|/calendar>, and L<numeric|/numeric>.
1516              
1517             Upon error, it sets an L<exception object|Locale::Intl::Exception> and returns C<undef> in scalar context, or an empty list in list context.
1518              
1519             Example:
1520              
1521             my $myLocale = Locale::Intl->new( 'fr', {
1522             hourCycle => 'h12',
1523             calendar => 'gregory',
1524             });
1525             say $myLocale->baseName; # fr
1526             say $myLocale->toString(); # fr-u-ca-gregory-hc-h12
1527             my $myLocMaximized = $myLocale->maximize();
1528              
1529             # The "Latn" and "FR" tags are added
1530             # fr-Latn-FR
1531             # since French is only written in the Latin script and
1532             # is most likely to be spoken in France.
1533             say $myLocMaximized->baseName;
1534              
1535             # fr-Latn-FR-u-ca-gregory-hc-h12
1536             # Note that the extension tags (after '-u') remain unchanged.
1537             say $myLocMaximized->toString();
1538              
1539             =head2 minimise
1540              
1541             This is an alias for L<minimise|/minimise>
1542              
1543             =head2 minimize
1544              
1545             my $english = Locale::Intl->new( 'en-Latn-US' );
1546             my $korean = Locale::Intl->new( 'ko-Kore-KR' );
1547             my $arabic = Locale::Intl->new( 'ar-Arab-EG' );
1548              
1549             say $english->minimize()->baseName;
1550             # en
1551              
1552             say $korean->minimize()->baseName;
1553             # ko
1554              
1555             say $arabic->minimize()->baseName;
1556             # ar
1557              
1558             my $myLocale = Locale::Intl->new( 'fr-Latn-FR', {
1559             hourCycle => 'h12',
1560             calendar => 'gregory',
1561             });
1562             say $myLocale->baseName; # fr-Latn-FR
1563             say $myLocale->toString(); # fr-Latn-FR-u-ca-gregory-hc-h12
1564              
1565             my $myLocMinimized = $myLocale->minimize();
1566              
1567             # Prints 'fr', since French is only written in the Latin script and
1568             # is most likely to be spoken in France.
1569             say $myLocMinimized->baseName);
1570              
1571             # fr-u-ca-gregory-hc-h12
1572             # Note that the extension tags (after '-u') remain unchanged.
1573             say $myLocMinimized->toString();
1574              
1575             This method attempts to remove information about this C<locale> that would be added by calling L<maximize()|/maximize>, which means removing any language, script, or region subtags from the locale language identifier (essentially the contents of baseName).
1576              
1577             This is useful when there are superfluous subtags in the language identifier; for instance, C<en-Latn> can be simplified to C<en>, since C<Latn> is the only script used to write English. C<minimize()> only affects the main subtags that comprise the L<language identifier|Locale::Unicode>: C<language>, C<script>, and C<region> subtags. Other subtags after the C<-u> in the L<locale identifier|Locale::Unicode> are called L<extension subtags|Locale::Unicode/"BCP47 EXTENSIONS"> and are not affected by the C<minimize()> method. Examples of these subtags include L<hourCycle|/hourCycle>, L<calendar|/calendar>, and L<numeric|/numeric>.
1578              
1579             This returns a new L<Locale::Intl> instance whose L<baseName|/baseName> property returns the result of the L<Remove Likely Subtags|https://www.unicode.org/reports/tr35/#Likely_Subtags> algorithm executed against C<< $locale->baseName >>.
1580              
1581             =for Pod::Coverage pass_error
1582              
1583             =head2 toString
1584              
1585             my $french = Locale::Intl->new('fr-Latn-FR', {
1586             calendar => 'gregory',
1587             hourCycle => 'h12',
1588             });
1589             const korean = Locale::Intl->new('ko-Kore-KR', {
1590             numeric => 'true',
1591             caseFirst => 'upper',
1592             });
1593              
1594             say $french->toString();
1595             # fr-Latn-FR-u-ca-gregory-hc-h12
1596              
1597             say $korean->toString();
1598             # ko-Kore-KR-u-kf-upper-kn
1599              
1600             This method returns this L<Locale::Intl>'s full locale identifier string.
1601              
1602             The string value is computed once and is cached until any of the C<locale>'s attributes are changed.
1603              
1604             =head1 PROPERTIES
1605              
1606             =head2 baseName
1607              
1608             # Sets locale to Canadian French
1609             my $myLoc = Locale::Intl->new( "fr-Latn-CA" );
1610             say $myLoc->toString(); # fr-Latn-CA-u-ca-gregory
1611             say $myLoc->baseName; # fr-Latn-CA
1612              
1613             # calendar to Gregorian, hour cycle to 24 hours
1614             my $japan = Locale::Intl->new( "ja-JP-u-ca-gregory-hc-24" );
1615             say $japan->toString(); # ja-JP-u-ca-gregory-hc-h24
1616             $japan->baseName; # ja-JP
1617              
1618             # Dutch and region as Belgium, but options override the region to the Netherlands
1619             my $dutch = Locale::Intl->new( "nl-Latn-BE", { region => "NL" });
1620            
1621             say $dutch->baseName; # nl-Latn-NL
1622              
1623             The C<baseName> accessor property of L<Locale::Intl> instances returns a substring of this C<locale>'s string representation, containing core information about this locale.
1624              
1625             Specifically, this returns the substring containing the C<language>, the C<script> and C<region> if available.
1626              
1627             See L<Unicode grammar ID|https://www.unicode.org/reports/tr35/#Identifiers> for more information.
1628              
1629             =head2 calendar
1630              
1631             This returns the calendar type for this locale.
1632              
1633             The C<calendar> property's value is set at object instantiation time, either through the C<ca> attribute of the C<locale> identifier or through the C<calendar> option of the L<Locale::Unicode> constructor. The latter takes priority if they are both present; and if neither is present, the property has value C<undef>.
1634              
1635             For a list of supported calendar types, see L<Locale::Intl/getCalendars>.
1636              
1637             For example:
1638              
1639             Adding a C<calendar> through the C<locale> attribute.
1640              
1641             In the L<Unicode locale string specifications|https://www.unicode.org/reports/tr35/>, C<calendar> era types are C<locale> attribute "extension subtags". These subtags add additional data about the C<locale>, and are added to C<locale> identifiers by using the C<-u> extension. Thus, the C<calendar> era type can be added to the initial C<locale> identifier string that is passed into the L<Locale::Intl> constructor. To add the calendar type, first add the C<-u> extension to the string. Next, add the L<-ca|Locale::Unicode/ca> extension to indicate that you are adding a calendar type. Finally, add the calendar era type to the string.
1642              
1643             my $locale = Locale::Intl->new( 'he-IL-u-ca-hebrew-tz-jeruslm' );
1644             say $locale->calendar; # hebrew
1645              
1646             Alternatively, you could also achieve the same results, using the methods inherited from L<Locale::Unicode>:
1647              
1648             my $locale = Locale::Intl->new( 'he-IL' );
1649             $locale->ca( 'hebrew' )->tz( 'jeruslm' );
1650             say $locale->calendar; # hebrew
1651              
1652             Adding a C<calendar> type via the optional hash or hash reference of options.
1653              
1654             The L<Locale::Intl> constructor takes an optional hash or hash reference of options, which can contain any of several extension types, including calendars. Set the C<calendar> property of the optional hash or hash reference to your desired C<calendar> era, and then pass it into the constructor.
1655              
1656             my $locale = Locale::Intl->new( 'he-IL', { calendar => 'hebrew' } );
1657             say $locale->calendar; # hebrew
1658              
1659             =head2 caseFirst
1660              
1661             The C<caseFirst> accessor property of L<Locale::Intl> instances returns whether case is taken into account for this C<locale>'s collation rules.
1662              
1663             There are 3 values that the C<caseFirst> property can have, outlined in the table below.
1664              
1665             =over 4
1666              
1667             =item * C<upper>
1668              
1669             Upper case to be sorted before lower case.
1670              
1671             =item * C<lower>
1672              
1673             Lower case to be sorted before upper case.
1674              
1675             =item * C<false>
1676              
1677             No special case ordering.
1678              
1679             =back
1680              
1681             Setting the caseFirst value via the locale string
1682              
1683             In the L<Unicode locale string specifications|https://www.unicode.org/reports/tr35/>, the values that C<aseFirst> represents correspond to the attribute L<kf|Locale::Unicode/kf>. C<kf> is treated as a C<locale> string "extension subtag". These subtags add additional data about the C<locale>, and are added to C<locale> identifiers by using the C<-u> extension attribute. Thus, the C<caseFirst> value can be added to the initial C<locale> identifier string that is passed into the L<Locale|Locale::Unicode> constructor. To add the C<caseFirst> value, first add the C<-u> extension key to the string. Next, add the L<-kf|Locale::Unicode/kf> extension key to indicate that you are adding a value for C<caseFirst>. Finally, add the C<caseFirst> value to the string.
1684              
1685             my $locale = Locale::Intl->new( "fr-Latn-FR-u-kf-upper" );
1686             say $locale->caseFirst; # upper
1687              
1688             Setting the C<caseFirst> value via the optional hash or hash reference of options.
1689              
1690             The L<Locale::Intl> constructor takes an optional hash or hash reference of options, which can be used to pass extension types. Set the C<caseFirst> property of the configuration object to your desired C<caseFirst> value, and then pass it into the constructor.
1691              
1692             my $locale = Locale::Intl->new( "en-Latn-US", { caseFirst => "lower" });
1693             say $locale->caseFirst; # lower
1694              
1695             =head2 collation
1696              
1697             The C<collation> accessor property of L<Locale::Intl> instances returns the C<collation> type for this C<locale>, which is used to order strings according to the C<locale>'s rules.
1698              
1699             The C<collation> property's value is set at object instantiation time, either through the L<co|Locale::Unicode/co> attribute of the L<locale identifier|Locale::Unicode> or through the C<collation> option of the L<Locale::Intl> constructor. The latter takes priority if they are both present; and if neither is present, the property has value C<undef>.
1700              
1701             For a list of supported collation types, see L<getCollations()|Locale::Intl/getCollations>.
1702              
1703             For example:
1704              
1705             Adding a collation type via the locale string.
1706              
1707             In the L<Unicode locale string specifications|https://www.unicode.org/reports/tr35/>, C<collation> types are C<locale> attribute "extension subtags". These subtags add additional data about the C<locale>, and are added to L<locale identifiers|Locale::Unicode> by using the C<-u> extension. Thus, the L<collation|Locale::Unicode/collation> type can be added to the initial L<locale identifier|Locale::Unicode> string that is passed into the L<Locale::Intl> constructor. To add the C<collation> type, first add the C<-u> extension to the string. Next, add the C<-co> extension to indicate that you are adding a collation type. Finally, add the collation type to the string.
1708              
1709             my $locale = Locale::Intl->new( "zh-Hant-u-co-zhuyin" );
1710             say $locale->collation; # zhuyin
1711              
1712             Adding a collation type via the configuration object argument.
1713              
1714             The L<Locale::Intl> constructor has an optional hash or hash reference of options, which can contain any of several extension types, including C<collation> types. Set the C<collation> property of the configuration object to your desired C<collation> type, and then pass it into the constructor.
1715              
1716             my $locale = Locale::Intl->new( "zh-Hant", { collation => "zhuyin" });
1717             say $locale->collation; # zhuyin
1718              
1719             =head2 hourCycle
1720              
1721             The C<hourCycle> accessor property of L<Locale::Intl> instances returns the L<hour cycle|Locale::Unicode/hour_cycle> type for this L<locale identifier|Locale::Unicode>.
1722              
1723             There are 2 main types of time keeping conventions (clocks) used around the world: the 12 hour clock and the 24 hour clock. The C<hourCycle> property's value is set upon object instantiation, either through the L<hc|Locale::Unicode/hc> attribute of the L<locale identifier|Locale::Unicode> or through the C<hourCycle> option of the L<Locale::Intl> constructor. The latter takes priority if they are both present; and if neither is present, the property has value C<undef>.
1724              
1725             For a list of supported hour cycle types, see L<getHourCycles()|Locale::Intl/getHourCycles>.
1726              
1727             For example:
1728              
1729             Like other C<locale> subtags, the hour cycle type can be added to the L<Locale::Intl> object via the locale string, or an option upon object instantiation.
1730              
1731             Adding an hour cycle via the locale string
1732              
1733             In the L<Unicode locale string specifications|https://www.unicode.org/reports/tr35/>, L<hour cycle|Locale::Unicode/hour_cycle> types are locale attribute "extension subtags". These subtags add additional data about the C<locale>, and are added to L<locale identifiers|Locale::Unicode> by using the C<-u> extension. Thus, the hour cycle type can be added to the initial L<locale identifier|Locale::Unicode> string that is passed into the L<Locale::Intl> constructor. To add the L<hour cycle|Locale::Unicode/hour_cycle> type, first add the C<-u> extension key to the string. Next, add the C<-hc> extension to indicate that you are adding an hour cycle. Finally, add the hour cycle type to the string.
1734              
1735             my $locale = Locale::Intl->new( "fr-FR-u-hc-h23" );
1736             say $locale->hourCycle; # h23
1737              
1738             Adding an hour cycle via the configuration object argument
1739              
1740             The L<Locale::Intl> constructor has an optional hash or hash reference of options, which can contain any of several extension types, including L<hour cycle|Locale::Unicode/hour_cycle> types. Set the C<hourCycle> property of the configuration object to your desired hour cycle type, and then pass it into the constructor.
1741              
1742             my $locale = Locale::Intl->new( "en-US", { hourCycle => "h12" });
1743             say $locale->hourCycle; # h12
1744              
1745             =head2 language
1746              
1747             The C<language> accessor property of L<Locale::Intl> instances returns the C<language> associated with this C<locale>.
1748              
1749             Language is one of the core features of a C<locale>. The Unicode specification treats the C<language> identifier of a C<locale> as the C<language> and the C<region> together (to make a distinction between dialects and variations, e.g. British English vs. American English). However, the C<language> property of an L<Locale::Intl> object returns strictly the C<locale>'s C<language> subtag. This subtag can be a 2 or 3-characters code.
1750              
1751             For example:
1752              
1753             Setting the C<language> in the locale identifier string argument.
1754              
1755             In order to be a valid L<Unicode locale identifier|Locale::Unicode>, a string must start with the C<language> subtag. The main argument to the L<Locale::Intl> constructor must be a valid L<Unicode locale identifier|Locale::Unicode>, so whenever the constructor is used, it must be passed an identifier with a C<language> subtag.
1756              
1757             my $locale = Locale::Intl->new( "en-Latn-US" );
1758             say $locale->language; # en
1759              
1760             Overriding language via the configuration object.
1761              
1762             While the C<language> subtag must be specified, the L<Locale::Intl> constructor takes an hash or hash reference of options, which can override the C<language> subtag.
1763              
1764             my $locale = Locale::Intl->new( "en-Latn-US", { language => "es" });
1765             say $locale->language; # es
1766              
1767             =head2 numberingSystem
1768              
1769             The C<numberingSystem> accessor property of L<Locale::Intl> instances returns the numeral system for this C<locale>.
1770              
1771             A numeral system is a system for expressing numbers. The C<numberingSystem> property's value is set upon object instantiation, either through the L<nu|Locale::Unicode/nu> attribute of the L<locale identifier|Locale::Unicode> or through the C<numberingSystem> option of the L<Locale::Intl> constructor. The latter takes priority if they are both present; and if neither is present, the property has value C<undef>.
1772              
1773             For a list of supported numbering system types, see L<getNumberingSystems()|Locale::Intl/getNumberingSystems>.
1774              
1775             Adding a numbering system via the locale string.
1776              
1777             In the L<Unicode locale string specifications|https://www.unicode.org/reports/tr35/>, numbering system types are C<locale> attribute "extension subtags". These subtags add additional data about the C<locale>, and are added to C<locale> identifiers by using the C<-u> extension. Thus, the numbering system type can be added to the initial C<locale> identifier string that is passed into the L<Locale::Intl> constructor. To add the numbering system type, first add the C<-u> extension attribute to the string. Next, add the L<-nu|Locale::Unicode/nu> extension to indicate that you are adding a numbering system. Finally, add the numbering system type to the string.
1778              
1779             my $locale = Locale::Intl->new( "fr-Latn-FR-u-nu-mong" );
1780             say $locale->numberingSystem; # mong
1781              
1782             Adding a numbering system via the configuration object argument.
1783              
1784             The L<Locale::Intl> constructor has an optional hash or hash reference of options, which can contain any of several extension types, including numbering system types. Set the C<numberingSystem> property of the hash or hash reference of options to your desired numbering system type, and then pass it into the constructor.
1785              
1786             my $locale = Locale::Intl->new( "en-Latn-US", { numberingSystem => "latn" });
1787             say $locale->numberingSystem; # latn
1788              
1789             =head2 numeric
1790              
1791             The C<numeric> accessor property of L<Locale::Intl> instances returns a L<boolean object|Locale::Intl::Boolean> representing whether this C<locale> has special collation handling for C<numeric> characters.
1792              
1793             Like C<caseFirst>, C<numeric> represents a modification to the collation rules utilized by the locale. C<numeric> is a boolean value, which means that it can be either L<true|Locale::Intl::Boolean/true> or L<false|Locale::Intl::Boolean/false>. If C<numeric> is set to C<false>, there will be no special handling of C<numeric> values in strings. If C<numeric> is set to C<true>, then the C<locale> will take C<numeric> characters into account when collating strings. This special C<numeric> handling means that sequences of decimal digits will be compared as numbers. For example, the string C<A-21> will be considered less than C<A-123>.
1794              
1795             Example:
1796              
1797             Setting the numeric value via the locale string.
1798              
1799             In the L<Unicode locale string specifications|https://www.unicode.org/reports/tr35/>, the values that C<numeric> represents correspond to the attribute L<kn|Locale::Unicode/kn>. L<kn|Locale::Unicode/kn> is considered a L<locale|Locale::Unicode> string extension subtag". These subtags add additional data about the L<locale|Locale::Unicode>, and are added to L<locale identifiers|Locale::Unicode> by using the -u extension key. Thus, the C<numeric> value can be added to the initial L<locale identifier|Locale::Unicode> string that is passed into the L<Locale::Intl> constructor. To set the C<numeric> value, first add the C<-u> extension attribute to the string. Next, add the C<-kn> extension attribute to indicate that you are adding a value for C<numeric>. Finally, add the C<numeric> value to the string. If you want to set C<numeric> to true, adding the L<kn|Locale::Unicode/kn> attribute will suffice. To set the value to false, you must specify in by adding "false" after the L<kn|Locale::Unicode/kn> attribute.
1800              
1801             my $locale = Locale::Intl->new("fr-Latn-FR-u-kn-false");
1802             say $locale->numeric); # false
1803              
1804             Setting the numeric value via the configuration object argument.
1805              
1806             The L<Locale::Unicode> constructor has an optional hash or hash reference of options, which can be used to pass extension types. Set the C<numeric> property of the hash or hash reference of options to your desired C<numeric> value and pass it into the constructor.
1807              
1808             my $locale = Locale::Intl->new("en-Latn-US", { numeric => $true_value });
1809             say $locale->numeric; # true
1810              
1811             =head2 region
1812              
1813             The C<region> accessor property of L<Locale::Intl> instances returns the C<region> of the world (usually a country) associated with this C<locale>. This could be a L<country code|Locale::Unicode/country_code>, or a world region represented with a L<3-digits code|Locale::Unicode/region>
1814              
1815             The C<region> is an essential part of the L<locale identifier|Locale::Unicode>, as it places the C<locale> in a specific area of the world. Knowing the C<locale>'s region is vital to identifying differences between locales. For example, English is spoken in the United Kingdom and the United States of America, but there are differences in spelling and other C<language> conventions between those two countries.
1816              
1817             For example:
1818              
1819             Setting the region in the locale identifier string argument.
1820              
1821             The C<region> is the third part of a valid L<Unicode language identifier|Locale::Unicode> string, and can be set by adding it to the L<locale identifier|Locale::Unicode> string that is passed into the L<Locale::Intl> constructor.
1822              
1823             my $locale = Locale::Intl->new( "en-Latn-US" );
1824             say $locale->region; # US
1825              
1826             my $locale = Locale::Intl->new( "fr-Latn-150" );
1827             say $locale->region; # 150
1828             # 150 is the region code for Europe
1829              
1830             See the file C<territories.json> in the L<CLDR repository|https://github.com/unicode-org/cldr-json/tree/main/cldr-json/cldr-localenames-full> for the localised names of those territories.
1831              
1832             =head2 script
1833              
1834             The C<script> accessor property of L<Locale::Intl> instances returns the C<script> used for writing the particular C<language> used in this C<locale>.
1835              
1836             A C<script>, sometimes called writing system, is one of the core attributes of a L<locale|Locale::Unicode>. It indicates the set of symbols, or glyphs, that are used to write a particular C<language>. For instance, the C<script> associated with English is Latin (C<latn>), whereas the C<script> used to represent Japanese Katanaka is C<Kana> and the one typically associated with Korean is Hangul (C<Hang>). In many cases, denoting a C<script> is not strictly necessary, since the language (which is necessary) is only written in a single C<script>. There are exceptions to this rule, however, and it is important to indicate the C<script> whenever possible, in order to have a complete L<Unicode language identifier|Locale::Unicode>.
1837              
1838             For example:
1839              
1840             Setting the script in the locale identifier string argument.
1841              
1842             The C<script> is the second part of a valid L<Unicode language identifier|Locale::Unicode> string, and can be set by adding it to the L<locale identifier|Locale::Unicode> string that is passed into the L<Locale::Intl> constructor. Note that the C<script> is not a required part of a L<locale identifier|Locale::Unicode>.
1843              
1844             my $locale = Locale::Intl->new( "en-Latn-US" );
1845             say $locale->script); # Latn
1846              
1847             Setting the C<script> via the hash or hash reference of options.
1848              
1849             The L<Locale::Intl> constructor takes an hash or hash reference of options, which can be used to set the C<script> subtag and property.
1850              
1851             my $locale = Locale::Intl->new("fr-FR", { script => "Latn" });
1852             say $locale; # fr-Latn-FR
1853             say $locale->script; # Latn
1854              
1855             =head1 OVERLOADING
1856              
1857             Instances of L<Locale::Intl> have the stringification overloaded as inherited from L<Locale::Unicode>
1858              
1859             =head1 AUTHOR
1860              
1861             Jacques Deguest E<lt>F<jack@deguest.jp>E<gt>
1862              
1863             =head1 SEE ALSO
1864              
1865             L<DateTime::Format::Intl>
1866              
1867             =head1 CREDITS
1868              
1869             Credits to Mozilla for L<parts of their documentation|https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Intl/Locale> I copied here.
1870              
1871             =head1 COPYRIGHT & LICENSE
1872              
1873             Copyright(c) 2024 DEGUEST Pte. Ltd.
1874              
1875             All rights reserved
1876              
1877             This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
1878              
1879             =cut