File Coverage

blib/lib/Text/Guess/Script.pm

Criterion	Covered	Total	%
statement	41	41	100.0
branch	8	8	100.0
condition	4	6	83.3
subroutine	8	8	100.0
pod	3	3	100.0
total	64	66	98.4

package Text::Guess::Script;

use strict;
use warnings;

our $VERSION = '0.07';

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 $names   = {};

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

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

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

  return $result;
}



1;

__END__