File Coverage

blib/lib/Lingua/JA/Gal.pm

Criterion	Covered	Total	%
statement	34	34	100.0
branch	10	10	100.0
condition	6	7	85.7
subroutine	8	8	100.0
pod	1	1	100.0
total	59	60	98.3

package Lingua::JA::Gal;
use strict;
use warnings;
use utf8;
our $VERSION = '0.03';

use Exporter 'import';
use File::ShareDir 'dist_file';
use Unicode::Japanese;

our @EXPORT_OK = qw/gal/;

our $Lexicon ||= do {
    my $file = dist_file('Lingua-JA-Gal', 'lexicon.pl');
    do $file;
};

sub gal {
    my $class   = shift if $_[0] eq __PACKAGE__; ## no critic
    my $text    = shift || "";
    my $options = shift || {};

    $options->{rate} = 100 if not defined $options->{rate};

    $text =~ s{(.)}{ _gal_char($1, $options) }ge;
    $text;
}

sub _gal_char {
    my ($char, $options) = @_;

    my $suggestions = do {
        my $normalized = Unicode::Japanese->new($char)->z2h->h2zKana->getu;
        $Lexicon->{ $normalized } || [];
    };

    if (my $callback = $options->{callback}) {
        return $callback->($char, $suggestions, $options);
    }

    if (@$suggestions && int(rand 100) < $options->{rate}) {
        return $suggestions->[ int(rand @$suggestions) ];
    } else {
        return $char;
    }
}

1;
__END__