view release on metacpan or  search on metacpan

lib/Acme/Ikamusume.pm  view on Meta::CPAN

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;
        

lib/Acme/Ikamusume.pm  view on Meta::CPAN

                $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__

=encoding utf-8

=head1 NAME

Acme::Ikamusume - The invader comes from the bottom of the sea!

=head1 SYNOPSIS

  use utf8;
  use Acme::Ikamusume;

  print Acme::Ikamusume->geso('イカ娘です。あなたもperlで侵略しませんか？');
  # => イカ娘でゲソ。お主もperlで侵略しなイカ？

=head1 DESCRIPTION

Acme::Ikamusume converts Japanese text into like Ikamusume speak.
Ikamusume, meaning "Squid-Girl", she is a cute Japanese comic/manga
character (L<http://www.ika-musume.com/>).

Try this module here: L<http://ika.koneta.org/>. enjoy!

=head1 METHODS

=over 4

=item $output = Acme::Ikamusume->geso( $input )

=back

=head1 AUTHOR

Naoki Tomita E<lt>tomita@cpan.orgE<gt>

=head1 LICENSE

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut