文件操作 - dictionaries-common.config

文件: /var/lib/dpkg/info/dictionaries-common.config

编辑文件内容

#!/usr/bin/perl -w
# -------------------------------------------------------------------------
# dictionaries-common.config-header:
#   Some stuff will be appended to make dictionaries-common.config:
#   - dc-debconf-default-value.pl
#   - dc-debconf-select.pl
#   - dictionaries-common.config-footer
# -------------------------------------------------------------------------

use strict;
use Debconf::Client::ConfModule q(:all);

version ('2.0');

if ( -l "/etc/dictionary" ) {
  input ("medium","dictionaries-common/old_wordlist_link");
}

# Unregistering some no longer used debconf questions.

unregister("dictionaries-common/languages");
unregister("dictionaries-common/move_old_usr_dict");
unregister("dictionaries-common/remove_old_usr_dict_link");
unregister("shared/packages-ispell");
unregister("shared/packages-wordlist");

go();

# ------------------------------------------------------------------------
# Local Variables:
# perl-indent-level: 2
# coding: iso-8859-1
# End:
# ----------------------------------------------------------------------------
# dc-debconf-default-value.pl:
#  Dealing with default value selection. Functions and definitions.
# ----------------------------------------------------------------------------

# Trying to find a reasonable guess for default ispell dictionary and wordlist
# from the debian-installer settings, envvars or pre-policy symlinks and the
# list of ispell dictionaries and wordlists to be installed

my $dcscript     = "/usr/share/dictionaries-common/dc-debconf-select.pl";
my $debug        = "yes" if exists $ENV{'DICT_COMMON_DEBUG'};

# Suffixes for different variants. They must be declared here.
my @suffixes     = ("",
		    "-insane",
		    "-huge",
		    "-large",
		    "-medium",
		    "-small",
		    "-gut");
my %equivs       = ("bg"      => "bulgarian",
		    "ca"      => "catalan",
		    "cs"      => "czech",
		    "da"      => "danish",
		    "de"      => "ngerman",
		    "de:1"    => "ogerman",
		    "de_CH"   => "swiss",
		    "en_US"   => "american",
		    "en_US:1" => "miscfiles",
		    "en_CA"   => "canadian",
		    "en_CA:1" => "american",
		    "en_GB"   => "british",
		    "en_AU"   => "british",
		    "eo"      => "esperanto",
		    "es"      => "spanish",
		    "fi"      => "finnish",
		    "fo"      => "faroese",
		    "fr"      => "french",
		    "ga"      => "irish",
		    "gd"      => "gaelic",
		    "gl"      => "galician-minimos",
		    "gv"      => "manx",
		    "hu"      => "hungarian",
		    "it"      => "italian",
		    "lt"      => "lithuanian",
		    "nb"      => "norwegian->bokma",    # Match bokmal and bokmaal
		    "nl"      => "dutch",
		    "nn"      => "norwegian->nynorsk",
		    "pl"      => "polish",
		    "pt"      => "portuguese",
		    "pt_BR"   => "brazilian",
		    "ru"      => "russian",
		    "sv"      => "swedish",
		    "tl"      => "tagalog",
		    "uk"      => "ukrainian");
my %alternatives   = ("ispell"   => "ispell-dictionary.hash",
		      "wordlist" => "dictionary");

# -------------------------------------------------------------
sub dc_debugprint(){
# -------------------------------------------------------------
# Show info if in debug mode
# -------------------------------------------------------------
  print STDERR "@_" if $debug;
}

# -------------------------------------------------------------
sub dc_set (){
# -------------------------------------------------------------
# Set debconf value unless already set
# -------------------------------------------------------------
  my $guessed   = shift;
  my $question  = $guessed->{'question'};
  my $value     = $guessed->{'guess'};
  my $priority  = $guessed->{'priority'};

my ($errorcode, $oldvalue) = get($question);

$oldvalue = "unset" unless $oldvalue;

if ( $errorcode or $oldvalue eq "unset" ){
    &dc_debugprint(" dict-common::dc_set: $question: errorcode: $errorcode; priority: $priority\n" .
		   "   Old:[$oldvalue] --> New:[$value]\n");
    set("$question","$value");
  } elsif ( $oldvalue eq $value ) {
    print STDERR " dict-common::dc_set: $question is already set to
      [$oldvalue]. Preserving it.\n";
  } else {
    print STDERR " dict-common::dc_set: Warning: $question is already set to
      [$oldvalue].
      Not setting to [$value]\n";
  }

if ( $debug ){                 # --- Check if question value is actually set
    ($errorcode, $oldvalue) = get($question);
    if ( $errorcode ){
      print STDERR " dict-common::dc_set: $question reading failed with $errorcode\n";
    } elsif ( $oldvalue) {
      print STDERR " dict-common::dc_set: $question is set to [$oldvalue]\n";
    } else {
      print STDERR " dict-common::dc_set: $question value is void, bad thing\n";
    }
  }
}

