home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / perl5 / Debian / DictionariesCommon.pm < prev   
Encoding:
Perl POD Document  |  2009-02-20  |  16.8 KB  |  579 lines
  1. #!/usr/bin/perl
  2.  
  3. package Debian::DictionariesCommon;
  4.  
  5. use base qw(Exporter);
  6. use Text::Iconv;
  7.  
  8. # List all exported symbols here.
  9. our @EXPORT_OK = qw(parseinfo updatedb loaddb
  10.             dico_checkroot
  11.             dc_get_spellchecker_params
  12.             getlibdir getsysdefault setsysdefault
  13.             getuserdefault setuserdefault
  14.             build_emacsen_support
  15.             build_jed_support
  16.             build_squirrelmail_support
  17.             );
  18. # Import :all to get everything.
  19. our %EXPORT_TAGS = (all => [@EXPORT_OK]);
  20.  
  21. my $infodir             = "/var/lib/dictionaries-common";
  22. my $cachedir            = "/var/cache/dictionaries-common";
  23. my $ispelldefault       = "ispell-default";
  24. my $sysdefault          = "/etc/dictionaries-common/$ispelldefault";
  25. my $userdefault         = "$ENV{HOME}/.$ispelldefault";
  26. my $emacsensupport      = "emacsen-ispell-dicts.el";
  27. my $jedsupport          = "jed-ispell-dicts.sl";
  28. my $squirrelmailsupport = "sqspell.php";
  29.  
  30. sub dico_checkroot {
  31.   return if ($> == 0 or ($^O eq 'interix' and $> == 197108));
  32.   die "$0: You must run this as root.\n";
  33. }
  34.  
  35. sub getlibdir {
  36.   my $class = shift;
  37.   return "$infodir/$class";
  38. }
  39.  
  40. sub mydie {
  41.   my $routine = shift;
  42.   my $errmsg = shift;
  43.   die __PACKAGE__, "($routine):E: $errmsg";
  44. }
  45.  
  46. sub parseinfo {
  47.   my $file = shift;
  48.   local $/ = "";    # IRS is global, we need 'local' here, not 'my'
  49.   open (DICT, "< $file");
  50.   my %dictionaries =
  51.     map {
  52.       s/^([^:]+):/lc ($1) . ":"/meg;  # Lower case field names
  53.       my %hash = /^([^:]+):\s*((?<!\n)[^\n]+)\s*$/mg;
  54.       map { delete $hash{$_} if ($hash{$_} =~ /^\s+$/) } keys %hash;
  55.       mydie ('parseinfo',
  56.          qq{Record in file $file does not have a "Language" entry})
  57.     if not exists $hash{language};
  58.       mydie ('parseinfo',
  59.          qq{Record in file $file does not have a "Hash-Name" entry})
  60.     if not exists $hash{"hash-name"};
  61.       my $lang = delete $hash{language};
  62.       ($lang, \%hash);
  63.     } <DICT>;
  64.   return \%dictionaries;
  65. }
  66.  
  67. # ------------------------------------------------------------------
  68. sub dc_dumpdb {
  69. # ------------------------------------------------------------------
  70. # Save %dictionaries in Data::Dumper like format. This function
  71. # should be enough for the limited needs of dictionaries-common
  72. # ------------------------------------------------------------------
  73.   my $class        = shift;
  74.   my $dictionaries = shift;
  75.   my @fullarray    = ();
  76.   my @dictarray    = ();
  77.   my $output       = "$cachedir/$class.db";
  78.   my $dictentries  = '';
  79.   my $thevalue     = '';
  80.  
  81.   foreach $thedict ( sort keys %{$dictionaries}){
  82.     $dictentries = $dictionaries->{$thedict};
  83.     @dictarray   = ();
  84.     foreach $thekey ( sort keys %{$dictentries}){
  85.       $thevalue = $dictentries->{$thekey};
  86.       # Make sure \ and ' are escaped in keyvals
  87.       $thevalue =~ s/(\\|\')/\\$1/g;
  88.       push (@dictarray,"     \'$thekey\' => \'$thevalue\'");
  89.     }
  90.     # Make sure \ and ' are escaped in dict names
  91.     $thedict =~ s/(\\|\')/\\$1/g;
  92.     push (@fullarray,
  93.       "  \'$thedict\' => \{\n" . join(",\n",@dictarray) . "\n  \}");
  94.   }
  95.  
  96.   mkdir $cachedir unless (-d $cachedir);
  97.  
  98.   open (DB,"> $output");
  99.   print DB generate_comment("### ") . "\n";
  100.   print DB "%dictionaries = (\n";
  101.   print DB join (",\n",@fullarray);
  102.   print DB "\n);\n\n1;\n";
  103.   close DB;
  104. }
  105.  
  106. # ------------------------------------------------------------------
  107. sub dc_get_spellchecker_params {
  108. # ------------------------------------------------------------------
  109. # dc_get_spellchecker_params($class,\%language)
  110. #  Get right params for $class (currently unused) and $language
  111. # ------------------------------------------------------------------
  112.   my $class       = shift;
  113.   my $language    = shift;
  114.   my $d_option    = "";
  115.   my $w_option    = "";
  116.   my $T_option    = "";
  117.   my $ispell_args = "";
  118.  
  119.   $d_option = "-d $language->{'hash-name'}"
  120.       if exists $language->{'hash-name'};
  121.   $w_option = "-w $language->{'additionalchars'}"
  122.       if exists $language->{'additionalchars'};
  123.  
  124.   if ( exists $language->{'extended-character-mode'} ){
  125.     $T_option =  $language->{'extended-character-mode'};
  126.     $T_option =~ s/^~//; # Strip leading ~ from Extended-Character-Mode.
  127.     $T_option =  '-T ' . $T_option;
  128.   }
  129.  
  130.   if ( exists $language->{'ispell-args'} ){
  131.     $ispell_args = $language->{'ispell-args'};
  132.     foreach ( split('\s+',$ispell_args) ) {
  133.       # No d_option if already in $ispell_args
  134.       $d_option = "" if /^\-d/;
  135.     }
  136.   }
  137.   return "$d_option $w_option $T_option $ispell_args";
  138. }
  139.  
  140. # ------------------------------------------------------------------
  141. sub updatedb {
  142. # ------------------------------------------------------------------
  143. # Parse info files for the given class and update class database
  144. # ------------------------------------------------------------------
  145.   my $class        = shift;
  146.   my %dictionaries = ();
  147.  
  148.   foreach my $file (<$infodir/$class/*>) {
  149.     next if $file =~ m/.*~$/;                 # Ignore ~ backup files
  150.     my $dicts = &parseinfo ("$file");
  151.     %dictionaries = (%dictionaries, %$dicts);
  152.   }
  153.   &dc_dumpdb($class,\%dictionaries);
  154. }
  155.  
  156. sub loaddb {
  157.   my $class  = shift;
  158.   my $dbfile = "$cachedir/$class.db";
  159.   if (-e $dbfile) {
  160.     do $dbfile;
  161.   }
  162.   return \%dictionaries;
  163. }
  164.  
  165. sub getdefault {
  166.   $file = shift;
  167.   if (-f $file) {
  168.     my $lang = `cat $file`;
  169.     chomp $lang;
  170.     return $lang;
  171.   }
  172.   else {
  173.     return undef;
  174.   }
  175. }
  176.  
  177. sub getuserdefault {
  178.   getdefault ($userdefault);
  179. }
  180.  
  181. sub getsysdefault {
  182.   getdefault ($sysdefault);
  183. }
  184.  
  185. sub setsysdefault {
  186.   $value = shift;
  187.   open (DEFAULT, "> $sysdefault");
  188.   print DEFAULT $value;
  189.   close DEFAULT;
  190. }
  191.  
  192. sub setuserdefault {
  193.   my $default      = getuserdefault ();
  194.   my $dictionaries = loaddb ("ispell");
  195.   my @choices      = sort keys %$dictionaries;
  196.  
  197.   if (scalar @choices == 0) {
  198.     warn "Sorry, no ispell dictionary is installed in your system.\n";
  199.     return;
  200.   }
  201.  
  202.   my $initial = -1;
  203.   if (defined $default) {
  204.     for (my $i = 0; $i < scalar @choices; $i++) {
  205.       if ($default eq $choices[$i]) {
  206.     $initial = $i;
  207.     last;
  208.       }
  209.     }
  210.   }
  211.  
  212.   open (TTY, "/dev/tty");
  213.   while (1) {
  214.     $| = 1;
  215.     print
  216.       "\nSelect your personal ispell dictionary for use with ispell-wrapper\n\n";
  217.     for ($i = 0; $i < scalar @choices; $i++) {
  218.       print "  " . ($i == $initial ? "*" : " ")
  219.          . " [" . ($i+1) . "] $choices[$i]\n";
  220.     }
  221.     print qq(\nSelect number or "q" for quit)
  222.       . ($initial != -1 ? " (* is the current default): " : ": ");
  223.     my $sel = <TTY>;
  224.     chomp $sel;
  225.     last if $sel eq "q";
  226.     if ($sel < 1 or $sel > scalar @choices) {
  227.       print qq{\nInvalid choice "$sel".\n\n};
  228.       next;
  229.     }
  230.     else {
  231.       $sel--;
  232.       open (DEFAULT, "> $userdefault");
  233.       print DEFAULT $choices[$sel];
  234.       close DEFAULT;
  235.       last;
  236.     }
  237.   }
  238.   close TTY;
  239. }
  240.  
  241. sub generate_comment {
  242.   my $commstr = shift;
  243.   my $comment = "This file is part of the dictionaries-common package.
  244. It has been automatically generated.
  245. DO NOT EDIT!";
  246.   $comment =~ s{^}{$commstr}mg;
  247.   return "$comment\n";
  248. }
  249.  
  250. # ------------------------------------------------------------------
  251. sub build_emacsen_support {
  252. # ------------------------------------------------------------------
  253. # Put info from dicts info files into emacsen-ispell-dicts.el
  254. # ------------------------------------------------------------------
  255.   my $elisp          = '';
  256.   my @classes        = ("aspell","hunspell","ispell");
  257.   my %entries        = ();
  258.   my %class_locales  = ();
  259.  
  260.   foreach $class ( @classes ){
  261.     my $dictionaries = loaddb ($class);
  262.  
  263.     foreach $k (keys %$dictionaries) {
  264.       my $lang = $dictionaries->{$k};
  265.  
  266.       next if (exists $lang->{'emacs-display'}
  267.            && $lang->{'emacs-display'} eq "no");
  268.  
  269.       my $hashname = $lang->{"hash-name"};
  270.       my $casechars = exists $lang->{casechars} ?
  271.       $lang->{casechars} : "[a-zA-Z]";
  272.       my $notcasechars = exists $lang->{"not-casechars"} ?
  273.       $lang->{"not-casechars"} : "[^a-zA-Z]";
  274.       my $otherchars = exists $lang->{otherchars} ?
  275.       $lang->{otherchars} : "[']";
  276.       my $manyothercharsp = exists $lang->{"many-otherchars"} ?
  277.       ($lang->{"many-otherchars"} eq "yes" ? "t" : "nil") : "nil";
  278.       my $ispellargs = exists $lang->{"ispell-args"} ?
  279.       ('("' . join ('" "', split (/\s+/, $lang->{"ispell-args"}))
  280.        . '")') : (qq/("-d" "/ . $lang->{"hash-name"} . qq/")/) ;
  281.       my $extendedcharactermode = exists $lang->{"extended-character-mode"} ?
  282.       ('"' . $lang->{"extended-character-mode"} . '"') : "nil";
  283.       my $codingsystem = exists $lang->{"coding-system"} ?
  284.       $lang->{"coding-system"} : "nil";
  285.       my $emacsenname = exists $lang->{"emacsen-name"} ?
  286.       $lang->{"emacsen-name"} : $hashname;
  287.  
  288.       $entries{$class}{$emacsenname} = $entries{'all'}{$emacsenname} =
  289.       ['"' . $emacsenname  . '"',
  290.        '"' . $casechars    . '"',
  291.        '"' . $notcasechars . '"',
  292.        '"' . $otherchars   . '"',
  293.        $manyothercharsp,
  294.        $ispellargs,
  295.        $extendedcharactermode,
  296.        $codingsystem];
  297.  
  298.       if ( $class eq "aspell" && exists $lang->{"aspell-locales"} ){
  299.     foreach ( split(/\s*,\s*/,$lang->{"aspell-locales"}) ){
  300.       $class_locales{"aspell"}{$_} = $emacsenname;
  301.     }
  302.       } elsif ( $class eq "hunspell" && exists $lang->{"hunspell-locales"} ){
  303.     foreach ( split(/\s*,\s*/,$lang->{"hunspell-locales"}) ){
  304.       $class_locales{"hunspell"}{$_} = $emacsenname;
  305.     }
  306.       }
  307.     }
  308.   }
  309.  
  310.   # Write alists of ispell, hunspell and aspell only installed dicts and their properties
  311.  
  312.   foreach $class ( @classes ) {
  313.     my @class_dicts = reverse sort keys %{ $entries{$class} };
  314.     if ( scalar @class_dicts ){
  315.       $elisp .= "\n;; Adding $class dicts\n\n";
  316.       foreach ( @class_dicts ){
  317.     my $mystring = join ("\n     ",@{ $entries{$class}{$_} });
  318.     $elisp .= "(add-to-list \'debian-$class-only-dictionary-alist\n  \'($mystring))\n";
  319.       }
  320.       $elisp .= "\n";
  321.     }
  322.   }
  323.  
  324.   # Write a list of locales associated to each emacsen name
  325.  
  326.   foreach my $class ("aspell", "hunspell"){
  327.     my $tmp_locales = $class_locales{$class};
  328.     if ( defined $tmp_locales && scalar %$tmp_locales ){
  329.       $elisp .= "\n\n;; An alist that will try to map $class locales to emacsen names";
  330.       $elisp .= "\n\n(setq debian-$class-equivs-alist \'(\n";
  331.       foreach ( sort keys %$tmp_locales ){
  332.     $elisp .= "     (\"$_\" \"$tmp_locales->{$_}\")\n";
  333.       }
  334.       $elisp .= "))\n";
  335.  
  336.       # Obtain here debian-aspell-dictionary, after debian-aspell-equivs-alist
  337.       # is loaded
  338.  
  339.       $elisp .="
  340. ;; Get default value for debian-$class-dictionary. Will be used if
  341. ;; spellchecker is $class and ispell-local-dictionary is not set.
  342. ;; We need to get it here, after debian-$class-equivs-alist is loaded
  343.  
  344. (setq debian-$class-dictionary (debian-ispell-get-$class-default))\n\n";
  345.    } else {
  346.       $elisp .= "\n\n;; No emacsen-$class-equivs entries were found\n";
  347.    }}
  348.  
  349.   open (ELISP, "> $cachedir/$emacsensupport")
  350.       or die "Cannot open emacsen cache file";
  351.   print ELISP generate_comment (";;; ");
  352.   print ELISP $elisp;
  353.   close ELISP;
  354. }
  355.  
  356. # ------------------------------------------------------------------
  357. sub build_jed_support {
  358. # ------------------------------------------------------------------
  359. # Put info from dicts info files into jed-ispell-dicts.sl
  360. # ------------------------------------------------------------------
  361.  
  362.   my @classes = ("aspell","ispell");
  363.   my $slang   = generate_comment ("%%% ");
  364.  
  365.   ## The S-Lang code generated below will be wrapped in preprocessor
  366.   ## ifexists constructs, insuring that the $jedsupport file will
  367.   ## always evaluate correctly.
  368.  
  369.   foreach $class ( @classes ){
  370.     my %class_slang    = ();
  371.     my %class_slang_u8 = ();
  372.     if ( my $dictionaries = loaddb ($class) ){
  373.       foreach $k (sort keys %$dictionaries) {
  374.     my $lang = $dictionaries->{$k};
  375.     next if (exists $lang->{'jed-display'}
  376.          && $lang->{'jed-display'} eq "no");
  377.  
  378.     my $hashname = $lang->{"hash-name"};
  379.     my $additionalchars = exists $lang->{additionalchars} ?
  380.         $lang->{additionalchars} : "";
  381.     my $otherchars = exists $lang->{otherchars} ?
  382.         $lang->{otherchars} : "'";
  383.     my $emacsenname = exists $lang->{"emacsen-name"} ?
  384.         $lang->{"emacsen-name"} : $hashname;
  385.     my $extendedcharmode = exists $lang->{"extended-character-mode"} ?
  386.         $lang->{"extended-character-mode"} : "";
  387.     my $ispellargs = exists $lang->{"ispell-args"} ?
  388.         $lang->{"ispell-args"} : "";
  389.     my $codingsystem = exists $lang->{"coding-system"} ?
  390.         $lang->{"coding-system"} : "l1";
  391.  
  392.     # Strip enclosing [] from $otherchars
  393.     $otherchars =~ s/^\[//;
  394.     $otherchars =~ s/\]$//;
  395.     # Convert chars in octal \xxx representation to the character
  396.     $otherchars =~ s/\\([0-3][0-7][0-7])/chr(oct($1))/ge;
  397.     $additionalchars =~ s/\\([0-3][0-7][0-7])/chr(oct($1))/ge;
  398.  
  399.     $class_slang{$emacsenname} =
  400.         "  $class" . "_add_dictionary (\n"
  401.         . "    \"$emacsenname\",\n"
  402.         . "    \"$hashname\",\n"
  403.         . "    \"$additionalchars\",\n"
  404.         . "    \"$otherchars\",\n"
  405.         . ($class eq "ispell" ? "    \"$extendedcharmode\",\n" : "")
  406.         . "    \"$ispellargs\");";
  407.     if ( $class eq "aspell" ){
  408.       my $converter = Text::Iconv->new ($codingsystem, "utf8");
  409.       my $additionalchars_utf = $converter->convert ($additionalchars);
  410.       my $otherchars_utf = $converter->convert ($otherchars);
  411.       $class_slang_u8{$emacsenname} =
  412.           qq{    aspell_add_dictionary (
  413.       "$emacsenname",
  414.       "$hashname",
  415.       "$additionalchars_utf",
  416.       "$otherchars_utf",
  417.       "$ispellargs");};
  418.     } # if $class ..
  419.       } # foreach $k ..
  420.     } # if loaddb ..
  421.     if ( scalar keys %class_slang ){
  422.       $slang .= "\n\#ifexists $class" . "_add_dictionary\n";
  423.       if ( $class eq "aspell" ){
  424.     $slang .= "  if (_slang_utf8_ok) {\n"
  425.         . join("\n",sort values %class_slang_u8)
  426.         . "\n  } else {\n"
  427.         . join("\n",sort values %class_slang)
  428.         . "\n  }";
  429.       } else {
  430.     $slang .= join("\n",sort values %class_slang);
  431.       }
  432.       $slang .= "\n\#endif\n";
  433.     }
  434.   } # foreach $class
  435.   open (SLANG, "> $cachedir/$jedsupport")
  436.       or die "Cannot open jed cache file";
  437.   print SLANG $slang;
  438.   close SLANG;
  439. }
  440.  
  441. # ------------------------------------------------------------------
  442. sub build_squirrelmail_support {
  443. # ------------------------------------------------------------------
  444. # Build support file for squirrelmail with a list of available
  445. # dictionaries and associated spellchecker calls, in php format.
  446. # ------------------------------------------------------------------
  447.   my @classes      = ("aspell","ispell","hunspell");
  448.   my $php          = "<?php\n";
  449.   my @dictlist     = ();
  450.  
  451.   $php .= generate_comment ("### ");
  452.   $php .= "\$SQSPELL_APP = array (\n";
  453.  
  454.   foreach my $class (@classes) {
  455.     my $dictionaries = loaddb ($class);
  456.     foreach ( keys %$dictionaries ){
  457.       next if m/.*[^a-z]tex[^a-z]/i;            # Discard tex variants
  458.       my $lang = $dictionaries->{$_};
  459.       my $squirrelname;
  460.       if ( defined $lang->{"squirrelmail"} ){
  461.     next if ( lc($lang->{"squirrelmail"}) eq "no" );
  462.     $squirrelname = $lang->{"squirrelmail"};
  463.       } else {
  464.     next unless m/^(.*)\((.+)\)$/;
  465.     $squirrelname = $2;
  466.       }
  467.       my $spellchecker_params =
  468.     &dc_get_spellchecker_params($class,$lang);
  469.       push @dictlist, qq {  '$squirrelname ($class)' => '$class -a $spellchecker_params'};
  470.     }
  471.   }
  472.  
  473.   $php .= join(",\n", sort @dictlist);
  474.   $php .= "\n);\n";
  475.  
  476.   open (PHP, "> $cachedir/$squirrelmailsupport")
  477.       or die "Cannot open SquirrelMail cache file";
  478.   print PHP $php;
  479.   close PHP;
  480. }
  481.  
  482. # Ensure we evaluate to true.
  483. 1;
  484.  
  485. __END__
  486.  
  487. #Local Variables:
  488. #perl-indent-level: 2
  489. #End:
  490.  
  491. =head1 NAME
  492.  
  493. Debian::DictionariesCommon.pm - dictionaries-common library
  494.  
  495. =head1 SYNOPSIS
  496.  
  497.     use Debian::DictionariesCommon q(:all)
  498.     $dictionaries = parseinfo ('/var/lib/dictionaries-common/ispell/iwolof');
  499.     loaddb ('ispell')
  500.     updatedb ('wordlist')
  501.  
  502. =head1 DESCRIPTION
  503.  
  504. Common functions for use from the dictionaries-common system.
  505.  
  506. =head1 CALLING FUNCTIONS
  507.  
  508. =over
  509.  
  510. =item C<dico_checkroot>
  511.  
  512. Check for rootness and fail if not.
  513.  
  514. =item C<build_emacsen_support>
  515.  
  516. Put info from dicts info files into emacsen-ispell-dicts.el
  517.  
  518. =item C<build_jed_support>
  519.  
  520. Put info from dicts info files into jed-ispell-dicts.sl
  521.  
  522. =item C<build_squirrelmail_support>
  523.  
  524. Build support file for squirrelmail with a list of available
  525. dictionaries and associated spellchecker calls, in php format.
  526.  
  527. =item C<$libdir = getlibdir($class)>
  528.  
  529. Return info dir for given class.
  530.  
  531. =item C<$default = getsysdefault>
  532.  
  533. Return value for system default ispell dictionary.
  534.  
  535. =item C<$libdir = getuserdefault>
  536.  
  537. Return value for user default ispell dictionary.
  538.  
  539. =item C<dc_get_spellchecker_params($class,\%language)>
  540.  
  541. Get right params for $class (currently unused) and $language
  542.  
  543. =item C<\%dictionaries = loaddb($class)>
  544.  
  545. Read class .db file and return a reference to a hash
  546. with its contents.
  547.  
  548. =item C<\%result = parseinfo($file)>
  549.  
  550. Parse given info file and return a reference to a hash with
  551. the relevant data.
  552.  
  553. =item C<setsysdefault($value)>
  554.  
  555. Set value for system default ispell dictionary.
  556.  
  557. =item C<setuserdefault>
  558.  
  559. Set value for user default ispell dictionary, after asking
  560. to select it from the available values.
  561.  
  562. =item C<updatedb($class)>
  563.  
  564. Parse info files for given class and update class .db
  565. file under dictionaries-common cache dir.
  566.  
  567. =back
  568.  
  569. =head1 SEE ALSO
  570.  
  571. Debian dictionaries-common policy.
  572.  
  573. =head1 AUTHORS
  574.  
  575.  Rafael Laboissiere
  576.  Agustin Martin
  577.  
  578. =cut
  579.