cpan/Unicode-Collate/Collate/Locale.pm

   1 package Unicode::Collate::Locale;
   2
   3 use strict;
   4 use Carp;
   5 use base qw(Unicode::Collate);
   6
   7 our $VERSION = '0.94';
   8
   9 my $PL_EXT  = '.pl';
  10
  11 my %LocaleFile = map { ($_, $_) } qw(
  12    af ar as az be bg bn ca cs cy da eo es et fa fi fil fo fr
  13    gu ha haw hi hr hu hy ig is ja kk kl kn ko kok ln lt lv
  14    mk ml mr mt nb nn nso om or pa pl ro ru sa se si sk sl sq
  15    sr sv ta te th tn to tr uk ur vi wae wo yo zh
  16 );
  17    $LocaleFile{'default'} = '';
  18 # aliases
  19    $LocaleFile{'bs'}      = 'hr';
  20    $LocaleFile{'sr_Latn'} = 'hr';
  21 # short file names
  22    $LocaleFile{'de__phonebook'}   = 'de_phone';
  23    $LocaleFile{'es__traditional'} = 'es_trad';
  24    $LocaleFile{'fi__phonebook'}   = 'fi_phone';
  25    $LocaleFile{'si__dictionary'}  = 'si_dict';
  26    $LocaleFile{'sv__reformed'}    = 'sv_refo';
  27    $LocaleFile{'zh__big5han'}     = 'zh_big5';
  28    $LocaleFile{'zh__gb2312han'}   = 'zh_gb';
  29    $LocaleFile{'zh__pinyin'}      = 'zh_pin';
  30    $LocaleFile{'zh__stroke'}      = 'zh_strk';
  31    $LocaleFile{'zh__zhuyin'}      = 'zh_zhu';
  32
  33 my %TypeAlias = qw(
  34     phone     phonebook
  35     phonebk   phonebook
  36     dict      dictionary
  37     reform    reformed
  38     trad      traditional
  39     big5      big5han
  40     gb2312    gb2312han
  41 );
  42
  43 sub _locale {
  44     my $locale = shift;
  45     if ($locale) {
  46         $locale = lc $locale;
  47         $locale =~ tr/\-\ \./_/;
  48         $locale =~ s/_([0-9a-z]+)\z/$TypeAlias{$1} ?
  49                                   "_$TypeAlias{$1}" : "_$1"/e;
  50         $LocaleFile{$locale} and return $locale;
  51
  52         my @code = split /_/, $locale;
  53         my $lan = shift @code;
  54         my $scr = @code && length $code[0] == 4 ? ucfirst shift @code : '';
  55         my $reg = @code && length $code[0] <  4 ? uc      shift @code : '';
  56         my $var = @code                         ?         shift @code : '';
  57
  58         my @list;
  59         push @list, (
  60             "${lan}_${scr}_${reg}_$var",
  61             "${lan}_${scr}__$var", # empty $scr should not be ${lan}__$var.
  62             "${lan}_${reg}_$var",  # empty $reg may be ${lan}__$var.
  63             "${lan}__$var",
  64         ) if $var ne '';
  65         push @list, (
  66             "${lan}_${scr}_${reg}",
  67             "${lan}_${scr}",
  68             "${lan}_${reg}",
  69              ${lan},
  70         );
  71         for my $loc (@list) {
  72             $LocaleFile{$loc} and return $loc;
  73         }
  74     }
  75     return 'default';
  76 }
  77
  78 sub getlocale {
  79     return shift->{accepted_locale};
  80 }
  81
  82 sub locale_version {
  83     return shift->{locale_version};
  84 }
  85
  86 sub _fetchpl {
  87     my $accepted = shift;
  88     my $f = $LocaleFile{$accepted};
  89     return if !$f;
  90     $f .= $PL_EXT;
  91
  92     # allow to search @INC
  93 #   use File::Spec;
  94 #   my $path = File::Spec->catfile('Unicode', 'Collate', 'Locale', $f);
  95     my $path = "Unicode/Collate/Locale/$f";
  96     my $h = do $path;
  97     croak "Unicode/Collate/Locale/$f can't be found" if !$h;
  98     return $h;
  99 }
 100
 101 sub new {
 102     my $class = shift;
 103     my %hash = @_;
 104     $hash{accepted_locale} = _locale($hash{locale});
 105
 106     if (exists $hash{table}) {
 107         croak "your table can't be used with Unicode::Collate::Locale";
 108     }
 109
 110     my $href = _fetchpl($hash{accepted_locale});
 111     while (my($k,$v) = each %$href) {
 112         if (exists $hash{$k}) {
 113             croak "$k is reserved by $hash{locale}, can't be overwritten";
 114         }
 115         $hash{$k} = $v;
 116     }
 117     return $class->SUPER::new(%hash);
 118 }
 119
 120 1;
 121 __END__
 122
 123 MEMORANDA for developing
 124
 125 locale          based CLDR
 126 ----------------------------------------------------------------------------
 127 af              2.0 = 1.8.1
 128 ar              2.0
 129 as              2.0 = 1.8.1
 130 az              2.0 = 1.8.1 (type="standard")
 131 be              2.0
 132 bg              2.0
 133 bn              2.0.1 (type="standard")
 134 bs              2.0 (alias source="hr")
 135 ca              2.0 = 1.8.1 (alt="proposed" type="standard")
 136 cs              2.0 = 1.8.1 (type="standard")
 137 cy              2.0 = 1.8.1
 138 da              2.0 = 1.8.1 (type="standard") [modify aA to pass CLDR tests]
 139 de__phonebook   2.0 (type="phonebook")
 140 eo              2.0 = 1.8.1
 141 es              2.0 (type="standard")
 142 es__traditional 2.0 = 1.8.1 (type="traditional")
 143 et              2.0 = 1.8.1
 144 fa              2.0 = 1.8.1
 145 fi              2.0 = 1.8.1 (type="standard" alt="proposed")
 146 fi__phonebook   2.0 = 1.8.1 (type="phonebook")
 147 fil             2.0 (type="standard") = 1.8.1
 148 fo              2.0 = 1.8.1 (alt="proposed" type="standard")
 149 fr              2.0 (fr_CA, backwards="on")
 150 gu              2.0 (type="standard")
 151 ha              2.0
 152 haw             2.0 = 1.8.1
 153 hi              2.0 (type="standard")
 154 hr              2.0 (type="standard")
 155 hu              2.0 = 1.8.1 (alt="proposed" type="standard")
 156 hy              2.0 = 1.8.1
 157 ig              2.0 = 1.8.1
 158 is              2.0 = 1.8.1 (type="standard")
 159 ja              22.1 = 2.0 = 1.8.1 (type="standard")
 160 kk              2.0
 161 kl              2.0 = 1.8.1 (type="standard")
 162 kn              2.0 (type="standard")
 163 ko              22.1 = 2.0 = 1.8.1 (type="standard")
 164 kok             2.0 = 1.8.1
 165 ln              2.0 (type="standard") = 1.8.1
 166 lt              2.0
 167 lv              2.0 (type="standard") = 1.8.1
 168 mk              2.0
 169 ml              2.0
 170 mr              2.0 = 1.8.1
 171 mt              2.0
 172 nb              2.0 (type="standard")
 173 nn              2.0 (type="standard")
 174 nso             2.0 = 1.8.1
 175 om              2.0 = 1.8.1
 176 or              2.0
 177 pa              2.0 = 1.8.1
 178 pl              2.0 = 1.8.1
 179 ro              2.0 (type="standard")
 180 ru              2.0
 181 sa              1.8.1 (type="standard" alt="proposed") [currently in /seed]
 182 se              2.0 = 1.8.1 (type="standard")
 183 si              2.0 (type="standard")
 184 si__dictionary  2.0 (type="dictionary")
 185 sk              2.0 (type="standard")
 186 sl              2.0 = 1.8.1 (type="standard" alt="proposed")
 187 sq              2.0 = 1.8.1 (alt="proposed" type="standard")
 188 sr              2.0 (type="standard")
 189 sr_Latn         2.0 = 1.8.1 (alias source="hr")
 190 sv              2.0 (type="standard")
 191 sv__reformed    2.0 = 1.8.1 (type="reformed")
 192 ta              2.0
 193 te              2.0
 194 th              2.0 (type="standard")
 195 tn              2.0 = 1.8.1
 196 to              2.0 = 1.8.1 (type="standard" alt="proposed")
 197 tr              2.0 = 1.8.1 (type="standard")
 198 uk              2.0
 199 ur              2.0
 200 vi              2.0 = 1.8.1
 201 wae             2.0
 202 wo              1.8.1 [currently in /seed]
 203 yo              2.0 = 1.8.1
 204 zh              22.1 = 2.0 = 1.8.1 (type="standard")
 205 zh__big5han     22.1 = 2.0 = 1.8.1 (type="big5han")
 206 zh__gb2312han   22.1 = 2.0 = 1.8.1 (type="gb2312han")
 207 zh__pinyin      22.1 = 2.0         (type='pinyin' alt='short')
 208 zh__stroke      22.1 = 2.0 = 1.9.1 (type='stroke' alt='short')
 209 zh__zhuyin      22.1 = 22          (type='zhuyin' alt='short')
 210 ----------------------------------------------------------------------------
 211
 212 =head1 NAME
 213
 214 Unicode::Collate::Locale - Linguistic tailoring for DUCET via Unicode::Collate
 215
 216 =head1 SYNOPSIS
 217
 218   use Unicode::Collate::Locale;
 219
 220   #construct
 221   $Collator = Unicode::Collate::Locale->
 222       new(locale => $locale_name, %tailoring);
 223
 224   #sort
 225   @sorted = $Collator->sort(@not_sorted);
 226
 227   #compare
 228   $result = $Collator->cmp($a, $b); # returns 1, 0, or -1.
 229
 230 B<Note:> Strings in C<@not_sorted>, C<$a> and C<$b> are interpreted
 231 according to Perl's Unicode support. See L<perlunicode>,
 232 L<perluniintro>, L<perlunitut>, L<perlunifaq>, L<utf8>.
 233 Otherwise you can use C<preprocess> (cf. C<Unicode::Collate>)
 234 or should decode them before.
 235
 236 =head1 DESCRIPTION
 237
 238 This module provides linguistic tailoring for it
 239 taking advantage of C<Unicode::Collate>.
 240
 241 =head2 Constructor
 242
 243 The C<new> method returns a collator object.
 244
 245 A parameter list for the constructor is a hash, which can include
 246 a special key C<locale> and its value (case-insensitive) standing
 247 for a Unicode base language code (two or three-letter).
 248 For example, C<Unicode::Collate::Locale-E<gt>new(locale =E<gt> 'FR')>
 249 returns a collator tailored for French.
 250
 251 C<$locale_name> may be suffixed with a Unicode script code (four-letter),
 252 a Unicode region code, a Unicode language variant code. These codes are
 253 case-insensitive, and separated with C<'_'> or C<'-'>.
 254 E.g. C<en_US> for English in USA,
 255 C<az_Cyrl> for Azerbaijani in the Cyrillic script,
 256 C<es_ES_traditional> for Spanish in Spain (Traditional).
 257
 258 If C<$locale_name> is not available,
 259 fallback is selected in the following order:
 260
 261     1. language with a variant code
 262     2. language with a script code
 263     3. language with a region code
 264     4. language
 265     5. default
 266
 267 Tailoring tags provided by C<Unicode::Collate> are allowed as long as
 268 they are not used for C<locale> support.  Esp. the C<table> tag
 269 is always untailorable, since it is reserved for DUCET.
 270
 271 E.g. a collator for French, which ignores diacritics and case difference
 272 (i.e. level 1), with reversed case ordering and no normalization.
 273
 274     Unicode::Collate::Locale->new(
 275         level => 1,
 276         locale => 'fr',
 277         upper_before_lower => 1,
 278         normalization => undef
 279     )
 280
 281 Overriding a behavior already tailored by C<locale> is disallowed
 282 if such a tailoring is passed to C<new()>.
 283
 284     Unicode::Collate::Locale->new(
 285         locale => 'da',
 286         upper_before_lower => 0, # causes error as reserved by 'da'
 287     )
 288
 289 However C<change()> inherited from C<Unicode::Collate> allows
 290 such a tailoring that is reserved by C<locale>. Examples:
 291
 292     new(locale => 'ca')->change(backwards => undef)
 293     new(locale => 'da')->change(upper_before_lower => 0)
 294     new(locale => 'ja')->change(overrideCJK => undef)
 295
 296 =head2 Methods
 297
 298 C<Unicode::Collate::Locale> is a subclass of C<Unicode::Collate>
 299 and methods other than C<new> are inherited from C<Unicode::Collate>.
 300
 301 Here is a list of additional methods:
 302
 303 =over 4
 304
 305 =item C<$Collator-E<gt>getlocale>
 306
 307 Returns a language code accepted and used actually on collation.
 308 If linguistic tailoring is not provided for a language code you passed
 309 (intensionally for some languages, or due to the incomplete implementation),
 310 this method returns a string C<'default'> meaning no special tailoring.
 311
 312 =item C<$Collator-E<gt>locale_version>
 313
 314 (Since Unicode::Collate::Locale 0.87)
 315 Returns the version number (perhaps C</\d\.\d\d/>) of the locale, as that
 316 of F<Locale/*.pl>.
 317
 318 B<Note:> F<Locale/*.pl> that a collator uses should be identified by
 319 a combination of return values from C<getlocale> and C<locale_version>.
 320
 321 =back
 322
 323 =head2 A list of tailorable locales
 324
 325       locale name       description
 326     --------------------------------------------------------------
 327       af                Afrikaans
 328       ar                Arabic
 329       as                Assamese
 330       az                Azerbaijani (Azeri)
 331       be                Belarusian
 332       bg                Bulgarian
 333       bn                Bengali
 334       bs                Bosnian
 335       ca                Catalan
 336       cs                Czech
 337       cy                Welsh
 338       da                Danish
 339       de__phonebook     German (umlaut as 'ae', 'oe', 'ue')
 340       eo                Esperanto
 341       es                Spanish
 342       es__traditional   Spanish ('ch' and 'll' as a grapheme)
 343       et                Estonian
 344       fa                Persian
 345       fi                Finnish (v and w are primary equal)
 346       fi__phonebook     Finnish (v and w as separate characters)
 347       fil               Filipino
 348       fo                Faroese
 349       fr                French
 350       gu                Gujarati
 351       ha                Hausa
 352       haw               Hawaiian
 353       hi                Hindi
 354       hr                Croatian
 355       hu                Hungarian
 356       hy                Armenian
 357       ig                Igbo
 358       is                Icelandic
 359       ja                Japanese [1]
 360       kk                Kazakh
 361       kl                Kalaallisut
 362       kn                Kannada
 363       ko                Korean [2]
 364       kok               Konkani
 365       ln                Lingala
 366       lt                Lithuanian
 367       lv                Latvian
 368       mk                Macedonian
 369       ml                Malayalam
 370       mr                Marathi
 371       mt                Maltese
 372       nb                Norwegian Bokmal
 373       nn                Norwegian Nynorsk
 374       nso               Northern Sotho
 375       om                Oromo
 376       or                Oriya
 377       pa                Punjabi
 378       pl                Polish
 379       ro                Romanian
 380       ru                Russian
 381       sa                Sanskrit
 382       se                Northern Sami
 383       si                Sinhala
 384       si__dictionary    Sinhala (U+0DA5 = U+0DA2,0DCA,0DA4)
 385       sk                Slovak
 386       sl                Slovenian
 387       sq                Albanian
 388       sr                Serbian
 389       sr_Latn           Serbian in Latin (tailored as Croatian)
 390       sv                Swedish (v and w are primary equal)
 391       sv__reformed      Swedish (v and w as separate characters)
 392       ta                Tamil
 393       te                Telugu
 394       th                Thai
 395       tn                Tswana
 396       to                Tonga
 397       tr                Turkish
 398       uk                Ukrainian
 399       ur                Urdu
 400       vi                Vietnamese
 401       wae               Walser
 402       wo                Wolof
 403       yo                Yoruba
 404       zh                Chinese
 405       zh__big5han       Chinese (ideographs: big5 order)
 406       zh__gb2312han     Chinese (ideographs: GB-2312 order)
 407       zh__pinyin        Chinese (ideographs: pinyin order) [3]
 408       zh__stroke        Chinese (ideographs: stroke order) [3]
 409       zh__zhuyin        Chinese (ideographs: zhuyin order) [3]
 410     --------------------------------------------------------------
 411
 412 Locales according to the default UCA rules include
 413 chr (Cherokee),
 414 de (German),
 415 en (English),
 416 ga (Irish),
 417 id (Indonesian),
 418 it (Italian),
 419 ka (Georgian),
 420 ms (Malay),
 421 nl (Dutch),
 422 pt (Portuguese),
 423 st (Southern Sotho),
 424 sw (Swahili),
 425 xh (Xhosa),
 426 zu (Zulu).
 427
 428 B<Note>
 429
 430 [1] ja: Ideographs are sorted in JIS X 0208 order.
 431 Fullwidth and halfwidth forms are identical to their normal form.
 432 The difference between hiragana and katakana is at the 4th level,
 433 the comparison also requires C<(variable =E<gt> 'Non-ignorable')>,
 434 and then C<katakana_before_hiragana> has no effect.
 435
 436 [2] ko: Plenty of ideographs are sorted by their reading. Such
 437 an ideograph is primary (level 1) equal to, and secondary (level 2)
 438 greater than, the corresponding hangul syllable.
 439
 440 [3] zh__pinyin, zh__stroke and zh__zhuyin: implemented alt='short',
 441 where a smaller number of ideographs are tailored.
 442
 443 Note: 'pinyin' is in latin, 'zhuyin' is in bopomofo.
 444
 445 =head1 INSTALL
 446
 447 Installation of C<Unicode::Collate::Locale> requires F<Collate/Locale.pm>,
 448 F<Collate/Locale/*.pm>, F<Collate/CJK/*.pm> and F<Collate/allkeys.txt>.
 449 On building, C<Unicode::Collate::Locale> doesn't require any of F<data/*.txt>,
 450 F<gendata/*>, and F<mklocale>.
 451 Tests for C<Unicode::Collate::Locale> are named F<t/loc_*.t>.
 452
 453 =head1 CAVEAT
 454
 455 =over 4
 456
 457 =item tailoring is not maximum
 458
 459 Even if a certain letter is tailored, its equivalent would not always
 460 tailored as well as it. For example, even though W is tailored,
 461 fullwidth W (C<U+FF37>), W with acute (C<U+1E82>), etc. are not
 462 tailored. The result may depend on whether source strings are
 463 normalized or not, and whether decomposed or composed.
 464 Thus C<(normalization =E<gt> undef)> is less preferred.
 465
 466 =back
 467
 468 =head1 AUTHOR
 469
 470 The Unicode::Collate::Locale module for perl was written
 471 by SADAHIRO Tomoyuki, <SADAHIRO@cpan.org>.
 472 This module is Copyright(C) 2004-2012, SADAHIRO Tomoyuki. Japan.
 473 All rights reserved.
 474
 475 This module is free software; you can redistribute it and/or
 476 modify it under the same terms as Perl itself.
 477
 478 =head1 SEE ALSO
 479
 480 =over 4
 481
 482 =item Unicode Collation Algorithm - UTS #10
 483
 484 L<http://www.unicode.org/reports/tr10/>
 485
 486 =item The Default Unicode Collation Element Table (DUCET)
 487
 488 L<http://www.unicode.org/Public/UCA/latest/allkeys.txt>
 489
 490 =item Unicode Locale Data Markup Language (LDML) - UTS #35
 491
 492 L<http://www.unicode.org/reports/tr35/>
 493
 494 =item CLDR - Unicode Common Locale Data Repository
 495
 496 L<http://cldr.unicode.org/>
 497
 498 =item L<Unicode::Collate>
 499
 500 =item L<Unicode::Normalize>
 501
 502 =back
 503
 504 =cut