path: root/perl-install/keyboard.pm

package keyboard; # $Id$

use diagnostics;
use strict;

#-######################################################################################
#- misc imports
#-######################################################################################
use common qw(:common :system :file);
use run_program;
use commands;
use log;
use c;


#-######################################################################################
#- Globals
#-######################################################################################
my $KMAP_MAGIC = 0x8B39C07F;

#- a best guess of the keyboard layout, based on the choosen locale
my %lang2keyboard =
(
  'af' => 'us_intl',
  'az' => 'az',
  'be' => 'by',
  'be_BY.CP1251' => 'by',
  'bg' => 'bg',
'bg_BG'=> 'bg',
  'br' => 'fr',
  'ca' => 'es',
  'cs' => 'cz_qwerty',
  'cy' => 'uk',
  'da' => 'dk',
  'de' => 'de',
'de_AT'=> 'de',
'de_CH'=> 'ch_de',
'de_DE'=> 'de', 
  'el' => 'gr',
  'en' => 'us',
'en_US'=> 'us',
'en_GB'=> 'uk',
  'eo' => 'us_intl',
  'es' => 'es',
  'es@tradicional' => 'es',
'es_AR'=> 'la',
'es_ES'=> 'es',
'es_MX'=> 'la',
  'et' => 'ee',
  'eu' => 'es',
  'fa' => 'ir',
  'fi' => 'fi',
  'fr' => 'fr',
'fr_BE'=> 'be',
'fr_CA'=> 'qc',
'fr_CH'=> 'ch_fr',
'fr_FR'=> 'fr',
  'ga' => 'uk',
  'gl' => 'es',
  'he' => 'il',
  'hr' => 'hr',
  'hu' => 'hu',
  'hy' => 'am',
  'is' => 'is',
  'it' => 'it',
  'ja' => 'jp',
  'ka' => 'ge_la',
  'lt' => 'lt',
  'mk' => 'mk',
  'nb' => 'no',
'nl_BE'=> 'be',
'nl_NL'=> 'us_intl:95 uk:2 nl:1',
#'nl_NL'=> 'nl',
  'no' => 'no',
  'no@nynorsk' => 'no',
  'ny' => 'no',
  'oc' => 'fr',
  'pl' => 'pl',
  'pt' => 'pt',
'pt_BR'=> 'br',
'pt_PT'=> 'pt',
  'ru' => 'ru',
  'ru_RU.KOI8-R' => 'ru',
  'sk' => 'sk_qwerty',
  'sl' => 'si',
  'sp' => 'sr',
  'sr' => 'yu',
  'sv' => 'se',
  'sv@ny' => 'se',
  'sv@traditionell' => 'se',
  'th' => 'th',
  'tr' => 'tr_q',
  'uk' => 'ua',
'uk_UA' => 'ua',
  'vi' => 'vn',
'vi_VN.tcvn' => 'vn',
'vi_VN.viscii' => 'vn',
  'wa' => 'be',
);

