File Coverage

blib/lib/Test/Text.pm

Criterion	Covered	Total	%
statement	94	96	97.9
branch	7	10	70.0
condition	10	24	41.6
subroutine	22	23	95.6
pod	6	6	100.0
total	139	159	87.4

package Test::Text;

use warnings;
use strict;
use utf8; # Files and dictionaries might use utf8
use Encode;

use Carp;
use Path::Tiny;
use Text::Hunspell;
use Test::Text::Sentence qw(split_sentences);
use v5.22;

use version; our $VERSION = qv('0.6.6'); # Really works with RMarkdown

use parent 'Test::Builder::Module'; # Included in Test::Simple

my $CLASS = __PACKAGE__;
our @EXPORT= 'just_check';

BEGIN {
  binmode *STDOUT, ":encoding(utf8)";
  binmode *STDERR, ":encoding(utf8)";
}

# Module implementation here
sub new {
  my $class = shift;
  my $dir = shift || croak "Need a single directory with text" ;
  my $data_dir = shift || croak "No default spelling data directory\n";
  my $language = shift || "en_US"; # Defaults to English
  my @files = @_ ; # Use all appropriate files in dir by default
  if (!@files ) {
    @files = glob("$dir/*.md $dir/*.tex $dir/*.txt $dir/*.markdown $dir/*.Rmd $dir/*.Rmarkdown)");
  } else {
    @files = map( "$dir/$_", @files );
  }
  my $self = {
	      _dir => $dir,
	      _data_dir => $data_dir,
	      _files => \@files
  };
  bless  $self, $class;

  # Speller declaration
  my $speller = Text::Hunspell->new(
				  "$data_dir/$language.aff",    # Hunspell or other affix file
				  "$data_dir/$language.dic"     # Hunspell or other dictionary file
				   );
  croak "Couldn't create speller: $1" if !$speller;
  $self->{'_speller'} = $speller;
  $speller->add_dic("$dir/words.dic"); # word.dic should be in the text directory
  return $self;
}

sub dir {
    return shift->{'_dir'};
}

sub files {
  return shift->{'_files'};
}

sub check {
  my $self = shift;
  my $tb= $CLASS->builder;
  my $speller = $self->{'_speller'};
  my %vocabulary;
  my @sentences;
  for my $f ( @{$self->files}) {
    my $file_content= path($f)->slurp_utf8;
    if ( $f =~ /(\.md|\.markdown|\.Rmd|\.Rmarkdown)/ ) {
      $file_content = _strip_urls( $file_content);
      $file_content = _strip_code( $file_content);
    }
    push @sentences, split_sentences( $file_content );
    $tb->cmp_ok( scalar @sentences, ">=", 1, "We have " . ($#sentences + 1) . " sentences");
    my @words = ($file_content =~ m{\b(\p{L}+)\b}g);
    for my $w (@words) {
      next if !$w;
      $vocabulary{lc($w)}++;
      $tb->ok( $speller->check( $w),  "$f >> '". encode_utf8($w) . "'");
    }
    my $different_words = scalar keys %vocabulary;
    $tb->cmp_ok(  $different_words, ">", 1, "We have $different_words different words");
  }

}

sub _strip_urls {
  my $text = shift || carp "No text";
  $text =~ s/\[(.+?)\]\(\S+\)/$1/sg;
  return $text;
}

sub _strip_code {
  my $text = shift || carp "No text in _strip_code";
  $text =~ s/---[\w\W]*?---//g;
  $text =~ s/~~~[\w\W]*?~~~//g;
  $text =~ s/```.+?```//g;
  $text =~ s/`[^`]+?`//g;
  return $text;
}


sub just_check {
    my $dir = shift || croak "Need a directory with text" ;
    my $data_dir = shift || croak "No default spelling data directory\n";
    my $language = shift || "en_US"; # Defaults to English
    my $call_done_testing = shift // 1; # Defaults to 1
    my $tesxt = Test::Text->new($dir, $data_dir, $language, @_);
    my $tb= $CLASS->builder;
    $tb->subtest( "Testing $dir" => sub {
      $tesxt->check();
    });
    $tb->done_testing() if $call_done_testing;
}

sub done_testing {
  my $tb= $CLASS->builder;
  $tb->done_testing;
}

"All over, all out, all over and out"; # Magic circus phrase said at the end of the show

__END__