# -------------------------------------------------------------
sub dc_extractlangname (){
# -------------------------------------------------------------
# Look if a dict matching $langkey in %equivs is to be installed
# and return the preferred language name if so.
# -------------------------------------------------------------
  my $langkey             = shift;
  my $classinfo           = shift;
  my $classprefix         = $classinfo->{'prefix'};
  my $debconf_vals        = $classinfo->{'languages'};
  my $debconf_defaultvals = $classinfo->{'default_langs'};
  my @thevalues           = ();
  my $thestring;
  my $thepackage;
  my $thevariant;
  my $pkgfullname;

if ( defined $equivs{$langkey} ){
    ($thepackage,$thevariant) = split ("->",$equivs{$langkey});
    foreach my $suffix ( @suffixes ){
      if ( $thepackage eq "miscfiles" ){
	$pkgfullname = "$thepackage$suffix";
      } else {
	$pkgfullname = "$classprefix$thepackage$suffix";
      }
      &dc_debugprint(" dc_extractlangname: Trying package $pkgfullname\n");
      if ( defined $debconf_vals->{"$pkgfullname"} ){
	if ( defined $debconf_defaultvals->{"$pkgfullname"} ){
	  $thestring = $debconf_defaultvals->{"$pkgfullname"};
	} else {
	  $thestring = $debconf_vals->{"$pkgfullname"};
	}
	@thevalues = sort split (/\s*,\s*/,$thestring);
	if ( $thevariant ){
	  @thevalues = grep {/$thevariant/i} @thevalues;
	}
	@thevalues = sort {
	  # Sort tex variants last
	  $a =~ m/tex/i <=> $b =~ m/tex/i
	    || $a cmp $b } @thevalues;
	if ( scalar @thevalues >= 1 ){
	  return "$thevalues[0]";
	} else {
	  return;
	}
      }
    }
  }
}

# -------------------------------------------------------------
sub dc_guesslang (){
# -------------------------------------------------------------
# Try different combinations of $language and $country and possible
# fallbacks in case dc_extractlangname() does not find a good guess
# -------------------------------------------------------------
  my $classinfo   = shift;
  my $language    = shift;
  my $country     = shift;
  my $class       = $classinfo->{'class'};
  my $classprefix = $classinfo->{'prefix'};
  my $msgprefix   = "dc_guesslang";
  my $priority    = "medium";
  my $guessed;

&dc_debugprint(" $msgprefix: Looking for langkey matches [$class,$classprefix,$language,$country].\n");
  if ( $guessed = &dc_extractlangname("$language" . "_" . uc($country),$classinfo)
       || &dc_extractlangname("$language" . "_" . uc("$country") . ":1",$classinfo)
       || &dc_extractlangname("$language",$classinfo)
       || &dc_extractlangname("$language:1",$classinfo)
    ){
    $priority = "low";
  } else {
    my @sorted_keys = sort {
      # Sort keys matching ^$language_ first
      $b =~ m/^$language(\_|:|$)/ cmp $a =~ m/^$language(\_|:|$)/
	# Then american english
	|| $b =~ m/^en\_US/ cmp $a =~ m/^en\_US/
	# Then any english variant
	|| $b =~ m/^en\_/ cmp $a =~ m/^en\_/
	# Then anything else alphabetically
	|| $a cmp $b
    } keys %equivs;
    &dc_debugprint(" dc_guesslang: Trying an alternative for $class from keys:\n  "
		   . join(', ',@sorted_keys) . "\n");
    foreach ( @sorted_keys ){
      last if ( $guessed = &dc_extractlangname($_, $classinfo) );
    }
  }
  return { 'guess'    => $guessed,
	   'priority' => $priority,
	   'class'    => $class
  } if $guessed;
}

