Acme-Nyaa
4 results

 view release on metacpan or  search on metacpan

eg/nyaaproxy.psgi  view on Meta::CPAN 

builder {
    sub {
        my $env = shift;
        my $url = $env->{'REQUEST_URI'} || $env->{'PATH_INFO'};
        my $req = Plack::Request->new( $env );
        my $res = undef;
        my $err = [ 'Failed to connect' ];
        my $cth = [ 'Content-Type' => 'text/plain' ];
        my $tmp = undef;

        if( length $url > 1 ) {

            if( $url =~ m|\A/(https?://)(.+?)/(.*)\z| ) {
                $servername = $1.$2;
                $requesturl = $servername.'/'.$3;

            } else {
                $requesturl = $servername.$url;
            }
            $htresponse = $httpobject->get( $requesturl );

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


sub language {
    my $self = shift;
    my $lang = shift // $self->{'language'};

    return $self->{'language'} if $lang eq $self->{'language'};
    return $self->{'language'} unless $lang =~ m/\A[a-zA-Z]{2}\z/;

    my $nekoobject = undef;
    my $referclass = $self->loadmodule( $lang );
    return $self->{'language'} unless length $referclass;
    return $self->{'language'} if $referclass eq $self->subclass;

    $nekoobject = $self->findobject( $referclass, 1 );
    return $self->{'language'} unless ref $nekoobject eq $referclass;

    $self->{'language'} = $lang;
    $self->{'subclass'} = $referclass;
    return $self->{'language'};
}

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

}

sub loadmodule {
    my $self = shift;
    my $lang = shift;
    my $list = $self->{'loaded-languages'};

    my $referclass = __PACKAGE__.'::'.ucfirst( lc $lang );
    my $alterclass = __PACKAGE__.'::'.ucfirst( $Default );

    return q() unless length $lang;
    return $referclass if( grep { lc $lang eq $_ } @$list );

    eval {
        Module::Load::load $referclass; 
        push @$list, lc $lang;
    };

    return $referclass unless $@;
    return $alterclass if( grep { 'ja' eq $_ } @$list );

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

    return $alterclass;
}

sub findobject {
    my $self = shift;
    my $name = shift;
    my $new1 = shift || 0;
    my $this = undef;
    my $objs = $self->{'objects'} || [];

    return unless length $name;

    for my $e ( @$objs ) {

        next unless ref($e) eq $name;
        $this = $e;
    }
    return $this if ref $this;
    return unless $new1;

    $this = $name->new;

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

    my $self = shift;
    return $self->{'encoding'};
}

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

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

    $text = ref $argv ? $$argv : $argv;
    return $text unless $self->{'encoding'};
    return $text unless length $text;

    $text = Encode::encode_utf8 $text if utf8::is_utf8 $text;
    if( $self->{'encoding'} ne 'utf8' ) {
        Encode::from_to( $text, 'utf8', $self->{'encoding'} );
    }

    return $text;
}

1;

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

    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;

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

    $neko =~ s{($RxPeriod)}{$1$Separator}g;
    $neko .= $Separator unless $neko =~ m{$Separator};

    my $hiralength = scalar @$HiraganaTails;
    my $katalength = scalar @$KatakanaTails;
    my $writingset = [ split( $Separator, $neko ) ];
    my $haschomped = 0;
    my ( $r1,$r2 ) = 0;

    for my $e ( @$writingset ) {

        next if $e =~ m/\A$RxPeriod\s*\z/;
        next if $e =~ m/$RxEndOfList\s*\z/;
        next if grep { $e =~ m/\A$_\s*/ } @$DoNotBecomeCat;
        next if grep { $e =~ m/$_$RxPeriod?\z/ } @$HiraganaTails;

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

        if( $e =~ m/な$RxPeriod?\s*\z/ ) {
            # な => にゃー
            $e =~ s/な($RxPeriod?)(\s*)\z/$HiraganaNya$1$2/;

        } elsif( $e =~ m/ナ$RxPeriod?\s*\z/ ) {
            # ナ => ニャー
            $e =~ s/ナ($RxPeriod?)(\s*)\z/$HiraganaNya$1$2/;

        } elsif( $e =~ m/\p{InHiragana}$RxPeriod\s*\z/ ) {

            $r1 = int rand $katalength;
            $e =~ s/($RxPeriod)(\s*)\z/$KatakanaTails->[ $r1 ]$1$2/;

        } elsif( $e =~ m/\p{InKatakana}$RxPeriod\s*\z/ ) {

            $r1 = int rand $hiralength;
            $e =~ s/($RxPeriod)(\s*)\z/$HiraganaTails->[ $r1 ]$1$2/;

        } elsif( $e =~ m/\p{InCJKUnifiedIdeographs}$RxPeriod?\s*\z/ ) {

            $r1 = int rand $hiralength;
            $r2 = int rand scalar @$Copulae;
            $e =~ s/($RxPeriod?)(\s*)\z/$Copulae->[ $r2 ]$KatakanaTails->[ $r1 ]$1$2/;

        } else {
            if( $e =~ m/($RxEndOfSentence)\s*\z/ ) {
                # ... => ニャー..., ! => ニャ!
                my $eos = $1;

                if( $e =~ m/\p{InKatakana}$RxEndOfSentence\s*\z/ ) {

                    $r1 = int rand( $hiralength / 2 );
                    $e =~ s/$RxEndOfSentence/$HiraganaTails->[ $r1 ]$eos/g;

                } elsif( $e =~ m/\p{InHiragana}$RxEndOfSentence\s*\z/ ) {

                    $r1 = int rand( $katalength / 2 );
                    $e =~ s/$RxEndOfSentence/$KatakanaTails->[ $r1 ]$eos/g;

                } else {
                    $r1 = int rand( $katalength / 2 );
                    $r2 = int rand( scalar @$Copulae );
                    $e =~ s/$RxEndOfSentence/$Copulae->[ $r2 ]$KatakanaTails->[ $r1 ]$eos/g;
                }

            } elsif( $e =~ m/$RxConversation\s*\z/ ) {

                # 0.5の確率で会話の後ろで猫が喧嘩をする
                if( $e =~ m/\A(.*$RxConversation[ ]*)($RxConversation.*)\s*\z/ ) {

                    $r1 = int rand scalar @$FightingCats;
                    $e = $1.$FightingCats->[ $r1 ].$2 if int(rand(10)) % 2;
                }
                $r1 = int rand scalar @$FightingCats;
                $e .= $FightingCats->[ $r1 ] if int(rand(10)) % 2;

            } else {

                $r1 = int rand $katalength;

                if( $e =~ m/[0-9\p{Latin}]\s*\z/ ) {

                    $r2 = int rand scalar @$Copulae;
                    $e =~ s/(\s*?)\z/ $Copulae->[ $r2 ]$KatakanaTails->[ $r1 ]$1/;

                } elsif( $e =~ m/\p{InKatakana}\s*\z/ ) {

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

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

    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;


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

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

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

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

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

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

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


        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;

        ok( $size1 >= $size0, 
            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 ) );

        $text4 = $sabatora->neko( \$text3 );
        is( $text4, $text3, sprintf( "[2] %s", $label ) );
    }
}

use Encode::Guess qw(shiftjis euc-jp 7bit-jis);
foreach my $e ( @$encoding ) {

    foreach my $t ( @$textlist ) {

        next unless length $t > 100;
        my $label = sprintf( "->cat(%s)", $e );
        my $guess = undef;
        my ($text0, $text1, $text2, $text3, $text4);
        my ($size0, $size1, $size2, $size3, $size4);

        $text0 = $t; chomp $text0;
        Encode::from_to( $text0, 'utf8', $e );
        $guess = Encode::Guess->guess( $text0 );

        ok( ref $guess, ref $guess );
        ok( $guess->name, $guess->name );
        like( $guess->name, qr/$e/, $e );

        $text1 = $sabatora->cat( \$text0 );
        Encode::from_to( $text0, $e, 'utf8' );
        utf8::decode $text0 unless utf8::is_utf8 $text0;

        ok( length $text1 >= length $text0, sprintf( "[2] %s", $label ) );

        $text2 = $sabatora->cat( \$text1 );
        ok( length $text2 >= length $text1, sprintf( "[2] %s", $label ) );

        $label = sprintf( "->neko(%s)", $e );
        $text3 = $sabatora->neko( \$text0 );
        ok( length $text3 >= length $text0, sprintf( "[2] %s", $label ) ); 

        $text4 = $sabatora->neko( \$text3 );
        is( $text4, $text3, sprintf( "[2] %s", $label ) );
    }
}

foreach my $e ( '', '猫', 'ねこ', 'ネコ' ) {

    $nekotext = $sabatora->nyaa($e);
    ok( length $nekotext, sprintf( "->nyaa(%s) => %s", e($e), e($nekotext) ) );
}

$nekotext = 't/a-part-of-i-am-a-cat.ja.txt';
ok( -T $nekotext, sprintf( "%s is textfile", $nekotext ) );
ok( -r $nekotext, sprintf( "%s is readable", $nekotext ) );

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

my $text0 = join( '', @$textlist );
my $text1 = $sabatora->straycat( $textlist );
my $text2 = $sabatora->straycat( \$text0 );

utf8::decode $text0 unless utf8::is_utf8 $text0;

ok( length( $text1 ) > length( $text0 ) );
ok( length( $text2 ) > length( $text0 ) );

done_testing();
__END__



( run in 0.870 second using v1.01-cache-2.11-cpan-65fba6d93b7 )