home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2007 September / PCWSEP07.iso / Software / Linux / Linux Mint 3.0 Light / LinuxMint-3.0-Light.iso / casper / filesystem.squashfs / var / lib / dpkg / info / dictionaries-common.config < prev    next >
Encoding:
Text File  |  2006-12-19  |  16.7 KB  |  505 lines
  1. #!/usr/bin/perl -w
  2. # -------------------------------------------------------------------------------
  3. # dictionaries-common.config-base:
  4. #  dc-debconf-select.pl will be added to the end of this file
  5. #  to make dictionaries-common.config
  6. # -------------------------------------------------------------------------------
  7.  
  8. use Debconf::Client::ConfModule q(:all);
  9.  
  10. version ('2.0');
  11.  
  12. if ( -l "/etc/dictionary" ) {
  13.   input ("medium","dictionaries-common/old_wordlist_link");
  14. }
  15.  
  16. if ( not -l "/usr/dict" ){
  17.   set("dictionaries-common/remove_old_usr_dict_link","false");
  18. }
  19.  
  20. go();
  21.  
  22. if ( $ARGV[0] eq "reconfigure" ){
  23.   my $flag_file = "/var/cache/dictionaries-common/postinst.reconfiguring";
  24.   open (REC_FLAG,"> $flag_file") or die "Could not open $flag_file for writing";
  25.   print REC_FLAG "We are reconfiguring the package...\n";
  26.   close REC_FLAG;
  27. }
  28.  
  29. # Trying to find a reasonable guess for default ispell dictionary and wordlist
  30. # from the debian-installer settings, envvars or pre-policy symlinks and the
  31. # list of ispell dictionaries and wordlists to be installed
  32.  
  33. $priority{"ispell"}   = "critical";
  34. $priority{"wordlist"} = "critical";
  35. $di_language          = "debian-installer/language";
  36. $di_country           = "debian-installer/country";
  37. $dcscript             = "/usr/share/dictionaries-common/dc-debconf-select.pl";
  38. $fromdcconfig         = "yes";
  39. $debug                = "yes" if exists $ENV{'DICT_COMMON_DEBUG'};
  40.  
  41.  
  42. my %debconf_vals = ();
  43. my @suffixes     = ("","-large","-medium","-small","-gut");
  44. my %equivs       = ("bg"      => "bulgarian",
  45.             "ca"      => "catalan",
  46.             "cs"      => "czech",
  47.             "da"      => "danish",
  48.             "de"      => "ngerman",
  49.             "de:1"    => "ogerman",
  50.             "de_CH"   => "swiss",
  51.             "en_US"   => "american",
  52.             "en_US:1" => "miscfiles",
  53.             "en_CA"   => "canadian",
  54.             "en_CA:1" => "american",
  55.             "en_GB"   => "british",
  56.             "en_AU"   => "british",
  57.             "eo"      => "esperanto",
  58.             "es"      => "spanish",
  59.             "fi"      => "finnish",
  60.             "fo"      => "faroese",
  61.             "fr"      => "french",
  62.             "ga"      => "irish",
  63.             "gd"      => "gaelic",
  64.             "gl"      => "galician-minimos",
  65.             "gv"      => "manx",
  66.             "hu"      => "hungarian",
  67.             "it"      => "italian",
  68.             "lt"      => "lithuanian",
  69.             "nb"      => "norwegian->bokmal",
  70.             "nl"      => "dutch",
  71.             "nn"      => "norwegian->nynorsk",
  72.             "pl"      => "polish",
  73.             "pt"      => "portuguese",
  74.             "pt_BR"   => "brazilian",
  75.             "ru"      => "russian",
  76.             "sv"      => "swedish",
  77.             "tl"      => "tagalog",
  78.             "uk"      => "ukrainian");
  79. my %pending_keys   = ();
  80. my %reverse_equivs = ();
  81. my %alternatives   = ("ispell"   => "ispell-dictionary.hash",
  82.               "wordlist" => "dictionary");
  83.  
  84. # -------------------------------------------------------------
  85. sub dc_debugprint(){
  86. # -------------------------------------------------------------
  87. # Show info if in debug mode
  88. # -------------------------------------------------------------
  89.   print STDERR "@_" if $debug;
  90. }
  91.  
  92. # -------------------------------------------------------------
  93. sub dc_set (){
  94. # -------------------------------------------------------------
  95. # Set debconf value unless already set
  96. # -------------------------------------------------------------
  97.   my $question  = shift;
  98.   my $value     = shift;
  99.   my $priority  = $priority{$class} || "";
  100.   
  101.   my ($errorcode, $oldvalue) = get($question);
  102.   
  103.   $oldvalue = "unset" unless $oldvalue;
  104.   
  105.   if ( $errorcode or $oldvalue eq "unset" ){
  106.     &dc_debugprint("  $question: errorcode: $errorcode; priority: $priority\n" .
  107.            "  Old:[$oldvalue] --> New:[$value]\n");
  108.     set("$question","$value");
  109.   } elsif ( $oldvalue eq $value ) {
  110.     print STDERR "Info: $question is already set to 
  111.       [$oldvalue]. Preserving it.\n";
  112.   } else {
  113.     print STDERR "Warning: $question is already set to 
  114.       [$oldvalue].
  115.       Not setting to [$value]\n";
  116.   }
  117.   
  118.   if ( $debug ){                 # --- Check if question value is actually set
  119.     ($errorcode, $oldvalue) = get($question);
  120.     if ( $errorcode ){
  121.       print STDERR "dictionaries-common: $question reading failed with $errorcode\n";
  122.     } elsif ( $oldvalue) {
  123.       print STDERR "dictionaries-common: $question actually set to [$oldvalue]\n";
  124.     } else {
  125.       print STDERR "dictionaries-common: $question value is void, bad thing\n";
  126.     }
  127.   }
  128.   &dc_debugprint ("Not tried: " . join(', ',sort keys %pending_keys) . "\n---\n");
  129. }
  130.  
  131. # -------------------------------------------------------------
  132. sub extractlangname (){
  133. # -------------------------------------------------------------
  134. # Look if a dict matching $langkey in %equivs is to be installed
  135. # and return the preferred language name if so.
  136. # -------------------------------------------------------------
  137.   my $langkey    = shift;
  138.   my $thestring  = '';
  139.   my $thepackage = '';
  140.   my $thevariant = '';
  141.   my @thevalues  = ();
  142.  
  143.   if ( exists $pending_keys{$langkey} ){ # Make sure we do not try it again
  144.     &dc_debugprint("Trying langkey $langkey\n");
  145.     delete $pending_keys{$langkey}; 
  146.   } else {   
  147.     if ( exists $equivs{$langkey} ){
  148.       # This $langkey was already tried, no need to try it again
  149.       &dc_debugprint("Already done langkey $langkey\n");
  150.     } else {
  151.       # This $langkey does not exist
  152.       &dc_debugprint("Non-existant langkey $langkey\n");
  153.     }
  154.     return; 
  155.   }
  156.   
  157.   if ( exists $equivs{$langkey} ){
  158.     ($thepackage,$thevariant) = split ("->",$equivs{$langkey}); 
  159.     foreach $suffix ( @suffixes ){
  160.       if ( $thepackage eq "miscfiles" ){
  161.     $pkgfullname = "$thepackage$suffix";
  162.       } else {
  163.     $pkgfullname = "$classprefix$thepackage$suffix";
  164.       }
  165.       &dc_debugprint(" Trying package $pkgfullname\n");
  166.       if ( exists $debconf_vals{"$pkgfullname"} ){
  167.     if ( exists $debconf_defaultvals{"$pkgfullname"} ){
  168.       $thestring = $debconf_defaultvals{"$pkgfullname"};
  169.     } else {
  170.       $thestring = $debconf_vals{"$pkgfullname"};
  171.     }
  172.     @thevalues = sort split (/\s*,\s*/,$thestring);
  173.     if ( $thevariant ){
  174.       @thevalues = grep {/$thevariant/i} @thevalues;
  175.     } 
  176.     @thevalues = sort { 
  177.       $a =~ m/tex/i <=> $b =~ m/tex/i # Sort tex variants last
  178.         || 
  179.       $a cmp $b } @thevalues;
  180.     if ( scalar @thevalues >= 1 ){
  181.       return "$thevalues[0]";
  182.     } else {
  183.       return;
  184.     }
  185.       }
  186.     }
  187.   }
  188. }
  189.  
  190. # -------------------------------------------------------------
  191. sub guesslang (){
  192. # -------------------------------------------------------------
  193. # Try different combinations of $language and $country and possible
  194. # fallbacks in case extractlangname() does not find a good guess
  195. # -------------------------------------------------------------
  196.   my $class     = shift;
  197.   my $language  = shift;
  198.   my $country   = shift;
  199.   my $guessed   = '';
  200.   my @possible_fallbacks = ();
  201.  
  202.   if ( $guessed = &extractlangname("$language" . "_" . uc($country))
  203.        || &extractlangname("$language" . "_" . uc("$country") . ":1")
  204.        || &extractlangname("$language")
  205.        || &extractlangname("$language:1")
  206.        ){ 
  207.     $priority{$class} = "low";
  208.     return $guessed;
  209.   } else {
  210.     @possible_fallbacks = grep {/$language\_/} sort keys %equivs;
  211.     $priority{$class} = "medium";
  212.     foreach ( @possible_fallbacks ){
  213.       return $guessed if ( $guessed = &extractlangname($_));
  214.     }
  215.     $priority{$class} = "high";
  216.     return;
  217.   }
  218. }
  219.  
  220. # -------------------------------------------------------------
  221. sub guessotherlang (){
  222. # -------------------------------------------------------------
  223. # Iterate over the not yet tried $langkey values for a dict to be
  224. # installed. Return first match
  225. # -------------------------------------------------------------
  226.   my $guessed = '';
  227.   
  228.   foreach ( sort keys %pending_keys ){
  229.     return $guessed if ( $guessed = &extractlangname($_));
  230.   }
  231. }
  232.  
  233. # -------------------------------------------------------------
  234. sub guesslang4link(){
  235. # -------------------------------------------------------------
  236. # Try guessing default value after (woody or older) former symlink
  237. # -------------------------------------------------------------
  238.   my $class      = shift;
  239.   my $prefix     = '';
  240.   my $guess      = '';
  241.   my $language   = '';
  242.   my $link       = "/etc/alternatives/$alternatives{$class}";
  243.   
  244.   return if not ( -l $link );
  245.   
  246.   if ( $guess = readlink($link) ){
  247.  
  248.     &dc_debugprint("Found link $guess. ");
  249.  
  250.     $guess =~ s/\.hash$//;
  251.     $guess =~ s/^.*\///;
  252.     $guess =~ s/(\-\.)(small|medium|large)$//;
  253.     $guess =~ s/\-english$//;
  254.     
  255.     $guess = "norwegian->bokmal"  if ($guess eq "bokmσl");
  256.     $guess = "norwegian->nynorsk" if ($guess eq "nynorsk");
  257.     $guess = "ogerman"            if ($guess eq "german");
  258.     $guess = "miscfiles"          if ($guess eq "web2");
  259.     $guess = "danish"             if ($guess eq "dansk");
  260.     $guess = "french"             if ($guess eq "francais");
  261.     $guess = "swedish"            if ($guess eq "svenska");
  262.  
  263.     &dc_debugprint("Fine tuned to $guess.\n");
  264.     
  265.     if ( exists $reverse_equivs{$guess} ){
  266.       $language = $reverse_equivs{$guess}; 
  267.     } else {
  268.       return;
  269.     }
  270.     return $guessed if ( $guessed = &extractlangname($language) );
  271.   } 
  272.   return;
  273. }
  274.  
  275. # -------------------------------------------------------------
  276. sub dc_manual_alternative (){
  277. # -------------------------------------------------------------
  278. # Check if woody (or older) alternative exists and is set to manual
  279. # -------------------------------------------------------------
  280.   my $class  = shift;
  281.   my $file   = "/var/lib/dpkg/alternatives/$alternatives{$class}";
  282.   my $status = '';
  283.  
  284.   if ( -r $file ){
  285.     open(FILE,"< $file") or return;
  286.     $status = <FILE>;
  287.     close FILE;
  288.     $status = "" unless $status;
  289.     chomp $status;
  290.     return "Manual (previous alternative setting)" if ( $status eq "manual" );
  291.   }
  292. }
  293.  
  294. # -------------------------------------------------------------
  295. sub dc_debconf_rebuild (){
  296. # -------------------------------------------------------------
  297. # Gather info from debconf for the (to be) installed packages for class
  298. #   %debconf_vals         : pkg -> languages provided by package
  299. #   %debconf_defaultvals  : pkg -> default language for package
  300. # -------------------------------------------------------------
  301.   my $class = shift;
  302.   return unless $class;
  303.   my $question = "shared/packages-$class";
  304.   my ($errorcode,$pkgowners) = metaget ($question, "owners");
  305.   return if $errorcode;
  306.   
  307.   %debconf_vals = ();
  308.   %debconf_defaultvals = ();
  309.   foreach ( split (/\s*,\s*/,$pkgowners) ){
  310.     #$debconf_vals{$_} = metaget ("$_/languages", "default");
  311.     $debconf_vals{$_} = get ("$_/languages");
  312.     my ($errorcode,$pkgdefaults) = get ("$_/defaults");
  313.     $debconf_defaultvals{$_} = $pkgdefaults if not $errorcode;
  314.   }
  315.   return "ok";
  316. }
  317.  
  318. # -----------------------------------------------------------------
  319.  
  320. &dc_debugprint("dictionaries-common: (re)configuring ...\n");
  321.  
  322. if ( not -e $dcscript ){
  323.   if ( -e "/etc/default/locale" ){
  324.     $language = $ENV{'LANG'} if exists $ENV{'LANG'};
  325.   }
  326.   &dc_debugprint("LANG is set to $language\n") if $language;
  327.   unless ( $language ){
  328.     ($errorcode,$language) = get($di_language);
  329.     $language = '' if $errorcode;
  330.     &dc_debugprint("Debconf gives language: $language\n") if $language;
  331.   }
  332.   unless  ( readlink ("/etc/alternatives/ispell-dictionary.hash") ||
  333.         readlink ("/etc/alternatives/dictionary")){
  334.     $language = $language ||
  335.     $ENV{'LANG'} ||
  336.     $ENV{'LC_MESSAGES'} ||
  337.     $ENV{'LC_ALL'} ||
  338.     '';
  339.   }
  340.   if ( $language ){                # Installing from scratch
  341.     $language = "en" if ( $language eq "C" );
  342.     # Deal with de_DE:de_DE@euro:de:en_GB.UTF-8:en like entries
  343.     $language = ( split(":",$language) )[0];
  344.     $language =~ s/[\.@].*$//;                # Remove variant and charset 
  345.     ($language,$country) = split("_",$language);
  346.     if ( not $country ){
  347.       ($errorcode,$country) = get($di_country);
  348.       if ( $errorcode or not $country ){
  349.     $country = "unset";
  350.       }
  351.     }
  352.     foreach $class ("ispell","wordlist"){
  353.       $classprefix = substr($class,0,1);
  354.       if ( &dc_debconf_rebuild($class) ){
  355.     %pending_keys = %equivs;
  356.     if ( $guessed = &guesslang($class,$language,$country) ){
  357.       &dc_debugprint("* Guessed [d-i]->($class,$language,$country)\n");
  358.       &dc_set("dictionaries-common/default-$class","$guessed");
  359.     } else {
  360.       if ( $guessed = &guesslang($class,"en","US")
  361.            || &guessotherlang ){
  362.         &dc_debugprint("*** Forcing [$guessed] for ($class,$language,$country) ***\n");
  363.         $priority{$class} = "medium";
  364.         &dc_set("dictionaries-common/default-$class","$guessed");
  365.         &dc_debugprint("** --- **\n");
  366.       } else {
  367.         &dc_debugprint("* Nothing found\n");
  368.         $priority{$class} = "critical";
  369.       }
  370.     }
  371.       }
  372.     }
  373.   } else {                  # Upgrading from woody or previous release
  374.     foreach ( keys %equivs ){
  375.       $reverse_equivs{$equivs{$_}} = $_;
  376.     }
  377.     &dc_debugprint("dictionaries-common: Trying pre-sarge symlinks\n");
  378.     foreach $class ("ispell","wordlist"){
  379.       $classprefix = substr($class,0,1);
  380.       if ( &dc_debconf_rebuild($class) ){
  381.     %pending_keys = %equivs;
  382.     if ( $guessed = &guesslang4link($class) ){
  383.       if ( &dc_manual_alternative($class) ){
  384.         &dc_debugprint("- $class was in manual mode. Setting critical priority\n");
  385.         $priority{$class} = "critical";
  386.       } else {
  387.         $priority{$class} = "low";
  388.         foreach ( keys %debconf_vals ){
  389.           my $oldpackage = $_;
  390.           next if ( $oldpackage eq "dictionaries-common" );
  391.           $oldpackage = "wenglish" if ( $oldpackage eq "wamerican" );
  392.           # critical priority if exists debconf entry without a
  393.           # previous package installed. This means that besides
  394.           # upgrading, new dicts are being installed.
  395.           if ( not -e "/var/lib/dpkg/info/$oldpackage.list" ){
  396.         $priority{$class} = "critical";
  397.         &dc_debugprint("* New dict [$oldpackage] is to be installed\n");
  398.         last;
  399.           }
  400.         }
  401.       }
  402.       &dc_set("dictionaries-common/default-$class","$guessed");
  403.     }
  404.       }
  405.     }
  406.   }
  407. }
  408.  
  409. # Unregistering no longer used dictionaries-common/languages and
  410. # dictionaries-common ownership of other two shared questions
  411.  
  412. unregister("dictionaries-common/languages");
  413. unregister("shared/packages-ispell");
  414. unregister("shared/packages-wordlist");
  415.  
  416. # Prompting the questions if required
  417.  
  418. if ( not -e $dcscript ){             # First dictionaries-common installation
  419.   foreach $class ("ispell","wordlist"){
  420.     &dc_debconf_select($class,$priority{$class}); 
  421.     # This might have been pre-seeded and question not asked.
  422.     # Make sure question is tagged as seen in this case 
  423.     if ( $priority{$class} ne "critical" ){
  424.       fset ("dictionaries-common/default-$class", "seen", "true");
  425.       go();
  426.     }
  427.   }
  428. } else {                              # Reconfiguring or upgrading
  429.   foreach $class ("ispell","wordlist"){
  430.     &dc_debconf_select($class);
  431.   }
  432. }
  433.  
  434. &dc_debugprint("dictionaries-common: (re)configuring ...Done.\n");
  435.  
  436. # Local Variables:
  437. # perl-indent-level: 2
  438. # coding: iso-8859-1
  439. # End:
  440.  
  441. # -------------------------------------------------------------------------------
  442. # dc-debconf-select.pl:
  443. #  This file will be added to end of dictionaries-common.config-base
  444. #  to make dictionaries-common.config, as well as installed under
  445. #  /usr/share/dictionaries-common for single ispell dicts /wordlists use
  446. # -------------------------------------------------------------------------------
  447.  
  448. sub dc_debconf_select (){
  449.   my $class      = shift;
  450.   my $priority   = shift;
  451.   my $question   = "shared/packages-$class";
  452.   my $debug      = "yes" if exists $ENV{'DICT_COMMON_DEBUG'};
  453.   my @newchoices = ();
  454.   my @oldchoices = ();
  455.   my %title      = ('ispell'   => "Dictionaries-common: Ispell dictionary",
  456.             'wordlist' => "Dictionaries-common: Wordlist dictionary"
  457.             );
  458.   
  459.   $priority = "medium" unless $priority;
  460.   
  461.   my ($errorcode,$pkgowners) = metaget ($question, "owners");
  462.   return if $errorcode;
  463.   
  464.   foreach (split (/\s*,\s*/, $pkgowners)){
  465.     my $entry = metaget ("$_/languages", "default");
  466.     for ( $entry ){ # trim leading/trailing whitespaces
  467.       s/^\s+//;
  468.       s/\s+$//;
  469.     }
  470.     push (@newchoices, split(/\s*,\s*/, $entry));
  471.   }
  472.   my $choices = join (', ', sort {lc $a cmp lc $b} @newchoices);
  473.   
  474.   $question = "dictionaries-common/default-$class";
  475.   @oldchoices = split(/\s*,\s*/,metaget ($question, "choices"));
  476.   pop @oldchoices;
  477.   my $oldchoices = join (', ', @oldchoices);
  478.   print STDERR "** dictionaries-common: $class, $priority, $question\n" .
  479.       "   new:[$choices]\n   old:[$oldchoices]\n" if $debug;
  480.   unless ( scalar @newchoices == 0 ) { 
  481.     if ( $choices ne $oldchoices ) {
  482.       subst ($question, "choices", $choices);
  483.       fset ($question, "seen", "false");
  484.     }   
  485.     input ($priority, $question);
  486.     title ($title{$class});
  487.     go ();
  488.   }
  489.   
  490.   # If called from dictionaries-common.config, check actual values in debug mode
  491.   if ( $debug && $fromdcconfig ){
  492.     print STDERR "** dictionaries-common.config: Checking some real values for $question\n";
  493.     print STDERR "   Real choices: " . metaget ($question, "choices") . "\n";
  494.     print STDERR "   Real value: "   . get ($question) . "\n";
  495.     print STDERR "---\n";
  496.   }
  497. }
  498.  
  499. # Local Variables:
  500. # perl-indent-level: 2
  501. # End:
  502.  
  503. 1;
  504.  
  505.