File:  [LON-CAPA] / loncom / interface / spellcheck.pm
Revision 1.4: download - view: text, annotated - select for diffs
Mon Sep 10 09:51:06 2012 UTC (12 years, 3 months ago) by foxr
Branches: MAIN
CVS tags: version_2_12_X, version_2_11_X, version_2_11_5_msu, version_2_11_5, version_2_11_4_uiuc, version_2_11_4_msu, version_2_11_4, version_2_11_3_uiuc, version_2_11_3_msu, version_2_11_3, version_2_11_2_uiuc, version_2_11_2_msu, version_2_11_2_educog, version_2_11_2, version_2_11_1, version_2_11_0_RC3, version_2_11_0_RC2, version_2_11_0_RC1, version_2_11_0, HEAD
bz838 - add spellchecking to <input type='text'> and <textarea>

# The LearningOnline Network
# Printout
#
# $Id: spellcheck.pm,v 1.4 2012/09/10 09:51:06 foxr Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# /home/httpd/html/adm/gpl.txt
# http://www.lon-capa.org/
#
#
package Apache::spellcheck;
use CGI qw(:standard);
use Apache::Constants qw(:common);
use strict;
use Text::Aspell;

#------------------------------------------------------
#
# array_to_json - Take a Perl array of strings and convert
#                 it to JSON representation.  Note that
#                 this could be done with the JSON package
#                 but in this application context it's just
#                 too trivial to bother.
# @param values - reference to an array.
#
# @return string - the JSON for the array.
#
sub array_to_json {
    my $array_ref = shift;
    my @array     = @$array_ref;

    # surround each array element in double quotes.
    # ..and convert into a comma separated string:

    for (my $i = 0; $i < scalar(@array); $i++) {
	$array[$i] = '"' . $array[$i] . '"';
    }
    my $array_guts = join(', ', @array);
    return '[' . $array_guts . ']';
}

#--------------------------------------------------------
#
# spell_check -  Check the spellings of a set of white-space
#                separated words.  Output is a JSON array
#                of the mis-spelled words.
#
#
#  @param words - the words to check.
#  @param lang  - The language in which to run the spell checker.
#
#  @return - The JSON array to print.
#
sub spell_check {
    my ($words, $lang) = @_;
    
    my $checker = Text::Aspell->new;
    $checker->set_option('lang', $lang);

    #  Turn the words into an array:

    my @word_list = split(/\+/, $words);

    my @mis_spelled;
    foreach my $word (@word_list) {
	if (!$checker->check($word)) {
	    push (@mis_spelled, $word);
	}
    }
    return &array_to_json(\@mis_spelled);
}
#-------------------------------------------------------
#
# suggest spellings for a mis-spelled word.
# 
# @param word - The mis-spelled word.
# @param lang - The language in which to suggest.
#
# @return the JSON to output.
#
sub suggest_spellings {
    my ($word, $lang) = @_;
    my $checker = Text::Aspell->new;
    $checker->set_option('lang', $lang);

    my @suggestions = $checker->suggest($word);

    return &array_to_json(\@suggestions);
}
#--------------------------------------------------------
#
#  Handler.  We are given some query parameters that tell us
#  what to do.  Specifically:
#    lang = The spellcheck language
#    The Data is the text to check with no punctuation.
#    we must respond with Json of the miss-spelled words.
#    if the data is of the form suggest='word' we must
#    return suggested spellings for "word"
#    as a Json array.

sub handler {
    my $r = shift;
    my $raw_params;

    if ($r->method eq 'POST') {
	$raw_params = $r->content();
    } else {
	$raw_params = $r->args();
    }


    my $query = CGI->new($raw_params);

    # Figure out the language defaulting to english.

    my $language = "en-US";
    if ($query->param('lang')) {
	$language = $query->param('lang');
    }
    #  Regardless, response Content type: is application/json:

    $r->content_type( 'application/json');
    $r->send_http_header;

    # Whether we are suggesting or spell checking
    # depends on which of the suggest or text args are present:


    my $data;

    if ($query->param('text')) {
	$data =  &spell_check($query->param('text'), $language);
    } elsif ($query->param('suggest')) {
	$data = &suggest_spellings($query->param('suggest'), $language);
    } else {
	$data = "[]";		# We seem to get this from time to time.
    }
    $r->print($data);

    return OK;
}

    1;
__END__

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>