lib/Packages/I18N/Languages.pm

   1 # Taken from the webwml CVS tree (english/templates/languages.wml)
   2
   3 package Packages::I18N::Languages;
   4
   5 use strict;
   6 use warnings;
   7
   8 use Exporter;
   9
  10 our @ISA = qw( Exporter );
  11 our @EXPORT = qw( langcmp get_transliteration get_selfname );
  12
  13 # language directory name => native name of the language
  14 # non-ASCII letters must be escaped (using entities)!
  15 my %selflang = (
  16                 ar     => '&#1593;&#1585;&#1576;&#1610;&#1577;',
  17                 bg     => '&#1041;&#1098;&#1083;&#1075;&#1072;&#1088;&#1089;&#1082;&#1080;',
  18                 ca     => 'catal&agrave;',
  19                 cs     => '&#269;esky',
  20                 da     => 'dansk',
  21                 de     => 'Deutsch',
  22                 el     => '&#917;&#955;&#955;&#951;&#957;&#953;&#954;&#940;',
  23                 en     => 'English',
  24                 eo     => 'Esperanto',
  25                 es     => 'espa&ntilde;ol',
  26                 fa     => '&#x0641;&#x0627;&#x0631;&#x0633;&#x06cc;',
  27                 fi     => 'suomi',
  28                 fr     => 'fran&ccedil;ais',
  29                 hu     => 'magyar',
  30                 hr     => 'hrvatski',
  31                 hy     => '&#1344;&#1377;&#1397;&#1381;&#1408;&#1381;&#1398;',
  32                 id     => 'Indonesia',
  33                 it     => 'Italiano',
  34                 ja     => '&#26085;&#26412;&#35486;',
  35                 km     => 'Khmer',
  36                 ko     => '&#54620;&#44397;&#50612;',
  37                 lt     => 'Lietuvi&#371;',
  38                 nl     => 'Nederlands',
  39                 "no"   => 'norsk&nbsp;(bokm&aring;l)',
  40                 pl     => 'polski',
  41                 pt     => 'Portugu&ecirc;s (pt)',
  42                 'pt-pt'=> 'Portugu&ecirc;s (pt)',
  43                 'pt-br'=> 'Portugu&ecirc;s (br)',
  44                 ro     => 'rom&acirc;n&#259;',
  45                 ru     => '&#1056;&#1091;&#1089;&#1089;&#1082;&#1080;&#1081;',
  46                 sk     => 'slovensky',
  47                 sv     => 'svenska',
  48                 'sv-se'=> 'svenska',
  49                 sl     => 'sloven&#353;&#269;ina',
  50                 tr     => 'T&uuml;rk&ccedil;e',
  51                 uk     => '&#1091;&#1082;&#1088;&#1072;&#1111;&#1085;&#1089;&#1100;&#1082;&#1072;',
  52                 zh     => '&#20013;&#25991;',
  53                 'zh-cn'=> '&#20013;&#25991;',
  54                 'zh-hk'=> '&#27491;&#39636;&#20013;&#25991;',
  55                 'zh-tw'=> '&#20013;&#25991;',
  56                 );
  57
  58 # language directory name => Latin transliteration of the language name
  59 # This is used for language names which consist entirely of non-Latin
  60 # characters, to aid those that have browsers which cannot show different
  61 # character sets at once.
  62 my %translit = (
  63                 ar => "Arabiya",
  64                 bg => "B&#601;lgarski",
  65                 el => "Ellinika",
  66                 fa => "Farsi",
  67                 hy => "hayeren",
  68                 ja => "Nihongo",
  69                 ko => "Hangul", # Not sure. "Hanguk-Mal" (=Spoken Korean)?
  70                 ru => "Russkij",
  71                 uk => "ukrajins'ka",
  72                 zh => "Zhongwen",
  73                 'zh-cn'=> "Zhongwen,&#31616;",
  74                 'zh-hk'=> "Zhongwen,HK",
  75                 'zh-tw'=> "Zhongwen,&#32321;",
  76                 );
  77
  78 # second transliteration table, used for languages starting with a latin
  79 # diacritic letter
  80 my %translit2 = (
  81                  cs    => "cesky",
  82 );
  83
  84 sub langcmp ($$) {
  85   my ($first, $second) = @_;
  86
  87   # Handle sorting of non-latin characters
  88   # If there is a transliteration for this language available, use it
  89   $first = $translit{$first} if defined $translit{$first};
  90   $second = $translit{$second} if defined $translit{$second};
  91
  92   # Then handle special cases (initial latin letters with diacritics)
  93   $first = $translit2{$first} if defined $translit2{$first};
  94   $second = $translit2{$second} if defined $translit2{$second};
  95
  96   # Put remaining entity-only names last in the list
  97   if (substr($first,0,1) eq '&')
  98   {
  99     $first =~ s/^&/ZZZ&/;
 100   }
 101   if (substr($second,0,1) eq '&')
 102   {
 103     $second =~ s/^&/ZZZ&/;
 104   }
 105   #    There seems to be a bug with localization in
 106   #    Perl 5.005 so we need those extra variables.
 107   my ($ufirst, $usecond) = (uc($first), uc($second));
 108   return $ufirst cmp $usecond;
 109 }
 110
 111 sub get_selfname {
 112     return $selflang{$_[0]} if exists $selflang{$_[0]};
 113     return undef;
 114 }
 115
 116 sub get_transliteration {
 117     return $translit{$_[0]} if exists $translit{$_[0]};
 118     return undef;
 119 }
 120
 121 1;