# -------------------------------------------------------------
sub dc_guess_langkey_for_link(){
# -------------------------------------------------------------
# Try guessing langkey after (woody or older) former symlink
# -------------------------------------------------------------
  my $class          = shift;
  my $link           = "/etc/alternatives/$alternatives{$class}";
  my %reverse_equivs = ();
  my $prefix;
  my $guess;
  my $language;

return unless ( -l $link );

if ( $guess = readlink($link) ){
    &dc_debugprint("dictionaries-common.config: Found pre-policy link $link->$guess.");

$guess =~ s/\.hash$//;
    $guess =~ s/^.*\///;
    $guess =~ s/(\-\.)(small|medium|large)$//;
    $guess =~ s/\-english$//;

$guess = "norwegian->bokma"   if ($guess =~ m/^bokm.*l$/);
    $guess = "norwegian->nynorsk" if ($guess eq "nynorsk");
    $guess = "ogerman"            if ($guess eq "german");
    $guess = "miscfiles"          if ($guess eq "web2");
    $guess = "danish"             if ($guess eq "dansk");
    $guess = "french"             if ($guess eq "francais");
    $guess = "swedish"            if ($guess eq "svenska");

&dc_debugprint("dictionaries-common.config: pre-policy link target fine tuned to $guess.\n");

# Build reverse equivs
    foreach ( keys %equivs ){
      $reverse_equivs{$equivs{$_}} = $_;
    }

# Check for a match and return langkey if found
    if ( exists $reverse_equivs{$guess} ){
      return $reverse_equivs{$guess};
    } else {
      &dc_debugprint("dictionaries-common.config: No match found for pre-policy symlink $link.\n");
    }
  }
}

# -------------------------------------------------------------
sub dc_manual_alternative (){
# -------------------------------------------------------------
# Check if woody (or older) alternative exists and is set to manual
# -------------------------------------------------------------
  my $class  = shift;
  my $file   = "/var/lib/dpkg/alternatives/$alternatives{$class}";
  my $status;

if ( -r $file ){
    open(FILE,"< $file") or return;
    $status = <FILE>;
    close FILE;
    $status = "" unless $status;
    chomp $status;
    return "Manual (previous alternative setting)" if ( $status eq "manual" );
  }
}

# -------------------------------------------------------------
sub dc_parse_classinfo (){
# -------------------------------------------------------------
# Gather info for (to be) installed packages for class
# debconf info:
#   $classinfo->{'languages'}:     pkg -> languages provided by package
#   $classinfo->{'default_langs'}: pkg -> default language for package
# Other info
#   $classinfo->{'class'}:         Class
#   $classinfo->{'classprefix'}:   Class prefix
# -------------------------------------------------------------
  my $class = shift;
  return unless $class;
  my $question = "shared/packages-$class";
  my ($errorcode,$pkgowners) = metaget ($question, "owners");
  return if $errorcode;

my %debconf_vals = ();
  my %debconf_defaultvals = ();
  my %classprefix = ( 'ispell' => "i", "wordlist" => "w" );

foreach my $pkg ( split (/\s*,\s*/,$pkgowners) ){
    $debconf_vals{$pkg} = get ("$pkg/languages");
    my ($errorcode,$pkgdefaults) = get ("$pkg/defaults");
    $debconf_defaultvals{$pkg} = $pkgdefaults unless $errorcode;
  }

return {
    'class'         => $class,
    'prefix'        => $classprefix{$class},
    'languages'     => \%debconf_vals,
    'default_langs' => \%debconf_defaultvals
  } if %debconf_vals;
}

