#!/usr/bin/perl -w

use strict;

#
# Package contents
#
$::keymaps = {};

# Any item named 'Standard' will be the default choice among its siblings.
# Any single item ditto.
# If none bears that name, declare a sibling element "default => 'his name'".

# Not perfect: the last package declaring a default will win :}
# Maybe package with no default should depend on package with one ?
# Lintian will have to be smart then !

# Maybe implement ratings instead of 'default' flag ?

#####KEYMAPS#####

# END OF DATAPACKAGE-SPECIFIC PART
# BELOW THIS LINE IS THE GENERIC PART

# This a preliminary debconf script for console-related data.
# (c) 1999-2000, Yann Dirson <dirson@debian.org>

# It has the following limitations that should be addressed:
# - only handles keymap configuration (ie, only does part of kbdconfig's job)
# - does not allow testing keymap before accepting it (REGRESSION).
# - does not allow reloading a default keymap (REGRESSION).

use Debconf::Client::ConfModule ':all';

die "Syntax error: no argument" if ($#ARGV < 0);

#####COMMON#####

# Layout of questions is:
#
# console-data/keymap/
#   /family
#   /azerty/
#     /layout
#     /french/
#       /variant
#       /without euro/
#         /keymap

# FIXME: maybe use eg. country codes in storage, and translate into
# localized string when needed ?

sub declare_keymaps {
  my ($defs) = @_;

  foreach my $kbdarch (@{$defs->{archsets}->{guess_arch($defs)}}) {
    declare_families ($defs, $defs->{allitems}->{$kbdarch}, $defs->{prefix});
  }
}

# Maybe set a default choice if none already set
sub maybe_set_default_choice {
#	my ($question, $default) = @_;
#	(my $ret, my $seen) = fget ($question, 'seen');
#	if ($seen eq 'false') {
#	  my $x = metaget ($question, 'value') ;
#	  print STDERR " $question is #$x# ";
#	}	
#set ($question, $default) if $seen eq 'false';
}

#
# Clear obsolete entries from the database,
# Tidy up this ugly hack somehow
sub clear_cruft {
	my ($version) = @_;
	my $ret = 0;
	my $val = '';
	if ($version eq '') {
		$version='0';
	}
	my $x=system("dpkg --compare-versions $version lt 0.7.25");
	if ($x eq 0 ) {
		unregister ('console-data/keymap/full');
		my ($ret, $val) = metaget ('console-data/keymap/azerty/french/variant', 'value');
		if ($val eq 'With Euro (latin 0)') {
			set ('console-data/keymap/azerty/french/variant','With Euro (latin 9)');
		}
		subst ('console-data/keymap/azerty/french/variant', 'choices',
			'Apple USB, PC keyboard (non-US 102 keys), Same as X11 (latin 1), With Euro (latin 9)');
	}
	# The speakup keymaps were removed from console-data in sarge
	($ret, $val) = get ('console-data/keymap/full');
	set ('console-data/keymap/full', 'us') if ($val eq  "speakup");
	set ('console-data/keymap/full', 'lt') if ($val eq "speakup-lt");
	my $lith_keymap = 'console-data/keymap/qwerty/lithuanian/standard/keymap';
	($ret, $val) = get ($lith_keymap);
	set ($lith_keymap, 'latin4') if ($val eq "Speakup");
	subst ($lith_keymap, 'choices', 'latin4, unicode');
	my $us_keymap = 'console-data/keymap/qwerty/us_american/standard/keymap';
	($ret, $val) = get ($us_keymap);
	set ($us_keymap, 'standard') if ($val eq "Speakup");
	subst ($us_keymap, 'choices', 
		'Standard, US International (ISO 8859-1), US International (ISO 8859-15), With latin1');
}


sub find_default {
  my ($leveldefs, $question) = @_;

  if (defined $leveldefs->{default}) {
    my $def = $leveldefs->{default};
    # FIXME: not really deleted ?!
    delete $leveldefs->{default};
    return $def;
  } elsif (defined $leveldefs->{Standard}) {
    return 'Standard';
#  } elsif (scalar(keys %{$leveldefs}) == 1) {
  } else {
    printf STDERR "No default for $question - picking one\n";
    $::warned = 1;
    return (keys %{$leveldefs})[0];
  }
}

sub declare_families {
  my ($defs, $familydefs, $prefix) = @_;
  my $familyquestion = $prefix . $defs->{toplevel};
  $familyquestion = correctname $familyquestion;

  # There is only one family question, never need to register more

  my ($ret, $families) = metaget ($familyquestion, 'choices');
  my @families = split (/, */, $families);

  # take default entry into account
  my $default = find_default ($familydefs, $familyquestion);

  foreach my $family (keys %{$familydefs}) {
    # add family if not declared yet
    push (@families, $family) unless grep { $_ eq $family } @families;

    declare_layouts ($defs,
		     $familydefs->{$family},
		     $prefix . $family . '/');
  }

  # Update list of available families
  subst ($familyquestion, 'choices', join (", ", sort @families));
  maybe_set_default_choice ($familyquestion, $default);
}

sub declare_layouts {
  my ($defs, $layoutdefs, $prefix) = @_;
  my $layoutquestion = $prefix . $defs->{sublevels}->[0];
  $layoutquestion = correctname $layoutquestion;

  # create if needed
  my ($ret) = get ($layoutquestion);
  register ($defs->{prefix} . 'template/' . $defs->{sublevels}->[0],
	    $layoutquestion) if $ret == 10;

  ($ret, my $layouts) = metaget ($layoutquestion, 'choices');
  my @layouts = split (/, */, $layouts);

  # take default entry into account
  my $default = find_default ($layoutdefs, $layoutquestion);

  foreach my $layout (keys %{$layoutdefs}) {
    # add layout if not declared yet
    push (@layouts, $layout) unless grep { $_ eq $layout } @layouts;

    declare_kbdvariants ($defs,
			 $layoutdefs->{$layout},
			 $prefix . $layout . '/');
  }
  # Update list of available layouts
  subst ($layoutquestion, 'choices', join (", ", sort @layouts));
  # Maybe set default choice
  maybe_set_default_choice ($layoutquestion, $default);
}

sub declare_kbdvariants {
  my ($defs, $kbdvariantdefs, $prefix) = @_;
  my $kbdvariantquestion = $prefix . $defs->{sublevels}->[1];
  $kbdvariantquestion = correctname $kbdvariantquestion;

  # create if needed
  my ($ret) = get ($kbdvariantquestion);
  register ($defs->{prefix} . 'template/' . $defs->{sublevels}->[1],
	    $kbdvariantquestion) if $ret == 10;

  ($ret, my $kbdvariants) = metaget ($kbdvariantquestion, 'choices');
  my @kbdvariants = split (/, */, $kbdvariants);

  # take default entry into account
  my $default = find_default ($kbdvariantdefs, $kbdvariantquestion);

  foreach my $kbdvariant (keys %{$kbdvariantdefs}) {
    # add kbdvariant if not declared yet
    push (@kbdvariants, $kbdvariant) unless grep { $_ eq $kbdvariant } @kbdvariants;

    declare_mapvariants ($defs,
			 $kbdvariantdefs->{$kbdvariant},
			 $prefix . $kbdvariant . '/');
  }
  # Update list of available kbdvariants
  subst ($kbdvariantquestion, 'choices', join (", ", sort @kbdvariants));
  # Maybe set default choice
  maybe_set_default_choice ($kbdvariantquestion, $default);
}

sub declare_mapvariants {
  my ($defs, $mapvariantdefs, $prefix) = @_;
  my $mapvariantquestion = $prefix . $defs->{sublevels}->[2];
  $mapvariantquestion = correctname $mapvariantquestion;

  # create if needed
  my ($ret) = get ($mapvariantquestion);
  register ($defs->{prefix} . 'template/' . $defs->{sublevels}->[2],
	    $mapvariantquestion) if $ret == 10;

  # take default entry into account
  my $default = find_default ($mapvariantdefs, $mapvariantquestion);

  ($ret, my $mapvariants) = metaget ($mapvariantquestion, 'choices');
  my @mapvariants = split (/, */, $mapvariants);

  foreach my $mapvariant (keys %{$mapvariantdefs}) {
    # add mapvariant if not declared yet
    push (@mapvariants, $mapvariant) unless grep { $_ eq $mapvariant } @mapvariants;
  }
  # Update list of available mapvariants
  subst ($mapvariantquestion, 'choices', join (", ", sort @mapvariants));
  maybe_set_default_choice ($mapvariantquestion, $default);
}

# handle transitions in the state machine
sub transition {
  my ($defs, $origstate, $priority, $prev, $next) = @_;
  my $newstate;
  my $ret;
  my @retval;

  # compute question according to state
  my $prefix = $defs->{prefix};
  my $question = $prefix . $defs->{toplevel};
  for (my $level = 0; $level < $origstate; $level ++) {
    my ($ret, $choice) = get ($question);
    $prefix = $prefix . $choice . '/';
    $question = $prefix . $defs->{sublevels}->[$level];
    $question = correctname $question;
  }

  ($ret) = input ($priority, $question);
  @retval = go;
  if ($retval[0] eq 30) {
      $newstate = $prev;
  } else {
    $newstate = $next;
  }

  return $newstate;
}


# The real config engine
sub configure {
  my ($defs) = @_;
  my $ret;
  my @retval;

  my $state = 0;
  # This is a simple state machine for all config items
  while ($state != 99) {

    #
    # Change the keymap ?
    #

    ($state == 0) && do {

      # This one has a default, we can trust it has a value
      ($ret) = input ('high', 'console-data/keymap/policy');
      if ($ret == 30) {		# if the question is not going to be asked...
 	maybe_set_default_choice ('console-data/keymap/policy', "Don't touch keymaps");
      }
      @retval = go;
      if ($retval[0] eq 30) {
	set ('console-data/keymap/policy', "Don't touch keymap");
	exit 30; 
      }

      my $policy = get ('console-data/keymap/policy');

      # Ugly workaround for Bug 107700
      $policy = 'Select keymap from arch list' if
          $policy eq "console-data/keymap/policy doesn't exist";

      if ($policy eq 'Select keymap from arch list') {
	$state = 1;
	next;
      } elsif ($policy eq "Don't touch keymap") {
	# if the user has a bootime keymap in an old location, warn
	if (! -r '/etc/console/boottime.kmap.gz'
	    and ( -r '/etc/kbd/default.kmap' or -r '/etc/kbd/default.kmap.gz' or
		  -r '/etc/console-tools/default.kmap' or -r '/etc/console-tools/default.kmap.gz')) {
	  input ('critical', 'console-data/keymap/ignored');
	  @retval = go;
	  if ($retval[0] eq "backup") {
	    ($ret, my $seen) = fget ('console-data/keymap/policy', 'seen');
	    if ($seen eq 'false') {
	      # Hitting "back" here has no meaning mostly, but try to behave as sanely as I
	      # can think of.
	      exit 30;
	    } else {
	      next;
	    }
	  }
	}

	$state = 99;
      } elsif ($policy eq 'Keep kernel keymap') {
	$state = 99;
      } elsif ($policy eq 'Select keymap from full list') {
        my $ret;
        ($ret) = input ('high', 'console-data/keymap/full');
        if ($ret == 30) {
            $state = 99;
            next;
        }
        @retval = go;
        if ($retval[0] eq 'backup') {
           $state = 0;
        } else {
           $state = 99;
           my($full);
           ($ret, $full) = get ('console-data/keymap/full');
           if ($full) {
               set ('console-data/keymap/full', $::all_maps{$full});
           }
        }
      } else {
	die "get(console-data/keymap/policy) said $policy"
      }
    };

    #
    # Keymap changes
    #

    ($state == 1) && do {

	my $kstate = 0;

        if (guess_arch($::keymap_defs) eq 'powerpc/mac') {
            my($proc_file) = "/proc/sys/dev/mac_hid/keyboard_sends_linux_keycodes";
            if (-e $proc_file) {
                open(KEYCODES, $proc_file);
                my($input) = <KEYCODES>;
                chomp($input);
                close(KEYCODES);
                if ($input eq "0") {
                    input ('high', 'console-data/keymap/powerpcadb');
                    @retval = go;
                    if ($retval[0] eq 'backup') {
                        $kstate = -1;
                    } else {
                        my($answer);
                        ($ret, $answer) = get ('console-data/keymap/powerpcadb');
                        if ($answer eq 'no') {
                            set ('console-data/keymap/policy', "Don't touch keymap");
                            exit;
                        }
                    }
                    if ($kstate != -1) {
                        open(KEYCODES,  "> $proc_file") || die "Cannot open $proc_file for writing!\n";
                        print KEYCODES "1";
                        close(KEYCODES);
                    }
                }
            }
        }

	# This is a simple embedded state machine for keymap
	while (($kstate != 99) and ($kstate != -1)) {
	  ($kstate == 0) && do { # get_family
	    $kstate = transition ($defs, 0, 'high', -1, 1);
	    next;
	  };

	  ($kstate == 1) && do { # get_layout
	    $kstate = transition ($defs, 1, 'high', 0, 2);
	    next;
	  };

	  ($kstate == 2) && do { # get_kbdvariant
	    $kstate = transition ($defs, 2, 'medium', 1, 3);
	    next;
	  };

	  ($kstate == 3) && do { # get_mapvariant
	    $kstate = transition ($defs, 3, 'low', 2, 99);
	    next;
	  };
	}

	if ($kstate == -1) {
	  $state = 0;
	} else {
	  $state = 99;
	}

      next;
    };

    #
    # The default font, and SFM fallbacks
    #

    #
    # The default ACM ?
    #
  }
}

sub deconfigure {
  my ($defs) = @_;

  # FIXME: should deregister our entries' choices

#  purge;

  # FIXME: should run configuration of console-common afterwards (if needed ?)
}

# GO !

capb ('backup');

# FIXME: this should go in declare_keymaps(), but if I put it there, it
# doesn't seem to work. dunno why
sub walk;
sub walk
{
    my $h = shift;
    my @id = @_;

    for my $k (sort keys %$h)
    {
	next if $k eq 'default';
	if (ref $h->{$k} eq 'HASH')
	{
	    walk $h->{$k}, @id, $k;
	    next;
	}
	my($id) = join(' / ', @id, $k);
	$::all_maps{$id} = $h->{$k};
    }
}


walk $::keymaps;
subst ('console-data/keymap/full', 'choices', join (", ", sort keys %::all_maps));

if ($ARGV[0] eq 'configure') {
  $::warned = 0;
  # do not attempt declaration of empty keymap-list
  declare_keymaps ($::keymap_defs) if %{$::keymaps};
  if ($::warned) {
    printf STDERR <<EOF

If you have information about what choice should be the default for
the above questions which gave warnings, please mail it to
console-data\@packages.debian.org.  Thanks for your help.
EOF
  ;
  }
  # Clear cruft that may be in the database
  clear_cruft ($ARGV[1]);
  # Re-insert, as they've just been deleted... by clear_cruft()
  subst ('console-data/keymap/full', 'choices', join (", ", sort keys %::all_maps));

  # Don't tread on keymaps not installed via install-keymap
  my $hash = 'none';
  my $bootmap = '/etc/console/boottime.kmap.gz';
  $hash = `md5sum $bootmap | cut -f1 -d' '`  if -r $bootmap;
  chomp($hash);
  my ($ret, $val) = get ('console-data/bootmap-md5sum');
  set ('console-data/keymap/policy',"Don't touch keymap") if $val ne $hash;

  configure($::keymap_defs);
}
elsif ($ARGV[0] eq 'reconfigure') {
  configure($::keymap_defs);
}
elsif ($ARGV[0] eq 'X-deconfigure') {
  deconfigure($::keymap_defs);
}