File Coverage

blib/lib/Text/SpellChecker.pm
Criterion Covered Total %
statement 25 25 100.0
branch 3 6 50.0
condition n/a
subroutine 6 6 100.0
pod n/a
total 34 37 91.8


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Text::SpellChecker - OO interface for spell-checking a block of text
4              
5             =head1 SYNOPSIS
6              
7             use Text::SpellChecker;
8             ($Text::SpellChecker::pre_hl_word,
9             $Text::SpellChecker::post_hl_word) = (qw([ ]));
10              
11             my $checker = Text::SpellChecker->new(text => "Foor score and seven yeers ago");
12              
13             while (my $word = $checker->next_word) {
14             print $checker->highlighted_text,
15             "\n",
16             "$word : ",
17             (join "\t", @{$checker->suggestions}),
18             "\nChoose a new word : ";
19             chomp (my $new_word = );
20             $checker->replace(new_word => $new_word) if $new_word;
21             }
22              
23             print "New text : ".$checker->text."\n";
24              
25             --or--
26              
27             use CGI;
28             use Text::SpellChecker;
29             my $q = new CGI;
30             print $q->header,
31             $q->start_html,
32             $q->start_form(-method=>'POST',-action=>$ENV{SCRIPT_NAME});
33              
34             my $checker = Text::SpellChecker->new(
35             text => "Foor score and seven yeers ago",
36             from_frozen => $q->param('frozen') # will be false the first time.
37             );
38              
39             $checker->replace(new_word => $q->param('replacement'))
40             if $q->param('replace');
41              
42             if (my $word = $checker->next_word) {
43             print $q->p($checker->highlighted_text),
44             $q->br,
45             qq|Next word : "$word"|,
46             $q->br,
47             $q->submit(-name=>'replace',-value=>'replace with:'),
48             $q->popup_menu(-name=>'replacement',-values=>$checker->suggestions),
49             $q->submit(-name=>'skip');
50             } else {
51             print "Done. New text : ".$checker->text;
52             }
53              
54             print $q->hidden(-name => 'frozen',
55             -value => $checker->serialize,
56             -override => 1),
57             $q->end_form,
58             $q->end_html;
59              
60              
61             =head1 DESCRIPTION
62              
63             This module is a thin layer above either Text::Aspell or Text::Hunspell (preferring
64             the latter if available), and allows one to spellcheck a body of text.
65              
66             Whereas Text::(Hu|A)spell deals with words, Text::Spellchecker deals with blocks of text.
67             For instance, we provide methods for iterating through the text, serializing the object (thus
68             remembering where we left off), and highlighting the current misspelled word within
69             the text.
70              
71             =head1 METHODS
72              
73             =over 4
74              
75             =item $checker = Text::SpellChecker->new(text => $text, from_frozen => $serialized_data, lang => $lang)
76              
77             Send either the text or a serialized object to the constructor.
78             Optionally, the language of the text can also be passed.
79             If no language is passed, $ENV{LANG} will be used, if it is set.
80             If it is not set, the default language will be "en_US".
81              
82             =item $checker = new_from_frozen($serialized_data)
83              
84             This is provided separately, so that it may be
85             overridden for alternative serialization techniques.
86              
87             =item $str=$checker->serialize
88              
89             Represent the object in its current state.
90              
91             =item $checker->reset
92              
93             Reset the checker to the beginning of the text, and clear the list of ignored words.
94              
95             =item $word = $checker->next_word
96              
97             Returns the next misspelled word.
98              
99             =item $checker->current_word
100              
101             Returns the most recently returned word.
102              
103             =item $checker->replace(new_word => $word)
104              
105             Replace the current word with $word.
106              
107             =item $checker->ignore_all
108              
109             Ignore all subsequent occurences of the current word.
110              
111             =item $checker->replace_all(new_word => $new_word)
112              
113             Replace all subsequent occurences of the current word with a new word.
114              
115             =item $checker->suggestions
116              
117             Returns a reference to a list of alternatives to the
118             current word in a scalar context, or the list directly
119             in a list context.
120              
121             =item $checker->text
122              
123             Returns the current text (with corrections that have been
124             applied).
125              
126             =item $checker->highlighted_text
127              
128             Returns the text, but with the current word surrounded by $Text::SpellChecker::pre_hl_word and
129             $Text::SpellChecker::post_hl_word.
130              
131             =back
132              
133             =head1 CONFIGURATION OPTIONS
134              
135             =over
136              
137             =item $Text::SpellChecker::pre_hl_word
138              
139             Set this to control the highlighting of a misspelled word.
140              
141             =item $Text::SpellChecker::post_hl_word
142              
143             Set this to control the highlighting of a misspelled word.
144              
145             =item $Text::SpellCheckerDictionaryPath{Hunspell}
146              
147             Set this to the hunspell dictionary path. By default /usr/share/hunspell.
148              
149             This directory should have $lang.dic and $lang.aff files.
150            
151             =back
152              
153             =head1 LICENSE
154              
155             This library is free software; you can redistribute it and/or modify
156             it under the same terms as Perl itself.
157              
158             =head1 TODO
159              
160             Add word to custom dictionary
161              
162             =head1 SEE ALSO
163              
164             Text::Aspell, Text::Hunspell
165              
166             =head1 AUTHOR
167              
168             Brian Duggan
169              
170             =cut
171              
172             package Text::SpellChecker;
173 2     2   37413 use Carp;
  2         5  
  2         159  
