The Perl Advent Calendar needs more articles for 2022. Submit your idea today!
package Search::Tools::SpellCheck;
use Moo;
use Carp;
extends 'Search::Tools::Object';
use Text::Aspell;
use Search::Tools::QueryParser;

our $VERSION = '1.007';

has 'query_parser' =>
    ( is => 'rw', default => sub { Search::Tools::QueryParser->new() } );
has 'max_suggest' => ( is => 'rw', default => sub {4} );
has 'dict'        => ( is => 'rw' );
has 'lang'        => ( is => 'rw' );
has 'aspell'      => ( is => 'rw' );

sub BUILD {
    my $self = shift;
            or croak "can't get new() Text::Aspell"

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


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

sub suggest {
    my $self      = shift;
    my $query_str = shift;
    confess "query required" unless defined $query_str;
    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) ) {
                $s->{suggestions} = 0;
            else {
                my @sg = $self->aspell->suggest($word);
                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;

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


    return $suggest;



=head1 NAME

Search::Tools::SpellCheck - offer spelling suggestions


 use Search::Tools::SpellCheck;
 my $query = 'the quick fox color:brown and "lazy dog" not jumped';
 my $spellcheck = 
                        dict        => 'path/to/my/dictionary',
                        max_suggest => 4,
 my $suggestions = $spellcheck->suggest($query);

This module offers suggestions for alternate spellings using Text::Aspell.

=head1 METHODS

=head2 new( %I<opts> )

Create a new SpellCheck object.
%I<opts> should include:


=item dict

Path(s) to your dictionary.

=item lang

Language to use. Default is C<en_US>.

=item max_suggest

Maximum number of suggested spellings to return. Default is C<4>.

=item query_parser

A Search::Tools::QueryParser object.


=head2 BUILD

Called internally by new().

=head2 suggest( @I<terms> )

Returns an arrayref of hashrefs. Each hashref is composed of the following
key/value pairs:


=item word

The keyword used.

=item suggestions

If value is C<0> (zero) then the word was found in the dictionary
and is spelled correctly.

If value is an arrayref, the array contains a list of suggested spellings.


=head2 aspell

If you need access to the Text::Aspell object used internally,
this accessor will get/set it.


=head1 AUTHOR

Peter Karman C<< <> >>


Thanks to Atomic Learning C<> 
for sponsoring the development of this module.

Thanks to Bill Moseley, Text::Aspell maintainer, for the API
suggestions for this module.

=head1 BUGS

Please report any bugs or feature requests to C<bug-search-tools at>, or through
the web interface at L<>.  
I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Search::Tools

You can also look for information at:

=over 4

=item * RT: CPAN's request tracker


=item * AnnoCPAN: Annotated CPAN documentation


=item * CPAN Ratings


=item * Search CPAN




Copyright 2009 by Peter Karman.

This package is free software; you can redistribute it and/or modify it under the 
same terms as Perl itself.

=head1 SEE ALSO

Search::Tools::QueryParser, Text::Aspell