comment on

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

In reply to Re: Spell Checkers - Text::Ispell : What I Did by George_Sherston
in thread Spell Checkers - Text::Ispell by George_Sherston

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		`&`
	<		`<`
	>		`>`
	[		`[`
	]		`]`

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.