174 2     2   1400 use Storable qw(freeze thaw);
  2         6392  
  2         147  
175 2     2   1073 use MIME::Base64;
  2         1084  
  2         115  
176 2     2   11 use warnings;
  2         3  
  2         57  
177 2     2   8 use strict;
  2         2  
  2         307  
178              
179             our $VERSION = '0.13';
180              
181             our $pre_hl_word = qq||;
182             our $post_hl_word = "";
183             our %SpellersAvailable;
184             BEGIN {
185             %SpellersAvailable = (
186 2 50       3 Aspell => do { eval{require Text::Aspell}; $@ ? 0 : 1},
  2         368  
  2         13  
187 2 50   2   4 Hunspell => do { eval{require Text::Hunspell}; $@ ? 0 : 1},
  2         4  
  2         301  
  2         14  
188             );
189 2 50       5 unless (grep { $_ } values %SpellersAvailable) {
  4         18  
190 2         72 die "Could not load Text::Aspell or Text::Hunspell. At least one must be installed";
191             };
192             }
193             our %DictionaryPath = (
194             Hunspell => q[/usr/share/hunspell]
195             );
196              
197             #
198             # new
199             #
200             # parameters :
201             # text : the text we're checking
202             # from_frozen : serialized class data to use instead of using text
203             #
204             sub new {
205             my ($class,%args) = @_;
206             return $class->new_from_frozen($args{from_frozen}) if $args{from_frozen};
207             bless {
208             text => $args{text},
209             ignore_list => {}, # keys of this hash are words to be ignored
210             ( lang => $args{lang} ) x !!$args{lang},
211             }, $class;
212             }
213              
214             sub reset {
215             my $self = shift;
216             $self->{position} = undef;
217             $self->{ignore_list} = {};
218             }
219              
220             # Ignore all remaining occurences of the current word.
221              
222             sub ignore_all {
223             my $self = shift;
224             my $word = $self->current_word or croak "Can't ignore all : no current word";
225             $self->{ignore_list}{$word} = 1;
226             }
227              
228             # Replace all remaining occurences with the given word
229              
230             sub replace_all {
231             my ($self,%args) = @_;
232             my $new_word = $args{new_word} or croak "no replacement given";
233             my $current = $self->current_word;
234             $self->replace(new_word => $new_word);
235             my $saved_position = $self->{position};
236             while (my $next = $self->next_word) {
237             next unless $next eq $current;
238             $self->replace(new_word => $new_word);
239             }
240             $self->{position} = $saved_position;
241             }
242              
243             #
244             # new_from_frozen
245             #
246             # Alternative handy constructor using serialized object.
247             #
248             sub new_from_frozen {
249             my $class = shift;
250             my $frozen = shift;
251             my $self = thaw(decode_base64($frozen)) or croak "Couldn't unthaw $frozen";
252             unless (ref $self =~ /Spellchecker/i) {
253             bless $self, $class;
254             }
255             return $self;
256             }
257              
258             #
259             # next_word
260             #
261             # Get the next misspelled word.
262             # Returns false if there are no more.
263             #
264             sub next_word {
265             my $self = shift;
266             pos $self->{text} = $self->{position};
267             my $word;
268             my $sp = $self->_hunspell || $self->_aspell || die "Could not make a speller with Text::Hunspell or Text::Aspell.";
269             while ($self->{text} =~ m/\b(\p{L}+(?:'\p{L}+)?)/g) {
270             $word = $1;
271             next if $self->{ignore_list}{$word};
272             last if !$sp->check($word);
273             }
274             unless ($self->{position} = pos($self->{text})) {
275             $self->{current_word} = undef;
276             return undef;
277             }
278             $self->{suggestions} = [ $sp->suggest($word) ];
279             $self->{current_word} = $word;
280             return $word;
281             }
282              
283             #
284             # Private method returning a Text::Aspell object
285             #
286             sub _aspell {
287             my $self = shift;
288             return unless $SpellersAvailable{Aspell};
289              
290             unless ( $self->{aspell} ) {
291             $self->{aspell} = Text::Aspell->new;
292             $self->{aspell}->set_option( lang => $self->{lang} )
293             if $self->{lang};
294             }
295              
296             return $self->{aspell};
297             }
298              
299             sub _hunspell {
300             my $self = shift;
301             return unless $SpellersAvailable{Hunspell};
302             unless ( -d $DictionaryPath{Hunspell} ){
303             warn "Could not find hunspell dictionary directory $DictionaryPath{Hunspell}.";
304             return;
305             }
306             my $env_lang;
307             ($env_lang) = $ENV{LANG} =~ /^([^\.]*)/ if $ENV{LANG};
308             my $lang = $self->{lang} || $env_lang || "en_US";
309             my $dic = sprintf("%s/%s.dic", $DictionaryPath{Hunspell}, $lang );
310             my $aff = sprintf("%s/%s.aff", $DictionaryPath{Hunspell}, $lang );
311             -e $dic or do {
312             warn "Could not find $dic";
313             return;
314             };
315             -e $aff or do {
316             warn "could not find $aff";
317             return;
318             };
319              
320             unless ( $self->{hunspell} ) {
321             $self->{hunspell} = Text::Hunspell->new($aff,$dic);
322             }
323              
324             return $self->{hunspell};
325             }
326              
327             #
328             # replace - replace the current word with a new one.
329             #
330             # parameters :
331             # new_word - the replacement for the current word
332             #
333             sub replace {
334             my ($self,%args) = @_;
335             my $new_word = $args{new_word} or croak "no replacement given";
336             my $word = $self->current_word or croak "can't replace with $new_word : no current word";
337             $self->{position} -= length($word); # back up : we'll recheck this word, but that's okay.
338             substr($self->{text},$self->{position},length($word)) = $new_word;
339             }
340              
341             #
342             # highlighted_text
343             #
344             # Get the text with the current misspelled word highlighted.
345             #
346             sub highlighted_text {
347             my $self = shift;
348             my $word = $self->current_word;
349             return $self->{text} unless ($word and $self->{position});
350             my $text = $self->{text};
351             substr($text,$self->{position} - length($word),length($word)) = "$pre_hl_word$word$post_hl_word";
352             return $text;
353             }
354              
355             #
356             # Some accessors
357             #
358             sub text { return $_[0]->{text}; }
359             sub suggestions {
360             return unless $_[0]->{suggestions};
361             return wantarray
362             ? @{$_[0]->{suggestions}}
363             : $_[0]->{suggestions}
364             ;
365             }
366             sub current_word { return $_[0]->{current_word}; }
367              
368             #
369             # Handy serialization method.
370             #
371             sub serialize {
372             my $self = shift;
373              
374             # remove mention of Aspell object, if any
375             my %copy = %$self;
376             delete $copy{aspell};
377             delete $copy{hunspell};
378              
379             return encode_base64 freeze \%copy;
380             }
381              
382             1;
383