usr.sbin/kbdmap/kbdmap.pl

   1 #!/usr/bin/perl
   2 #
   3 # Copyright (c) March 1995 Wolfram Schneider <wosch@FreeBSD.org>. Berlin.
   4 # All rights reserved.
   5 #
   6 # Redistribution and use in source and binary forms, with or without
   7 # modification, are permitted provided that the following conditions
   8 # are met:
   9 # 1. Redistributions of source code must retain the above copyright
  10 #    notice, this list of conditions and the following disclaimer.
  11 # 2. Redistributions in binary form must reproduce the above copyright
  12 #    notice, this list of conditions and the following disclaimer in the
  13 #    documentation and/or other materials provided with the distribution.
  14 #
  15 # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
  16 # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
  17 # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  18 # ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
  19 # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  20 # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
  21 # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  22 # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  23 # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
  24 # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
  25 # SUCH DAMAGE.
  26 #
  27 # kbdmap/vidfont - front end for syscons
  28 #
  29 # $FreeBSD: src/usr.sbin/kbdmap/kbdmap.pl,v 1.10.2.2 2001/03/05 13:08:47 ru Exp $
  30 # $DragonFly: src/usr.sbin/kbdmap/Attic/kbdmap.pl,v 1.2 2003/06/17 04:29:55 dillon Exp $
  31
  32
  33 # simple test if syscons works
  34 $x11 = system("kbdcontrol -d >/dev/null");
  35 if ($x11) {
  36     warn "You are not on a virtual console - " .
  37         "expect certain strange side-effects\n";
  38     sleep 2;
  39 }
  40
  41 sub variables_static {
  42     $lang_default = "en";       # set default language
  43     $lang = $ENV{'LC_ALL'} || $ENV{'LC_CTYPE'} || $ENV{'LANG'} || $lang_default;
  44     $lang = &lang($lang);
  45     $program = $0; $program =~ s|.*/||; $program =~ s/\.(pl|perl)$//;
  46     $keymapdir = "/usr/share/syscons/keymaps";
  47     $fontdir = "/usr/share/syscons/fonts";
  48     $sysconfig = "/etc/rc.conf";
  49
  50     # for test only
  51     #$keymapdir = "/tmp/kbdmap/syscons/keymaps";
  52     #$fontdir = "/tmp/kbdmap/syscons/fonts";
  53
  54     # read current font from rc.conf
  55     $font_default = "cp437-8x16.fnt";
  56     $font_current = &font_current($font_default);
  57
  58     if ($program eq "kbdmap") {
  59         $dir = $keymapdir;
  60     } else {
  61         $dir = $fontdir;
  62     }
  63
  64     @langsupport = ('MENU', 'FONT'); # lang depended variables
  65     $show = 0;                  # show which languages currently supported
  66     $index = "INDEX";           # Keyboard language database
  67     $verbose = 0;
  68     %keymap = '';
  69 }
  70
  71 sub lang {
  72     local($lang) = @_;
  73
  74     #$lang =~ s/_.*//;          # strip country and font
  75     $lang =~ s/^(C)$/en/;       # aliases
  76     #$lang =~ s/^(..).*/$1/;    # use only first to characters
  77
  78     return $lang;
  79 }
  80
  81 sub font_current {
  82     local($font) = @_;
  83     local($font_current);
  84
  85     open(F, "$sysconfig") || warn "$sysconfig: $!\n";
  86
  87     while(<F>) {
  88         /^#/ && next;
  89         if (/^\s*font[0-9]+x[0-9]+\s*=\s*\"?([^\s\"]+)\"?/) {
  90             $font_current = $1 if $1 ne "NO";
  91         }
  92     }
  93     close F;
  94
  95     return $font_current if $font_current;
  96     return $font;
  97 }
  98
  99 sub vidcontrol {
 100     local($font) = @_;
 101
 102     return $x11 if $x11;        # syscons test failed
 103
 104     if ($font =~ /.*([0-9]+x[0-9]+)(\.fnt)?$/) {
 105         warn "vidcontrol -f $1 $font\n" if $verbose;
 106         return system("vidcontrol -f $1 $font");
 107     } else {
 108         warn "Which font size? ``$font''\n";
 109         return 1;
 110     }
 111 }
 112
 113 sub menu_read {
 114     local($e,@a,$mark,$ext);
 115     local($keym, $lg, $dialect, $desc);
 116     local(@langlist) = $lang_default;
 117
 118     $ext = $dir; $ext =~ s|.*/||;
 119     # en_US.ISO8859-1 -> en_..\.ISO8859-1
 120     ($dialect = $lang) =~ s/^(..)_..(.+)$/$1_..$2/;
 121     # en_US.ISO8859-1 -> en
 122     ($lang_abk = $lang) =~ s/^(..)_.*$/$1/;
 123
 124     # read index database
 125     open(I, "$dir/$index.$ext") || warn "$dir/$index.$ext: $!\n";
 126     while(<I>) {
 127         # skip blank lines and comments
 128         /^#/ && next;
 129         s/^\s+//;
 130         /^\w/ || next;
 131         s/\s+$//;
 132
 133         ($keym, $lg, $desc) = split(/:/);
 134         if (! -r "$keym" && ! -r "$dir/$keym" &&
 135             !grep(/$keym/, @langsupport)) {
 136             warn "$keym not found!\n" if $verbose;
 137             next;
 138         }
 139
 140         # set empty language to default language
 141         $lg = $lang_default if $lg eq "";
 142
 143         # save language
 144         if ($show) {
 145             foreach $e (split(/,/, $lg)) {
 146                 push(@langlist, $e) if !grep($_ eq $e, @langlist);
 147             }
 148         }
 149
 150         # 4) your choise if exist
 151         # 3) long match e.g. en_GB.ISO8859-1 is equal to en_..\.ISO8859-1
 152         # 2) short match 'de'
 153         # 1) default langlist 'en'
 154         # 0) any language
 155         #
 156         # language may be a kommalist
 157         # higher match overwrite lower
 158         # last entry overwrite previous if exist twice in database
 159
 160         # found your favorite language :-)
 161         if ($lg =~  /^(.+,)?$lang(,.+)?$/) {
 162             $keymap{$keym} = $desc;
 163             $mark{$keym} = 4;
 164         } elsif ($mark{$keym} <= 3 && $lg =~  /^(.+,)?$dialect(,.+)?$/) {
 165             # dialect
 166             $keymap{$keym} = $desc;
 167             $mark{$keym} = 3;
 168         } elsif ($mark{$keym} <= 2 && $lg =~  /^(.+,)?$lang_abk(,.+)?$/) {
 169             # abrevation
 170             $keymap{$keym} = $desc;
 171             $mark{$keym} = 2;
 172         } elsif ($mark{$keym} <= 1 && $lg =~  /^(.+,)?$lang_default(,.+)?$/) {
 173             # default
 174             $keymap{$keym} = $desc;
 175             $mark{$keym} = 1;
 176         } elsif ($mark{$keym} <= 0) {
 177             # any
 178             $keymap{$keym} = $desc;
 179             $mark{$keym} = 0;
 180         }
 181     }
 182     close I;
 183
 184     if ($show) {
 185         @langlist = sort(@langlist);
 186         print "Currently supported languages: @langlist\n";
 187         exit(0);
 188     }
 189
 190     # remove variables from list
 191     local($ee);
 192     foreach $e (@langsupport) {
 193         ($ee = $e) =~ y/A-Z/a-z/;
 194         eval "\$$ee = \"$keymap{$e}\"";
 195         #warn "$e \$$ee = \"$keymap{$e}\"";
 196         delete $keymap{$e};
 197     }
 198     #warn "$font $font_default $font_current\n";
 199
 200
 201     # look for keymaps which are not in database
 202     opendir(D, "$dir") || warn "$dir: $!\n";
 203     foreach $e (readdir(D)) {
 204         if ($e =~ /^[a-z].*(kbd|fnt)$/ && !$keymap{$e}) {
 205             warn "$e not in database\n" if $verbose;
 206             $keymap{$e} = $e;
 207             $keymap{$e} =~ s/\.(kbd|fnt)$//;
 208         }
 209     }
 210     closedir D;
 211
 212     # sort menu, font 8x8 is less than 8x14 and 8x16
 213     foreach $e (sort(keys %keymap)) {
 214         if ($keymap{$e}) {
 215             push(@a, "\"$keymap{$e}\" \"\"");
 216         }
 217     }
 218     # side effects to @a
 219     grep(s/8x8/8x08/, @a);
 220     @a = sort @a;
 221     grep(s/8x08/8x8/, @a);
 222
 223     if ($print) {
 224         foreach (@a) {
 225             s/"//g; #"
 226             print "$_\n";
 227         }
 228         exit;
 229     }
 230
 231     return @a;
 232 }
 233
 234 sub dialog {
 235     srand;
 236     local(@argv) = @_;
 237     local($tmp) = "/tmp/_kbd_lang" . rand(9999);
 238
 239     $dialog = "/usr/bin/dialog \\
 240 --clear \\
 241 --title \"Keyboard Menu\" \\
 242 --menu \"$menu\" \\
 243 -1 -1 10";
 244
 245     ## *always* start right font, don't believe that your current font
 246     ## is equal with default font in /etc/rc.conf
 247     ## see also at end of this function
 248     ## if ($font) {
 249
 250     # start right font, assume that current font is equal
 251     # to default font in /etc/rc.conf
 252     #
 253     # $font is the font which require the language $lang; e.g.
 254     # russian *need* a koi8 font
 255     # $font_current is the current font from /etc/rc.conf
 256     if ($font && $font ne $font_current) {
 257         &vidcontrol($font);
 258     }
 259
 260     # start dialog
 261     system("$dialog @argv 2> $tmp");
 262
 263     if (!$?) {
 264         $choise = `cat $tmp`;
 265         foreach $e (keys %keymap) {
 266             if ($keymap{$e} eq $choise) {
 267                 if ($program eq "kbdmap") {
 268                     system("kbdcontrol -l $dir/$e\n") unless $x11;
 269                     print "keymap=$e", "\n";
 270                 } else {
 271                     &vidcontrol("$dir/$e");
 272                     $_ = $e;
 273                     if (/^.*\-(.*)\.fnt/) {
 274                         $font=$1
 275                     } else { $font="unknown" }
 276                     print "font$font=$e", "\n";
 277                 }
 278                 last;
 279             }
 280         }
 281     # } else {
 282     } elsif ($font && $font ne $font_current) {
 283         # cancel, restore old font
 284         &vidcontrol($font_current);
 285     }
 286     unlink $tmp;
 287     exit($?);
 288 }
 289
 290 sub usage {
 291     warn <<EOF;
 292 usage: $program\t[-K] [-V] [-d|-default] [-h|-help] [-l|-lang language]
 293 \t\t[-p|-print] [-r|-restore] [-s|-show] [-v|-verbose]
 294 EOF
 295     exit 1;
 296 }
 297
 298 # Argumente lesen
 299 sub parse {
 300     local(@argv) = @_;
 301
 302     while($_ = $argv[0], /^-/) {
 303         shift @argv;
 304         last if /^--$/;
 305         if (/^--?(h|help|\?)$/)  { &usage; }
 306         elsif (/^-(v|verbose)$/) { $verbose = 1; }
 307         elsif (/^-(l|lang)$/)    { $lang = &lang($argv[0]); shift @argv; }
 308         elsif (/^-(d|default)$/) { $lang = $lang_default }
 309         elsif (/^-(s|show)$/)    { $show = 1 }
 310         elsif (/^-(p|print)$/)   { $print = 1 }
 311         elsif (/^-(r|restore)$/) { &vidcontrol($font_current); exit(0) }
 312         elsif (/^-K$/)           { $dir = $keymapdir; }
 313         elsif (/^-V$/)           { $dir = $fontdir; }
 314         else                     { &usage }
 315     }
 316 }
 317
 318 # main
 319 &variables_static;              # read variables
 320 &parse(@ARGV);                  # parse arguments
 321 &dialog(&menu_read);            # start dialog and kbdcontrol/vidcontrol