Text::SpellChecker - OO interface for spell-checking a block of text

    use Text::SpellChecker;
    ($Text::SpellChecker::pre_hl_word,
     $Text::SpellChecker::post_hl_word) = (qw([ ]));

    my $checker = Text::SpellChecker->new(text => "Foor score and seven yeers ago");

    while (my $word = $checker->next_word) {
        print $checker->highlighted_text, 
            "\n", 
            "$word : ",
            (join "\t", @{$checker->suggestions}),
            "\nChoose a new word : ";
        chomp (my $new_word = <STDIN>);
        $checker->replace(new_word => $new_word) if $new_word;
    }

    print "New text : ".$checker->text."\n";

    use CGI;
    use Text::SpellChecker;
    my $q = new CGI;
    print $q->header,
          $q->start_html,
          $q->start_form(-method=>'POST',-action=>$ENV{SCRIPT_NAME});

    my $checker = Text::SpellChecker->new(
        text => "Foor score and seven yeers ago",
        from_frozen => $q->param('frozen') # will be false the first time.
    ); 

    $checker->replace(new_word => $q->param('replacement')) 
        if $q->param('replace');

    if (my $word = $checker->next_word) {
        print $q->p($checker->highlighted_text),
            $q->br, 
            qq|Next word : "$word"|, 
            $q->br,
            $q->submit(-name=>'replace',-value=>'replace with:'),
            $q->popup_menu(-name=>'replacement',-values=>$checker->suggestions),
            $q->submit(-name=>'skip');
    } else {
        print "Done.  New text : ".$checker->text;
    }

    print $q->hidden(-name => 'frozen',
                     -value => $checker->serialize,
                     -override => 1), 
          $q->end_form, 
          $q->end_html;

package Text::SpellChecker;
use Carp;
use Storable qw(freeze thaw);
use MIME::Base64;
use warnings;
use strict;

our $VERSION = '0.11';

our $pre_hl_word = qq|<span style="background-color:red;color:white;font-weight:bold;">|;
our $post_hl_word = "</span>";
our %SpellersAvailable;
BEGIN {
    %SpellersAvailable = (
        Aspell   => do { eval{require Text::Aspell};   $@ ? 0 : 1},
        Hunspell => do { eval{require Text::Hunspell}; $@ ? 0 : 1},
    );
    unless (grep { $_ } values %SpellersAvailable) {
        die "Could not load Text::Aspell or Text::Hunspell.  At least one must be installed";
    };
}
our %DictionaryPath = (
    Hunspell => q[/usr/share/hunspell]
);

#
# new
#
# parameters :
#   text : the text we're checking
#   from_frozen : serialized class data to use instead of using text
#
sub new {
    my ($class,%args) = @_;
    return $class->new_from_frozen($args{from_frozen}) if $args{from_frozen};
    bless {
            text => $args{text},
            ignore_list => {},    # keys of this hash are words to be ignored
            ( lang => $args{lang} ) x !!$args{lang},
    }, $class;
}

sub reset {
    my $self = shift;
    $self->{position} = undef;
    $self->{ignore_list} = {};
}

# Ignore all remaining occurences of the current word.

sub ignore_all {
    my $self = shift;
    my $word = $self->current_word or croak "Can't ignore all : no current word";
    $self->{ignore_list}{$word} = 1;
}

# Replace all remaining occurences with the given word

sub replace_all {
    my ($self,%args) = @_;
    my $new_word = $args{new_word} or croak "no replacement given";
    my $current = $self->current_word;
    $self->replace(new_word => $new_word);
    my $saved_position = $self->{position};
    while (my $next = $self->next_word) {
         next unless $next eq $current;
         $self->replace(new_word => $new_word);
    }
    $self->{position} = $saved_position;
}

#
# new_from_frozen
#
# Alternative handy constructor using serialized object.
#
sub new_from_frozen {
    my $class = shift;
    my $frozen = shift;
    my $self = thaw(decode_base64($frozen)) or croak "Couldn't unthaw $frozen";
    unless (ref $self =~ /Spellchecker/i) {
        bless $self, $class;
    }
    return $self;
}

#
# next_word
# 
# Get the next misspelled word. 
# Returns false if there are no more.
#
sub next_word {
    my $self = shift;
    pos $self->{text} = $self->{position};
    my $word;
    my $sp = $self->_hunspell || $self->_aspell || die "Could not make a speller with Text::Hunspell or Text::Aspell.";
    while ($self->{text} =~ m/([a-zA-Z]+(?:'[a-zA-Z]+)?)/g) {
        $word = $1;
        next if $self->{ignore_list}{$word};
        last if !$sp->check($word);
    }
    unless ($self->{position} = pos($self->{text})) {
        $self->{current_word} = undef;
        return undef;
    }
    $self->{suggestions} = [ $sp->suggest($word) ];
    $self->{current_word} = $word;
    return $word;
}

#
# Private method returning a Text::Aspell object
#
sub _aspell {
    my $self = shift;
    return unless $SpellersAvailable{Aspell};

    unless ( $self->{aspell} ) {
        $self->{aspell} = Text::Aspell->new;
        $self->{aspell}->set_option( lang => $self->{lang} ) 
                if $self->{lang};
    }

    return $self->{aspell};
}

sub _hunspell {
    my $self = shift;
    return unless $SpellersAvailable{Hunspell};
    unless ( -d $DictionaryPath{Hunspell} ){
        warn "Could not find hunspell dictionary directory $DictionaryPath{Hunspell}.";
        return;
    }
    my $env_lang;
    ($env_lang) = $ENV{LANG} =~ /^([^\.]*)/ if $ENV{LANG};
    my $lang = $self->{lang} || $env_lang || "en_US";
    my $dic = sprintf("%s/%s.dic", $DictionaryPath{Hunspell}, $lang );
    my $aff = sprintf("%s/%s.aff", $DictionaryPath{Hunspell}, $lang );
    -e $dic or do {
        warn "Could not find $dic";
        return;
    };
    -e $aff or do {
        warn "could not find $aff";
        return;
    };

    unless ( $self->{hunspell} ) {
        $self->{hunspell} = Text::Hunspell->new($aff,$dic);
    }

    return $self->{hunspell};
}

#
# replace - replace the current word with a new one.
#
# parameters :
#   new_word - the replacement for the current word
#
sub replace {
    my ($self,%args) = @_;
    my $new_word = $args{new_word} or croak "no replacement given";
    my $word = $self->current_word or croak "can't replace with $new_word : no current word";
    $self->{position} -= length($word); # back up : we'll recheck this word, but that's okay.
    substr($self->{text},$self->{position},length($word)) = $new_word;
}

#
# highlighted_text
# 
# Get the text with the current misspelled word highlighted.
#
sub highlighted_text {
    my $self = shift;
    my $word = $self->current_word;
    return $self->{text} unless ($word and $self->{position});
    my $text = $self->{text};
    substr($text,$self->{position} - length($word),length($word)) = "$pre_hl_word$word$post_hl_word";
    return $text;
}

#
# Some accessors
#
sub text         { return $_[0]->{text}; }
sub suggestions  { 
    return unless $_[0]->{suggestions};
    return wantarray 
                ? @{$_[0]->{suggestions}} 
                :   $_[0]->{suggestions} 
                ;  
}
sub current_word { return $_[0]->{current_word};  }

#
# Handy serialization method.
#
sub serialize {
   my $self = shift;

   # remove mention of Aspell object, if any
   my %copy = %$self;
   delete $copy{aspell};
   delete $copy{hunspell};

   return encode_base64 freeze \%copy;
}

1;