#- key = extension for Xmodmap file, [0] = description of the keyboard,
#- [1] = name for loadkeys, [2] = name for XKB
my %keyboards = (
arch() =~ /^sparc/ ? (
 "cs" => [ __("Czech (QWERTZ)"), "sunt5-cz-us", "czsk(cz_us_qwertz)" ],
 "de" => [ __("German"),         "sunt5-de-latin1", "de" ],
 "dvorak" => [ __("Dvorak"),     "sundvorak",   "dvorak" ],
 "es" => [ __("Spanish"),        "sunt5-es",    "es" ],
 "fi" => [ __("Finnish"),        "sunt5-fi-latin1", "fi" ],
 "fr" => [ __("French"),         "sunt5-fr-latin1", "fr" ],
 "no" => [ __("Norwegian"),      "sunt4-no-latin1", "no" ],
 "pl" => [ __("Polish"),         "sun-pl-altgraph", "pl" ],
 "ru" => [ __("Russian"),        "sunt5-ru",    "ru" ],
 "uk" => [ __("UK keyboard"),    "sunt5-uk",    "gb" ],
 "us" => [ __("US keyboard"),    "sunkeymap",   "us" ],
) : (
arch() eq "ppc" ? (
 "us" => [ __("US keyboard"),    "mac-us-ext",  "us" ],
 "de_nodeadkeys" => [ __("German"), "mac-de-latin1-nodeadkeys", "de(nodeadkeys)" ],
 "fr" => [ __("French"),         "mac-fr2-ext",   "fr" ],
) : (
 "am_old" => [ __("Armenian (old)"),	"am_old",	"am(old)" ],
 "am" => [ __("Armenian (typewriter)"),	"am-armscii8",	"am" ],
 "am_phonetic" => [ __("Armenian (phonetic)"), "am_phonetic", "am(phonetic)" ],
#- only xmodmap is currently available
#-"ar" => [ __("Arabic"),        "ar-8859_6",   "ar" ],
 "az" => [ __("Azerbaidjani (latin)"), "az",	"az" ],
 "a3" => [ __("Azerbaidjani (cyrillic)"), "az-koi8c","az(cyrillic)" ],
 "be" => [ __("Belgian"),        "be-latin1",   "be" ],
 "bg" => [ __("Bulgarian"),      "bg",          "bg" ],
 "br" => [ __("Brazilian (ABNT-2)"),      "br-abnt2",    "br" ],
 "by" => [ __("Belarusian"),      "by-cp1251",  "byru" ],
 "ch_de" => [ __("Swiss (German layout)"), "sg-latin1", "de_CH" ],
 "ch_fr" => [ __("Swiss (French layout)"), "fr_CH-latin1", "fr_CH" ],
 "cz" => [ __("Czech (QWERTZ)"), "cz-latin2",   "czsk(cz_us_qwertz)" ],
 "cz_qwerty" => [ __("Czech (QWERTY)"), "cz-lat2", "czsk(cz_us_qwerty)" ],
 "cz_prog" => [ __("Czech (Programmers)"), "cz-lat2-prog", "czsk(us_cz_prog)" ],
 "de" => [ __("German"),         "de-latin1",   "de" ],
 "de_nodeadkeys" => [ __("German (no dead keys)"), "de-latin1-nodeadkeys", "de(nodeadkeys)" ],
 "dk" => [ __("Danish"),         "dk-latin1",   "dk" ],
 "dvorak" => [ __("Dvorak (US)"),     "pc-dvorak-latin1", "dvorak" ],
 "dvorak_no" => [ __("Dvorak (Norwegian)"),     "no-dvorak", "dvorak(no)" ],
 "ee" => [ __("Estonian"),       "ee-latin9",   "ee" ],
 "es" => [ __("Spanish"),        "es-latin1",   "es" ],
 "fi" => [ __("Finnish"),        "fi-latin1",   "fi" ],
 "fr" => [ __("French"),         "fr-latin1",   "fr" ],
 "ge_ru"=>[__("Georgian (\"Russian\" layout)"),"ge_ru-georgian_academy","ge_ru"],
 "ge_la"=>[__("Georgian (\"Latin\" layout)"),"ge_la-georgian_academy","ge_la"],
 "gr" => [ __("Greek"),          "gr-8859_7",   "gr" ],
 "hu" => [ __("Hungarian"),      "hu-latin2",   "hu" ],
 "hr" => [ __("Croatian"),	 "croat",	"yu" ],
 "il" => [ __("Israeli"),        "il-8859_8",   "il" ],
 "il_phonetic" => [ __("Israeli (Phonetic)"),"hebrew",   "il_phonetic" ],
 "ir" => [ __("Iranian"),        "ir-isiri3342","ir" ],
 "is" => [ __("Icelandic"),      "is-latin1",   "is" ],
 "it" => [ __("Italian"),        "it-latin1",   "it" ],
 "jp" => [ __("Japanese 106 keys"), "jp106",	"jp" ],
 "la" => [ __("Latin American"), "la-latin1",   "la" ],
 "mk" => [ __("Macedonian"),	 "mk",		"mk" ],
 "nl" => [ __("Dutch"),          "nl-latin1",   "nl" ],
 "lt" => [ __("Lithuanian AZERTY (old)"), "lt-latin7","lt_a" ],
#- TODO: write a console kbd map for lt_new
 "lt_new" => [ __("Lithuanian AZERTY (new)"), "lt-latin7","lt_std" ],
 "lt_b" => [ __("Lithuanian \"number row\" QWERTY"), "ltb-latin7", "lt" ],
 "lt_p" => [ __("Lithuanian \"phonetic\" QWERTY"), "ltp-latin7", "lt_p" ],
 "no" => [ __("Norwegian"),      "no-latin1",   "no" ],
 "pl" => [ __("Polish (qwerty layout)"),        "pl", "pl" ],
 "pl2" => [ __("Polish (qwertz layout)"),       "pl-latin2", "pl2" ],
 "pt" => [ __("Portuguese"),     "pt-latin1",   "pt" ],
 "qc" => [ __("Canadian (Quebec)"), "qc-latin1","ca_enhanced" ],
 "ru" => [ __("Russian"),        "ru4",         "ru(winkeys)" ],
 "ru_yawerty" => [ __("Russian (Yawerty)"),"ru-yawerty","ru_yawerty" ],
 "se" => [ __("Swedish"),        "se-latin1",   "se" ],
 "si" => [ __("Slovenian"),      "slovene",     "si" ],
 "sk" => [ __("Slovakian (QWERTZ)"), "sk-qwertz",   "czsk(sk_us_qwertz)" ],
 "sk_qwerty" => [ __("Slovakian (QWERTY)"), "sk-qwerty", "czsk(sk_us_qwerty)" ],
 "sk_prog" => [ __("Slovakian (Programmers)"), "sk-prog", "czsk(us_sk_prog" ],
 "th" => [ __("Thai keyboard"),  "th",          "th" ],
 "tr_f" => [ __("Turkish (traditional \"F\" model)"), "trf", "tr_f" ],
 "tr_q" => [ __("Turkish (modern \"Q\" model)"), "tr_q-latin5", "tr" ],
 "ua" => [ __("Ukrainian"),      "ua",           "ua" ],
 "uk" => [ __("UK keyboard"),    "uk",           "gb" ],
 "us" => [ __("US keyboard"),    "us",           "us" ],
 "us_intl" => [ __("US keyboard (international)"), "us-latin1", "us_intl" ],
 "vn" => [ __("Vietnamese \"numeric row\" QWERTY"),"vn-tcvn", "vn" ], 
 "yu" => [ __("Yugoslavian (latin/cyrillic)"), "sr", "sr" ],
)),
);


