File Coverage

blib/lib/Text/Guess/Script.pm

Criterion	Covered	Total	%
statement	39	39	100.0
branch	8	8	100.0
condition	2	3	100.0
subroutine	8	8	100.0
pod	3	3	100.0
total	60	61	100.0

package Text::Guess::Script;

use strict;
use warnings;

our $VERSION = '0.06';

use Unicode::Normalize;
use Unicode::UCD qw(charscript prop_value_aliases);

our @codes;

sub new {
  my $class = shift;
  # uncoverable condition false
  bless @_ ? @_ > 1 ? {@_} : {%{$_[0]}} : {}, ref $class || $class;
}

sub guess {
  my ($self, $text) = @_;

  if ( $text eq '' ) { return ''; }

  my $guesses = $self->_guesses($text);

  return $guesses->[0]->[0];
}

sub guesses {
  my ($self, $text) = @_;

  if ( $text eq '' ) { return []; }

  my $guesses = $self->_guesses($text);

  return $guesses;
}

sub _guesses {
  my ($self, $text) = @_;

  my $text_NFC = NFC($text);

  my @tokens = $text_NFC =~ m/(.)/xmsg;

  my $chars = {};
  for my $token (@tokens) {
    $chars->{$token}++;
  }

  my $guesses = {};
  #my @other_codes = @codes;
  #my @seen_codes;

  for my $char (keys %$chars) {
    my ($code, $name) = prop_value_aliases("Script",charscript(ord($char)));

    $guesses->{$code} += $chars->{$char};
  }

  my $result = [
  	map { [ $_, $guesses->{$_}/scalar(@tokens) ] }
    sort { $guesses->{$b} <=> $guesses->{$a} }
    keys(%$guesses)
  ];
  return $result;
}



1;

__END__