Search::Tools::SpellCheck - offer spelling suggestions

 use Search::Tools::SpellCheck;

 my $query = 'the quick fox color:brown and "lazy dog" not jumped';

 my $spellcheck = 
    Search::Tools::SpellCheck->new(
                        dict        => 'path/to/my/dictionary',
                        max_suggest => 4,
                        );

 my $suggestions = $spellcheck->suggest($query);

 

    perldoc Search::Tools

package Search::Tools::SpellCheck;
use strict;
use warnings;
use Carp;
use base qw( Search::Tools::Object );
use Text::Aspell;
use Search::Tools::QueryParser;

our $VERSION = '0.59';

__PACKAGE__->mk_accessors(
    qw(
        max_suggest
        dict
        aspell
        query_parser
        )
);

sub init {
    my $self = shift;
    $self->SUPER::init(@_);
    $self->{query_parser} ||= Search::Tools::QueryParser->new();
    $self->{max_suggest}  ||= 4;
    $self->aspell(
               Text::Aspell->new
            or croak "can't get new() Text::Aspell"
    );

    $self->aspell->set_option( 'lang', $self->{query_parser}->lang );
    $self->_check_err;
    $self->aspell->set_option( 'sug-mode', 'fast' );
    $self->_check_err;
    $self->aspell->set_option( 'master', $self->dict ) if $self->dict;
    $self->_check_err;

}

sub _check_err {
    my $self = shift;
    carp $self->aspell->errstr if $self->aspell->errstr;
}

sub suggest {
    my $self        = shift;
    my $query_str   = shift or croak "query required";
    my $suggest     = [];
    my $phr_del     = $self->query_parser->phrase_delim;
    my $ignore_case = $self->query_parser->ignore_case;
    my $query       = $self->query_parser->parse($query_str);

    for my $term ( @{ $query->terms } ) {

        $term =~ s/$phr_del//g;
        my @w = split( m/\ +/, $term );

    WORD: for my $word (@w) {

            my $s = { word => $word };
            if ( $self->aspell->check($word) ) {
                $self->_check_err;
                $s->{suggestions} = 0;
            }
            else {
                my @sg = $self->aspell->suggest($word);
                $self->_check_err;
                if ( !@sg or !defined $sg[0] ) {
                    $s->{suggestions} = [];
                }
                else {

                    if ($ignore_case) {

                        # make them unique but preserve order
                        my $c = 0;
                        my %u = map { lc($_) => $c++ } @sg;
                        @sg = sort { $u{$a} <=> $u{$b} } keys %u;
                    }

                    $s->{suggestions}
                        = [ splice( @sg, 0, $self->max_suggest ) ];
                }
            }
            push( @$suggest, $s );

        }
    }

    return $suggest;
}

1;

__END__