Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number
 
PerlMonks  

Re: Spell Checkers - Text::Ispell : What I Did

by George_Sherston (Vicar)
on Jul 25, 2002 at 23:43 UTC ( [id://185381]=note: print w/replies, xml ) Need Help??


in reply to Spell Checkers - Text::Ispell

Confident that I was now barking up the right tree I wrote a package of functions that integrates into the content management system. These let me get the text of a page from the d.b. where it lives, identifying it by its ID number, and then sends a list of questionable words to the browser window. Then, when the user's changes are submitted, it does the updating and saving. I found Lingua::Ispell very easy to work with; a Data::Dump of the info it returns shows how intuitive it all is - it gives me the info I need, and even gives it intelligible names. And Ispell itself seems pretty smart too. The below doesn't have much documentation yet, and is still clunky in places, but might be useful if somebody wants to see a real-world implementation. 

package Client::Spell;
require Exporter;
@ISA = ("Exporter");

use strict;
use lib '/home/httpd/lib';

use CGI qw/:standard :cgi-lib/;
use Main;
use Data::Dumper;
use Lingua::Ispell qw( :all );
use Cooke::Shared;
use dev;

$Lingua::Ispell::path = '/usr/bin/ispell';
use_dictionary('/lib/Client/british.multi');
my %g = Vars;
my $tagnames = '!--|A|ABBR|ACRONYM|ADDRESS|APPLET|AREA|B|BASE|BASEFONT
+|BDO|BIG|BLOCKQUOTE|BODY|BR|BUTTON|CAPTION|CENTER|CITE|CODE|COL|COLGR
+OUP|DD|DEL|DFN|DIR|DIV|DL|DT|EM|FIELDSET|FONT|FORM|FRAME|FRAMESET|H1|
+H2|H3|H4|H5|H6|HEAD|HR|HTML|I|IFRAME|IMG|INPUT|INS|ISINDEX|KBD|LABEL|
+LEGEND|LI|LINK|MAP|MENU|META|NOFRAMES|NOSCRIPT|OBJECT|OL|OPTGROUP|OPT
+ION|P|PARAM|PRE|Q|S|SAMP|SCRIPT|SELECT|SMALL|SPAN|STRIKE|STRONG|STYLE
+|SUB|SUP|TABLE|TBODY|TD|TEXTAREA|TFOOT|TH|THEAD|TITLE|TR|TT|U|UL|VAR'
+;


sub
DoSubstitutions
{

    my $Text = shift;
    my $Words = shift;

    my %Offsets;

    for (sort {$a <=> $b} keys %$Words) {
        my $Offset = 0;
        if (defined $Offsets{$Words->{$_}->{Key}}{$Words->{$_}->{Index
+}}) {
            $Offset = $Offsets{$Words->{$_}->{Key}}{$Words->{$_}->{Ind
+ex}};
        }
        substr
            $Text->{$Words->{$_}->{Key}}->[$Words->{$_}->{Index}]->{Te
+xt},
            $Words->{$_}->{Offset} - 1 + $Offset,
            length($Words->{$_}->{Word}),
            $Words->{$_}->{Alt};

        $Offset += (length($Words->{$_}->{Alt}) - length($Words->{$_}-
+>{Word}));
        $Offsets{$Words->{$_}->{Key}}{$Words->{$_}->{Index}} = $Offset
+;
    }
    for my $key (keys %$Text) {
        my @temp = @{$Text->{$key}};
        $Text->{$key} = '';
        for (@temp) {
            $Text->{$key} .= $_->{Tag};
            $Text->{$key} .= $_->{Text};
        }
    }

    return $Text;
}


sub
PutResultsInDB
{
    my $dbh = shift;
    my $ID = shift;
    my $Text = shift;

    my $ref = FetchStar($dbh,'test','ID',$ID);
    for (keys %$Text) {
        $ref->{$_} = $Text->{$_};
    }

    ReplaceMultipleValues($dbh,'test',$ref);
}


sub
RetrieveText
{
    my $FileName = shift;

    open GET, "tempfiles/$FileName" or die;
    my $b;
    read GET, $b, -s(GET);
    my %Text = %{my $VAR1; eval($b)};
    close GET;
    unlink "tempfiles/$FileName" or die;

    return \%Text;
}


sub
SaveText
{
    my $Text = shift;
    my $FileName = shift;

    while (1) {
        $FileName = int rand 1000000;
        last unless stat "tempfiles/$FileName";
    }

    open SAVE, ">tempfiles/$FileName";
    print SAVE Dumper $Text;

    return $FileName;
}


sub
GetText
{
    my $dbh = shift;
    my $ID = shift;

    my $sth = $dbh->prepare("SELECT Header,ShortHeader,MainText,Specia
+lText FROM test WHERE ID = ?");
    $sth->execute($ID);
    my $Text = $sth->fetchrow_hashref;

    for (keys %$Text) {
        $Text->{$_} = NormaliseText($Text->{$_});
    }

    return $Text;
}


sub
NormaliseText
{
    my $Text = shift || '';

    $Text =~ s/\n/ /ig;
    $Text =~ s/\s{2,}/ /ig;
    my @Text;
    if ($Text !~ /<(:$tagnames)/i) {
        push @Text, {
            Tag => '',
            Text => $Text,
        };
    }
    elsif ($Text =~ s/^([^><]+?)(<(:$tagnames))/$2/i) {
        push @Text, {
            Tag => '',
            Text => $1,
        };
    }
#    while ($Text =~ s/\s*(<\/*)($tagnames)\b([^>]*?>)\s*(.*?)(<\/*)($
+tagnames)/$5$6/i) {
    while ($Text =~ s/(<\/*)($tagnames)\b([^>]*?>)(.*?)(<\/*)($tagname
+s)/$5$6/i) {
        push @Text, {
            Tag => "$1$2$3",
            Text => $4,
        };
    my $str = $Text;
    $str =~ s/</&lt;/g;
    }
    if ($Text =~ /(<\/*)($tagnames)\b([^>]*?>)(.*)$/i) {
        push @Text, {
            Tag => "$1$2$3",
            Text => $4,
        };
    }
    return \@Text;
}


sub
CheckAndSendResults
{
    my $Text = shift;
    my $ID = shift;
    my $FileName = shift;

    my $offset = 20;

    print
        header,
        start_html(
               -style => {
                -src => 'style/management.css',
               },
            -title => 'Content Management Pages',
        ),
        startform,
        hidden(
            -name => 'FileName',
            -value => $FileName,
        ),
        hidden(
            -name => 'ID',
            -value => $ID,
        ),
        h1('Spell Check');

    my $sp = 0;
    my $c = 'FFFFFF';
    for my $Key (keys %$Text) {
        my $Index = 0;
        for my $string (@{$Text->{$Key}}) {
            $string->{Text} =~ s/\s*\n+\s*/ /g;
            for my $r (spellcheck($string->{Text})) {
                PrintStartCheck() unless $sp;
                $sp ++;
                $c = $c eq 'CCCCFF' ? 'FFFFFF' : 'CCCCFF';
                my $L = substr(
                    $string->{Text},
                    $r->{offset} > $offset ? 
                        $r->{offset} - $offset :
                        0,
                    $r->{offset} > $offset ?
                        $offset - 1 :
                        $r->{offset} - 1,
                );
                $L =~ s/^\S+? (.* .*)/$1/;
                my $R = substr(
                    $string->{Text},
                    $r->{offset} + length($r->{term}) - 1,
                    length($string->{Text}) > $r->{offset} + length($r
+->{term}) + $offset - 1 ?
                        $offset :
                        length($string->{Text}) - ($r->{offset} + leng
+th($r->{term}) - 1)
                );
                $R =~ s/(.* .*) \S+?$/$1/;
                my @Words = ($r->{term});
                if (defined @{$r->{misses}}) {
                    push @Words, @{$r->{misses}};
                }
                if (defined @{$r->{guesses}}) {
                    push @Words, @{$r->{guesses}};
                }
                my $last = @Words;
                push @Words, 'other (enter word): '; 
                print
                    '<TR VALIGN="TOP">',
                    '<TD WIDTH=200 BGCOLOR="#',
                    $c,
                    '" CLASS="L">',
                    ($L ? '... ' : '') . "$L <B>$r->{'term'}</B> $R" .
+ ($R ? ' ...' : ''),
                    '</TD><TD WIDTH=500 BGCOLOR="#',
                    $c,
                    '" CLASS="N">',
                    hidden(
                        -name => "Word_$sp",
                        -value => $r->{term},
                    ),                
                    hidden(
                        -name => "Key_$sp",
                        -value => $Key,
                    ),                
                    hidden(
                        -name => "Index_$sp",
                        -value => $Index,
                    ),                
                    hidden(
                        -name => "Offset_$sp",
                        -value => $r->{offset},
                    ),                
                    radio_group(
                        -name => "Alt_$sp",
                        -values => \@Words,
                    ),
                    textfield(
                        -name => "New_$sp",
                        -size => 10,
                        -onfocus => 'document.forms[0].Alt_' . $sp . '
+[' . $last . '].checked=1',
                    ),
                    '</TD></TR>';
            }
            $Index ++;
        }
    }
    if ($sp) {
        PrintEndCheck();
    }
    else {
        print
            h2('No mis-spelt words were found!'),
            p('<a href="index.pl">Click here to return to the main pag
+e</a>');
    }
    print
        endform,
        end_html;
}


sub
ProcessAlternatives
{
    my $g = shift;
    my $Text = shift;

    my %Words;

    for (keys %g) {
        if (/^(\w+)_(\d+)$/) {
            $Words{$2}{$1} = $g->{$_};
        }
    }

    for (keys %Words) {
        if ($Words{$_}{Alt} eq $Words{$_}{Word}) {
            add_word($Words{$_}{Word}) or die "cd not add";
        }
        else {
            if ($Words{$_}{Alt} eq 'other (enter word): ') {
                add_word($Words{$_}{New}) or die "cd not add";
                $Words{$_}{Alt} = $Words{$_}{New};
            }
        }
    }

    save_dictionary();

    return \%Words;
}


sub
PrintStartCheck
{
    print <<END;
<TABLE CELLPADDING=5 CELLSPACING=0 BORDER=0>
    <TR>
        <TD COLSPAN="2" CLASS="L">
            <h2>Here are the results of the spell check:</h2>
            For each 'questionable' word, please select from the list 
+of alternatives the word you wish to use, then click on 'Submit Spell
+ings'.
        </TD>
    </TR>
    <TR>
        <TD COLSPAN="2" WIDTH="700" ALIGN="RIGHT">
            <INPUT TYPE="SUBMIT" NAME="Action" VALUE="Submit Spellings
+" CLASS="button">
        </TD>
    </TR>
    <TR>
        <TD WIDTH="200" CLASS="L">
            <I>Questionable Word</I>,
        </TD>
        <TD WIDTH="500" CLASS="L">
            <I>Alternatives</I>
        </TD>
    </TR>
END
}


sub
PrintEndCheck
{
    print <<END;
        </TD>
    </TR>
    <TR>
        <TD COLSPAN="2" WIDTH="700" ALIGN="RIGHT">
            <BR><BR>
            <INPUT TYPE="SUBMIT" NAME="Action" VALUE="Submit Spellings
+" CLASS="button">
        </TD>
    </TR>
</TABLE>
END
}

no strict;
@EXPORT = qw/
    GetText
    SaveText
    CheckAndSendResults
    RetrieveText
    ProcessAlternatives
    DoSubstitutions
    PutResultsInDB
/;

'jbr me fecit jul mmii';

[download]


update: changed Text::Ispell to Lingua::Ispell in narrative, thanks to Anonymonk comment below.

§ George Sherston

Replies are listed 'Best First'.
Re: Re: Spell Checkers - Text::Ispell : What I Did
by Anonymous Monk on Aug 01, 2002 at 20:11 UTC
    I notice that you again refer to Text::Ispell in your narrative, even though you use Lingua::Ispell in the code.

    I hope people can remember to use only Lingua::Ispell rather than Text::Ispell, which is horribly obsolete.

    Btw - thanks for the kind words about Lingua::Ispell.

[reply]

In Section Seekers of Perl Wisdom

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?

www.com | www.net | www.org
Node Status?
node history
Node Type: note [id://185381]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? • Last hour • Other CB clients
Other Users?
Others scrutinizing the Monastery: (5)
As of 2024-04-19 12:35 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found