view release on metacpan or  search on metacpan

lib/Acme/Nyaa/Ja.pm  view on Meta::CPAN

    my $neko = undef;

    return q() if( $ref1 ne '' && $ref1 ne 'SCALAR' );
    $text = $ref1 eq 'SCALAR' ? $$argv : $argv;
    return q() unless length $text;


    eval { 
        $self->reckon( \$text );
        $neko = $self->toutf8( $text ); 
    };
    return $text if $@;

    my $nounstable = {
        '神' => 'ネコ',
        '神' => 'ネコ',
    };

    for my $e ( keys %$nounstable ) {

        next unless $neko =~ m{$e};
        my $f = $nounstable->{ $e };

        $neko =~ s{\A[$e]\z}{$f};
        $neko =~ s{\A[$e](\p{InHiragana})}{$f$1};
        $neko =~ s{\A[$e](\p{InKatakana})}{$f$1};
        $neko =~ s{(\p{InHiragana})[$e](\p{InHiragana})}{$1$f$2}g;
        $neko =~ s{(\p{InHiragana})[$e](\p{InKatakana})}{$1$f$2}g;
        $neko =~ s{(\p{InKatakana})[$e](\p{InKatakana})}{$1$f$2}g;
        $neko =~ s{(\p{InKatakana})[$e](\p{InHiragana})}{$1$f$2}g;
        $neko =~ s{(\p{InHiragana})[$e]($RxPeriod|$RxComma)?\z}{$1$f$2}g;
        $neko =~ s{(\p{InKatakana})[$e]($RxPeriod|$RxComma)?\z}{$1$f$2}g;
    }

    return $self->utf8to( $neko ) unless $flag;
    return $neko;
}

sub nyaa {
    my $self = shift;
    my $argv = shift || q();
    my $text = ref $argv ? $$argv : $argv;
    my $nyaa = [];

    push @$nyaa, @$KatakanaTails, @$HiraganaTails;
    return $text.$nyaa->[ int rand( scalar @$nyaa ) ];
}

sub straycat {
    my $self = shift;
    my $argv = shift // return q();
    my $noun = shift // 0;

    my $ref1 = ref $argv;
    my $data = [];
    my $text = q();

    my $nekobuffer = q();
    my $leftbuffer = q();
    my $buffersize = 144;
    my $entityrmap = {
        '、' => '、',
        '。' => '。',
    };

    return q() unless $ref1 =~ m/(?:ARRAY|SCALAR)/;
    push @$data, $ref1 eq 'ARRAY' ? @$argv : $$argv;
    return q() unless scalar @$data;

    for my $r ( @$data ) {

        # To be a cat
        if( $r =~ m|[^\x20-\x7e]+| ) {
            # Encode if any multibyte character exsits
            eval { 
                $self->reckon( \$r );
                $nekobuffer .=  $self->toutf8( $r );
            };
            next if $@;

        } else {
            $nekobuffer .= $r;
        }

        for my $e ( keys %$entityrmap ) {
            # Convert character entity reference to character itself.
            next unless $nekobuffer =~ m/$e/;
            $nekobuffer =~ s/$e/$entityrmap->{ $e }/g;
        }

        if( length $nekobuffer < $buffersize ) {

            if( $nekobuffer =~ m/(.+$RxPeriod)(.*)/msx ) {

                $nekobuffer = $1;
                $leftbuffer = $2;

            } else {
                next;
            }
        }

        if( $nekobuffer =~ m|[^\x20-\x7e]+| ) {
            # Convert if any multibyte character exsits
            $nekobuffer = $self->cat( \$nekobuffer, 1 );
        }

        if( $noun ) {
            # Convert noun
            $nekobuffer = $self->neko( \$nekobuffer, 1 ) if $nekobuffer =~ m|[^\x20-\x7e]+|;
            $leftbuffer = $self->neko( \$leftbuffer, 1 ) if $leftbuffer =~ m|[^\x20-\x7e]+|;
        }

        $text .= $nekobuffer;
        $nekobuffer  = $leftbuffer;
        $leftbuffer  = q();
    }

    $text .= $nekobuffer if length $nekobuffer;
    return $self->utf8to( $text );
}

sub reckon {
    # Recognize text encoding
    my $self = shift;
    my $argv = shift;

    my $ref1 = ref $argv;
    my $text = $ref1 eq 'SCALAR' ? $$argv: $argv;
    return q() unless length $text;

    use Encode::Guess qw(shiftjis euc-jp 7bit-jis);
    $self->{'utf8flag'} = utf8::is_utf8 $text;

    my $code = Encode::Guess->guess( $text );
    my $name = q();
    return q() unless ref $code;

    # What encoding
    $name = $code->name;
    $name = $1 if $name =~ m/\A(.+) or .+/;

    if( $name ne 'ascii' ) {
        $self->{'encoding'} ||= $name;
    }
    return $self->{'encoding'};
}