| Server IP : 79.136.114.73 / Your IP : 3.17.81.34 Web Server : Apache/2.4.7 (Ubuntu) PHP/5.5.9-1ubuntu4.29 OpenSSL/1.0.1f System : Linux b8009 3.13.0-170-generic #220-Ubuntu SMP Thu May 9 12:40:49 UTC 2019 x86_64 User : www-data ( 33) PHP Version : 5.5.9-1ubuntu4.29 Disable Function : pcntl_alarm,pcntl_fork,pcntl_waitpid,pcntl_wait,pcntl_wifexited,pcntl_wifstopped,pcntl_wifsignaled,pcntl_wexitstatus,pcntl_wtermsig,pcntl_wstopsig,pcntl_signal,pcntl_signal_dispatch,pcntl_get_last_error,pcntl_strerror,pcntl_sigprocmask,pcntl_sigwaitinfo,pcntl_sigtimedwait,pcntl_exec,pcntl_getpriority,pcntl_setpriority, MySQL : ON | cURL : ON | WGET : ON | Perl : ON | Python : ON | Sudo : ON | Pkexec : ON Directory : /usr/share/perl5/Debian/ |
Upload File : |
#!/usr/bin/perl
package Debian::DictionariesCommon;
use strict;
use base qw(Exporter);
use Text::Iconv;
# List all exported symbols here.
our @EXPORT_OK = qw(parseinfo updatedb loaddb
dico_checkroot
dico_debugprint
dico_get_spellchecker_params
getlibdir
dico_getsysdefault dico_setsysdefault
getuserdefault setuserdefault
build_emacsen_support
build_jed_support
build_squirrelmail_support
dico_activate_trigger
dico_set_default_symlink
);
# Import :all to get everything.
our %EXPORT_TAGS = (all => [@EXPORT_OK]);
my $infodir = "/var/lib/dictionaries-common";
my $cachedir = "/var/cache/dictionaries-common";
my $sys_default_dir = "/etc/dictionaries-common";
my $ispelldefault = "ispell-default";
my $userdefault = ( defined $ENV{HOME} ) ? "$ENV{HOME}/.$ispelldefault" : undef;
my $emacsensupport = "emacsen-ispell-dicts.el";
my $jedsupport = "jed-ispell-dicts.sl";
my $squirrelmailsupport = "sqspell.php";
my $debug = 1 if ( defined $ENV{'DICT_COMMON_DEBUG'} );
my %sys_default_file = ("ispell" => "$sys_default_dir/ispell-default",
"wordlist" => "$sys_default_dir/wordlist-default");
# ------------------------------------------------------------------
sub dico_checkroot {
# ------------------------------------------------------------------
# Check if we are root
# ------------------------------------------------------------------
return if ($> == 0 or ($^O eq 'interix' and $> == 197108));
die "$0: You must run this as root.\n";
}
# -------------------------------------------------------------
sub dico_debugprint {
# -------------------------------------------------------------
# Show info if in debug mode
# -------------------------------------------------------------
print STDERR "@_\n" if $debug;
}
# ------------------------------------------------------------------
sub getlibdir {
# ------------------------------------------------------------------
# Get location for dict-common info snippets
# ------------------------------------------------------------------
my $class = shift;
return "$infodir/$class";
}
# ------------------------------------------------------------------
sub mydie {
# ------------------------------------------------------------------
# A wrapper to die with some local flavor.
# ------------------------------------------------------------------
my $routine = shift;
my $errmsg = shift;
die __PACKAGE__, "($routine):E: $errmsg";
}
# ------------------------------------------------------------------
sub parseinfo {
# ------------------------------------------------------------------
# Parse given dict-common info file
# ------------------------------------------------------------------
my $file = shift;
local $/ = ""; # IRS is global, we need 'local' here, not 'my'
open (DICT, "< $file");
my %dictionaries =
map {
s/^([^:]+):/lc ($1) . ":"/meg; # Lower case field names
my %hash = /^([^:]+):\s*((?<!\n)[^\n]+)\s*$/mg;
map { delete $hash{$_} if ($hash{$_} =~ /^\s+$/) } keys %hash;
mydie ('parseinfo',
qq{Record in file $file does not have a "Language" entry})
if not exists $hash{language};
mydie ('parseinfo',
qq{Record in file $file does not have a "Hash-Name" entry})
if not exists $hash{"hash-name"};
my $lang = delete $hash{language};
($lang, \%hash);
} <DICT>;
return \%dictionaries;
}
# ------------------------------------------------------------------
sub dico_dumpdb {
# ------------------------------------------------------------------
# Save %dictionaries in Data::Dumper like format. This function
# should be enough for the limited needs of dictionaries-common
# ------------------------------------------------------------------
my $class = shift;
my $dictionaries = shift;
my @fullarray = ();
my @dictarray = ();
my $output = "$cachedir/$class.db";
my $dictentries = '';
my $thevalue = '';
foreach my $thedict ( sort keys %{$dictionaries}){
$dictentries = $dictionaries->{$thedict};
@dictarray = ();
foreach my $thekey ( sort keys %{$dictentries}){
$thevalue = $dictentries->{$thekey};
# Make sure \ and ' are escaped in keyvals
$thevalue =~ s/(\\|\')/\\$1/g;
push (@dictarray," \'$thekey\' => \'$thevalue\'");
}
# Make sure \ and ' are escaped in dict names
$thedict =~ s/(\\|\')/\\$1/g;
push (@fullarray,
" \'$thedict\' => \{\n" . join(",\n",@dictarray) . "\n \}");
}
mkdir $cachedir unless (-d $cachedir);
open (DB,"> $output");
print DB generate_comment("### ") . "\n";
print DB "package Debian::DictionariesCommon::dbfile;\n\n";
print DB "%dictionaries = (\n";
print DB join (",\n",@fullarray);
print DB "\n);\n\n1;\n";
close DB;
}
# ------------------------------------------------------------------
sub dico_get_spellchecker_params {
# ------------------------------------------------------------------
# dico_get_spellchecker_params($class,\%language)
# Get right params for $class (currently unused) and $language
# ------------------------------------------------------------------
my $class = shift;
my $language = shift;
my $d_option = "";
my $w_option = "";
my $T_option = "";
my $ispell_args = "";
$d_option = "-d $language->{'hash-name'}"
if exists $language->{'hash-name'};
$w_option = "-w $language->{'additionalchars'}"
if exists $language->{'additionalchars'};
if ( exists $language->{'extended-character-mode'} ){
$T_option = $language->{'extended-character-mode'};
$T_option =~ s/^~//; # Strip leading ~ from Extended-Character-Mode.
$T_option = '-T ' . $T_option;
}
if ( exists $language->{'ispell-args'} ){
$ispell_args = $language->{'ispell-args'};
foreach ( split('\s+',$ispell_args) ) {
# No d_option if already in $ispell_args
$d_option = "" if /^\-d/;
}
}
return "$d_option $w_option $T_option $ispell_args";
}
# ------------------------------------------------------------------
sub updatedb {
# ------------------------------------------------------------------
# Parse info files for the given class and update class database
# ------------------------------------------------------------------
my $class = shift;
my %dictionaries = ();
foreach my $file (<$infodir/$class/*>) {
next if $file =~ m/.*~$/; # Ignore ~ backup files
my $dicts = &parseinfo ("$file");
%dictionaries = (%dictionaries, %$dicts);
}
&dico_dumpdb($class,\%dictionaries);
}
# ------------------------------------------------------------------
sub loaddb {
# ------------------------------------------------------------------
# Load class database
# ------------------------------------------------------------------
my $class = shift;
my $dbfile = "$cachedir/$class.db";
if (-e $dbfile) {
do $dbfile;
}
return \%Debian::DictionariesCommon::dbfile::dictionaries;
}
# ------------------------------------------------------------------
sub getdefault {
# ------------------------------------------------------------------
# Read default value from specified file. Comments and empty lines are ignored.
# ------------------------------------------------------------------
my $file = shift;
my $lang;
if (-f $file) {
open( my $FILE,"< $file")
or die "Dictionaries-common::getdefault: Could not open $file for read. Aborting ...\n";
while (<$FILE>){
next if m/^\s*\#/;
next if m/^\s*$/;
$lang = $_;
last;
}
close $FILE;
}
return $lang;
}
# ------------------------------------------------------------------
sub getuserdefault {
# ------------------------------------------------------------------
# Get user default from user's default file
# ------------------------------------------------------------------
die "Dictionaries-common::getuserdefault: Could not set \$userdefault. Aborting ...\n"
unless $userdefault;
getdefault ($userdefault);
}
# ------------------------------------------------------------------
sub dico_getsysdefault {
# ------------------------------------------------------------------
# Get system default value for given class
# ------------------------------------------------------------------
my $class = shift;
getdefault ($sys_default_file{$class});
}
# ------------------------------------------------------------------
sub dico_setsysdefault {
# ------------------------------------------------------------------
# Set system default value for given class
# ------------------------------------------------------------------
my $class = shift;
my $value = shift;
open (DEFAULT, "> $sys_default_file{$class}");
print DEFAULT $value;
close DEFAULT;
}
# ------------------------------------------------------------------
sub setuserdefault {
# ------------------------------------------------------------------
# Write user's default value to user's default file
# ------------------------------------------------------------------
my $default = getuserdefault ();
my $dictionaries = loaddb ("ispell");
my %languages = ();
my %elanguages = ();
foreach my $language ( sort keys %$dictionaries ){
my $entry = $dictionaries->{$language};
my $elanguage = $language;
if ( defined $entry->{'elanguage'} ){
$elanguage = $entry->{'elanguage'};
}
$languages{$elanguage} = $language;
$elanguages{$language} = $elanguage;
}
unless ( %languages ) {
warn "Sorry, no ispell dictionary is installed in your system.\n";
return;
}
my @choices = sort keys %languages;
my $initial = -1;
if ( defined $default ) {
my $default = $elanguages{$default};
for ( my $i = 0; $i < scalar @choices; $i++ ) {
if ( $default eq $choices[$i] ) {
$initial = $i;
last;
}
}
}
open (TTY, "/dev/tty");
while (1) {
$| = 1;
print
"\nSelect your personal ispell dictionary for use with ispell-wrapper\n\n";
for ( my $i = 0; $i < scalar @choices; $i++ ) {
print " " . ($i == $initial ? "*" : " ")
. " [" . ($i+1) . "] $choices[$i]\n";
}
print qq(\nSelect number or "q" for quit)
. ($initial != -1 ? " (* is the current default): " : ": ");
my $sel = <TTY>;
chomp $sel;
last if $sel eq "q";
if ($sel < 1 or $sel > scalar @choices) {
print qq{\nInvalid choice "$sel".\n\n};
next;
}
else {
$sel--;
open (DEFAULT, "> $userdefault");
print DEFAULT $languages{$choices[$sel]};
close DEFAULT;
last;
}
}
close TTY;
}
# ------------------------------------------------------------------
sub generate_comment {
# ------------------------------------------------------------------
# Generate a standard comment string with given prefix
# ------------------------------------------------------------------
my $commstr = shift;
my $comment = "This file is part of the dictionaries-common package.
It has been automatically generated.
DO NOT EDIT!";
$comment =~ s{^}{$commstr}mg;
return "$comment\n";
}
# ------------------------------------------------------------------
sub build_emacsen_support {
# ------------------------------------------------------------------
# Put info from dicts info files into emacsen-ispell-dicts.el
# ------------------------------------------------------------------
my $elisp = '';
my @classes = ("aspell","hunspell","ispell");
my %entries = ();
my %class_locales = ();
foreach my $class ( @classes ){
my $dictionaries = loaddb ($class);
foreach my $k (keys %$dictionaries) {
my $lang = $dictionaries->{$k};
next if (exists $lang->{'emacs-display'}
&& $lang->{'emacs-display'} eq "no");
my $hashname = $lang->{"hash-name"};
my $casechars = exists $lang->{casechars} ?
$lang->{casechars} : "[a-zA-Z]";
my $notcasechars = exists $lang->{"not-casechars"} ?
$lang->{"not-casechars"} : "[^a-zA-Z]";
my $otherchars = exists $lang->{otherchars} ?
$lang->{otherchars} : "[']";
my $manyothercharsp = exists $lang->{"many-otherchars"} ?
($lang->{"many-otherchars"} eq "yes" ? "t" : "nil") : "nil";
my $ispellargs = exists $lang->{"ispell-args"} ?
$lang->{"ispell-args"} : "-d $hashname";
my $extendedcharactermode = exists $lang->{"extended-character-mode"} ?
('"' . $lang->{"extended-character-mode"} . '"') : "nil";
my $codingsystem = exists $lang->{"coding-system"} ?
$lang->{"coding-system"} : "nil";
my $emacsenname = exists $lang->{"emacsen-name"} ?
$lang->{"emacsen-name"} : $hashname;
# Explicitly add " -d $hashname" to $ispellargs if not already there.
# Note that this must check for "-dxx", "-d xx", "-C -d xx", "-C -dxx" like matches
if ( $ispellargs !~ m/( |^)-d/ ){
dico_debugprint(" - $class-emacsen: Adding \" -d $hashname\" to \"$ispellargs\"");
$ispellargs .= " -d $hashname";
}
$entries{$class}{$emacsenname} = $entries{'all'}{$emacsenname} =
['"' . $emacsenname . '"',
'"' . $casechars . '"',
'"' . $notcasechars . '"',
'"' . $otherchars . '"',
$manyothercharsp,
'("' . join ('" "', split (/\s+/,$ispellargs)) . '")',
$extendedcharactermode,
$codingsystem];
if ( $class eq "aspell" && exists $lang->{"aspell-locales"} ){
foreach ( split(/\s*,\s*/,$lang->{"aspell-locales"}) ){
$class_locales{"aspell"}{$_} = $emacsenname;
}
} elsif ( $class eq "hunspell" && exists $lang->{"hunspell-locales"} ){
foreach ( split(/\s*,\s*/,$lang->{"hunspell-locales"}) ){
$class_locales{"hunspell"}{$_} = $emacsenname;
}
}
}
}
# Write alists of ispell, hunspell and aspell only installed dicts and their properties
foreach my $class ( @classes ) {
my @class_dicts = reverse sort keys %{ $entries{$class} };
if ( scalar @class_dicts ){
$elisp .= "\n;; Adding $class dicts\n\n";
foreach ( @class_dicts ){
my $mystring = join ("\n ",@{ $entries{$class}{$_} });
$elisp .= "(add-to-list \'debian-$class-only-dictionary-alist\n \'($mystring))\n";
}
$elisp .= "\n";
}
}
# Write a list of locales associated to each emacsen name
foreach my $class ("aspell", "hunspell"){
my $tmp_locales = $class_locales{$class};
if ( defined $tmp_locales && scalar %$tmp_locales ){
$elisp .= "\n\n;; An alist that will try to map $class locales to emacsen names";
$elisp .= "\n\n(setq debian-$class-equivs-alist \'(\n";
foreach ( sort keys %$tmp_locales ){
$elisp .= " (\"$_\" \"$tmp_locales->{$_}\")\n";
}
$elisp .= "))\n";
# Obtain here debian-aspell-dictionary, after debian-aspell-equivs-alist
# is loaded
$elisp .="
;; Get default value for debian-$class-dictionary. Will be used if
;; spellchecker is $class and ispell-local-dictionary is not set.
;; We need to get it here, after debian-$class-equivs-alist is loaded
(setq debian-$class-dictionary (debian-ispell-get-$class-default))\n\n";
} else {
$elisp .= "\n\n;; No emacsen-$class-equivs entries were found\n";
}}
open (ELISP, "> $cachedir/$emacsensupport")
or die "Cannot open emacsen cache file";
print ELISP generate_comment (";;; ");
print ELISP $elisp;
close ELISP;
}
# ------------------------------------------------------------------
sub build_jed_support {
# ------------------------------------------------------------------
# Put info from dicts info files into jed-ispell-dicts.sl
# ------------------------------------------------------------------
my @classes = ("aspell","ispell");
my $slang = generate_comment ("%%% ");
## The S-Lang code generated below will be wrapped in preprocessor
## ifexists constructs, insuring that the $jedsupport file will
## always evaluate correctly.
foreach my $class ( @classes ){
my %class_slang = ();
my %class_slang_u8 = ();
if ( my $dictionaries = loaddb ($class) ){
foreach my $k (sort keys %$dictionaries) {
my $lang = $dictionaries->{$k};
next if (exists $lang->{'jed-display'}
&& $lang->{'jed-display'} eq "no");
my $hashname = $lang->{"hash-name"};
my $additionalchars = exists $lang->{additionalchars} ?
$lang->{additionalchars} : "";
my $otherchars = exists $lang->{otherchars} ?
$lang->{otherchars} : "'";
my $emacsenname = exists $lang->{"emacsen-name"} ?
$lang->{"emacsen-name"} : $hashname;
my $extendedcharmode = exists $lang->{"extended-character-mode"} ?
$lang->{"extended-character-mode"} : "";
my $ispellargs = exists $lang->{"ispell-args"} ?
$lang->{"ispell-args"} : "";
my $codingsystem = exists $lang->{"coding-system"} ?
$lang->{"coding-system"} : "l1";
# Strip enclosing [] from $otherchars
$otherchars =~ s/^\[//;
$otherchars =~ s/\]$//;
# Convert chars in octal \xxx representation to the character
$otherchars =~ s/\\([0-3][0-7][0-7])/chr(oct($1))/ge;
$additionalchars =~ s/\\([0-3][0-7][0-7])/chr(oct($1))/ge;
$class_slang{$emacsenname} =
" $class" . "_add_dictionary (\n"
. " \"$emacsenname\",\n"
. " \"$hashname\",\n"
. " \"$additionalchars\",\n"
. " \"$otherchars\",\n"
. ($class eq "ispell" ? " \"$extendedcharmode\",\n" : "")
. " \"$ispellargs\");";
if ( $class eq "aspell" ){
my $converter = Text::Iconv->new ($codingsystem, "utf8");
my $additionalchars_utf = $converter->convert ($additionalchars);
my $otherchars_utf = $converter->convert ($otherchars);
$class_slang_u8{$emacsenname} =
qq{ aspell_add_dictionary (
"$emacsenname",
"$hashname",
"$additionalchars_utf",
"$otherchars_utf",
"$ispellargs");};
} # if $class ..
} # foreach $k ..
} # if loaddb ..
if ( scalar keys %class_slang ){
$slang .= "\n\#ifexists $class" . "_add_dictionary\n";
if ( $class eq "aspell" ){
$slang .= " if (_slang_utf8_ok) {\n"
. join("\n",sort values %class_slang_u8)
. "\n } else {\n"
. join("\n",sort values %class_slang)
. "\n }";
} else {
$slang .= join("\n",sort values %class_slang);
}
$slang .= "\n\#endif\n";
}
} # foreach $class
open (SLANG, "> $cachedir/$jedsupport")
or die "Cannot open jed cache file";
print SLANG $slang;
close SLANG;
}
# ------------------------------------------------------------------
sub build_squirrelmail_support {
# ------------------------------------------------------------------
# Build support file for squirrelmail with a list of available
# dictionaries and associated spellchecker calls, in php format.
# ------------------------------------------------------------------
my @classes = ("aspell","ispell","hunspell");
my $php = "<?php\n";
my @dictlist = ();
$php .= generate_comment ("### ");
$php .= "\$SQSPELL_APP = array (\n";
foreach my $class (@classes) {
my $dictionaries = loaddb ($class);
foreach ( keys %$dictionaries ){
next if m/.*[^a-z]tex[^a-z]/i; # Discard tex variants
my $lang = $dictionaries->{$_};
my $squirrelname;
if ( defined $lang->{"squirrelmail"} ){
next if ( lc($lang->{"squirrelmail"}) eq "no" );
$squirrelname = $lang->{"squirrelmail"};
} else {
next unless m/^(.*)\((.+)\)$/;
$squirrelname = $2;
}
my $spellchecker_params =
&dico_get_spellchecker_params($class,$lang);
push @dictlist, qq { '$squirrelname ($class)' => '$class -a $spellchecker_params'};
}
}
$php .= join(",\n", sort @dictlist);
$php .= "\n);\n";
open (PHP, "> $cachedir/$squirrelmailsupport")
or die "Cannot open SquirrelMail cache file";
print PHP $php;
close PHP;
}
# ------------------------------------------------------------------
sub dico_activate_trigger {
# ------------------------------------------------------------------
# Try activating provided trigger if run under dpkg control.
# Return true in success, nil otherwise.
# ------------------------------------------------------------------
my $trigger = shift;
die "DictionariesCommon::dico_activate_trigger: No trigger provided. Aborting ...\n" unless $trigger;
if ( defined $ENV{'DPKG_RUNNING_VERSION'} &&
system("type dpkg-trigger >/dev/null 2>&1 && dpkg-trigger $trigger") == 0 ){
dico_debugprint("DictionariesCommon::dico_activate_trigger: Enabled trigger \"$trigger\"");
return 1;
}
return;
}
# ------------------------------------------------------------------
sub dico_set_default_symlink {
# ------------------------------------------------------------------
# Try setting default symlinks for ispell dictionaries and wordlists.
# dico_set_default_symlink($class,$value)
# ------------------------------------------------------------------
my $class = shift;
die "DictionariesCommon::dico_set_default_symlink: No class passed" unless $class;
my $value = shift;
die "DictionariesCommon::dico_set_default_symlink: No value passed" unless $value;
my $dictionaries = loaddb ($class);
my $program = "update-default-$class";
my $linkdir = "/etc/dictionaries-common";
my $class_name = { 'ispell' => "ispell dictionary",
'wordlist' => "wordlist"};
my $libdir = { 'ispell' => "/usr/lib/ispell",
'wordlist' => "/usr/share/dict"};
my $link_suffixes = { 'ispell' => [".hash", ".aff"],
'wordlist' => [""]};
my $link_basename = { 'ispell' => "default",
'wordlist' => "words"};
if ( defined $dictionaries->{$value}{"hash-name"} ){
dico_debugprint("update-default-$class: \"$value\" -> \"$dictionaries->{$value}{'hash-name'}\"");
my $hash = "$libdir->{$class}/" . $dictionaries->{$value}{"hash-name"};
foreach my $i ( @{$link_suffixes->{$class}}) {
my $link_to = "$hash$i";
if ( -e "$link_to" ) {
my $link_from = "$linkdir/$link_basename->{$class}$i";
system "ln -fs $link_to $link_from";
dico_debugprint("$program: \"$link_from\" symlink set to \"$link_to\"");
} else {
die "$program:
Could not make the default symlink to \"$link_to\".
This may be a temporary problem due to installation ordering. If that
file is not present after installation, please file a bugreport
against $class_name->{$class} package owning that file.
\n";
}
}
} else {
die "$program: Selected value \"$value\" for $class_name->{$class}\n" .
"does not contain a hash name entry in the database.\n";
}
}
# Ensure we evaluate to true.
1;
__END__
#Local Variables:
#perl-indent-level: 2
#End:
=head1 NAME
Debian::DictionariesCommon.pm - dictionaries-common library
=head1 SYNOPSIS
use Debian::DictionariesCommon q(:all)
$dictionaries = parseinfo ('/var/lib/dictionaries-common/ispell/iwolof');
loaddb ('ispell')
updatedb ('wordlist')
=head1 DESCRIPTION
Common functions for use from the dictionaries-common system.
=head1 CALLING FUNCTIONS
=over
=item C<dico_checkroot>
Check for rootness and fail if not.
=item C<build_emacsen_support>
Put info from dicts info files into emacsen-ispell-dicts.el
=item C<build_jed_support>
Put info from dicts info files into jed-ispell-dicts.sl
=item C<build_squirrelmail_support>
Build support file for squirrelmail with a list of available
dictionaries and associated spellchecker calls, in php format.
=item C<$libdir = getlibdir($class)>
Return info dir for given class.
=item C<$default = dico_getsysdefault($class)>
Return system default value for given class.
=item C<$libdir = getuserdefault>
Return value for user default ispell dictionary.
=item C<dico_get_spellchecker_params($class,\%language)>
Get right params for $class (currently unused) and $language
=item C<\%dictionaries = loaddb($class)>
Read class .db file and return a reference to a hash
with its contents.
=item C<\%result = parseinfo($file)>
Parse given info file and return a reference to a hash with
the relevant data.
=item C<setsysdefault($value)>
Set value for system default ispell dictionary.
=item C<setuserdefault>
Set value for user default ispell dictionary, after asking
to select it from the available values.
=item C<updatedb($class)>
Parse info files for given class and update class .db
file under dictionaries-common cache dir.
=back
=head1 SEE ALSO
Debian dictionaries-common policy.
=head1 AUTHORS
Rafael Laboissiere
Agustin Martin
=cut