package lang; # $Id$
use diagnostics;
use strict;
use common;
use log;
#- key: lang name (locale name for some (~5) special cases needing
#- extra distinctions)
#- [0]: lang name in english
#- [1]: transliterated locale name in the locale name (used for sorting)
#- [2]: default locale name to use for that language if there isn't
#- an existing locale for the combination language+country choosen
#- [3]: geographic groups that this language belongs to (for displaying
#- in the menu grouped in smaller lists), 1=Europe, 2=Asia, 3=Africa,
#- 4=Oceania&Pacific, 5=America (if you wonder, it's the order
#- used in the olympic flag)
#- [4]: special value for LANGUAGE variable (if different of the default
#- of 'll_CC:ll_DD:ll' (ll_CC: locale (if exist) resulting of the
#- combination of chosen lang (ll) and country (CC), ll_DD: the
#- default locale shown here (field [2]) and ll: the language (the key))
my %langs = (
'af' => [ 'Afrikaans', 'Afrikaans', 'af_ZA', ' 3 ', 'iso-8859-1' ],
'am' => [ 'Amharic', 'ZZ emarNa', 'am_ET', ' 3 ', 'utf_am' ],
#- doesn't work well after install
#'ar' => [ 'Arabic', 'AA Arabic', 'ar_EG', ' 23 ', 'utf_ar' ],
'az' => [ 'Azeri (Latin)', 'Azerbaycanca', 'az_AZ', ' 2 ', 'utf_az' ],
'be' => [ 'Belarussian', 'Belaruskaya', 'be_BY', '1 ', 'cp1251' ],
'bg' => [ 'Bulgarian', 'Blgarski', 'bg_BG', '1 ', 'cp1251' ],
'bn' => [ 'Bengali', 'ZZ Bengali', 'bn_BD', ' 2 ', 'unicode' ],
'br' => [ 'Brezhoneg', 'Brezhoneg', 'br_FR', '1 ', 'iso-8859-15', 'br:fr_FR:fr' ],
'bs' => [ 'Bosnian', 'Bosanski', 'bs_BA', '1 ', 'iso-8859-2' ],
'ca' => [ 'Catalan', 'Catala', 'ca_ES', '1 ', 'iso-8859-15', 'ca:es_ES:es' ],
'cs' => [ 'Czech', 'Cestina', 'cs_CZ', '1 ', 'iso-8859-2' ],
'cy' => [ 'Cymraeg (Welsh)', 'Cymraeg', 'cy_GB', '1 ', 'utf_lat8', 'cy:en_GB:en' ],
'da' => [ 'Danish', 'Dansk', 'da_DK', '1 ', 'iso-8859-15' ],
'de' => [ 'German', 'Deutsch', 'de_DE', '1 ', 'iso-8859-15' ],
'el' => [ 'Greek', 'Ellynika', 'el_GR', '1 ', 'iso-8859-7' ],
'en_GB' => [ 'English (British)', 'English (British)', 'en_GB', '12345', 'iso-8859-15' ],
'en_US' => [ 'English (American)', 'English (American)', 'en_US', ' 5', 'C' ],
'eo' => [ 'Esperanto', 'Esperanto', 'eo_XX', '12345', 'unicode' ],
'es' => [ 'Spanish', 'Espanol', 'es_ES', '1 3 5', 'iso-8859-15' ],
'et' => [ 'Estonian', 'Eesti', 'et_EE', '1 ', 'iso-8859-15' ],
'eu' => [ 'Euskara (Basque)', 'Euskara', 'eu_ES', '1 ', 'iso-8859-15' ],
'fa' => [ 'Farsi (Iranian)', 'AA Farsi', 'fa_IR', ' 2 ', 'utf_ar' ],
'fi' => [ 'Finnish (Suomi)', 'Suomi', 'fi_FI', '1 ', 'iso-8859-15' ],
#'fo' => [ 'Faroese', 'Foroyskt', 'fo_FO', '1 ', 'iso-8859-1' ],
'fr' => [ 'French', 'Francais', 'fr_FR', '1 345', 'iso-8859-15' ],
'ga' => [ 'Gaelic (Irish)', 'Gaeilge', 'ga_IE', '1 ', 'iso-8859-15', 'ga:en_IE:en_GB:en' ],
#'gd' => [ 'Gaelic (Scottish)', 'Gaidhlig', 'gb_GB', '1 ', 'utf_lat8', 'gd:en_GB:en' ],
'gl' => [ 'Galego (Galician)', 'Galego', 'gl_ES', '1 ', 'iso-8859-15', 'gl:es_ES:es:pt:pt_BR' ],
#'gv' => [ 'Gaelic (Manx)', 'Gaelg', 'gv_GB', '1 ', 'utf_lat8', 'gv:en_GB:en' ],
'he' => [ 'Hebrew', 'AA Ivrit', 'he_IL', ' 2 ', 'utf_he' ],
'hi' => [ 'Hindi', 'ZZ Hindi', 'hi_IN', ' 2 ', 'unicode' ],
'hr' => [ 'Croatian', 'Hrvatski', 'hr_HR', '1 ', 'iso-8859-2' ],
'hu' => [ 'Hungarian', 'Magyar', 'hu_HU', '1 ', 'iso-8859-2' ],
'hy' => [ 'Armenian', 'ZZ Armenian', 'hy_AM', ' 2 ', 'utf_hy' ],
#'ia' => [ 'Interlingua', 'Interlingua', 'ia_XX', '1 5', 'utf8' ],
'id' => [ 'Indonesian', 'Bahasa Indonesia', 'id_ID', ' 2 ', 'iso-8859-1' ],
'is' => [ 'Icelandic', 'Islenska', 'is_IS', '1 ', 'iso-8859-1' ],
'it' => [ 'Italian', 'Italiano', 'it_IT', '1 ', 'iso-8859-15' ],
#-'iu' => [ 'Inuktitut', 'ZZ Inuktitut', 'iu_CA', ' 5', 'utf_iu' ],
'ja' => [ 'Japanese', 'ZZ Nihongo', 'ja_JP', ' 2 ', 'jisx0208' ],
'ka' => [ 'Georgian', 'ZZ Georgian', 'ka_GE', ' 2 ', 'utf_ka' ],
#-'kl' => [ 'Greenlandic (inuit)', 'ZZ Inuit', 'kl_GL', ' 5', 'iso-8859-1' ],
'kn' => [ 'Kannada', 'ZZ Kannada', 'kn_IN', ' 2 ', 'unicode' ],
'ko' => [ 'Korean', 'ZZ Korea', 'ko_KR', ' 2 ', 'ksc5601' ],
#-'kw' => [ 'Cornish', 'Kernewek', 'kw_GB', '1 ', 'utf_lat8', 'kw:en_GB:en' ],
'lo' => [ 'Laotian', 'Laotian', 'lo_LA', ' 2 ', 'utf_lo' ],
'lt' => [ 'Lithuanian', 'Lietuviskai', 'lt_LT', '1 ', 'iso-8859-13' ],
'lv' => [ 'Latvian', 'Latviesu', 'lv_LV', '1 ', 'iso-8859-13' ],
'mi' => [ 'Maori', 'Maori', 'mi_NZ', ' 4 ', 'unicode' ],
'mk' => [ 'Macedonian', 'Makedonski', 'mk_MK', '1 ', 'utf_cyr1' ],
'mn' => [ 'Mongolian', 'Mongol', 'mn_MN', ' 2 ', 'utf_cyr2' ],
'ms' => [ 'Malay', 'Bahasa Melayu', 'ms_MY', ' 2 ', 'iso-8859-1' ],
'mt' => [ 'Maltese', 'Maltin', 'mt_MT', '1 3 ', 'unicode' ],
'nb' => [ 'Norwegian Bokmaal', 'Norsk, Bokmal', 'no_NO', '1 ', 'iso-8859-1', 'nb:no' ],
'nl' => [ 'Dutch', 'Nederlands', 'nl_NL', '1 ', 'iso-8859-15' ],
'nn' => [ 'Norwegian Nynorsk', 'Norsk, Nynorsk', 'nn_NO', '1 ', 'iso-8859-1', 'nn:no@nynorsk:no_NY:no:nb' ],
#-'oc' => [ 'Occitan', 'Occitan', 'oc_FR', '1 ', 'iso-8859-1', 'oc:fr_FR:fr' ],
#-'ph' => [ 'Pilipino', 'Pilipino', 'ph_PH', ' 2 ', 'iso-8859-1', 'ph:tl' ],
'pl' => [ 'Polish', 'Polski', 'pl_PL', '1 ', 'iso-8859-2' ],
'pt' => [ 'Portuguese', 'Portugues', 'pt_PT', '1 3 ', 'iso-8859-15', 'pt_PT:pt:pt_BR' ],
'pt_BR' => [ 'Portuguese Brazil', 'Portugues do Brasil', 'pt_BR', ' 5', 'iso-8859-1', 'pt_BR:pt_PT:pt' ],
'ro' => [ 'Romanian', 'Romana', 'ro_RO', '1 ', 'iso-8859-2' ],
'ru' => [ 'Russian', 'Russkij', 'ru_RU', '12 ', 'koi8-r' ],
'sk' => [ 'Slovak', 'Slovencina', 'sk_SK', '1 ', 'iso-8859-2' ],
'sl' => [ 'Slovenian', 'Slovenscina', 'sl_SI', '1 ', 'iso-8859-2' ],
'sp' => [ 'Serbian Cyrillic', 'Srpska', 'sp_YU', '1 ', 'iso-8859-5', 'sp:sr' ],
'sq' => [ 'Albanian', 'Shqip', 'sq_AL', '1 ', 'iso-8859-1' ],
'sr' => [ 'Serbian Latin', 'Srpska', 'sr_YU', '1 ', 'iso-8859-2' ],
'sv' => [ 'Swedish', 'Svenska', 'sv_SE', '1 ', 'iso-8859-1' ],
'ta' => [ 'Tamil', 'ZZ Tamil', 'ta_IN', ' 2 ', 'utf_ta' ],
'tg' => [ 'Tajik', 'Tojiki', 'tg_TJ', ' 2 ', 'utf_cyr2' ],
'th' => [ 'Thai', 'ZZ Thai', 'th_TH', ' 2 ', 'tis620' ],
'tr' => [ 'Turkish', 'Turkce', 'tr_TR', ' 2 ', 'iso-8859-9' ],
#-'tt' => [ 'Tatar', 'Tatar', 'tt_RU', ' 2 ', 'utf_cyr2' ],
'uk' => [ 'Ukrainian', 'Ukrayinska', 'uk_UA', '1 ', 'koi8-u' ],
#-'ur' => [ 'Urdu', 'AA Urdu', 'ur_PK', ' 2 ', 'utf_ar' ],
'uz' => [ 'Uzbek', 'Ozbekcha', 'uz_UZ', ' 2 ', 'unicode' ],
'vi' => [ 'Vietnamese', 'Tieng Viet', 'vi_VN', ' 2 ', 'utf_vi' ],
'wa' => [ 'Walon', 'Walon', 'wa_BE', '1 ', 'iso-8859-15', 'wa:fr_BE:fr' ],
#- Xhosa locale (xh_ZA) is not yet available, using en_ZA instead,
#- and defining a LANGUAGE variable
#waiting for lang-xh.png, it has kde trans.
#-'xh' => [ 'Xhosa', 'IsiXhosa', 'xh_ZA', ' 3 ', 'iso-8859-1', 'xh:en_ZA' ],
#-'yi' => [ 'Yiddish', 'AA Yidish', 'yi_US', '1 5', 'utf_he' ],
'zh_CN' => [ 'Chinese Simplified', 'ZZ ZhongWen', 'zh_CN', ' 2 ', 'gb2312', 'zh_CN.GB2312:zh_CN:zh' ],
'zh_TW' => [ 'Chinese Traditional', 'ZZ ZhongWen', 'zh_TW', ' 2 ', 'Big5', 'zh_TW.Big5:zh_TW:zh_HK:zh' ],
);
sub l2name { exists $langs{$_[0]} && $langs{$_[0]}[0] }
sub l2transliterated { exists $langs{$_[0]} && $langs{$_[0]}[1] }
sub l2locale { exists $langs{$_[0]} && $langs{$_[0]}[2] }
sub l2location {
my %geo = (1 => 'Europe', 2 => 'Asia', 3 => 'Africa', 4 => 'Oceania/Pacific', 5 => 'America');
map { if_($langs{$_[0]}[3] =~ $_, $geo{$_}) } 1..5;
}
sub l2charset { exists $langs{$_[0]} && $langs{$_[0]}[4] }
sub l2language { exists $langs{$_[0]} && $langs{$_[0]}[5] }
sub list_langs {
my (%options) = @_;
my @l = keys %langs;
$options{exclude_non_installed} ? grep { -e "/usr/share/locale/".l2locale($_)."/LC_CTYPE" } @l : @l;
}
sub text_direction_rtl() { N("default:LTR") eq "default:RTL" }
#- key: country name (that should be YY in xx_YY locale)
#- [0]: country name in natural language
#- [1]: default locale for that country
#- [2]: geographic groups that this country belongs to (for displaying
#- in the menu grouped in smaller lists), 1=Europe, 2=Asia, 3=Africa,
#- 4=Oceania&Pacific, 5=America (if you wonder, it's the order
#- used in the olympic flag)
#-
#- Note: for countries for which a glibc locale don't exist (yet) I tried to
#- put a locale that makes sense; and a '#' at the end of the line to show
#- the locale is not the "correct" one. 'en_US' is used when no good choice
#- is available.
my %countries = (
'AF' => [ N_("Afghanistan"), 'en_US', '2' ], #
'AD' => [ N_("Andorra"), 'ca_ES', '1' ], #
'AE' => [ N_("United Arab Emirates"), 'ar_AE', '2' ],
'AG' => [ N_("Antigua and Barbuda"), 'en_US', '5' ], #
'AI' => [ N_("Anguilla"), 'en_US', '5' ], #
'AL' => [ N_("Albania"), 'sq_AL', '1' ],
'AM' => [ N_("Armenia"), 'hy_AM', '2' ],
'AN' => [ N_("Netherlands Antilles"), 'en_US', '5' ], #
'AO' => [ N_("Angola"), 'pt_PT', '3' ], #
'AQ' => [ N_("Antarctica"), 'en_US', '4' ], #
'AR' => [ N_("Argentina"), 'es_AR', '5' ],
'AS' => [ N_("American Samoa"), 'en_US', '4' ], #
'AT' => [ N_("Austria"), 'de_AT', '1' ],
'AU' => [ N_("Australia"), 'en_AU', '4' ],
'AW' => [ N_("Aruba"), 'en_US', '5' ], #
'AZ' => [ N_("Azerbaijan"), 'az_AZ', '1' ],
'BA' => [ N_("Bosnia and Herzegovina"), 'bs_BA', '1' ],
'BB' => [ N_("Barbados"), 'en_US', '5' ], #
'BD' => [ N_("Bangladesh"), 'bn_BD', '2' ],
'BE' => [ N_("Belgium"), 'fr_BE', '1' ],
'BF' => [ N_("Burkina Faso"), 'en_US', '3' ], #
'BG' => [ N_("Bulgaria"), 'bg_BG', '1' ],
'BH' => [ N_("Bahrain"), 'ar_BH', '2' ],
'BI' => [ N_("Burundi"), 'en_US', '3' ], #
'BJ' => [ N_("Benin"), 'fr_FR', '3' ], #
'BM' => [ N_("Bermuda"), 'en_US', '5' ], #
'BN' => [ N_("Brunei Darussalam"), 'ar_EG', '2' ], #
'BO' => [ N_("Bolivia"), 'es_BO', '5' ],
'BR' => [ N_("Brazil"), 'pt_BR', '5' ],
'BS' => [ N_("Bahamas"), 'en_US', '5' ], #
'BT' => [ N_("Bhutan"), 'en_IN', '2' ], #
'BV' => [ N_("Bouvet Island"), 'en_US', '3' ], #
'BW' => [ N_("Botswana"), 'en_BW', '3' ],
'BY' => [ N_("Belarus"), 'be_BY', '1' ],
'BZ' => [ N_("Belize"), 'en_US', '5' ], #
'CA' => [ N_("Canada"), 'en_CA', '5' ],
'CC' => [ N_("Cocos (Keeling) Islands"), 'en_US', '4' ], #
'CD' => [ N_("Congo (Kinshasa)"), 'fr_FR', '3' ], #
'CF' => [ N_("Central African Republic"), 'fr_FR', '3' ], #
'CG' => [ N_("Congo (Brazzaville)"), 'fr_FR', '3' ], #
'CH' => [ N_("Switzerland"), 'de_CH', '1' ],
'CI' => [ N_("Cote d'Ivoire"), 'fr_FR', '3' ], #
'CK' => [ N_("Cook Islands"), 'en_US', '4' ], #
'CL' => [ N_("Chile"), 'es_CL', '5' ],
'CM' => [ N_("Cameroon"), 'fr_FR', '3' ], #
'CN' => [ N_("China"), 'zh_CN', '2' ],
'CO' => [ N_("Colombia"), 'es_CO', '5' ],
'CR' => [ N_("Costa Rica"), 'es_CR', '5' ],
'CU' => [ N_("Cuba"), 'es_DO', '5' ], #
'CV' => [ N_("Cape Verde"), 'pt_PT', '3' ], #
'CX' => [ N_("Christmas Island"), 'en_US', '4' ], #
'CY' => [ N_("Cyprus"), 'en_US', '1' ], #
'CZ' => [ N_("Czech Republic"), 'cs_CZ', '2' ],
'DE' => [ N_("Germany"), 'de_DE', '1' ],
'DJ' => [ N_("Djibouti"), 'en_US', '3' ], #
'DK' => [ N_("Denmark"), 'da_DK', '1' ],
'DM' => [ N_("Dominica"), 'en_US', '5' ], #
'DO' => [ N_("Dominican Republic"), 'es_DO', '5' ],
'DZ' => [ N_("Algeria"), 'ar_DZ', '3' ],
'EC' => [ N_("Ecuador"), 'es_EC', '5' ],
'EE' => [ N_("Estonia"), 'et_EE', '1' ],
'EG' => [ N_("Egypt"), 'ar_EG', '3' ],
'EH' => [ N_("Western Sahara"), 'ar_MA', '3' ], #
'ER' => [ N_("Eritrea"), 'ti_ER', '3' ],
'ES' => [ N_("Spain"), 'es_ES', '1' ],
'ET' => [ N_("Ethiopia"), 'am_ET', '3' ],
'FI' => [ N_("Finland"), 'fi_FI', '1' ],
'FJ' => [ N_("Fiji"), 'en_US', '4' ], #
'FK' => [ N_("Falkland Islands (Malvinas)"), 'en_GB', '5' ], #
'FM' => [ N_("Micronesia"), 'en_US', '4' ], #
'FO' => [ N_("Faroe Islands"), 'fo_FO', '1' ],
'FR' => [ N_("France"), 'fr_FR', '1' ],
'GA' => [ N_("Gabon"), 'fr_FR', '3' ], #
'GB' => [ N_("United Kingdom"), 'en_GB', '1' ],
'GD' => [ N_("Grenada"), 'en_US', '5' ], #
'GE' => [ N_("Georgia"), 'ka_GE', '2' ],
'GF' => [ N_("French Guiana"), 'fr_FR', '5' ], #
'GH' => [ N_("Ghana"), 'fr_FR', '3' ], #
'GI' => [ N_("Gibraltar"), 'en_GB', '1' ], #
'GL' => [ N_("Greenland"), 'kl_GL', '5' ],
'GM' => [ N_("Gambia"), 'en_US', '3' ], #
'GN' => [ N_("Guinea"), 'en_US', '3' ], #
'GP' => [ N_("Guadeloupe"), 'fr_FR', '5' ], #
'GQ' => [ N_("Equatorial Guinea"), 'en_US', '3' ], #
'GR' => [ N_("Greece"), 'el_GR', '1' ],
'GS' => [ N_("South Georgia and the South Sandwich Islands"), 'en_US', '4' ], #
'GT' => [ N_("Guatemala"), 'es_GT', '5' ],
'GU' => [ N_("Guam"), 'en_US', '4' ], #
'GW' => [ N_("Guinea-Bissau"), 'pt_PT', '3' ], #
'GY' => [ N_("Guyana"), 'en_US', '5' ], #
'HK' => [ N_("China") . ' (' . N_("Hong Kong") . ')', 'zh_HK', '2' ],
'HM' => [ N_("Heard and McDonald Islands"), 'en_US', '4' ], #
'HN' => [ N_("Honduras"), 'es_HN', '5' ],
'HR' => [ N_("Croatia"), 'hr_HR', '1' ],
'HT' => [ N_("Haiti"), 'fr_FR', '5' ], #
'HU' => [ N_("Hungary"), 'hu_HU', '1' ],
'ID' => [ N_("Indonesia"), 'id_ID', '2' ],
'IE' => [ N_("Ireland"), 'en_IE', '1' ],
'IL' => [ N_("Israel"), 'he_IL', '2' ],
'IN' => [ N_("India"), 'hi_IN', '2' ],
'IO' => [ N_("British Indian Ocean Territory"), 'en_GB', '2' ], #
'IQ' => [ N_("Iraq"), 'ar_IQ', '2' ],
'IR' => [ N_("Iran"), 'fa_IR', '2' ],
'IS' => [ N_("Iceland"), 'is_IS', '1' ],
'IT' => [ N_("Italy"), 'it_IT', '1' ],
'JM' => [ N_("Jamaica"), 'en_US', '5' ], #
'JO' => [ N_("Jordan"), 'ar_JO', '2' ],
'JP' => [ N_("Japan"), 'ja_JP', '2' ],
'KE' => [ N_("Kenya"), 'en_ZW', '3' ], #
'KG' => [ N_("Kyrgyzstan"), 'en_US', '2' ], #
'KH' => [ N_("Cambodia"), 'en_US', '2' ], # kh_KH not released yet
'KI' => [ N_("Kiribati"), 'en_US', '3' ], #
'KM' => [ N_("Comoros"), 'en_US', '2' ], #
'KN' => [ N_("Saint Kitts and Nevis"), 'en_US', '5' ], #
'KP' => [ N_("Korea (North)"), 'ko_KR', '2' ], #
'KR' => [ N_("Korea"), 'ko_KR', '2' ],
'KW' => [ N_("Kuwait"), 'ar_KW', '2' ],
'KY' => [ N_("Cayman Islands"), 'en_US', '5' ], #
'KZ' => [ N_("Kazakhstan"), 'ru_RU', '2' ], #
'LA' => [ N_("Laos"), 'lo_LA', '2' ],
'LB' => [ N_("Lebanon"), 'ar_LB', '2' ],
'LC' => [ N_("Saint Lucia"), 'en_US', '5' ], #
'LI' => [ N_("Liechtenstein"), 'de_CH', '1' ], #
'LK' => [ N_("Sri Lanka"), 'en_IN', '2' ], #
'LR' => [ N_("Liberia"), 'en_US', '3' ], #
'LS' => [ N_("Lesotho"), 'en_BW', '3' ], #
'LT' => [ N_("Lithuania"), 'lt_LT', '1' ],
'LU' => [ N_("Luxembourg"), 'de_LU', '1' ],
'LV' => [ N_("Latvia"), 'lv_LV', '1' ],
'LY' => [ N_("Libya"), 'ar_LY', '3' ],
'MA' => [ N_("Morocco"), 'ar_MA', '3' ],
'MC' => [ N_("Monaco"), 'fr_FR', '1' ], #
'MD' => [ N_("Moldova"), 'ro_RO', '1' ], #
'MG' => [ N_("Madagascar"), 'fr_FR', '3' ], #
'MH' => [ N_("Marshall Islands"), 'en_US', '4' ], #
'MK' => [ N_("Macedonia"), 'mk_MK', '1' ],
'ML' => [ N_("Mali"), 'en_US', '3' ], #
'MM' => [ N_("Myanmar"), 'en_US', '2' ], #
'MN' => [ N_("Mongolia"), 'mn_MN', '2' ],
'MP' => [ N_("Northern Mariana Islands"), 'en_US', '2' ], #
'MQ' => [ N_("Martinique"), 'fr_FR', '5' ], #
'MR' => [ N_("Mauritania"), 'en_US', '3' ], #
'MS' => [ N_("Montserrat"), 'en_US', '5' ], #
'MT' => [ N_("Malta"), 'mt_MT', '1' ],
'MU' => [ N_("Mauritius"), 'en_US', '3' ], #
'MV' => [ N_("Maldives"), 'en_US', '4' ], #
'MW' => [ N_("Malawi"), 'en_US', '3' ], #
'MX' => [ N_("Mexico"), 'es_MX', '5' ],
'MY' => [ N_("Malaysia"), 'ms_MY', '2' ],
'MZ' => [ N_("Mozambique"), 'pt_PT', '3' ], #
'NA' => [ N_("Namibia"), 'en_US', '3' ], #
'NC' => [ N_("New Caledonia"), 'fr_FR', '4' ], #
'NE' => [ N_("Niger"), 'en_US', '3' ], #
'NF' => [ N_("Norfolk Island"), 'en_GB', '4' ], #
'NG' => [ N_("Nigeria"), 'en_US', '3' ], #
'NI' => [ N_("Nicaragua"), 'es_NI', '5' ],
'NL' => [ N_("Netherlands"), 'nl_NL', '1' ],
'NO' => [ N_("Norway"), 'no_NO', '1' ],
'NP' => [ N_("Nepal"), 'en_IN', '2' ], #
'NR' => [ N_("Nauru"), 'en_US', '4' ], #
'NU' => [ N_("Niue"), 'en_US', '4' ], #
'NZ' => [ N_("New Zealand"), 'en_NZ', '4' ],
'OM' => [ N_("Oman"), 'ar_OM', '2' ],
'PA' => [ N_("Panama"), 'es_PA', '5' ],
'PE' => [ N_("Peru"), 'es_PE', '5' ],
'PF' => [ N_("French Polynesia"), 'fr_FR', '4' ], #
'PG' => [ N_("Papua New Guinea"), 'en_NZ', '4' ], #
'PH' => [ N_("Philippines"), 'ph_PH', '2' ],
'PK' => [ N_("Pakistan"), 'ur_PK', '2' ],
'PL' => [ N_("Poland"), 'pl_PL', '1' ],
'PM' => [ N_("Saint Pierre and Miquelon"), 'fr_CA', '5' ], #
'PN' => [ N_("Pitcairn"), 'en_US', '4' ], #
'PR' => [ N_("Puerto Rico"), 'es_PR', '5' ],
'PS' => [ N_("Palestine"), 'ar_JO', '2' ], #
'PT' => [ N_("Portugal"), 'pt_PT', '1' ],
'PY' => [ N_("Paraguay"), 'es_PY', '5' ],
'PW' => [ N_("Palau"), 'en_US', '2' ], #
'QA' => [ N_("Qatar"), 'ar_QA', '2' ],
'RE' => [ N_("Reunion"), 'fr_FR', '2' ], #
'RO' => [ N_("Romania"), 'ro_RO', '1' ],
'RU' => [ N_("Russia"), 'ru_RU', '1' ],
'RW' => [ N_("Rwanda"), 'fr_FR', '3' ], #
'SA' => [ N_("Saudi Arabia"), 'ar_SA', '2' ],
'SB' => [ N_("Solomon Islands"), 'en_US', '4' ], #
'SC' => [ N_("Seychelles"), 'en_US', '4' ], #
'SD' => [ N_("Sudan"), 'ar_SD', '5' ],
'SE' => [ N_("Sweden"), 'sv_SE', '1' ],
'SG' => [ N_("Singapore"), 'en_SG', '2' ],
'SH' => [ N_("Saint Helena"), 'en_GB', '5' ], #
'SI' => [ N_("Slovenia"), 'sl_SI', '1' ],
'SJ' => [ N_("Svalbard and Jan Mayen Islands"), 'en_US', '1' ], #
'SK' => [ N_("Slovakia"), 'sk_SK', '1' ],
'SL' => [ N_("Sierra Leone"), 'en_US', '3' ], #
'SM' => [ N_("San Marino"), 'it_IT', '1' ], #
'SN' => [ N_("Senegal"), 'fr_FR', '3' ], #
'SO' => [ N_("Somalia"), 'en_US', '3' ], #
'SR' => [ N_("Suriname"), 'nl_NL', '5' ], #
'ST' => [ N_("Sao Tome and Principe"), 'en_US', '5' ], #
'SV' => [ N_("El Salvador"), 'es_SV', '5' ],
'SY' => [ N_("Syria"), 'ar_SY', '2' ],
'SZ' => [ N_("Swaziland"), 'en_BW', '3' ], #
'TC' => [ N_("Turks and Caicos Islands"), 'en_US', '5' ], #
'TD' => [ N_("Chad"), 'en_US', '3' ], #
'TF' => [ N_("French Southern Territories"), 'fr_FR', '4' ], #
'TG' => [ N_("Togo"), 'fr_FR', '3' ], #
'TH' => [ N_("Thailand"), 'th_TH', '2' ],
'TJ' => [ N_("Tajikistan"), 'tg_TJ', '2' ],
'TK' => [ N_("Tokelau"), 'en_US', '4' ], #
'TL' => [ N_("East Timor"), 'pt_PT', '4' ], #
'TM' => [ N_("Turkmenistan"), 'en_US', '2' ], #
'TN' => [ N_("Tunisia"), 'ar_TN', '5' ],
'TO' => [ N_("Tonga"), 'en_US', '3' ], #
'TR' => [ N_("Turkey"), 'tr_TR', '2' ],
'TT' => [ N_("Trinidad and Tobago"), 'en_US', '5' ], #
'TV' => [ N_("Tuvalu"), 'en_US', '4' ], #
'TW' => [ N_("Taiwan"), 'zh_TW', '2' ],
'TZ' => [ N_("Tanzania"), 'en_US', '3' ], #
'UA' => [ N_("Ukraine"), 'uk_UA', '1' ],
'UG' => [ N_("Uganda"), 'en_US', '3' ], #
'UM' => [ N_("United States Minor Outlying Islands"), 'en_US', '5' ], #
'US' => [ N_("United States"), 'en_US', '5' ],
'UY' => [ N_("Uruguay"), 'es_UY', '5' ],
'UZ' => [ N_("Uzbekistan"), 'uz_UZ', '2' ],
'VA' => [ N_("Vatican"), 'it_IT', '1' ], #
'VC' => [ N_("Saint Vincent and the Grenadines"), 'en_US', '5' ],
'VE' => [ N_("Venezuela"), 'es_VE', '5' ],
'VG' => [ N_("Virgin Islands (British)"), 'en_GB', '5' ], #
'VI' => [ N_("Virgin Islands (U.S.)"), 'en_US', '5' ], #
'VN' => [ N_("Vietnam"), 'vi_VN', '2' ],
'VU' => [ N_("Vanuatu"), 'en_US', '4' ], #
'WF' => [ N_("Wallis and Futuna"), 'fr_FR', '4' ], #
'WS' => [ N_("Samoa"), 'en_US', '4' ], #
'YE' => [ N_("Yemen"), 'ar_YE', '2' ],
'YT' => [ N_("Mayotte"), 'fr_FR', '3' ], #
'YU' => [ N_("Serbia"), 'sp_YU', '1' ],
'ZA' => [ N_("South Africa"), 'en_ZA', '5' ],
'ZM' => [ N_("Zambia"), 'en_US', '3' ], #
'ZW' => [ N_("Zimbabwe"), 'en_ZW', '5' ],
);
sub c2name { exists $countries{$_[0]} && translate($countries{$_[0]}[0]) }
sub c2locale { exists $countries{$_[0]} && $countries{$_[0]}[1] }
sub list_countries {
my (%options) = @_;
my @l = keys %countries;
$options{exclude_non_installed} ? grep { -e "/usr/share/locale/".c2locale($_)."/LC_CTYPE" } @l : @l;
}
#- this list is built with 'cd /usr/share/i18n/locales ; echo ??_??'
#- plus sp_YU, eo_XX, mn_MN, lo_LA, ph_PH, en_BE
our @locales = qw(af_ZA am_ET ar_AE ar_BH ar_DZ ar_EG ar_IN ar_IQ ar_JO ar_KW ar_LB ar_LY ar_MA ar_OM ar_QA ar_SA ar_SD ar_SY ar_TN ar_YE az_AZ be_BY bg_BG bn_BD bn_IN br_FR bs_BA ca_ES cs_CZ cy_GB da_DK de_AT de_BE de_CH de_DE de_LU el_GR en_AU en_BW en_CA en_DK en_GB en_HK en_IE en_IN en_NZ en_PH en_SG en_US en_ZA en_ZW es_AR es_BO es_CL es_CO es_CR es_DO es_EC es_ES es_GT es_HN es_MX es_NI es_PA es_PE es_PR es_PY es_SV es_US es_UY es_VE et_EE eu_ES fa_IR fi_FI fo_FO fr_BE fr_CA fr_CH fr_FR fr_LU ga_IE gd_GB gl_ES gv_GB he_IL hi_IN hr_HR hu_HU hy_AM id_ID is_IS it_CH it_IT iw_IL ja_JP ka_GE kl_GL ko_KR kw_GB lt_LT lv_LV mi_NZ mk_MK mr_IN ms_MY mt_MT nl_BE nl_NL nn_NO no_NO oc_FR pl_PL pt_BR pt_PT ro_RO ru_RU ru_UA se_NO sk_SK sl_SI sq_AL sr_YU sv_FI sv_SE ta_IN te_IN tg_TJ th_TH ti_ER ti_ET tl_PH tr_TR tt_RU uk_UA ur_PK uz_UZ vi_VN wa_BE yi_US zh_CN zh_HK zh_SG zh_TW sp_YU eo_XX mn_MN lo_LA ph_PH en_BE);
sub standard_locale {
my ($lang, $country, $utf8) = @_;
retry:
member("${lang}_${country}", @locales) and return "${lang}_${country}".($utf8 ? '.UTF-8' : '');
length($lang) > 2 and $lang =~ s/^(..).*/$1/, goto retry;
}
sub getlocale_for_lang {
my ($lang, $country, $o_utf8) = @_;
standard_locale($lang, $country, $o_utf8) || l2locale($lang).($o_utf8 ? '.UTF-8' : '');
}
sub getlocale_for_country {
my ($lang, $country, $o_utf8) = @_;
standard_locale($lang, $country, $o_utf8) || c2locale($country).($o_utf8 ? '.UTF-8' : '');
}
sub getLANGUAGE {
my ($lang, $o_country, $o_utf8) = @_;
l2language($lang) || join(':', uniq(getlocale_for_lang($lang, $o_country, $o_utf8), $lang, if_($lang =~ /^(..)_/, $1)));
}
my %xim = (
#- xcin only works with 'zh_TW', 'zh_TW.Big5', 'zh_CN', 'zh_CN.GB2312'
#- all other locale names, in particular 'zh_HK' or 'zh_TW.UTF-8'
#- are unknown to it. So chinput is used for all but 'zh_TW'
'zh_TW' => {
ENC => 'big5',
XIM => 'xcin',
XIM_PROGRAM => 'xcin',
XMODIFIERS => '"@im=xcin-zh_TW"',
CONSOLE_NOT_LOCALIZED => 'yes',
},
'zh_TW.UTF-8' => {
ENC => 'utf8',
XIM => 'Chinput',
XIM_PROGRAM => 'chinput',
XMODIFIERS => '"@im=Chinput"',
CONSOLE_NOT_LOCALIZED => 'yes',
},
'zh_CN' => {
ENC => 'gb',
XIM => 'Chinput',
XIM_PROGRAM => 'chinput',
XMODIFIERS => '"@im=Chinput"',
CONSOLE_NOT_LOCALIZED => 'yes',
},
'zh_CN.UTF-8' => {
ENC => 'utf8',
XIM => 'Chinput',
XIM_PROGRAM => 'chinput',
XMODIFIERS => '"@im=Chinput"',
CONSOLE_NOT_LOCALIZED => 'yes',
},
'zh_SG' => {
ENC => 'gb',
XIM => 'Chinput',
XIM_PROGRAM => 'chinput',
XMODIFIERS => '"@im=Chinput"',
CONSOLE_NOT_LOCALIZED => 'yes',
},
'zh_SG.UTF-8' => {
ENC => 'utf8',
XIM => 'Chinput',
XIM_PROGRAM => 'chinput',
XMODIFIERS => '"@im=Chinput"',
CONSOLE_NOT_LOCALIZED => 'yes',
},
'zh_HK' => {
ENC => 'big5',
XIM => 'Chinput',
XIM_PROGRAM => 'chinput',
XMODIFIERS => '"@im=Chinput"',
CONSOLE_NOT_LOCALIZED => 'yes',
},
'zh_HK.UTF-8' => {
ENC => 'utf8',
XIM => 'Chinput',
XIM_PROGRAM => 'chinput',
XMODIFIERS => '"@im=Chinput"',
CONSOLE_NOT_LOCALIZED => 'yes',
},
'ko_KR' => {
ENC => 'kr',
XIM => 'Ami',
#- NOTE: there are several possible versions of ami, for the different
#- desktops (kde, gnome, etc). So XIM_PROGRAM isn't defined; it will
#- be the xinitrc script, XIM section, that will choose the right one
#- XIM_PROGRAM => 'ami',
XMODIFIERS => '"@im=Ami"',
CONSOLE_NOT_LOCALIZED => 'yes',
},
'ko_KR.UTF-8' => {
ENC => 'utf8',
XIM => 'Ami',
#- NOTE: there are several possible versions of ami, for the different
#- desktops (kde, gnome, etc). So XIM_PROGRAM isn't defined; it will
#- be the xinitrc script, XIM section, that will choose the right one
#- XIM_PROGRAM => 'ami',
XMODIFIERS => '"@im=Ami"',
CONSOLE_NOT_LOCALIZED => 'yes',
},
'ja_JP' => {
ENC => 'eucj',
XIM => 'kinput2',
XIM_PROGRAM => 'kinput2',
XMODIFIERS => '"@im=kinput2"',
},
'ja_JP.UTF-8' => {
ENC => 'utf8',
XIM => 'kinput2',
XIM_PROGRAM => 'kinput2',
XMODIFIERS => '"@im=kinput2"',
},
#- XFree86 has an internal XIM for Thai that enables syntax checking etc.
#- 'Passthroug' is no check at all, 'BasicCheck' accepts bad sequences
#- and convert them to right ones, 'Strict' refuses bad sequences
'th_TH' => {
XIM_PROGRAM => '/bin/true', #- it's an internal module
XMODIFIERS => '"@im=BasicCheck"',
},
#- xvnkb is not an XIM input method; but an input method of another
#- kind, only XIM_PROGRAM needs to be defined
#- ! xvnkb doesn't work in UTF-8 !
#- 'vi_VN.VISCII' => {
#- XIM_PROGRAM => 'xvnkb',
#- },
);
#- [0]: console font name
#- [1]: sfm map for console font (if needed)
#- [2]: acm file for console font (none if utf8)
#- [3]: iocharset param for mount (utf8 if utf8)
#- [4]: codepage parameter for mount (none if utf8)
my %charsets = (
#- chinese needs special console driver for text mode
"Big5" => [ undef, undef, undef, "big5", "950" ],
"gb2312" => [ undef, undef, undef, "gb2312", "936" ],
"C" => [ "lat0-16", undef, "iso15", "iso8859-1", "850" ],
"iso-8859-1" => [ "lat1-16", undef, "iso01", "iso8859-1", "850" ],
"iso-8859-2" => [ "lat2-sun16", undef, "iso02", "iso8859-2", "852" ],
"iso-8859-5" => [ "UniCyr_8x16", undef, "iso05", "iso8859-5", "866" ],
"iso-8859-7" => [ "iso07.f16", undef, "iso07", "iso8859-7", "869" ],
"iso-8859-9" => [ "lat5u-16", undef, "iso09", "iso8859-9", "857" ],
"iso-8859-13" => [ "tlat7", undef, "iso13", "iso8859-13", "775" ],
"iso-8859-15" => [ "lat0-16", undef, "iso15", "iso8859-15", "850" ],
#- japanese needs special console driver for text mode [kon2]
"jisx0208" => [ undef, undef, "trivial.trans", "euc-jp", "932" ],
"koi8-r" => [ "UniCyr_8x16", undef, "koi8-r", "koi8-r", "866" ],
"koi8-u" => [ "UniCyr_8x16", undef, "koi8-u", "koi8-u", "866" ],
"cp1251" => [ "UniCyr_8x16", undef, "cp1251", "cp1251", "866" ],
#- korean needs special console driver for text mode
"ksc5601" => [ undef, undef, undef, "euc-kr", "949" ],
#- I have no console font for Thai...
"tis620" => [ undef, undef, "trivial.trans", "tis-620", "874" ],
# UTF-8 encodings here; they differ in the console font mainly.
"utf_am" => [ "Agafari-16", undef, undef, "utf8", undef ],
"utf_ar" => [ "iso06.f16", undef, undef, "utf8", undef ],
"utf_az" => [ "tiso09e", undef, undef, "utf8", undef ],
"utf_cyr1" => [ "UniCyr_8x16", undef, undef, "utf8", undef ],
"utf_cyr2" => [ "koi8-k", undef, undef, "utf8", undef ],
"utf_he" => [ "iso08.f16", undef, undef, "utf8", undef ],
"utf_hy" => [ "arm8", undef, undef, "utf8", undef ],
"utf_ka" => [ "t_geors", undef, undef, "utf8", undef ],
"utf_lo" => [ undef, undef, undef, "utf8", undef ],
"utf_ta" => [ "tamil", undef, undef, "utf8", undef ],
"utf_vi" => [ "tcvn8x16", undef, undef, "utf8", undef ],
"utf_lat8" => [ "iso14.f16", undef, undef, "utf8", undef ],
# default for utf-8 encodings
"unicode" => [ "LatArCyrHeb-16", undef, undef, "utf8", undef ],
);
#- for special cases not handled magically
my %charset2kde_charset = (
gb2312 => 'gb2312.1980-0',
jisx0208 => 'jisx0208.1983-0',
ksc5601 => 'ksc5601.1987-0',
Big5 => 'big5-0',
cp1251 => 'microsoft-cp1251',
utf8 => 'iso10646-1',
tis620 => 'tis620-0',
#- Tamil KDE translations still use TSCII, and KDE know it as iso-8859-1
utf_ta => 'iso8859-1',
);
my @during_install__lang_having_their_LC_CTYPE = qw(ja ko ta);
#- -------------------
sub list {
my (%options) = @_;
my @l = list_langs();
if ($options{exclude_non_installed_langs}) {
@l = grep { -e "/usr/share/locale/$_/LC_CTYPE" } @l;
}
@l;
}
sub l2console_font {
my ($locale) = @_;
my $c = $charsets{l2charset($locale->{lang}) || return} or return;
my ($name, $sfm, $acm) = @$c;
undef $acm if $locale->{utf8};
($name, $sfm, $acm);
}
sub get_kde_lang {
my ($locale, $o_default) = @_;
#- get it using
#- echo C $(rpm -qp --qf "%{name}\n" /RPMS/kde-i18n-* | sed 's/kde-i18n-//')
my @valid_kde_langs = qw(C af ar az bg ca cs da de el en_GB eo es et fi fr he hu is it ja ko lt lv mt nb nl nn pl pt pt_BR ro ru sk sl sr sv ta th tr uk xh zh_CN.GB2312 zh_TW.Big5);
my %valid_kde_langs; @valid_kde_langs{@valid_kde_langs} = ();
my $valid_lang = sub {
my ($lang) = @_;
#- fast & dirty solution to ensure bad entries do not happen
my %fixlangs = (en => 'C', en_US => 'C', no => 'nb', sp => 'sr',
zh_CN => 'zh_CN.GB2312', zh_SG => 'zh_CN.GB2312', zh_TW => 'zh_TW.Big5', zh_HK => 'zh_TW.Big5');
exists $fixlangs{$lang} ? $fixlangs{$lang} :
exists $valid_kde_langs{$lang} ? $lang :
exists $valid_kde_langs{substr($lang, 0, 2)} ? substr($lang, 0, 2) : '';
};
my $r;
$r ||= $valid_lang->($locale->{lang});
$r ||= find { $valid_lang->($_) } split(':', getlocale_for_lang($locale->{lang}, $locale->{country}));
$r || $o_default || 'C';
}
sub charset2kde_charset {
my ($charset, $o_default) = @_;
my $iocharset = ($charsets{$charset} || [])->[3];
my @valid_kde_charsets = qw(big5-0 gb2312.1980-0 iso10646-1 iso8859-1 iso8859-4 iso8859-6 iso8859-8 iso8859-13 iso8859-14 iso8859-15 iso8859-2 iso8859-3 iso8859-5 iso8859-7 iso8859-9 koi8-r koi8-u ksc5601.1987-0 jisx0208.1983-0 microsoft-cp1251 tis620-0);
my %valid_kde_charsets; @valid_kde_charsets{@valid_kde_charsets} = ();
my $valid_charset = sub {
my ($charset) = @_;
#- fast & dirty solution to ensure bad entries do not happen
exists $valid_kde_charsets{$charset} && $charset;
};
my $r;
$r ||= $valid_charset->($charset2kde_charset{$charset});
$r ||= $valid_charset->($charset2kde_charset{$iocharset});
$r ||= $valid_charset->($iocharset);
$r || $o_default || 'iso10646-1';
}
#- font+size for different charsets; the field [0] is the default,
#- others are overrridens for fixed(1), toolbar(2), menu(3) and taskbar(4)
my %charset2kde_font = (
'C' => [ "Sans,10", "Monospace,10" ],
'iso-8859-1' => [ "Sans,10", "Monospace,10" ],
'iso-8859-2' => [ "Sans,10", "Monospace,10" ],
'iso-8859-7' => [ "Helvetica,12", "courier,10", "Helvetica,11" ],
'iso-8859-9' => [ "Sans,10", "Monospace,10" ],
'iso-8859-15' => [ "Sans,10", "Monospace,10" ],
'iso-8859-13' => [ "Sans,10", "Monospace,10" ],
'jisx0208' => [ "Kochi Mincho,13", "Kochi Gothic,13" ],
'ksc5601' => [ "Baekmuk Gulim,16" ],
'gb2312' => [ "Ar Pl Sungtil Gb,13" ],
'Big5' => [ "Ar Pl Mingti2l Big5,13" ],
'tis620' => [ "Norasi,16", "Norasi,15" ],
'utf_ar' => [ "Kacs_qr,13", "Courier New,13", "Kacs_qr,12" ],
'utf_az' => [ "Nimbus Sans,12", "Nimbus Mono,10", "Nimbus Sans,11" ],
'utf_hy' => [ "Artsounk,12", "Monospace,10", "Artsounk,11" ],
'utf_ta' => [ "Tscu_paranar,14", "Tsc_avarangalfxd,10", "Tscu_paranar,12", ],
#- the following should be changed to better defaults when better fonts
#- get available
'utf_vi' => [ "misc-fixed,13", "misc-fixed,13", "misc-fixed,10", ],
'utf_am' => [ "clearlyu,15" ],
'utf_he' => [ "clearlyu,15" ],
'utf_ka' => [ "clearlyu,15" ],
'utf_lo' => [ "clearlyu,15" ],
'default' => [ "Nimbus Sans,12", "Nimbus Mono,10", "Nimbus Sans,11" ],
);
sub charset2kde_font {
my ($charset, $type) = @_;
my $font = $charset2kde_font{$charset} || $charset2kde_font{default};
my $r = $font->[$type] || $font->[0];
#- the format is "font-name,size,-1,5,0,0,0,0,0,0" I have no idea of the
#- meaning of that "5"...
"$r,-1,5,0,0,0,0,0,0";
}
# this define pango name fonts (like "NimbusSans L") depending
# on the "charset" defined by language array. This allows to selecting
# an appropriate font for each language.
my %charset2pango_font = (
'tis620' => "Norasi 17",
'utf_ar' => "KacstBook 14",
'utf_cyr2' => "URW Bookman L 14",
'utf_he' => "ClearlyU 12",
'utf_hy' => "Artsounk 14",
'utf_ka' => "ClearlyU 14",
'utf_lo' => "ClearlyU 14",
'utf_ta' => "TSCu_Paranar 14",
'utf_vi' => "ClearlyU 14",
'iso-8859-7' => "Kerkis 14",
'jisx0208' => "Sans 18",
#- Nimbus Sans L is missing some chars used by some cyrillic languages,
#- but tose haven't yet DrakX translations; it also misses vietnamese
#- latin chars; all other latin and cyrillic are covered.
'default' => "Nimbus Sans L 12"
);
sub charset2pango_font {
my ($charset) = @_;
$charset2pango_font{exists $charset2pango_font{$charset} ? $charset : 'default'};
}
sub l2pango_font {
my ($lang) = @_;
my $charset = l2charset($lang) or log::l("no charset found for lang $lang!"), return;
my $font = charset2pango_font($charset);
log::l("lang:$lang charset:$charset font:$font sfm:$charsets{$charset}[0]");
if (common::usingRamdisk()) {
if ($charsets{$charset}[0] !~ /lat|koi|UniCyr/) {
install_any::remove_bigseldom_used();
unlink glob_('/usr/share/langs/*'); #- remove langs images
my @generic_fontfiles = qw(/usr/X11R6/lib/X11/fonts/12x13mdk.pcf.gz /usr/X11R6/lib/X11/fonts/18x18mdk.pcf.gz);
#- need to unlink first because the files actually exist (and are void); they must exist
#- because if not, when gtk starts, pango will recompute its cache file and exclude them
unlink($_), install_any::getAndSaveFile($_) foreach @generic_fontfiles;
}
my %pango_modules = (arabic => 'ar|fa|ur', hangul => 'ko', hebrew => 'he|yi', indic => 'hi|bn|ta|te|mr', thai => 'th');
foreach my $module (keys %pango_modules) {
next if $lang !~ /$pango_modules{$module}/;
install_any::remove_bigseldom_used();
my ($pango_modules_dir) = glob('/usr/lib/pango/*/modules');
install_any::getAndSaveFile("$pango_modules_dir/pango-$module-xft.so");
}
}
return $font;
}
sub set {
my ($lang, $b_translate_for_console) = @_;
#- disable Arabic in install as no (free) fonts are available.
$lang eq 'ar' and $lang='en_US';
exists $langs{$lang} or log::l("lang::set: trying to set to $lang but I don't know it!"), return;
my $dir = "$ENV{SHARE_PATH}/locale";
if (!-e "$dir/$lang" && common::usingRamdisk()) {
@ENV{qw(LANG LC_ALL LANGUAGE LINGUAS)} = ();
my @LCs = qw(LC_ADDRESS LC_COLLATE LC_IDENTIFICATION LC_MEASUREMENT LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER LC_TELEPHONE LC_TIME);
my $charset = during_install__l2charset($lang) || $lang;
#- there are 3 main charsets containing everything for all locales, except LC_CTYPE
#- by default, there is UTF-8.
#- when asked for GB2312 or BIG5, removing the other main charsets
my $main_charset = member($charset, 'GB2312', 'BIG5') ? $charset : 'UTF-8';
#- removing everything
#- except in main charset: only removing LC_CTYPE if it is there
eval { rm_rf($_ eq $main_charset ? "$dir/$_/LC_CTYPE" : "$dir/$_") } foreach all($dir);
if (!-e "$dir/$main_charset") {
#- getting the main charset
mkdir "$dir/$main_charset";
mkdir "$dir/$main_charset/LC_MESSAGES";
install_any::getAndSaveFile("$dir/$main_charset/$_") foreach @LCs, 'LC_MESSAGES/SYS_LC_MESSAGES';
}
mkdir "$dir/$lang";
#- linking to the main charset
symlink "../$main_charset/$_", "$dir/$lang/$_" foreach @LCs, 'LC_MESSAGES';
#- getting LC_CTYPE (putting it directly in $lang)
install_any::getAndSaveFile("Mandrake/mdkinst$dir/$charset/LC_CTYPE", "$dir/$lang/LC_CTYPE");
}
#- set all LC_* variables to a unique locale ("C"), and only redefine
#- LC_CTYPE (for X11 choosing the fontset) and LANGUAGE (for the po files)
$ENV{$_} = 'C' foreach qw(LC_NUMERIC LC_TIME LC_COLLATE LC_MONETARY LC_PAPER LC_NAME LC_ADDRESS LC_TELEPHONE LC_MEASUREMENT LC_IDENTIFICATION);
$ENV{LC_CTYPE} = $lang;
$ENV{LC_MESSAGES} = $lang;
$ENV{LANG} = $lang;
if ($b_translate_for_console && $lang =~ /^(ko|ja|zh|th)/) {
log::l("not translating in console");
$ENV{LANGUAGE} = 'C';
} else {
$ENV{LANGUAGE} = getLANGUAGE($lang);
}
load_mo();
$lang;
}
sub langs {
my ($l) = @_;
$l->{all} ? list_langs() : grep { $l->{$_} } keys %$l;
}
sub langsLANGUAGE {
my ($l, $o_c) = @_;
uniq(map { split ':', getLANGUAGE($_, $o_c) } langs($l));
}
sub langs_selected {
my ($locale) = @_;
#- adding the UTF-8 flag (if not forced) depends on the selected languages
$locale->{utf8} ||= l2charset($locale->{lang}) =~ /utf|unicode/
|| (uniq map { l2charset($_) } langs($locale->{langs})) > 1;
}
sub pack_langs {
my ($l) = @_;
my $s = $l->{all} ? 'all' : join ':', uniq(map { getLANGUAGE($_) } langs($l));
$ENV{RPM_INSTALL_LANG} = $s;
$s;
}
sub system_locales_to_ourlocale {
my ($locale_lang, $locale_country) = @_;
my $locale;
if (member($locale_lang, list_langs())) {
#- special lang's such as en_US pt_BR
$locale->{lang} = $locale_lang;
} else {
($locale->{lang}) = $locale_lang =~ /^(..)/;
}
($locale->{country}) = $locale_country =~ /^.._(..)/;
$locale->{utf8} = $locale_lang =~ /UTF-8/;
#- safe fallbacks
$locale->{lang} ||= 'en_US';
$locale->{country} ||= 'US';
$locale;
}
sub read {
my ($prefix, $user_only) = @_;
my ($f1, $f2) = ("$prefix$ENV{HOME}/.i18n", "$prefix/etc/sysconfig/i18n");
my %h = getVarsFromSh($user_only && -e $f1 ? $f1 : $f2);
system_locales_to_ourlocale($h{LC_MESSAGES} || 'en_US', $h{LC_MONETARY} || 'en_US');
}
sub write_langs {
my ($prefix, $langs) = @_;
my $s = pack_langs($langs);
symlink "$prefix/etc/rpm", "/etc/rpm" if $prefix;
substInFile { s/%_install_langs.*//; $_ .= "%_install_langs $s\n" if eof && $s } "$prefix/etc/rpm/macros";
}
sub write {
my ($prefix, $locale, $b_user_only, $b_dont_touch_kde_files) = @_;
$locale && $locale->{lang} or return;
my $locale_lang = getlocale_for_lang($locale->{lang}, $locale->{country}, $locale->{utf8});
my $locale_country = getlocale_for_country($locale->{lang}, $locale->{country}, $locale->{utf8});
my $h = {
XKB_IN_USE => '',
(map { $_ => $locale_lang } qw(LANG LC_COLLATE LC_CTYPE LC_MESSAGES LC_TIME)),
LANGUAGE => getLANGUAGE($locale->{lang}, $locale->{country}, $locale->{utf8}),
(map { $_ => $locale_country } qw(LC_NUMERIC LC_MONETARY LC_ADDRESS LC_MEASUREMENT LC_NAME LC_PAPER LC_IDENTIFICATION LC_TELEPHONE))
};
log::l("lang::write: lang:$locale->{lang} country:$locale->{country} locale|lang:$locale_lang locale|country:$locale_country language:$h->{LANGUAGE}");
my ($name, $sfm, $acm) = l2console_font($locale);
if ($name && !$b_user_only) {
my $p = "$prefix/usr/lib/kbd";
if ($name) {
eval {
cp_af("$p/consolefonts/$name.psf.gz", "$prefix/etc/sysconfig/console/consolefonts");
add2hash $h, { SYSFONT => $name };
};
$@ and log::l("missing console font $name");
}
if ($sfm) {
eval {
cp_af(glob_("$p/consoletrans/$sfm*"), "$prefix/etc/sysconfig/console/consoletrans");
add2hash $h, { UNIMAP => $sfm };
};
$@ and log::l("missing console unimap file $sfm");
}
if ($acm) {
eval {
cp_af(glob_("$p/consoletrans/$acm*"), "$prefix/etc/sysconfig/console/consoletrans");
add2hash $h, { SYSFONTACM => $acm };
};
$@ and log::l("missing console acm file $acm");
}
}
add2hash $h, $xim{$locale_lang};
#- deactivate translations on console for RTL languages
if ($locale_lang =~ /ar|fa|he|ur|yi/) {
add2hash $h, { CONSOLE_NOT_LOCALIZED => 'yes' }
}
setVarsInSh($prefix . ($b_user_only ? "$ENV{HOME}/.i18n" : '/etc/sysconfig/i18n'), $h);
eval {
my $charset = l2charset($locale->{lang});
my $confdir = $prefix . ($b_user_only ? "$ENV{HOME}/.kde" : '/usr') . '/share/config';
my ($prev_kde_charset) = cat_("$confdir/kdeglobals") =~ /^Charset=(.*)/mi;
mkdir_p($confdir);
update_gnomekderc("$confdir/kdeglobals", Locale => (
Charset => charset2kde_charset($charset),
Country => lc($locale->{country}),
Language => get_kde_lang($locale),
));
my %qt_xim = (zh => 'Over The Spot', ko => 'On The Spot', ja => 'Over The Spot');
if ($b_user_only && (my $qt_xim = $qt_xim{substr($locale->{lang}, 0, 2)})) {
update_gnomekderc("$ENV{HOME}/.qt/qtrc", General => (XIMInputStyle => $qt_xim));
}
if ($prev_kde_charset ne charset2kde_charset($charset)) {
update_gnomekderc("$confdir/kdeglobals", WM => (
activeFont => charset2kde_font($charset,0),
));
update_gnomekderc("$confdir/kdeglobals", General => (
fixed => charset2kde_font($charset, 1),
font => charset2kde_font($charset, 0),
menuFont => charset2kde_font($charset, 3),
taskbarFont => charset2kde_font($charset, 4),
toolBarFont => charset2kde_font($charset, 2),
));
update_gnomekderc("$confdir/konquerorrc", FMSettings => (
StandardFont => charset2kde_font($charset, 0),
));
update_gnomekderc("$confdir/kdesktoprc", FMSettings => (
StandardFont => charset2kde_font($charset, 0),
));
}
} if !$b_dont_touch_kde_files;
}
sub bindtextdomain() {
my $localedir = "$ENV{SHARE_PATH}/locale";
$localedir .= "_special" if $::isInstall;
c::setlocale();
c::bind_textdomain_codeset('libDrakX', 'UTF-8');
$::need_utf8_i18n = 1;
c::bindtextdomain('libDrakX', $localedir);
$localedir;
}
sub load_mo {
my ($lang) = @_;
my $localedir = bindtextdomain();
my $suffix = 'LC_MESSAGES/libDrakX.mo';
$lang ||= $ENV{LANGUAGE} || $ENV{LC_ALL} || $ENV{LC_MESSAGES} || $ENV{LANG};
foreach (split ':', $lang) {
my $f = "$localedir/$_/$suffix";
-s $f and return $_;
if ($::isInstall && common::usingRamdisk()) {
#- cleanup
eval { rm_rf($localedir) };
eval { mkdir_p(dirname("$localedir/$_/$suffix")) };
install_any::getAndSaveFile("$localedir/$_/$suffix");
-s $f and return $_;
}
}
'';
}
#- used in Makefile during "make get_needed_files"
sub console_font_files() {
map { -e $_ ? $_ : "$_.gz" }
(map { "/usr/lib/kbd/consolefonts/$_.psf" } uniq grep { $_ } map { $_->[0] } values %charsets),
(map { -e $_ ? $_ : "$_.sfm" } map { "/usr/lib/kbd/consoletrans/$_" } uniq grep { $_ } map { $_->[1] } values %charsets),
(map { -e $_ ? $_ : "$_.acm" } map { "/usr/lib/kbd/consoletrans/$_" } uniq grep { $_ } map { $_->[2] } values %charsets),
}
sub load_console_font {
my ($locale) = @_;
my ($name, $sfm, $acm) = l2console_font($locale);
require run_program;
run_program::run(if_($ENV{LD_LOADER}, $ENV{LD_LOADER}),
'consolechars', '-v', '-f', $name || 'lat0-sun16',
if_($sfm, '-u', $sfm), if_($acm, '-m', $acm));
#- in console mode install, ensure we'll get translations in the right codeset
#- (charset of locales reported by the glibc are UTF-8 during install)
if ($acm) {
c::bind_textdomain_codeset('libDrakX', l2charset($locale->{lang}));
$::need_utf8_i18n = 0;
}
}
sub fs_options {
my ($locale) = @_;
if ($locale->{utf8}) {
(iocharset => 'utf8', codepage => undef);
} else {
my $c = $charsets{l2charset($locale->{lang}) || return} or return;
my ($iocharset, $codepage) = @$c[3..4];
(iocharset => $iocharset, codepage => $codepage);
}
}
sub during_install__l2charset {
my ($lang) = @_;
return if member($lang, @during_install__lang_having_their_LC_CTYPE);
my ($c) = l2charset($lang) or die "bad lang $lang\n";
$c = 'UTF-8' if member($c, 'tis620', 'C');
$c = 'UTF-8' if $c =~ /koi8-/;
$c = 'UTF-8' if $c =~ /iso-8859/;
$c = 'UTF-8' if $c =~ /cp125/;
$c = 'UTF-8' if $c =~ /utf_/;
uc($c);
}
sub get_unneeded_png_lang_files() {
print join(' ', map { m|(langs/lang-(.*)\.png)|; if_(!member($2, list_langs()), $1) } glob("pixmaps/langs/lang-*.png"));
}
sub check() {
$^W = 0;
my $ok = 1;
my $warn = sub {
print STDERR "$_[0]\n";
};
my $err = sub {
&$warn;
$ok = 0;
};
my @wanted_charsets = uniq map { l2charset($_) } list_langs();
print "\tWarnings:\n";
$warn->("unused charset $_ (given in \%charsets, but not used in \%langs)") foreach difference2([ keys %charsets ], \@wanted_charsets);
$warn->("unused entry $_ in \%xim") foreach grep { !/UTF-8/ } difference2([ keys %xim ], [ map { l2locale($_) } list_langs() ]);
#- consolefonts are checked during build via console_font_files()
if (my @l = difference2([ 'default', keys %charsets ], [ keys %charset2kde_font ])) {
$warn->("no kde font for charset " . join(" ", @l));
}
if (my @l = grep { get_kde_lang({ lang => $_, country => 'US' }, 'err') eq 'err' } list_langs()) {
$warn->("no KDE lang for langs " . join(" ", @l));
}
if (my @l = grep { charset2kde_charset($_, 'err') eq 'err' } keys %charsets) {
$warn->("no KDE charset for charsets " . join(" ", @l));
}
$warn->("no country corresponding to default locale $_->[1] of lang $_->[0]")
foreach grep { $_->[1] =~ /^.._(..)/ && !exists $countries{$1} } map { [ $_, l2locale($_) ] } list_langs();
print "\tErrors:\n";
$err->("invalid charset $_ ($_ does not exist in \%charsets)") foreach difference2(\@wanted_charsets, [ keys %charsets ]);
$err->("invalid charset $_ in \%charset2kde_font ($_ does not exist in \%charsets)") foreach difference2([ keys %charset2kde_font ], [ 'default', keys %charsets ]);
$err->("default locale $_->[1] of lang $_->[0] isn't listed in \@locales")
foreach grep { !member($_->[1], @locales) } map { [ $_, l2locale($_) ] } list_langs();
$err->("lang image for lang $_->[0] is missing (file $_->[1])")
foreach grep { !(-e $_->[1]) } map { [ $_, "pixmaps/langs/lang-$_.png" ] } list_langs();
$err->("default locale $_->[1] of country $_->[0] isn't listed in \@locales")
foreach grep { !member($_->[1], @locales) } map { [ $_, c2locale($_) ] } list_countries();
exit($ok ? 0 : 1);
}
1;
="hl num">0x16 => 'Hidden DOS 16-bit FAT >=32M',
0x17 => 'Hidden IFS (e.g., HPFS)',
0x18 => 'AST Windows swapfile',
0x1b => 'Hidden WIN95 OSR2 32-bit FAT',
0x1c => 'Hidden WIN95 OSR2 32-bit FAT, LBA-mapped',
0x1e => 'Hidden FAT95',
0x22 => 'Used for Oxygen Extended Partition Table by ekstazya@sprint.ca.',
0x24 => 'NEC DOS 3.x',
0x35 => 'JFS (OS/2)',
0x38 => 'THEOS ver 3.2 2gb partition',
0x39 => 'THEOS ver 4 spanned partition',
0x3a => 'THEOS ver 4 4gb partition',
0x3b => 'THEOS ver 4 extended partition',
0x3c => 'PartitionMagic recovery partition',
0x40 => 'Venix 80286',
0x41 => 'Linux/MINIX (sharing disk with DRDOS) / Personal RISC Boot / PPC PReP (Power PC Reference Platform) Boot',
0x42 => 'Windows Dynamic Partition',
0x43 => 'Linux native (sharing disk with DRDOS)',
0x45 => 'EUMEL/Elan',
0x46 => 'EUMEL/Elan 0x46',
0x47 => 'EUMEL/Elan 0x47',
0x48 => 'EUMEL/Elan 0x48',
0x4d => 'QNX4.x',
0x4e => 'QNX4.x 2nd part',
0x4f => 'QNX4.x 3rd part / Oberon partition',
0x50 => 'OnTrack Disk Manager (older versions) RO',
0x51 => 'OnTrack Disk Manager RW (DM6 Aux1) / Novell',
0x52 => 'CP/M / Microport SysV/AT',
0x53 => 'Disk Manager 6.0 Aux3',
0x54 => 'Disk Manager 6.0 Dynamic Drive Overlay',
0x55 => 'EZ-Drive',
0x56 => 'Golden Bow VFeature Partitioned Volume. / DM converted to EZ-BIOS',
0x57 => 'DrivePro',
0x5c => 'Priam EDisk',
0x61 => 'SpeedStor',
0x63 => 'Unix System V (SCO, ISC Unix, UnixWare, ...), Mach, GNU Hurd',
0x64 => 'PC-ARMOUR protected partition / Novell Netware 2.xx',
0x65 => 'Novell Netware 3.xx or 4.xx',
0x67 => 'Novell',
0x68 => 'Novell 0x68',
0x69 => 'Novell 0x69',
0x70 => 'DiskSecure Multi-Boot',
0x75 => 'IBM PC/IX',
0x80 => 'MINIX until 1.4a',
0x81 => 'MINIX since 1.4b, early Linux / Mitac disk manager',
0x82 => 'Linux swap',
0x83 => 'Linux native',
0x84 => 'OS/2 hidden C: drive / Hibernation partition',
0x85 => 'Linux extended partition',
0x86 => 'Old Linux RAID partition superblock / NTFS volume set',
0x87 => 'NTFS volume set',
0x8a => 'Linux Kernel Partition (used by AiR-BOOT)',
0x8e => 'Linux Logical Volume Manager partition',
0x93 => 'Amoeba',
0x94 => 'Amoeba bad block table',
0x99 => 'DCE376 logical drive',
0xa0 => 'IBM Thinkpad hibernation partition / Phoenix NoteBIOS Power Management "Save-to-Disk" partition',
0xa5 => 'BSD/386, 386BSD, NetBSD, FreeBSD',
0xa6 => 'OpenBSD',
0xa7 => 'NEXTSTEP',
0xa9 => 'NetBSD',
0xaa => 'Olivetti Fat 12 1.44Mb Service Partition',
0xb7 => 'BSDI filesystem',
0xb8 => 'BSDI swap partition',
0xbe => 'Solaris boot partition',
0xc0 => 'CTOS / REAL/32 secure small partition',
0xc1 => 'DRDOS/secured (FAT-12)',
0xc4 => 'DRDOS/secured (FAT-16, < 32M)',
0xc6 => 'DRDOS/secured (FAT-16, >= 32M) / Windows NT corrupted FAT16 volume/stripe set',
0xc7 => 'Windows NT corrupted NTFS volume/stripe set / Syrinx boot',
0xcb => 'reserved for DRDOS/secured (FAT32)',
0xcc => 'reserved for DRDOS/secured (FAT32, LBA)',
0xcd => 'CTOS Memdump?',
0xce => 'reserved for DRDOS/secured (FAT16, LBA)',
0xd0 => 'REAL/32 secure big partition',
0xd1 => 'Old Multiuser DOS secured FAT12',
0xd4 => 'Old Multiuser DOS secured FAT16 <32M',
0xd5 => 'Old Multiuser DOS secured extended partition',
0xd6 => 'Old Multiuser DOS secured FAT16 >=32M',
0xd8 => 'CP/M-86',
0xdb => 'Digital Research CP/M, Concurrent CP/M, Concurrent DOS / CTOS (Convergent Technologies OS -Unisys) / KDG Telemetry SCPU boot',
0xdd => 'Hidden CTOS Memdump?',
0xe1 => 'DOS access or SpeedStor 12-bit FAT extended partition',
0xe3 => 'DOS R/O or SpeedStor',
0xe4 => 'SpeedStor 16-bit FAT extended partition < 1024 cyl.',
0xeb => 'BeOS',
0xee => 'EFI GPT',
0xef => 'EFI (FAT-12/16/32)',
0xf1 => 'SpeedStor 0xf1',
0xf2 => 'DOS 3.3+ secondary partition',
0xf4 => 'SpeedStor large partition / Prologue single-volume partition',
0xf5 => 'Prologue multi-volume partition',
0xfd => 'Linux RAID',
0xfe => 'SpeedStor > 1024 cyl. or LANstep / IBM PS/2 IML (Initial Microcode Load) partition, located at the end of the disk. / Windows NT Disk Administrator hidden partition / Linux Logical Volume Manager partition (old)',
0xff => 'Xenix Bad Block Table',
);
my %type2fs = (
arch() =~ /^ppc/ ? (
0x07 => 'hpfs',
) : (
0x07 => 'ntfs',
),
arch() !~ /sparc/ ? (
0x01 => 'vfat',
0x04 => 'vfat',
0x05 => 'ignore',
0x06 => 'vfat',
) : (
0x01 => 'ufs',
0x02 => 'ufs',
0x04 => 'ufs',
0x06 => 'ufs',
0x07 => 'ufs',
0x08 => 'ufs',
),
0x0b => 'vfat',
0x0c => 'vfat',
0x0e => 'vfat',
0x1b => 'vfat',
0x1c => 'vfat',
0x1e => 'vfat',
0x82 => 'swap',
0x83 => 'ext2',
0xeb => 'befs',
0xef => 'vfat',
0x107 => 'ntfs',
0x183 => 'reiserfs',
0x283 => 'xfs',
0x383 => 'jfs',
0x483 => 'ext3',
0x401 => 'apple',
0x402 => 'hfs',
);
my %types_rev = reverse %types;
my %fs2type = reverse %type2fs;
1;
sub important_types() {
my @l = (@important_types, if_($::expert, @important_types2, sort values %types));
difference2(\@l, \@bad_types);
}
sub type2fs {
my ($part, $o_default) = @_;
my $type = $part->{type};
$type2fs{$type} || $type =~ /^(\d+)$/ && $o_default || $type;
}
sub fs2type { $fs2type{$_[0]} || $_[0] }
sub type2name { $types{$_[0]} || $_[0] }
sub name2type {
local ($_) = @_;
/0x(.*)/ ? hex $1 : $types_rev{$_} || $_;
}
sub isEfi { arch() =~ /ia64/ && $_[0]{type} == 0xef }
sub isWholedisk { arch() =~ /^sparc/ && $_[0]{type} == 5 }
sub isExtended { arch() !~ /^sparc/ && ($_[0]{type} == 5 || $_[0]{type} == 0xf || $_[0]{type} == 0x85) }
sub isRawLVM { $_[0]{type} == 0x8e }
sub isRawRAID { $_[0]{type} == 0xfd }
sub isSwap { type2fs($_[0]) eq 'swap' }
sub isExt2 { type2fs($_[0]) eq 'ext2' }
sub isDos { arch() !~ /^sparc/ && ${{ 1 => 1, 4 => 1, 6 => 1 }}{$_[0]{type}} }
sub isWin { ${{ 0xb => 1, 0xc => 1, 0xe => 1, 0x1b => 1, 0x1c => 1, 0x1e => 1 }}{$_[0]{type}} }
sub isFat { isDos($_[0]) || isWin($_[0]) }
sub isFat_or_NTFS { isDos($_[0]) || isWin($_[0]) || $_[0]{type} == 0x107 }
sub isSunOS { arch() =~ /sparc/ && ${{ 0x1 => 1, 0x2 => 1, 0x4 => 1, 0x6 => 1, 0x7 => 1, 0x8 => 1 }}{$_[0]{type}} }
sub isApple { type2fs($_[0]) eq 'apple' && defined $_[0]{isDriver} }
sub isAppleBootstrap { type2fs($_[0]) eq 'apple' && defined $_[0]{isBoot} }
sub isHiddenMacPart { defined $_[0]{isMap} }
sub isThisFs { type2fs($_[1]) eq $_[0] }
sub isTrueFS { member(type2fs($_[0]), qw(ext2 reiserfs xfs jfs ext3)) }
sub isOtherAvailableFS { isEfi($_[0]) || isFat_or_NTFS($_[0]) || isSunOS($_[0]) || isThisFs('hfs', $_[0]) } #- other OS that linux can access its filesystem
sub isMountableRW { (isTrueFS($_[0]) || isOtherAvailableFS($_[0])) && !isThisFs('ntfs', $_[0]) }
sub isNonMountable {
my ($part) = @_;
isRawRAID($part) || isRawLVM($part) || isThisFs("ntfs", $part) && !$part->{isFormatted} && $part->{notFormatted};
}
sub isPartOfLVM { defined $_[0]{lvm} }
sub isPartOfRAID { defined $_[0]{raid} }
sub isPartOfLoopback { defined $_[0]{loopback} }
sub isRAID { $_[0]{device} =~ /^md/ }
sub isUBD { $_[0]{device} =~ /^ubd/ } #- should be always true during an $::uml_install
sub isLVM { $_[0]{VG_name} }
sub isLoopback { defined $_[0]{loopback_file} }
sub isMounted { $_[0]{isMounted} }
sub isBusy { isMounted($_[0]) || isPartOfRAID($_[0]) || isPartOfLVM($_[0]) || isPartOfLoopback($_[0]) }
sub isSpecial { isRAID($_[0]) || isLVM($_[0]) || isLoopback($_[0]) || isUBD($_[0]) }
sub maybeFormatted { $_[0]{isFormatted} || !$_[0]{notFormatted} }
#- works for both hard drives and partitions ;p
sub description {
my ($hd) = @_;
my $win = $hd->{device_windobe};
sprintf "%s%s (%s%s%s%s)",
$hd->{device},
$win && " [$win:]",
formatXiB($hd->{totalsectors} || $hd->{size}, 512),
$hd->{info} && ", $hd->{info}",
$hd->{mntpoint} && ", " . $hd->{mntpoint},
$hd->{type} && ", " . type2name($hd->{type});
}
sub isPrimary {
my ($part, $hd) = @_;
foreach (@{$hd->{primary}{raw}}) { $part eq $_ and return 1 }
0;
}
sub adjustStartAndEnd {
my ($hd, $part) = @_;
$hd->adjustStart($part);
$hd->adjustEnd($part);
}
sub verifyNotOverlap {
my ($a, $b) = @_;
$a->{start} + $a->{size} <= $b->{start} || $b->{start} + $b->{size} <= $a->{start};
}
sub verifyInside {
my ($a, $b) = @_;
$b->{start} <= $a->{start} && $a->{start} + $a->{size} <= $b->{start} + $b->{size};
}
sub verifyParts_ {
foreach my $i (@_) {
foreach (@_) {
next if !$i || !$_ || $i == $_ || isWholedisk($i) || isExtended($i); #- avoid testing twice for simplicity :-)
if (isWholedisk($_)) {
verifyInside($i, $_) or
cdie sprintf("partition sector #$i->{start} (%s) is not inside whole disk (%s)!",
formatXiB($i->{size}, 512), formatXiB($_->{size}, 512));
} elsif (isExtended($_)) {
verifyNotOverlap($i, $_) or
log::l(sprintf("warning partition sector #$i->{start} (%s) is overlapping with extended partition!",
formatXiB($i->{size}, 512))); #- only warning for this one is acceptable
} else {
verifyNotOverlap($i, $_) or
cdie sprintf("partitions sector #$i->{start} (%s) and sector #$_->{start} (%s) are overlapping!",
formatXiB($i->{size}, 512), formatXiB($_->{size}, 512));
}
}
}
}
sub verifyParts {
my ($hd) = @_;
verifyParts_(get_normal_parts($hd));
}
sub verifyPrimary {
my ($pt) = @_;
$_->{start} > 0 || arch() =~ /^sparc/ || die "partition must NOT start at sector 0" foreach @{$pt->{normal}};
verifyParts_(@{$pt->{normal}}, $pt->{extended});
}
sub assign_device_numbers {
my ($hd) = @_;
my $i = 1;
my $start = 1;
#- on PPC we need to assign device numbers to the holes too - big FUN!
#- not if it's an IBM machine using a DOS partition table though
if (arch() =~ /ppc/ && detect_devices::get_mac_model() !~ /^IBM/) {
#- first sort the normal parts
$hd->{primary}{normal} = [ sort { $a->{start} <=> $b->{start} } @{$hd->{primary}{normal}} ];
#- now loop through them, assigning partition numbers - reserve one for the holes
foreach (@{$hd->{primary}{normal}}) {
if ($_->{start} > $start) {
log::l("PPC: found a hole on $hd->{prefix} before $_->{start}, skipping device...");
$i++;
}
$_->{device} = $hd->{prefix} . $i;
$_->{devfs_device} = $hd->{devfs_prefix} . '/part' . $i;
$start = $_->{start} + $_->{size};
$i++;
}
} else {
foreach (@{$hd->{primary}{raw}}) {
$_->{device} = $hd->{prefix} . $i;
$_->{devfs_device} = $hd->{devfs_prefix} . '/part' . $i;
$i++;
}
foreach (map { $_->{normal} } @{$hd->{extended} || []}) {
my $dev = $hd->{prefix} . $i;
my $renumbered = $_->{device} && $dev ne $_->{device};
if ($renumbered) {
require fs;
eval { fs::umount_part($_) }; #- at least try to umount it
will_tell_kernel($hd, del => $_, 'delay_del');
push @{$hd->{partitionsRenumbered}}, [ $_->{device}, $dev ];
}
$_->{device} = $dev;
$_->{devfs_device} = $hd->{devfs_prefix} . '/part' . $i;
if ($renumbered) {
will_tell_kernel($hd, add => $_, 'delay_add');
}
$i++;
}
}
#- try to figure what the windobe drive letter could be!
#
#- first verify there's at least one primary dos partition, otherwise it
#- means it is a secondary disk and all will be false :(
#-
#- isFat_or_NTFS isn't true for 0x7 partitions, only for 0x107.
#- alas 0x107 is not set correctly at this stage
#- solution: don't bother with 0x7 vs 0x107 here
my ($c, @others) = grep { isFat_or_NTFS($_) || $_->{type} == 0x7 || $_->{type} == 0x17 } @{$hd->{primary}{normal}};
$i = ord 'C';
$c->{device_windobe} = chr($i++) if $c;
$_->{device_windobe} = chr($i++) foreach grep { isFat_or_NTFS($_) || $_->{type} == 0x7 || $_->{type} == 0x17 } map { $_->{normal} } @{$hd->{extended}};
$_->{device_windobe} = chr($i++) foreach @others;
}
sub remove_empty_extended {
my ($hd) = @_;
my $last = $hd->{primary}{extended} or return;
@{$hd->{extended}} = grep {
if ($_->{normal}) {
$last = $_;
} else {
%{$last->{extended}} = $_->{extended} ? %{$_->{extended}} : ();
}
$_->{normal};
} @{$hd->{extended}};
adjust_main_extended($hd);
}
sub adjust_main_extended {
my ($hd) = @_;
if (!is_empty_array_ref $hd->{extended}) {
my ($l, @l) = @{$hd->{extended}};
# the first is a special case, must recompute its real size
my $start = round_down($l->{normal}{start} - 1, $hd->{geom}{sectors});
my $end = $l->{normal}{start} + $l->{normal}{size};
my $only_linux = 1; my $has_win_lba = 0;
foreach (map { $_->{normal} } $l, @l) {
$start = min($start, $_->{start});
$end = max($end, $_->{start} + $_->{size});
$only_linux &&= isTrueFS($_) || isSwap($_);
$has_win_lba ||= $_->{type} == 0xc || $_->{type} == 0xe;
}
$l->{start} = $hd->{primary}{extended}{start} = $start;
$l->{size} = $hd->{primary}{extended}{size} = $end - $start;
}
if (!@{$hd->{extended} || []} && $hd->{primary}{extended}) {
will_tell_kernel($hd, del => $hd->{primary}{extended});
%{$hd->{primary}{extended}} = (); #- modify the raw entry
delete $hd->{primary}{extended};
}
verifyParts($hd); #- verify everything is all right
}
sub adjust_local_extended {
my ($hd, $part) = @_;
my $extended = find { $_->{normal} == $part } @{$hd->{extended} || []} or return;
$extended->{size} = $part->{size} + $part->{start} - $extended->{start};
#- must write it there too because values are not shared
my $prev = find { $_->{extended}{start} == $extended->{start} } @{$hd->{extended} || []} or return;
$prev->{extended}{size} = $part->{size} + $part->{start} - $prev->{extended}{start};
}
sub get_normal_parts {
my ($hd) = @_;
@{$hd->{primary}{normal} || []}, map { $_->{normal} } @{$hd->{extended} || []}
}
sub get_normal_parts_and_holes {
my ($hd) = @_;
my ($start, $last) = ($hd->first_usable_sector, $hd->last_usable_sector);
ref($hd) or print("get_normal_parts_and_holes: bad hd" . backtrace(), "\n");
my @l = map {
my $current = $start;
$start = $_->{start} + $_->{size};
my $hole = { start => $current, size => $_->{start} - $current, type => 0, rootDevice => $hd->{device} };
$hole, $_;
} sort { $a->{start} <=> $b->{start} } grep { !isWholedisk($_) } get_normal_parts($hd);
push @l, { start => $start, size => $last - $start, type => 0, rootDevice => $hd->{device} };
grep { $_->{type} || $_->{size} >= $hd->cylinder_size } @l;
}
sub read_one($$) {
my ($hd, $sector) = @_;
my ($pt, $info);
#- it can be safely considered that the first sector is used to probe the partition table
#- but other sectors (typically for extended partition ones) have to match this type!
if (!$sector) {
my @parttype = (
if_(arch() =~ /^ia64/, 'gpt'),
arch() =~ /^sparc/ ? ('sun', 'bsd') : ('dos', 'bsd', 'sun', 'mac'),
);
foreach ('empty', @parttype, 'lvm_PV', 'unknown') {
/unknown/ and die "unknown partition table format on disk " . $hd->{file};
eval {
# perl_checker: require partition_table::bsd
# perl_checker: require partition_table::dos
# perl_checker: require partition_table::empty
# perl_checker: require partition_table::gpt
# perl_checker: require partition_table::lvm_PV
# perl_checker: require partition_table::mac
# perl_checker: require partition_table::sun
require "partition_table/$_.pm";
bless $hd, "partition_table::$_";
($pt, $info) = $hd->read($sector);
log::l("found a $_ partition table on $hd->{file} at sector $sector");
};
$@ or last;
}
} else {
#- keep current blessed object for that, this means it is neccessary to read sector 0 before.
($pt, $info) = $hd->read($sector);
}
my @extended = $hd->hasExtended ? grep { isExtended($_) } @$pt : ();
my @normal = grep { $_->{size} && $_->{type} && !isExtended($_) } @$pt;
my $nb_special_empty = int(grep { $_->{size} && $_->{type} == 0 } @$pt);
@extended > 1 and die "more than one extended partition";
$_->{rootDevice} = $hd->{device} foreach @normal, @extended;
{ raw => $pt, extended => $extended[0], normal => \@normal, info => $info, nb_special_empty => $nb_special_empty };
}
sub read {
my ($hd) = @_;
my $pt = read_one($hd, 0) or return 0;
$hd->{primary} = $pt;
undef $hd->{extended};
verifyPrimary($pt);
eval {
my $need_removing_empty_extended;
if ($pt->{extended}) {
read_extended($hd, $pt->{extended}, \$need_removing_empty_extended) or return 0;
}
if ($need_removing_empty_extended) {
#- special case when hda5 is empty, it must be skipped
#- (windows XP generates such partition tables)
remove_empty_extended($hd); #- includes adjust_main_extended
}
};
die "extended partition: $@" if $@;
assign_device_numbers($hd);
remove_empty_extended($hd);
$hd->set_best_geometry_for_the_partition_table;
1;
}
sub read_extended {
my ($hd, $extended, $need_removing_empty_extended) = @_;
my $pt = read_one($hd, $extended->{start}) or return 0;
$pt = { %$extended, %$pt };
push @{$hd->{extended}}, $pt;
@{$hd->{extended}} > 100 and die "oops, seems like we're looping here :( (or you have more than 100 extended partitions!)";
if (@{$pt->{normal}} == 0) {
$$need_removing_empty_extended = 1;
delete $pt->{normal};
print "need_removing_empty_extended\n";
} elsif (@{$pt->{normal}} > 1) {
die "more than one normal partition in extended partition";
} else {
$pt->{normal} = $pt->{normal}[0];
#- in case of extended partitions, the start sector is local to the partition or to the first extended_part!
$pt->{normal}{start} += $pt->{start};
#- the following verification can broke an existing partition table that is
#- correctly read by fdisk or cfdisk. maybe the extended partition can be
#- recomputed to get correct size.
if (!verifyInside($pt->{normal}, $extended)) {
$extended->{size} = $pt->{normal}{start} + $pt->{normal}{size};
verifyInside($pt->{normal}, $extended) or die "partition $pt->{normal}{device} is not inside its extended partition";
}
}
if ($pt->{extended}) {
$pt->{extended}{start} += $hd->{primary}{extended}{start};
return read_extended($hd, $pt->{extended}, $need_removing_empty_extended);
} else {
1;
}
}
sub will_tell_kernel {
my ($hd, $action, $o_part, $o_delay) = @_;
if ($action eq 'resize') {
will_tell_kernel($hd, del => $o_part);
will_tell_kernel($hd, add => $o_part);
} else {
my $part_number = sub { $o_part->{device} =~ /(\d+)$/ ? $1 : internal_error("bad device " . description($o_part)) };
push @{$hd->{'will_tell_kernel' . ($o_delay || '')} ||= []},
[
$action,
$action eq 'force_reboot' ? () :
$action eq 'add' ? ($part_number->(), $o_part->{start}, $o_part->{size}) :
$action eq 'del' ? $part_number->() :
internal_error("unknown action $action")
];
}
if (!$o_delay) {
foreach my $delay ('delay_del', 'delay_add') {
my $l = delete $hd->{"will_tell_kernel$delay"} or next;
push @{$hd->{will_tell_kernel} ||= []}, @$l;
}
}
$hd->{isDirty} = 1;
}
sub tell_kernel {
my ($hd, $tell_kernel) = @_;
my $F = partition_table::raw::openit($hd);
my $force_reboot = any { $_->[0] eq 'force_reboot' } @$tell_kernel;
if (!$force_reboot) {
foreach (@$tell_kernel) {
my ($action, $part_number, $o_start, $o_size) = @$_;
if ($action eq 'add') {
$force_reboot ||= !c::add_partition(fileno $F, $part_number, $o_start, $o_size);
} elsif ($action eq 'del') {
$force_reboot ||= !c::del_partition(fileno $F, $part_number);
}
log::l("tell kernel $action ($part_number $o_start $o_size), rebootNeeded is now " . bool2text($hd->{rebootNeeded}));
}
}
if ($force_reboot) {
my @magic_parts = grep { $_->{isMounted} && $_->{real_mntpoint} } get_normal_parts($hd);
foreach (@magic_parts) {
syscall_('umount', $_->{real_mntpoint}) or log::l(N("error unmounting %s: %s", $_->{real_mntpoint}, $!));
}
$hd->{rebootNeeded} = !ioctl($F, c::BLKRRPART(), 0);
log::l("tell kernel force_reboot, rebootNeeded is now $hd->{rebootNeeded}.");
foreach (@magic_parts) {
syscall_('mount', $_->{real_mntpoint}, type2fs($_), c::MS_MGC_VAL()) or log::l(N("mount failed: ") . $!);
}
}
}
# write the partition table
sub write {
my ($hd) = @_;
$hd->{isDirty} or return;
$hd->{readonly} and die "a read-only partition table should not be dirty!";
#- set first primary partition active if no primary partitions are marked as active.
if (my @l = @{$hd->{primary}{raw}}) {
foreach (@l) {
$_->{local_start} = $_->{start};
$_->{active} ||= 0;
}
$l[0]{active} = 0x80 if !any { $_->{active} } @l;
}
#- last chance for verification, this make sure if an error is detected,
#- it will never be writed back on partition table.
verifyParts($hd);
$hd->write(0, $hd->{primary}{raw}, $hd->{primary}{info}) or die "writing of partition table failed";
#- should be fixed but a extended exist with no real extended partition, that blanks mbr!
if (arch() !~ /^sparc/) {
foreach (@{$hd->{extended}}) {
# in case of extended partitions, the start sector must be local to the partition
$_->{normal}{local_start} = $_->{normal}{start} - $_->{start};
$_->{extended} and $_->{extended}{local_start} = $_->{extended}{start} - $hd->{primary}{extended}{start};
$hd->write($_->{start}, $_->{raw}) or die "writing of partition table failed";
}
}
$hd->{isDirty} = 0;
$hd->{hasBeenDirty} = 1; #- used in undo (to know if undo should believe isDirty or not)
if (my $tell_kernel = delete $hd->{will_tell_kernel}) {
tell_kernel($hd, $tell_kernel);
}
}
sub active {
my ($hd, $part) = @_;
$_->{active} = 0 foreach @{$hd->{primary}{normal}};
$part->{active} = 0x80;
$hd->{isDirty} = 1;
}
# remove a normal partition from hard drive hd
sub remove {
my ($hd, $part) = @_;
my $i;
#- first search it in the primary partitions
$i = 0; foreach (@{$hd->{primary}{normal}}) {
if ($_ eq $part) {
will_tell_kernel($hd, del => $_);
splice(@{$hd->{primary}{normal}}, $i, 1);
%$_ = (); #- blank it
$hd->raw_removed($hd->{primary}{raw});
return 1;
}
$i++;
}
my ($first, $second, $third) = map { $_->{normal} } @{$hd->{extended} || []};
if ($third && $first eq $part) {
die "Can't handle removing hda5 when hda6 is not the second partition" if $second->{start} > $third->{start};
}
#- otherwise search it in extended partitions
foreach (@{$hd->{extended} || []}) {
$_->{normal} eq $part or next;
delete $_->{normal}; #- remove it
remove_empty_extended($hd);
assign_device_numbers($hd);
will_tell_kernel($hd, del => $part);
return 1;
}
0;
}
# create of partition at starting at `start', of size `size' and of type `type' (nice comment, uh?)
sub add_primary {
my ($hd, $part) = @_;
{
local $hd->{primary}{normal}; #- save it to fake an addition of $part, that way add_primary do not modify $hd if it fails
push @{$hd->{primary}{normal}}, $part;
adjust_main_extended($hd); #- verify
$hd->raw_add($hd->{primary}{raw}, $part);
}
push @{$hd->{primary}{normal}}, $part; #- really do it
}
sub add_extended {
arch() =~ /^sparc|ppc/ and die \N("Extended partition not supported on this platform");
my ($hd, $part, $extended_type) = @_;
$extended_type =~ s/Extended_?//;
my $e = $hd->{primary}{extended};
if ($e && !verifyInside($part, $e)) {
#-die "sorry, can't add outside the main extended partition" unless $::unsafe;
my $end = $e->{start} + $e->{size};
my $start = min($e->{start}, $part->{start});
$end = max($end, $part->{start} + $part->{size}) - $start;
{ #- faking a resizing of the main extended partition to test for problems
local $e->{start} = $start;
local $e->{size} = $end - $start;
eval { verifyPrimary($hd->{primary}) };
$@ and die
N("You have a hole in your partition table but I can't use it.
The only solution is to move your primary partitions to have the hole next to the extended partitions.");
}
}
if ($e && $part->{start} < $e->{start}) {
my $l = first(@{$hd->{extended}});
#- the first is a special case, must recompute its real size
$l->{start} = round_down($l->{normal}{start} - 1, $hd->cylinder_size);
$l->{size} = $l->{normal}{start} + $l->{normal}{size} - $l->{start};
my $ext = { %$l };
unshift @{$hd->{extended}}, { type => 5, raw => [ $part, $ext, {}, {} ], normal => $part, extended => $ext };
#- size will be autocalculated :)
} else {
my ($ext, $ext_size) = is_empty_array_ref($hd->{extended}) ?
($hd->{primary}, -1) : #- -1 size will be computed by adjust_main_extended
(top(@{$hd->{extended}}), $part->{size});
my %ext = (type => $extended_type || 5, start => $part->{start}, size => $ext_size);
$hd->raw_add($ext->{raw}, \%ext);
$ext->{extended} = \%ext;
push @{$hd->{extended}}, { %ext, raw => [ $part, {}, {}, {} ], normal => $part };
}
$part->{start}++; $part->{size}--; #- let it start after the extended partition sector
adjustStartAndEnd($hd, $part);
adjust_main_extended($hd);
}
sub add {
my ($hd, $part, $b_primaryOrExtended, $b_forceNoAdjust) = @_;
get_normal_parts($hd) >= ($hd->{device} =~ /^rd/ ? 7 : $hd->{device} =~ /^(sd|ida|cciss|ataraid)/ ? 15 : 63) and cdie "maximum number of partitions handled by linux reached";
$part->{notFormatted} = 1;
$part->{isFormatted} = 0;
$part->{rootDevice} = $hd->{device};
$part->{start} ||= 1 if arch() !~ /^sparc/; #- starting at sector 0 is not allowed
adjustStartAndEnd($hd, $part) unless $b_forceNoAdjust;
my $nb_primaries = $hd->{device} =~ /^rd/ ? 3 : 1;
if (arch() =~ /^sparc|ppc/ ||
$b_primaryOrExtended eq 'Primary' ||
$b_primaryOrExtended !~ /Extended/ && @{$hd->{primary}{normal} || []} < $nb_primaries) {
eval { add_primary($hd, $part) };
goto success if !$@;
}
if ($hd->hasExtended) {
eval { add_extended($hd, $part, $b_primaryOrExtended) };
goto success if !$@;
}
{
add_primary($hd, $part);
}
success:
assign_device_numbers($hd);
will_tell_kernel($hd, add => $part);
}
# search for the next partition
sub next {
my ($hd, $part) = @_;
first(
sort { $a->{start} <=> $b->{start} }