File Coverage

lib/Comment/Spell/Check.pm

Criterion	Covered	Total	%
statement	38	117	32.4
branch	2	24	8.3
condition	0	2	0.0
subroutine	13	21	61.9
pod			n/a
total	53	164	32.3

use 5.006;
use strict;
use warnings;

package Comment::Spell::Check;

our $VERSION = '0.002000';

# ABSTRACT: Check words from Comment::Spell vs a system spell checker.

our $AUTHORITY = 'cpan:KENTNL'; # AUTHORITY

use Moo qw( has extends around );
use Carp qw( croak carp );
use Devel::CheckBin qw( can_run );
use IPC::Run qw( run timeout );
use Text::Wrap qw( wrap );
use File::Spec;

extends 'Comment::Spell';

has 'spell_command'            => ( is => 'ro', lazy => 1, builder => '_build_spell_command' );
has 'spell_command_exec'       => ( is => 'ro', lazy => 1, builder => '_build_spell_command_exec' );
has 'spell_command_args'       => ( is => 'ro', lazy => 1, default => sub { [] } );
has '_spell_command_base_args' => ( is => 'ro', lazy => 1, builder => '_build_spell_command_base_args' );
has '_spell_command_all_args'  => ( is => 'ro', lazy => 1, builder => '_build_spell_command_all_args' );

my $arg_defaults = {
  'spell'    => [],
  'aspell'   => [ 'list', '-l', 'en', '-p', File::Spec->devnull, ],
  'ispell'   => [ '-l', ],
  'hunspell' => [ '-l', ],
};

sub _run_spell {
  my ( $command, $words ) = @_;
  my @badwords;
  local $@ = undef;
  my $ok = eval {
    my ( $results, $errors );
    run $command, \$words, \$results, \$errors, timeout(10);
    @badwords = split /\n/msx, $results;
    croak 'spellchecker had errors: ' . $errors if length $errors;
    1;
  };
  chomp for @badwords;
  return ( $ok, \@badwords, $@ );
}

sub _can_spell {
  my ($name) = @_;
  return unless my $bin = can_run($name);
  my ( $ok, $words, ) = _run_spell( [ $bin, @{ $arg_defaults->{$name} || [] } ], 'iamnotaword' );
  return unless $ok;
  return unless @{$words};
  return unless 'iamnotaword' eq $words->[0];
  return $bin;
}

sub _build_spell_command_exec {
  my @candidates = (qw( spell aspell ispell hunspell ));
  for my $candidate (@candidates) {
    return $candidate if _can_spell($candidate);
  }
  return croak <<"EOF";
Cant determine a spell checker automatically. Make sure one of: @candidates are installed or configure manually.
EOF
}

sub _build_spell_command_base_args {
  my ($self) = @_;
  my $cmd = $self->spell_command_exec;
  return ( $arg_defaults->{$cmd} || [] );
}

sub _build_spell_command_all_args {
  my ($self) = @_;
  return [ @{ $self->_spell_command_base_args }, @{ $self->spell_command_args } ];
}

sub _build_spell_command {
  my ($self) = @_;
  return [ can_run( $self->spell_command_exec ), @{ $self->_spell_command_all_args } ];
}

sub _spell_text {
  my ( $self, $text ) = @_;
  my @command = @{ $self->spell_command };
  my ( $ok, $words, $err ) = _run_spell( \@command, $text );
  if ( not $ok ) {
    carp $err;
  }
  return @{$words};
}

around 'parse_from_document' => sub {
  my ( $orig, $self, $document, @rest ) = @_;
  local $self->{fails} = [];    ## no critic (Variables::ProhibitLocalVars)
  my %counts;
  local $self->{counts}     = \%counts;    ## no critic (Variables::ProhibitLocalVars)
  local $self->{line_cache} = [];          ## no critic (Variables::ProhibitLocalVars)

  $document->index_locations;
  $self->$orig( $document, @rest );
  $self->_process_line_cache() if @{ $self->{line_cache} };

  if ( keys %counts ) {

    # Invert k => v to v => [ k ]
    my %values;
    push @{ $values{ $counts{$_} } }, $_ for keys %counts;

    my $labelformat = q[%6s: ];
    my $indent      = q[ ] x 10;

    $self->_print_output( qq[\nAll incorrect words, by number of occurrences:\n] . join qq[\n],
      map { wrap( ( sprintf $labelformat, $_ ), $indent, join q[, ], sort @{ $values{$_} } ) }
      sort { $a <=> $b } keys %values );
    $self->_flush_output;
  }
  return { fails => $self->{fails}, counts => $self->{counts} };
};

sub _report_badwords {
  my ( $self, $start_line, $stop_line, @badwords ) = @_;    ## no critic (Variables::ProhibitUnusedVarsStricter)
  my %counts;
  $counts{$_}++ for @badwords;
  $self->{counts}->{$_}++ for @badwords;
  my $fail = {
    line   => $start_line,
    counts => \%counts,
  };
  push @{ $self->{fails} }, $fail;
  my $label = sprintf q[line %6s: ], q[#] . $start_line;
  my $indent = q[ ] x 13;
  local $Text::Wrap::huge = 'overflow';                     ## no critic (Variables::ProhibitPackageVars)
  my @printwords;

  for my $key ( sort keys %counts ) {
    if ( $counts{$key} > 1 ) {
      push @printwords, $key . '(x' . $counts{$key} . ')';
      next;
    }
    push @printwords, $key;
  }
  $self->_print_output( wrap( $label, $indent, join q[ ], @printwords ) );
  $self->_print_output(qq[\n]);
  return;
}

sub _process_line_cache {
  my ($self) = @_;
  my $text = join qq[\n], map { $_->[1] } @{ $self->{line_cache} };
  my (@badwords) = split /[ ]/sxm, $self->stopwords->strip_stopwords( join q[ ], $self->_spell_text($text) );
  my $start      = $self->{line_cache}->[0]->[0];
  my $stop       = $self->{line_cache}->[-1]->[0];

  @{ $self->{line_cache} } = ();

  return unless @badwords;
  $self->_report_badwords( $start, $stop, @badwords );
  return;
}

sub _push_line_cache {
  my ( $self, $line, $text ) = @_;
  if ( not @{ $self->{line_cache} } ) {
    push @{ $self->{line_cache} }, [ $line, $text ];
    return;
  }

  # If there is any gap between lines, consider it a new paragraph.
  if ( ( $line - $self->{line_cache}->[-1]->[0] ) > 1 ) {
    $self->_process_line_cache;
  }
  push @{ $self->{line_cache} }, [ $line, $text ];
  return;
}

sub _handle_comment {
  my ( $self, $comment ) = @_;
  $self->_push_line_cache( $comment->line_number, $self->_comment_text($comment) );
  return;
}

no Moo;

1;

__END__