#-######################################################################################
#- Functions
#-######################################################################################
sub keyboards { keys %keyboards }
sub keyboard2text { $keyboards{$_[0]} && $keyboards{$_[0]}[0] }
sub keyboard2kmap { $keyboards{$_[0]} && $keyboards{$_[0]}[1] }
sub keyboard2xkb  { $keyboards{$_[0]} && $keyboards{$_[0]}[2] }

sub loadkeys_files {
    my $archkbd = arch() =~ /^sparc/ ? "sun" : arch() =~ /i.86/ ? "i386" : arch();
    my $p = "/usr/lib/kbd/keymaps/$archkbd";
    my $post = ".kmap.gz";
    my %trans = ("cz-latin2" => "cz-lat2");
    my (@l, %l);
    foreach (values %keyboards) {
	local $_ = $trans{$_->[1]} || $_->[1];
	my ($l) = grep { -e $_ } ("$p/$_$post");
	$l or /(..)/ and ($l) = grep { -e $_ } ("$p/$1$post");
	print STDERR "unknown $_\n" if $_[0] && !$l; $l or next;
	push @l, $l;
	foreach (`zgrep include $l | grep "^include"`) {
	    /include\s+"(.*)"/ or die "bad line $_";
	    @l{grep { -e $_ } ("$p/$1.inc.gz")} = ();
	}
    }        
    @l, keys %l, grep { -e $_ } map { "$p/$_.inc.gz" } qw(compose euro windowkeys linux-keys-bare);
}

sub unpack_keyboards {
    my ($k) = @_ or return;
    [ map { [ split ':' ] } split ' ', $k ];
}
sub lang2keyboards {
    my ($l) = @_;
    my $li = unpack_keyboards($lang2keyboard{$l}) || [ $keyboards{$l} && $l || "us" ];
    $li->[0][1] ||= 100;
    $li;
}
sub lang2keyboard {
    my ($l) = @_;
    my $kb = lang2keyboards($l)->[0][0];
    $keyboards{$kb} ? $kb : "us"; #- handle incorrect keyboad mapping to us.
}

