version 1.1089, 2012/08/07 09:25:39
|
version 1.1090, 2012/08/07 10:52:17
|
Line 3015 sub get_related_words {
|
Line 3015 sub get_related_words {
|
untie %thesaurus_db; |
untie %thesaurus_db; |
return @Words; |
return @Words; |
} |
} |
|
############################################################### |
|
# |
|
# Spell checking |
|
# |
|
|
|
=pod |
|
|
|
=head1 Spell checking |
|
|
|
=over 4 |
|
|
|
=item * &check_spelling($wordlist $language) |
|
|
|
Takes a string containing words and feeds it to an external |
|
spellcheck program via a pipeline. Returns a string containing |
|
them mis-spelled words. |
|
|
|
Parameters: |
|
|
|
=over 4 |
|
|
|
=item - $wordlist |
|
|
|
String that will be fed into the spellcheck program. |
|
|
|
=item - $language |
|
|
|
Language string that specifies the language for which the spell |
|
check will be performed. |
|
|
|
=back |
|
|
|
=back |
|
|
|
Note: This sub assumes that aspell is installed. |
|
|
|
|
|
=cut |
|
|
|
|
=pod |
=pod |
|
|
Line 3022 sub get_related_words {
|
Line 3061 sub get_related_words {
|
|
|
=cut |
=cut |
|
|
|
sub check_spelling { |
|
my ($wordlist, $language) = @_; |
|
|
|
# Format the command. If $language is null then |
|
# don't request a language - Note that's dangerous |
|
# because there's no assurance the server is running the intended default |
|
# language. |
|
|
|
my $langswitch = ''; |
|
if ($language) { |
|
$langswitch = "--lang=$language"; |
|
} |
|
|
|
my $aspell_command = "aspell -a $language"; |
|
my $full_command = "echo $wordlist | $aspell_command"; |
|
|
|
my $ispell_result = `$full_command`; |
|
|
|
# The result is several lines of text. |
|
# the first line will start with @(#). Other wise |
|
# There's an error. With an error our fallback is to declare |
|
# all the words are correctly spelled (return empty string). |
|
|
|
my @misspellings; |
|
my @lines = split(/\n/, $ispell_result); |
|
my $heading = shift(@lines); # header |
|
if ($heading =~ /^\@\(#\) /) { |
|
foreach my $word (split(/\s+/, $wordlist)) { |
|
my $spellok = pop(@lines); |
|
if (!($spellok =~ /^\*/)) { |
|
push(@misspellings, $word); |
|
} |
|
} |
|
return join(' ', (@misspellings)); # empty if all words ok. |
|
} else { |
|
return ""; |
|
} |
|
} |
|
|
# -------------------------------------------------------------- Plaintext name |
# -------------------------------------------------------------- Plaintext name |
=pod |
=pod |
|
|