# -*- Mode: perl; tab-width: 4; indent-tabs-mode: nil; -*- ################################ # Spell Checker Module # ################################ package BotModules::Spell; use vars qw(@ISA); @ISA = qw(BotModules); 1; # XXX Ideally we should move to using www.dict.org sub Help { my $self = shift; my ($event) = @_; return { '' => 'This module checks for spelling errors.', 'sp' => 'If you aren\'t sure of the spelling of a word, append \'(sp)\' to the word, and it will be checked for you. '. 'For example: \'My speling (sp?) is awful!\'' }; } sub Told { my $self = shift; my ($event, $message) = @_; $self->checkSpelling($event, $message); return $self->SUPER::Heard(@_); } sub Heard { my $self = shift; my ($event, $text) = @_; $self->checkSpelling($event, $text); return $self->SUPER::Heard(@_); } sub checkSpelling { my $self = shift; my ($event, $text) = @_; while ($text =~ s/^.*? # take everything up to the first word to check \b # look for a word break (\w+) # take the word to spell \s* # look for whitespace following it \(sp\??\) # followed by (sp) or (sp?) //isox) { # and remove everything up to here so we can do another check in a minute my $word = $1; # XXX escape $word $self->getURI($event, "http://www.m-w.com/cgi-bin/dictionary?va=$word", 'word', $1); # XXX should be configurable! } } sub GotURI { my $self = shift; my ($event, $query, $result, $command, $word) = @_; if ($command ne 'word') { return $self->SUPER::GorURI(@_); } else { my $reply; # Determine if page is error or not if (!length($result)) { $self->debug("Waah, failed utterly to get a response for '$word' from the dictionary server."); $reply = "The dictionary service is not accessible right now, sorry."; } elsif ($result =~ / # Match The\ word\ you've\ entered\ # literal string isn't\ in\ the\ dictionary\. # (not very smart), .*? # anything (non-greedy),
                         # PRE tag,
                       (.*?)                         # our suggestions,
                       <\/PRE>                       # PRE tag
                       /osx
                 # XXX this is hardcoded to m-w.com!
        ) {
            # Strip line numbering and anchor tags
            my $suggestions = $1;
            $suggestions =~ s/\s+[\d]+\.\s+//go;
            $suggestions =~ s/(.*?)<\/a>/$1 /go;

            # get them in list format
            my @suggestions = split(' ', $suggestions);

            # Comma delimit suggestions
            local $" = ', ';
            if (@suggestions > 7) {
                # lots of suggestions!
                # 7 is not arbitrary, it's supposed to be the number
                # of items people can remember at once.
                @suggestions = @suggestions[0..6];
                $reply = "Suggestions for '$word': @suggestions[0..6]...";
            } elsif (@suggestions) {
                # just a few suggestions
                $reply = "Suggestions for '$word': @suggestions";
            } else {
                # eh? Weird. Some problem on the server probably.
                $self->debug("Didn't get any suggestions for '$word'!");
                $reply = "I have no idea what '$word' is supposed to be, sorry.";
            }
        } else {
            # horrah!
            $reply = "'$word' seems to be the correct spelling.";
        }
        $self->say($event, $reply);
        return 0;
    }
}