• Files
• Commits
• Log
• Graph
• Stats

package LIMS::Controller::Roles::Aspell;

use Moose::Role;

use Data::Dumper;
use Text::Aspell;
use Path::Tiny;

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 get_speller_tempfile {
    my $self = shift;
    # speller is handed from add_new_words(), not from check_speller_words():
    my $speller = shift || $self->speller(); # $speller->print_config;

    my $file = sprintf '.aspell.%s.temp', $self->cfg('settings')->{_centre};
    my $dir  = $speller->get_option('home-dir'); # warn $dir;
    my $src  = path($dir, $file)->realpath; # warn $src;
    return $src;
}

#-------------------------------------------------------------------------------
sub _build_speller {
	my $self = shift;

    my $path = $self->cfg->{path_to_www_docs}; # warn $path;
    my $ctr  = $self->cfg('settings')->{_centre}; # warn $ctr;

    my $speller = Text::Aspell->new;

	# *.pws & *.prepl must be read/write by the webserver (eg 664 raj:www-data):
	# location of personal dicts:
    my $personal = sprintf '.aspell.%s.pws', $ctr; # warn $personal;
	my $home_dir = path($path, 'speller', 'dicts')->realpath; # warn $home_dir;
    my $medical  = path($home_dir, 'en-medical.rws')->realpath; # warn $medical;

    my %opts = (
        lang       => 'en_GB',
        personal   => $personal,
        'sug-mode' => 'fast',
        'home-dir' => $home_dir,
        'extra-dicts' => $medical, # needs manually rebuilding (see README.txt)
    ); # warn Dumper \%opts;

    $speller->set_option( $_ => $opts{$_} ) for keys %opts;
        # $speller->print_config; # !! doesn't report extra-dicts !!
    return $speller;
}

#-------------------------------------------------------------------------------
sub _is_unsupported {
	my $self = shift;
	my $word = shift;

	return 1 if $word =~ /\A(CD?)\d+\Z/; # CD4 or just numbers
}

1;