File Coverage

blib/lib/Acme/Ikamusume.pm

Criterion	Covered	Total	%
statement	18	20	90.0
branch			n/a
condition			n/a
subroutine	7	7	100.0
pod			n/a
total	25	27	92.5

package Acme::Ikamusume;
use 5.010001;
use strict;
use warnings;
use utf8;
our $VERSION = '0.08';

use File::ShareDir qw/dist_file/;
use Lingua::JA::Kana;

use Text::Mecabist;

sub geso {
    my $self = bless { }, shift;
    my $text = shift // "";

    my $parser = Text::Mecabist->new({
        userdic => dist_file('Acme-Ikamusume', Text::Mecabist->encoding->name .'.dic'),
    });

    my $doc = $parser->parse($text, sub {
        my $node = shift;
        return if not $node->readable;
        return if not $node->reading;
        $self->apply_rules($node);
    });

    return $doc->join('text');
}

sub godan {
    my ($verb, $from, $to) = @_;
    if (my ($kana) = $verb =~ /(\p{InHiragana})$/) {
        $kana = kana2romaji($kana);
        $kana =~ s/^sh/s/;
        $kana =~ s/^ch/t/;
        $kana =~ s/^ts/t/;
        $kana =~ s/$from$/$to/;
        $kana =~ s/^a$/wa/;
        $kana =~ s/ti/chi/;
        $kana =~ s/tu/tsu/;
        $kana = romaji2hiragana($kana);

        $verb =~ s/.$/$kana/;
    }
    $verb;
}