# -----------------------------------------------------------------
sub dc_guess_language_country_strings (){
# -----------------------------------------------------------------
# Try guessing $language $country pairs
# -----------------------------------------------------------------
  my $class       = shift;

my $di_language = "debian-installer/language";
  my $di_country  = "debian-installer/country";
  my $msgstring   = "dict-common.config->dc_guess_language_country_strings";

my $language;
  my $country;
  my $errorcode;

# First check if we are upgrading from ancient pre-policy setup with
  # symlinks set through alternatives and try guessing a langkey
  if ( $language = &dc_guess_langkey_for_link($class) ){
    &dc_debugprint("$msgstring: Guessed langkey $language from ancient pre-policy symlink.\n");
  } else {
    # If system is already installed use /etc/default/locale contents.
    # Otherwise try looking at debian-installer/language
    if ( -e "/etc/default/locale" ){
      $language = $ENV{'LANG'} if exists $ENV{'LANG'};
    }
    if ( $language ){
      &dc_debugprint("$msgstring: LANG=$language is to be used.\n") if $language;
    } else {
      ($errorcode,$language) = get($di_language);
      $language = '' if $errorcode;
      &dc_debugprint("$msgstring: Debconf gives language \"$language\"\n") if $language;
    }
  }

# Try hard to get a value if nothing was found
  $language = $language ||
    $ENV{'LANG'} ||
    $ENV{'LC_MESSAGES'} ||
    $ENV{'LC_ALL'} ||
    '';

# Get proper $language $country pairs if $language is available.
  if ( $language ){
    if ( $language eq "C" or $language eq "POSIX" ){
      &dc_debugprint("$msgstring: Using language \"en\" instead of\"$language\"\n");
      $language = "en";
    } else {
      # Deal with de_DE:de_DE@euro:de:en_GB.UTF-8:en like entries
      $language = ( split(":",$language) )[0];
      $language =~ s/[\.@].*$//;                # Remove variant and charset
      ($language,$country) = split("_",$language);
    }
    if ( not $country ){
      ($errorcode,$country) = get($di_country);
      if ( $errorcode or not $country ){
	$country = "unset";
      }
    }

# Make sure there is no leading/trailing whitespace.
    $language =~ s/^\s+//;
    $language =~ s/\s+$//;
    $country  =~ s/^\s+//;
    $country  =~ s/\s+$//;

} else {
    &dc_debugprint("$msgstring: No language candidate found. Defaulting to \"en_UNSET\"\n");
    $language = "en";
    $country  = "UNSET";
  }
  return $language, $country;
}

# -----------------------------------------------------------------
sub dc_set_default_value_for_class (){
# -----------------------------------------------------------------
# Try guessing a reasonable default value for given class after
# $language $country pair and set it if found.
# -----------------------------------------------------------------
  my $class       = shift;
  my $msgprefix   = "dc_set_default_value_for_class";
  my $question    = "dictionaries-common/default-$class";
  my $oldlink     = "/etc/alternatives/$alternatives{$class}";
  my $guessed;

if ( my $classinfo = &dc_parse_classinfo($class) ){
    # Ancient symlinks may be different for different classes,
    my ( $language, $country ) = &dc_guess_language_country_strings($class);

# First try something reasonably close to the lang +country pair
    if ( $guessed = &dc_guesslang($classinfo,$language,$country) ){
      &dc_debugprint(" $msgprefix: Guessed value ->($class,$language,$country,$guessed->{'guess'},$guessed->{'priority'})\n");
    } else {
      # Signal an error. This should never happen, thus the critical priority.
      &dc_debugprint(" $msgprefix: No good or bad guess found for ($class,$language,$country)\n");
      return;
    }

# Actually set the value if found
    if ( $guessed ) {
      $guessed->{'question'} = $question;
      &dc_set($guessed);
    }
  } else {
    &dc_debugprint("$msgprefix: No elements found for $class\n");
  }
  return $guessed;
}

# -----------------------------------------------------------------
# Local Variables:
# perl-indent-level: 2
# coding: utf-8
# End:
# ---------------------------------------------------------------------------
# dc-debconf-select.pl:
#  This file will be added to end of dictionaries-common.config-base
#  to make dictionaries-common.config, as well as installed under
#  /usr/share/dictionaries-common for single ispell dicts/wordlists use
# ---------------------------------------------------------------------------

use strict;

sub dico_get_packages (){
  # Get list of packages sharing the question
  my $class    = shift;
  my $question = "shared/packages-$class";
  my @pkglist  = ();

my ($errorcode,$packages) = metaget ($question, "owners");
  @pkglist = split (/\s*,\s*/, $packages) unless $errorcode;
  return \@pkglist;
}

sub dico_parse_languages (){
  # Get a hash reference of package -> list of (e)languages provided by package
  my $class    = shift;
  my $variant  = shift;
  my $packages = shift;
  my %tmphash  = ();

die "No variant (languages|elanguages) string supplied\n" unless $variant;

$packages = &dico_get_packages($class) unless $packages;

foreach my $pkg ( @$packages ){
    my ($errorcode, $entry ) = metaget("$pkg/$variant", "default");
    unless ( $errorcode ){
      $entry =~ s/^\s+//;
      $entry =~ s/\s+$//;
      $tmphash{$pkg} = $entry;
    }
  }
  return \%tmphash;
}

sub dico_get_all_choices (){
  # Get $choices and $echoices parallel lists sorted after $echoices and formatted for debconf
  my $class       = shift;
  my $languages   = shift;
  my $debug       = 1 if exists $ENV{'DICT_COMMON_DEBUG'};
  my %mappinghash = ();
  my $debug_prefix = "[$class,dico_get_all_choices]";

$languages   = &dico_parse_languages($class,"languages") unless $languages;

my $elanguages  = &dico_parse_languages($class,"elanguages",[ keys %$languages ]);

if ( $debug ){
    print STDERR "-------- $debug_prefix start --------\n";
    my $langlist  = join(', ',sort keys %{$languages});
    my $elanglist = join(', ',sort keys %{$elanguages});
    print STDERR " * Packages with languages: $langlist\n"  if $debug;
    print STDERR " * Packages with elanguages: $elanglist\n" if $debug;
  }

foreach my $pkg ( keys %$languages ){
    my @langs  = split(/\s*,\s*/, $languages->{$pkg});
    my @elangs = @langs;
    if ( exists $elanguages->{$pkg} ){
      my @tmp = split(/\s*,\s*/, $elanguages->{$pkg});
      if ( $debug ){
	print STDERR " langs: $#langs, "  . join(', ',@langs)  . "\n";
	print STDERR " tmp:   $#tmp, "    . join(', ',@tmp)    . "\n";
      }
      @elangs = @tmp if ( $#langs == $#tmp );
    }
    foreach my $index ( 0 .. $#langs ){
      $mappinghash{$langs[$index]} = $elangs[$index];
    }
  }
  my $echoices = join(', ', sort {lc($a) cmp lc($b)} values %mappinghash);
  my $choices  = join(', ',
		      sort {lc($mappinghash{$a}) cmp lc($mappinghash{$b})}
		      keys %mappinghash);
  if ( $debug ){
    print STDERR " * Choices:\n   [$choices]\n";
    print STDERR " * Echoices:\n   [$echoices]\n";
    print STDERR "-------- $debug_prefix end --------\n";
  }
  return $choices, $echoices;
}

# ---------------------------------------------------------------------------
sub dico_get_default_value (){
# ---------------------------------------------------------------------------
# debconf-is-not-a-registry:
# ---------------------------------------------------------------------------
  my $class             = shift;
  my $newchoices        = shift;
  my $question          = "dictionaries-common/default-$class";
  my $cachedir          = "/var/cache/dictionaries-common";
  my $sys_default_dir   = "$cachedir";
  my $debug             = 1 if defined $ENV{'DICT_COMMON_DEBUG'};
  my $debug_prefix      = "[$class,dico_get_default_value]";
  my %sys_default_files = ( 'ispell'   => "$sys_default_dir/ispell-default",
			    'wordlist' => "$sys_default_dir/wordlist-default");

my $sys_default_value;
  my $sys_default_file  = $sys_default_files{$class};
  # Get current value in system default file if available
  if ( -f $sys_default_file ){
    open ( my $SYS_DEFAULT_FILE, "<$sys_default_file" );
    while (<$SYS_DEFAULT_FILE>){
      next if m/^\s*\#/;
      next if m/^\s*$/;
      chomp;
      s/^\s+//;
      s/\s+$//;
      $sys_default_value = $_;
      last;
    }
    close $SYS_DEFAULT_FILE;
  }

my $debconf_default_value = get ($question);
  # If valid and different from debconf value, use it as new value
  if ( $sys_default_value && $sys_default_value ne $debconf_default_value ) {
    if ( defined $newchoices->{$sys_default_value} ){
      set($question,$sys_default_value);
      my $debconf_default_value_txt = $debconf_default_value ? $debconf_default_value : "";
      print STDERR
	"$debug_prefix: dictionaries-common warning:\n" .
	  " debconf question \"$question\" value did not match that in \"$sys_default_file\"\n" .
	    " Changing debconf value \"$debconf_default_value_txt\" to \"$sys_default_value\"\n";
      return $sys_default_value;
    } elsif ( $debconf_default_value ) {
      if ( $debug ){
	print STDERR
	  "$debug_prefix: dictionaries-common warning:\n" .
	    " \"$sys_default_value\" in \"$sys_default_file\" seems not available.\n" .
	      " Will set to debconf value \"$debconf_default_value\" in trigger. Be patient.\n";
      } elsif ( defined $ENV{DPKG_MAINTSCRIPT_NAME}
		&& $ENV{DPKG_MAINTSCRIPT_NAME} eq "config") {
	print STDERR
	  " \"$sys_default_value\" in \"$sys_default_file\" seems not available.\n" .
	    " Will set to debconf value \"$debconf_default_value\" in trigger. Be patient.\n";
      }
      return $debconf_default_value;
    }
  } else {
    return $debconf_default_value;
  }
}

sub dc_debconf_select (){
  my $classinfo   = shift;
  my $debug       = 1 if exists $ENV{'DICT_COMMON_DEBUG'};
  my $reconfigure = 1 if exists $ENV{'DEBCONF_RECONFIGURE'};
  my $echoices;
  my %title       = ('ispell'   => "Dictionaries-common: Ispell dictionary",
		     'wordlist' => "Dictionaries-common: Wordlist dictionary"
    );

my $class;
  my $priority;
  my $is_dcconfig;

# If $classinfo is a hash reference, function is called from dictionaries-common.config
  if ( ref($classinfo) eq 'HASH' ){
    $class       = $classinfo->{'class'};
    $priority    = $classinfo->{'priority'} if ( defined $classinfo->{'priority'} );
    $is_dcconfig = 1;
  } else {
    # Otherwise is called from ispell dictionary/wordlist config
    $class = $classinfo;
  }

my $packages     = &dico_get_packages($class);
  return unless $packages;

my $question     = "dictionaries-common/default-$class";
  my $flagdir      = "/var/cache/dictionaries-common";
  my $newflag      = "$flagdir/flag-$class-new";
  my $debug_prefix = "[$class,dc_debconf_select]";
  my $langscript   = "/usr/share/dictionaries-common/dc-debconf-default-value.pl";

print STDERR "----- $debug_prefix start -----------\n" if $debug;

# Get new base list of provided languages
  my %newchoices  = ();
  my $languages = &dico_parse_languages($class,"languages",$packages);
  foreach my $pkg ( keys %$languages ) {
    foreach my $lang ( split(/\s*,\s*/, $languages->{$pkg}) ){
      $newchoices{$lang}++;
    }
  }
  my $choices = join (', ', sort {lc($a) cmp lc($b)} keys %newchoices);

# Get old list of provided languages
  my @oldchoices  = split(/\s*,\s*/,metaget ($question, "choices-c"));
  pop @oldchoices;            # Remove the manual entry
  my $oldchoices = join (', ', sort {lc($a) cmp lc($b)} @oldchoices);

# If dictionaries-common is already installed (-r $langscript),
  # there are elements for this class to be installed (%newchoices)
  # and there were none before (! $oldchoices), means that we are installing
  # for the first time elements in this class, with dictionaries-common
  # already installed. Try getting a reasonable default value
  if ( -r $langscript && %newchoices && ! $oldchoices ){
    print STDERR "$debug_prefix: Configuring class \"$class\" for the first time\n\n" if $debug;
    # If called from dictionaries-common.config we already have
    # $langscript, and probably more recent. Including it here will cause
    # some warnings about subroutine re-definitions and even errors.
    require $langscript unless $is_dcconfig;
    my $guessed = &dc_set_default_value_for_class($class);
    $priority = $guessed->{'priority'} if ( defined $guessed->{'priority'} );
  }

# Get default ispell dictionary / wordlist.
  my $curval = &dico_get_default_value($class,\%newchoices);

# Will be given a value if current value is wrong, undef otherwise
  my $wrong_curval;

# Try harder to have a good default if current value is empty, but %newchoices not.
  unless ( $curval ){
    if ( -r $langscript && %newchoices ){
      print STDERR "$debug_prefix: Possible values, but unset \"$question\". Trying harder to get a default value.\n";
      # As above, if called from dictionaries-common.config we already have
      # $langscript, and probably more recent. Including it here will cause
      # some warnings about subroutine re-definitions and even errors.
      require $langscript unless $is_dcconfig;
      my $guessed = &dc_set_default_value_for_class($class);
      $priority = $guessed->{'priority'} if ( defined $guessed->{'priority'} );
      $curval = get ($question);
      print STDERR "$debug_prefix: \"$question\" set to \"$curval\". Can be changed with select-default-$class.\n";
    }
  }

if ( scalar %newchoices ) {
    # If $priority is set &dc_set_default_value_for_class found something.
    # This will usually be as much "medium", so honour it.
    unless ( $priority ){
      if ( $curval && ( $curval =~ /^Manual.*/ or defined $newchoices{$curval} ) ){
	# Use priority "medium" if current value is in the new list or mode is set to manual.
	$priority = "medium";
      } else {
	# Otherwise we either have a wrong value with no associated entry
	# or a void value with elements installed (and thus possible values).
	# This is an *error* that needs to be signalled and acted upon.
	# For this reason priority must be higher than the standard one.
	# We leave it as "high" instead of "critical" so question can be
	# overriden in special cases until underlying bug is fixed.
	$priority = "high";
	if ( $curval ){
	  $wrong_curval = $curval;
	  print STDERR "$debug_prefix error: \"$curval\" does not correspond to any package.\n";
	} else {
	  $wrong_curval = "Question unset";
	  print STDERR "$debug_prefix error: \"$question\" unset but $class elements installed.\n";
	}
      }
    }
  } else {
    $priority = "low";
    print STDERR "$debug_prefix info: No elements in given class.\n" if $debug;
  }

if ( $debug or $wrong_curval ){
    my $curval_txt = $wrong_curval || $curval;
    print STDERR "$debug_prefix:
 * Class: $class, Priority: $priority
 * Question: \"$question\", Previous or guessed value: \"$curval_txt\"
 * New choices: [$choices]
 * Old choices: [$oldchoices]\n";
  }

# May ask question if there is no match
  if ( scalar %newchoices ) {
    if ( $choices ne $oldchoices) {
      fset ($question, "seen", "false");
      # Let future processes in this apt run know that a new $class element is to be installed
      if ( -d $flagdir ) {
	open (my $FLAG, "> $newflag")
	  or die "Could not open $newflag for write. Aborting ...\n";
	print $FLAG "1\n";
	close $FLAG;
      }
    }
    my ( $errorcode, $seen ) = fget($question, "seen");
    if ( $seen eq "false" or $reconfigure ){
      ($choices, $echoices ) = &dico_get_all_choices($class,$languages);
      subst ($question, "choices", $choices);
      subst ($question, "echoices", $echoices);
    }
    input ($priority, $question);
    title ($title{$class});
    go ();
    subst ($question, "echoices", $choices); # Be backwards consistent
  }

# If called from dictionaries-common.config, check actual values in debug mode
  if ( $debug && $is_dcconfig ){
    print STDERR " * Checking really set values for $question:\n";
    print STDERR "   - Choices-C string: " . metaget ($question, "choices-c") . "\n";
    print STDERR "   - Really set value: " . get ($question) . "\n";
  }
  print STDERR "----- $debug_prefix end -----------\n" if $debug;
}

# Local Variables:
# perl-indent-level: 2
# End:

1;
# --------------------------------------------------------------------------
# dictionaries-common.config-footer:
#  Specific final stuff to be run from dictionaries-common.config
# --------------------------------------------------------------------------

&dc_debugprint("\ndictionaries-common: (re)configuring ...\n");

# Prompting the questions if required
if ( not -e $dcscript ){            # First dictionaries-common installation
  foreach my $class ("ispell","wordlist"){
    &dc_debugprint("\n- dictionaries-common.config: Initial configuration for class \"$class\".\n\n");
    # This returns $class and $priority (along with here unused $guess)
    my $classinfo = &dc_set_default_value_for_class($class);
    if ( $classinfo ){
      &dc_debconf_select($classinfo);
      # This might have been pre-seeded and question not asked.
      # Make sure question is tagged as seen in this case
      fset ("dictionaries-common/default-$class", "seen", "true");
      go();
    } else {
      &dc_debconf_select($class);
    }
  }
} else {                              # Reconfiguring or upgrading
  foreach my $class ("ispell","wordlist"){
    &dc_debconf_select({'class' => $class});
  }
}

&dc_debugprint("\ndictionaries-common: (re)configuring ...Done.\n\n");

# Local Variables:
# mode: perl
# perl-indent-level: 2
# coding: iso-8859-1
# End:

文件操作 - dictionaries-common.config

文件: /var/lib/dpkg/info/dictionaries-common.config

编辑文件内容

修改文件时间

删除文件