• Files
• Commits
• Log
• Graph
• Stats

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 <a href> 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);
    # extra-dicts needs manually rebuilding - suggest using words from personal dict:
	# $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;