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/</</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';
update: changed Text::Ispell to Lingua::Ispell in narrative, thanks to Anonymonk comment below.
§ George Sherston | [reply] [Watch: Dir/Any] [d/l] |