package LIMS::Controller::Roles::Aspell; use Moose::Role; use Text::Aspell; has speller => ( is => 'ro', isa => 'Text::Aspell', lazy_build => 1 ); has id_generator => ( is => 'rw', isa => 'Str' ); has seen => ( is => 'ro', isa => 'HashRef[Str]', default => sub { {} }, lazy => 1, traits => ['Hash'], handles => { has_seen => 'get', set_seen => 'set', }, ); has words => ( is => 'ro', isa => 'HashRef[Str]', default => sub { {} }, lazy => 1, traits => ['Hash'], handles => { has_word => 'get', set_word => 'set', }, ); has word_data => ( is => 'ro', isa => 'ArrayRef[HashRef]', default => sub { [] }, lazy => 1, traits => ['Array'], handles => { add_word_data => 'push', all_word_data => 'elements', clear_word_data => 'clear', }, ); #------------------------------------------------------------------------------- # idea borrowed from http://sedition.com/perl/cgi-javascript-spell.html sub do_spellcheck { my ($self, $fieldname) = @_; my $speller = $self->speller; # $self->debug($speller->list_dictionaries); my $text = $self->query->param($fieldname); # warn $text; WORD: while ( $text =~ /(['\w]+)/g ) { # add apos back my $word = $1; # skip numbers, CD4, etc: next WORD if $self->_is_unsupported($word); # skip if already seen: next WORD if $self->has_seen($word); # skip if word recognised in dictionary(s): unless ( $speller->check($word) ) { # warn $word; # add unrecognised word to 'words' collection: $self->set_word($word => 1); # get unique id for div: my $id = $self->id_generator; # warn $id; my $div_id = join '_', $fieldname, $id; # warn $div_id; my @suggestions = map { { escaped => quotemeta($_), # so apostrophied words work OK display => $_, # for display } } $speller->suggest($word); # eg, to restrict to 5: # @suggestions = splice(@sug,0,6) if @suggestions > 6; my %data = ( id => $div_id, word => quotemeta($word), fieldname => $fieldname, suggestions => \@suggestions, ); $self->add_word_data(\%data); # increment id_generator for next time: $self->id_generator(++$id); } # add word to 'seen' collection: $self->set_seen($word => 1); } my @data = $self->all_word_data; # reset for any more textareas: $self->clear_word_data; return \@data; } #------------------------------------------------------------------------------- sub colourise_text { my ($self, $fieldname) = @_; my $text = $self->query->param($fieldname); # warn $text; my $q = $self->query; my @words; while ( $text =~ /(['\w]+)/g ) { # add apos back my $word = $1; push @words, $self->has_word($word) ? $q->span({-class=>'unrecognised'}, $word) # highlight it : $word; } return \@words; } #------------------------------------------------------------------------------- sub _build_speller { my $self = shift; my $speller = Text::Aspell->new; # must be read/write by the webserver user - for location of personal dict: # $self->cfg->{path_to_www_docs} already has end slash: my $home_dir = $self->cfg->{path_to_www_docs} . 'speller/dicts'; my $medical = $home_dir . '/en-medical.rws'; $speller->set_option('lang','en_EN'); $speller->set_option('sug-mode','fast'); $speller->set_option('home-dir', $home_dir); # using personal dict instead - can add words to it: # $speller->set_option('extra-dicts', $medical); return $speller; } #------------------------------------------------------------------------------- sub _is_unsupported { my $self = shift; my $word = shift; return 1 if $word =~ /\A(CD?)\d+\Z/; # CD4 or just numbers } 1;