our @rules = (

    # userdic extra field
    sub {
        my $node = shift;
        my $word = $node->extra1 or return;
        $node->text($word);
    },

    # IKA: inflection
    sub {
        my $node = shift;
        return if not $node->extra2;
        return if not $node->extra2 =~ /inflection/;

        my $prev = $node->prev or return;

        if ($prev->is('名詞')) {
            $node->text('じゃなイカ');
        }
        elsif ($prev->is('副詞')) {
            $node->text('でゲソか');
        }
        elsif ($prev->is('助動詞') and
               $prev->surface eq 'です' and
               $prev->prev and $prev->prev->text !~ /^[いイ]{2}$/) {
            $prev->text('じゃなイ');
            $node->text('カ');
        }

        if ($prev->text =~ /(?:イー?カ|ゲソ)$/) {
            return;
        }
        elsif ($prev->inflection_type =~ /五段/) {
            $prev->text(godan($prev->text, '.' => 'a'));
            $node->text('なイカ');
        }
        elsif ($prev->inflection_type =~ /一段|カ変|サ変/) {
            $node->text('なイカ');
        }
    },

    # formal MASU to casual
    sub {
        my $node = shift;
        if ($node->lemma eq 'ます' and
            $node->is('助動詞') and
            $node->prev && $node->prev->is('動詞')) {

            if ($node->is('基本形')) { # ます
                $node->prev->text($node->prev->lemma);
                $node->text('');

                if ($node->next->pos =~ /^助詞/) {
                    $node->text($node->text . 'でゲソ');
                }
            }
            if ($node->is('連用形') and # ます
                $node->pos3 !~ /五段/) { # 五段 => { -i/っ/ん/い }
                $node->text('');
            }
        }
    },

    # no honorific
    sub {
        my $node = shift;
        if ($node->feature =~ /^名詞,接尾,人名,/ and
            $node->prev->text ne 'イカ娘') {
            $node->text('');
        }
    },

    # IKA/GESO: replace
    sub {
        my $node = shift;
        my $text = $node->text;

        $text =~ s/い[いー]か(.)/イーカ$1/g;
        $text =~ s/いか/イカ/g;
        $text =~ s/げそ/ゲソ/g;
        $node->text($text);

        return if $text =~ /イー?カ|ゲソ/;

        my $curr = katakana2hiragana($node->reading || "");

        $node->text($curr) if $curr =~ s/い[いー]か(.)/イーカ$1/g;
        $node->text($curr) if $curr =~ s/いか/イカ/g;
        $node->text($curr) if $curr =~ s/げそ/ゲソ/g;

        my $next = katakana2hiragana(($node->next and $node->next->reading) || "");
        my $prev = katakana2hiragana(join "",
            $node->prev && $node->prev->prev && $node->prev->prev->text,
            $node->prev && $node->prev->text);

        $node->text($curr) if $next =~ /^か./ && $curr =~ s/い[いー]$/イー/;
        $node->text($curr) if $prev =~ /い[いー]$/ && $curr =~ s/^か(.)/カ$1/;
        $node->text($curr) if $prev =~ /[いイ]$/ && $curr =~ s/^か/カ/;
        $node->text($curr) if $next =~ /^か/ && $curr =~ s/い$/イ/;
        $node->text($curr) if $next =~ /^そ/ && $curr =~ s/げ$/ゲ/;
        $node->text($curr) if $prev =~ /げ$/ && $curr =~ s/^そ/ソ/;
    },

    # IKA/GESO: DA + postp
    sub {
        my $node = shift;
        my $prev = $node->prev or return;

        if ($prev->surface eq 'だ' and
            $prev->text eq 'でゲソ' and
            (
                $node->pos =~ /助詞|助動詞/ or
                $node->is('接尾')
            )
        ) {
            my $kana = kana2romaji($node->text);
            if ($kana =~/^(?:ze|n[aeo]|yo|wa)/) {
                $node->text('');
                $prev->text('じゃなイカ');
            }
            if ($kana =~ /^zo/) {
                $node->text('');
            }
        }
    },

    sub {
        my $node = shift;
        my $prev = $node->prev or return;
        my $latest = join "",
            $prev->prev && $prev->prev->text,
            $prev && $prev->text,
            $node->text;

        if ($node->is('終助詞') and
            $latest =~ /(?:でゲソ|じゃなイカ)[よなね]$/) {
            $node->text('');
        }
    },

    # IKA: IIKA
    sub {
        my $node = shift;
        my $prev = $node->prev or return;

        if ($prev->text !~ /^(?:[いイ]{2})$/) {
            return;
        }
        if ($node->surface =~ /^(?:です|でしょう)$/ and
            $node->next->surface =~ /^か/) {
            $prev->text('いイ');
            $node->text('');
        }
        if ($node->surface eq 'でしょうか') {
            $prev->text('いイ');
            $node->text('カ');
        }
    },

    # GESO/IKA: eos
    sub {
        my $node = shift;
        my $next = $node->next or return;

        if ($next->stat == 3 or # MECAB_EOS_NODE
            (
                $next->is('記号') and
                $next->pos1 =~ /句点|括弧閉|GESO可/
            )
        ) {
            if ($node->pos =~ /^(?:その他|記号|助詞|接頭詞|接続詞|連体詞)/) {
                return;
            }

            if ($node->is('助動詞') and
                $node->prev and $node->prev->text eq 'じゃ' and
                $node->surface eq 'ない') {
                $node->text('なイカ');
                return;
            }

            if ($node->pos =~ /^助動詞/ and
                $node->prev and $node->prev->text =~ /(?:ゲソ|イー?カ)/) {
                return;
            }

            my $latest = join "",
                $node->prev && $node->prev->text,
                $node->text;
            if ($latest =~ /(?:ゲソ|イー?カ)$/) {
                return;
            }

            $node->text($node->text . 'でゲソ');
        }

        if ($node->is('動詞') and
            $node->inflection_form =~ '基本形' and
            $next->pos =~ /^助詞/) {
            $node->text($node->text . 'でゲソ');
        }
    },

    # EBI: accent
    sub {
        my $node = shift;
        my $text = $node->text;
        my @ebi_accent = qw(！ ♪ ♪ ♫ ♬ ♡);

        $text =~ s{(エビ|えび|海老)}{
            $1 . $ebi_accent[ int rand scalar @ebi_accent ];
        }e;

        $node->text($text);
    },
);

sub apply_rules {
    my ($self, $node) = @_;
    for my $rule (@rules) {
        $rule->($node);
    }
}

1;
__END__