home *** CD-ROM | disk | FTP | other *** search
/ PC Welt 2006 November (DVD) / PCWELT_11_2006.ISO / casper / filesystem.squashfs / usr / share / console / getkmapchoice.pl next >
Encoding:
Perl Script  |  2006-07-06  |  7.1 KB  |  268 lines

  1. #!/usr/bin/perl
  2.  
  3. use Debconf::Client::ConfModule ':all';
  4. use Debconf::Log;
  5.  
  6. sub my_warn { 
  7.    # Don't dump warnings into STDERR, as it will choke the return
  8.    # of results from debconf to install-keymap. Instead put the 
  9.    # warnings into debconf's debugging channel.
  10.    Debconf::Log::debug developer => "getkmapchoice warning: ".join(" ",@_);
  11. }
  12.  
  13. sub my_die {
  14.     # Don't die horribly, as install-keymap will then crash.
  15.     # Instead, dump the warning into debconf's logs,
  16.     # and return NONE, which hopefully will Do The Right Thing.
  17.     my_warn @_;
  18.     print STDERR "NONE";
  19.     exit 0;
  20. }
  21.  
  22. #####COMMON#####
  23. # -*- perl -*-
  24.  
  25. use vars qw( $obsolete_keymaps );
  26.  
  27. # Subarches
  28. # FIXME: not done
  29. # Issues:
  30. # * ppc issues not fully asserted yet
  31. # * /proc/hardware, which only exists on m68k and ppc, seems to be
  32. #   an OPTION while configuring the kernel !
  33. #   Any fallback when it's not there ?
  34. # * USB set of keymap should contain what ? mac ? pc ? subset of those ?
  35.  
  36. # SUBARCH    KEYMAP SET    DETECTION
  37. # m68k/atari    atari        "Model: Atari"
  38. # m68k/amiga    amiga        "Model: Amiga"
  39. # m68k/mac    mac        "Model: Macintosh"
  40. # m68k/mvme    pc        "Model: Motorola"
  41. # m68k/bvme    pc        "Model: BVME[46]000"
  42. # m68k/{sun,apollo,next,q40,hp300} Not supported by Debian
  43.  
  44. # ppc/apus    amiga        "machine: Amiga"
  45. # ppc/chrp    pc,mac        "machine: CHRP"
  46. # ppc/pmac    mac        "machine: PowerMac|[Pp]ower[Bb]ook*|Power|iMac*|PowerMac1*"
  47. # ppc/prep    pc        "machine: PReP"
  48. # ppc/{bbox,mbx,ppc64,82xx,8xx} Not yet supported by Debian
  49.  
  50. # arm/*        pc        (refered to as 'arm' only)
  51.  
  52. sub guess_arch {
  53.   my ($defs) = @_;
  54.  
  55.   my $arch = `dpkg --print-installation-architecture`;
  56.   chomp $arch;
  57.  
  58.   # Overrides for testing:
  59.   #     $arch = 'powerpc';
  60.   #     $arch = 'm68k';
  61.  
  62.   if (($arch eq 'powerpc') || ($arch eq 'm68k')) {
  63.     my $subarch;
  64.     if ($arch eq 'powerpc') {
  65.       my $line = `sed -n 's/^machine.*: //p' /proc/cpuinfo`;
  66.       chomp $line;
  67.       abort ($defs, "No \"machine\" field in /proc/cpuinfo") if $line eq '';
  68.       $subarch = lc $line;
  69.     } elsif ($arch eq 'm68k') {
  70.       my $line = `sed -n 's/^Model.*://p' /proc/hardware`;
  71.       chomp $line;
  72.       abort ($defs, "No \"Model\" field in /proc/hardware") if $line eq '';
  73.       $subarch = lc $line;
  74.     }
  75.     chomp($subarch);
  76.     $subarch =~ s/^\s*//;
  77.     $subarch = 'amiga'    if $subarch =~ m/amiga/;
  78.     $subarch = 'chrp'    if $subarch =~ m/chrp/;
  79.     $subarch = 'prep'    if $subarch =~ m/prep/;
  80.     $subarch = 'mac'    if $subarch =~ m/macintosh|powermac|powerbook|power|imac|powermac1/;
  81.     $subarch = 'atari'    if $subarch =~ m/atari/;
  82.     $subarch = 'mvme'    if $subarch =~ m/motorola/;
  83.     $subarch = 'bvme'    if $subarch =~ m/bvme/;
  84.  
  85.     $arch = "$arch/$subarch";
  86.   }
  87.  
  88.   # Overrides for testing:
  89.   #     $arch = 'sparc';
  90.   #     $arch = 'powerpc/mac';
  91.   #     $arch = 'powerpc/chrp';
  92.   #     $arch = 'm68k/amiga';
  93.   #     $arch = 'alpha';
  94.  
  95.   return $arch;
  96. }
  97.  
  98. sub abort {
  99.   my ($defs, $msg) = @_;
  100.   print STDERR "Debconf module aborted ($msg) - using old config mechanism.\n";
  101. #  fset_default($defs);
  102.   exit 0;
  103. }
  104.  
  105. sub correctname($) {
  106.   my ($string) = @_;
  107.  
  108.   $string = lc $string;
  109.   $string =~ s/[^a-z0-9+\-\.\/]/_/g;
  110.  
  111.   return $string;
  112. }
  113.  
  114. # BELOW THIS LINE IS STUFF FOR ALL KEYMAP PROVIDERS
  115.  
  116. $::keymap_defs = {
  117.           'prefix' => 'console-data/keymap/',
  118.           'toplevel' => 'family',
  119.           'sublevels' => [
  120.                   'layout',
  121.                   'variant',
  122.                   'keymap',
  123.                  ],
  124.           'allitems' => $::keymaps,
  125.           'obsolete' => $::obsolete_keymaps,
  126.           'archsets' => {
  127.                  'i386' => [ 'pc' ],
  128.                  #                   'hurd-i386' => [ 'pc' ],
  129.                  'sparc' => [ 'sparc' ],
  130.                  'alpha' => [ 'pc' ],
  131.                  'arm' => [ 'pc' ],
  132.                  'arm/riscpc' => [ 'pc' ],
  133.                  'mips' => [ 'pc' ],
  134.                  'm68k/atari' => [ 'atari' ],
  135.                  'm68k/amiga' => [ 'amiga' ],
  136.                  'm68k/mac' => [ 'mac' ],
  137.                  'm68k/mvme' => [ 'pc' ],
  138.                  'm68k/bvme' => [ 'pc' ],
  139.                  'powerpc/amiga' => [ 'amiga' ], # apus
  140.                  'powerpc/chrp' => [ 'pc', 'mac' ],
  141.                  'powerpc/mac' => [ 'pc' ],
  142.                  'powerpc/prep' => [ 'pc' ],
  143.                  'amd64' => [ 'pc' ],
  144.                 },
  145.          };
  146.  
  147. sub readfiles($) {
  148.   my ($path) = @_;
  149.  
  150.   opendir (DIR, $path) or my_die "Can't open directory \`$path': $!";
  151.   my @files = grep { ! /^\./ && -f "$path/$_" } readdir(DIR);
  152.   closedir DIR;
  153.  
  154.   foreach my $file (@files) {
  155. #    print STDERR "Loading $defsdir/$file\n";
  156.     require "$defsdir/$file";
  157.   }
  158. }
  159.  
  160. ($ret, $policy) = get ('console-data/keymap/policy');
  161. if ($policy eq "Don't touch keymap") {
  162.   # No keymap
  163.   $filename = 'NONE';
  164. } elsif ($policy eq 'Select keymap from full list') {
  165.   ($ret, $filename) = get ('console-data/keymap/full');
  166.   if (! $filename) {
  167.       $filename = 'NONE';
  168.   }
  169. } elsif ($policy eq 'Keep kernel keymap') {
  170.   # No keymap
  171.   $filename = 'KERNEL';
  172. } else {
  173.   # Get infos about selected keymap
  174.   ($ret, $family) = get ('console-data/keymap/family');
  175.   $cfamily = correctname $family;
  176.   my_die "No keyboard family selected: $family" unless $ret == 0;
  177.  
  178.   # This should only occur when no keymap is available
  179.   if ($family eq '') {
  180.     # Tell other programs (eg. install-keymap) not to do anything
  181.     print STDERR "NONE";
  182.     exit 0;
  183.   }
  184.  
  185.   ($ret, $layout) = get ("console-data/keymap/$cfamily/layout");
  186.   $clayout = correctname $layout;
  187.   if ($ret != 0) {
  188.     # Oops. mssing entry. recover if possible,
  189.     my_warn "No keyboard layout selected: $layout";
  190.     if ( ! $FILE ) {
  191.       my_die "No keymap selected" ;
  192.     } else { 
  193.       print STDERR $FILE; 
  194.       exit 0;
  195.     }
  196.   }
  197.   ($ret, $kbdvariant) = get ("console-data/keymap/$cfamily/$clayout/variant");
  198.   $ckbdvariant = correctname $kbdvariant;
  199.  if ($ret != 0) {
  200.      # Oops. mssing entry. recover if possible,
  201.      my_warn "No keyboard variant selected: $kbdvariant";
  202.      if ( ! $FILE ) {
  203.         my_die "No keymap selected" ;
  204.      } else {
  205.         print STDERR $FILE;
  206.         exit 0;
  207.      }
  208.  }
  209.   ($ret, $mapvariant) = get ("console-data/keymap/$cfamily/$clayout/$ckbdvariant/keymap");
  210.   if ($ret != 0) {
  211.     # Oops. mssing entry. recover if possible,
  212.     my_warn "No keymap variant selected: $mapvariant";
  213.     if ( ! $FILE ) {
  214.       my_die "No keymap selected" ;
  215.     } else {
  216.       print STDERR $FILE;
  217.       exit 0;
  218.     }
  219.   }
  220.  
  221.  
  222.   # Get list of keymap definitions
  223.   $defsdir = "/usr/share/console/lists/keymaps";
  224.   $keymaps = {};
  225.   readfiles ($defsdir);
  226.  
  227.  
  228.   # Find the right one
  229.   foreach my $kbdarch (@{$keymap_defs->{archsets}->{guess_arch($keymap_defs)}}) {
  230.     my $maps = $keymaps->{$kbdarch};
  231.  
  232.     $maps = $maps->{$family};
  233.     unless (defined $maps) {
  234.       my_warn "Family not found ($family)"; i
  235.       $maps = $keymaps->{$kbdarch};
  236.       $maps = $maps->{Unknown};
  237.       if (defined $maps) {
  238.         my_warn "Using $maps instead";
  239.       }
  240.       next;
  241.     }
  242.  
  243.     # 'Norwegian' had a typo in a previous version thus some people still
  244.     # have this string in their debconf database.
  245.     $layout =~ s/Norvegian/Norwegian/;
  246.  
  247.     $maps = $maps->{$layout};
  248.     unless (defined $maps) {
  249.       my_warn "Layout not found ($layout)"; next;
  250.     }
  251.  
  252.     $maps = $maps->{$kbdvariant};
  253.     unless (defined $maps) {
  254.       my_warn "Keyboard variant not found ($kbdvariant)"; next;
  255.     }
  256.  
  257.     $filename = $maps->{$mapvariant};
  258.     unless (defined $filename) {
  259.       my_warn "Keymap variant not found ($mapvariant)"; next;
  260.     }
  261.   }
  262. }
  263.  
  264. my_die "No matching map found" unless defined $filename;
  265.  
  266. # output result
  267. print STDERR "$filename\n";
  268.