Acme-Nyaa

 view release on metacpan or  search on metacpan

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

    # Constructor of Acme::Nyaa
    my $class = shift;
    my $argvs = { @_ };

    return $class if ref $class eq __PACKAGE__;
    $argvs->{'objects'} = [];
    $argvs->{'language'} ||= $Default;
    $argvs->{'loaded-languages'} = [];
    $argvs->{'objectid'} = int rand 2**24;
    $argvs->{'encoding'} = q();
    $argvs->{'utf8flag'} = undef;

    my $nyaan = bless $argvs, __PACKAGE__;
    my $klass = $nyaan->loadmodule( $argvs->{'language'} );
    my $this1 = $nyaan->findobject( $klass, 1 );

    $nyaan->{'subclass'} = $klass;
    return $nyaan;
}

sub subclass {

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

sub toutf8 {
    my $self = shift;
    my $argv = shift;
    my $text = undef;

    $text = ref $argv ? $$argv : $argv;
    return $text unless length $text;

    $self->reckon( \$text );
    return $text if $self->{'utf8flag'};
    return $text unless $self->{'encoding'};

    if( not $self->{'encoding'} =~ m/(?:ascii|utf8)/ ) {
        Encode::from_to( $text, $self->{'encoding'}, 'utf8' );
    }

    $text = Encode::decode_utf8 $text unless utf8::is_utf8 $text;
    return $text;
}

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

    my $self = shift;
    return __PACKAGE__->new unless ref $self;
    return $self;
}
*objects = *object;
*findobject = *object;

sub cat {
    my $self = shift;
    my $argv = shift;
    my $flag = shift // 0;

    my $ref1 = ref $argv;
    my $text = undef;
    my $neko = undef;
    my $nyaa = undef;

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

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

                    $e =~ s/(\s*?)\z/$KatakanaTails->[ $r1 ]$1/;
                }
            }
        }

        $e =~ s/[!]$RxPeriod/! /g;
        $e .= qq(\n) if $haschomped;

    } # End of for(@$writingset)

    return $self->utf8to( join( '', @$writingset ) ) unless $flag;
    return join( '', @$writingset );
}

sub neko {
    my $self = shift;
    my $argv = shift;
    my $flag = shift // 0;

    my $ref1 = ref $argv;
    my $text = undef;
    my $neko = undef;

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

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

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

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

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' ) {

t/11_acme-nyaa-ja.t  view on Meta::CPAN

open( my $fh, '<', $nekotext ) || die 'cannot open '.$nekotext;
$textlist = [ <$fh> ];
ok( scalar @$textlist, sprintf( "%s have %d lines", $nekotext, scalar @$textlist ) );
close $fh;

foreach my $f ( 0, 1 ) {

    foreach my $u ( @$textlist ) {

        my $label = $f ? '->cat(utf8-flagged)' : '->cat(utf8)';
        my ($text0, $text1, $text2, $text3, $text4);
        my ($size0, $size1, $size2, $size3, $size4);

        $text0 = $u; chomp $text0;
        utf8::decode $text0 if $f;

        $text1 = $sabatora->cat( \$text0 );
        utf8::decode $text0 unless utf8::is_utf8 $text0;
        $size0 = length $text0;
        $size1 = length $text1;

t/11_acme-nyaa-ja.t  view on Meta::CPAN

            sprintf( "[1] %s: %s(%d) => %s(%d)", $label, 
                    e($text0), $size0, 
                    e($text1), $size1) );

        $text2 = $sabatora->cat( \$text1 );
        utf8::decode $text1  unless utf8::is_utf8 $text1;
        $size1 = length $text1;
        $size2 = length $text2;
        ok( $size2 >= $size1, sprintf( "[2] %s", $label ) );

        $label = $f ? '->neko(utf8-flagged)' : '->neko(utf8)';
        $text3 = $sabatora->neko( \$text0 );
        utf8::decode $text0 unless utf8::is_utf8 $text0;
        $size0 = length $text0;
        $size3 = length $text3;

        ok( $size3 >= $size0, 
            sprintf( "[1] %s: %s(%d) => %s(%d)", $label, 
                    e($text0), $size0,
                    e($text3), $size3 ) );