sub load {ass="hl ipl">$h{if}\n";
    ref($h{of}) eq 'GLOB' ? (*OF = $h{of}) : sysopen(OF, $h{of}, 0x41) || die "error: can not open file $h{of}\n";

    $h{bs} = removeXiBSuffix($h{bs});

    for ($nb = 0; !$h{count} || $nb < $h{count}; $nb++) {
	printf "\r%02.1d%%", 100 * $nb / $h{count} if $h{count} && $percent;
	$read = sysread(IF, $tmp, $h{bs}) or ($h{count} ? die "error: can not read block $nb\n" : last);
	syswrite(OF, $tmp) or die "error: can not write block $nb\n";
	$read < $h{bs} and $read = 1, last;
    }
    print STDERR "\r$nb+$read records in\n";
    print STDERR   "$nb+$read records out\n";
}

sub head_tail {
    my ($h, $n) = getopts(\@_, qw(hn));
    $h || @_ < to_bool($n) and die "usage: $0 [-h] [-n lines] [<file>]\n";
    $n = $n ? shift : 10;
    my $fh; @_ ? open($fh, $_[0]) || die "error: can not open file $_[0]\n" : ($fh = *STDIN);

    if ($0 eq 'head') {
	local $_;
	while (<$fh>) { $n-- or return; print }
    } else {
	@_ = (); 
	local $_;
	while (<$fh>) { push @_, $_; @_ > $n and shift }
	print @_;
    }
}
sub head { $0 = 'head'; &head_tail }
sub tail { $0 = 'tail'; &head_tail }

sub strings {
    my ($h, $o, $n) = getopts(\@_, qw(hon));
    $h and die "usage: strings [-o] [-n min-length] [<files>]\n";
    $n = $n ? shift : 4;
    $/ = "\0"; @ARGV = @_; my $l = 0; 
    local $_;
    while (<>) {
	while (/[$printable_chars]{$n,}/og) {
	    printf "%07d ", ($l + length $') if $o;
	    print "$&\n";
	}
	$l += length;
    } continue { $l = 0 if eof }
}

sub hexdump {
    my $i = 0; $/ = \16; @ARGV = @_; 
    local $_;
    while (<>) {
	printf "%08lX  ", $i; $i += 16;
	print join(" ", (map { sprintf "%02X", $_ } unpack("C*", $_)),
		   (s/[^$printable_chars]/./og, $_)[1]), "\n";
    }
}

sub more {
    @ARGV = @_;
    require devices;
    my $tty = devices::make('tty');
    my $n = 0; 
    open(my $IN, $tty) or die "can not open $tty\n";
    local $_;
    while (<>) {
	if (++$n == 25) {
	    my $v = <$IN>;
	    $v =~ /^q/ and exit 0;
	    $n = 0;
	}
	print;
    }
}

sub insmod {
    my ($h) = getopts(\@_, qw(h));
    $h || @_ == 0 and die "usage: insmod <module> [options]\n";
    my $f = shift;

    require run_program;
    require modules;

    if (! -r $f) {
	my $name = basename($f);
	$name =~ s/\.k?o$//;
	($f) = modules::extract_modules('/tmp', $name);
    }
    if (! -r $f) {
	die "can not find module $f\n";
    }
    run_program::run(["insmod_", "insmod"], "-f", $f, @_) or die("insmod $f failed");
    unlink $f;
}

sub modprobe {
    my ($h) = getopts(\@_, qw(h));
    $h || @_ == 0 and die "usage: modprobe <module> [options]\n";
    my $name = shift;
    require modules;
    modules::load_dependencies("/modules/modules.dep");
    modules::load_with_options([ $name ], { $name => join(' ', @_) });
}

sub route {
    @_ == 0 or die "usage: route\nsorry, no modification handled\n";
    my ($titles, @l) = cat_("/proc/net/route");
    my @titles = split ' ', $titles;
    my %l;
    open ROUTE, ">&STDOUT"; #- ROUTE must be not be localised otherwise the "format ROUTE" fails
    format ROUTE_TOP =
Destination    Gateway        Mask           Iface
.
    format ROUTE =
@<<<<<<<<<<<<  @<<<<<<<<<<<<  @<<<<<<<<<<<<  @<<<<<<<
$l{Destination}, $l{Gateway}, $l{Mask}, $l{Iface}
.
    foreach (@l) {
	/^\s*$/ and next;
	@l{@titles} = split;
	$_ = join ".", reverse map { hex $_ } unpack "a2a2a2a2", $_ foreach @l{qw(Destination Gateway Mask)};
	$l{Destination} = 'default' if $l{Destination} eq "0.0.0.0";
	$l{Gateway}     = '*'       if $l{Gateway}     eq "0.0.0.0";
	write ROUTE;
    }
}

sub df {
    my ($h) = getopts(\@_, qw(h));
    my ($dev, $size, $free, $used, $use, $mntpoint);
    open DF, ">&STDOUT"; #- DF must be not be localised otherwise the "format DF" fails
    format DF_TOP =
Filesystem          Size      Used    Avail     Use  Mounted on
.
    format DF =
@<<<<<<<<<<<<<<<< @>>>>>>> @>>>>>>> @>>>>>>> @>>>>>% @<<<<<<<<<<<<<<<<<<<<<<<<<
$dev, $size, $used, $free, $use, $mntpoint
.
    my %h;
    foreach (cat_("/proc/mounts"), cat_("/etc/mtab")) {
	($dev, $mntpoint) = split;
	$h{$dev} = $mntpoint;
    }
    foreach (sort keys %h) {
	$dev = $_;
	($size, $free) = MDK::Common::System::df($mntpoint = $h{$dev});
	$size or next;

	$use = int(100 * ($size - $free) / $size);
	$used = $size - $free;
	if ($h) {
	    $used = int($used / 1024 . "M");
	    $size = int($size / 1024 . "M");
	    $free = int($free / 1024 . "M");
	}
	write DF if $size;
    }
}

sub kill {
    my $signal = 15;
    @_ or die "usage: kill [-<signal>] pids\n";
    $signal = (shift, $1)[1] if $_[0] =~ /^-(.*)/;
    kill $signal, @_ or die "kill failed: $!\n";
}

sub lspci() { lspcidrake() }
sub lspcidrake() {
    require detect_devices;
    print join "\n", detect_devices::stringlist(), '';
}
*lssbus = \&lspci;

sub dmesg() { print cat_("/tmp/syslog") }

sub sort {
    my ($n, $h) = getopts(\@_, qw(nh));
    $h and die "usage: sort [-n] [<file>]\n";
    my $fh; @_ ? open($fh, $_[0]) || die "error: can not open file $_[0]\n" : ($fh = *STDIN);
    if ($n) {
	print(sort { $a <=> $b } <$fh>);
    } else {
	print(sort <$fh>);
    }
}

sub du {
    my ($s, $h) = getopts(\@_, qw(sh));
    $h || !$s and die "usage: du -s [<directories>]\n";

    my $f; $f = sub {
	my ($e) = @_;
	my $s = (lstat($e))[12];
	$s += sum(map { &$f($_) } glob_("$e/*")) if !-l _ && -d _;
	$s;
    };
    print &$f($_) >> 1, "\t$_\n" foreach @_ ? @_ : glob_("*");
}

sub  install_cpio($$;@) {
    my ($dir, $name, @more) = @_; 

    return "$dir/$name" if -e "$dir/$name";

    my $cpio = "$dir.cpio.bz2";
    -e $cpio or return;

    eval { rm("-r", $dir) };
    mkdir $dir, 0755;
    require run_program;
    
    my $more = join " ", map { $_ && "$_ $_/*" } @more;
    run_program::run("cd $dir ; $ENV{LD_LOADER} bzip2 -cd $cpio | $ENV{LD_LOADER} cpio -id $name $name/* $more");

    "$dir/$name";
}

sub bug {
    my ($h) = getopts(\@_, "h");
    $h and die "usage: bug\nput file report.bug on fat formatted floppy\n";

    require detect_devices;
    mount devices::make(detect_devices::floppy()), "/fd0";

    require install_any;
    output("/fd0/report.bug", install_any::report_bug());
    umount "/fd0";
    common::sync();
}

sub loadkeys {
    my ($h) = getopts(\@_, "h");
    $h || @_ != 1 and die "usage: loadkeys <keyboard>\n";

    require keyboard;
    keyboard::setup({ KEYBOARD => $_[0] });
}

sub sync() { common::sync() }

1;