Acme-Oppai

 view release on metacpan or  search on metacpan

example/pearl  view on Meta::CPAN

#!/usr/bin/perl

use strict;
use warnings;
use utf8;

use Acme::Oppai;
use Encode;
use Time::HiRes qw(usleep);

my $wait = 1;
$SIG{INT} = 'IGNORE';

my $encoding = 'utf8';
if ($ENV{LANG} =~ /euc/i) {
    $encoding = 'euc-jp';
} elsif ($ENV{LANG} =~ /(shiftjis|sjis)/i) {
    $encoding = 'shiftjis';
} elsif ($ENV{LANG} =~ /jis/i) {
    $encoding = '7bit-jis';
}
binmode STDOUT, ":encoding($encoding)";

my $up = Acme::Oppai->new(default => 'up', use_utf8 => 1)->Oppai('おっ');
my $down = Acme::Oppai->new(default => 'down', use_utf8 => 1)->Oppai('ぱい！');
$up   = "$up";
$down = "$down";

my $now = $up;
my $i = 0;
while ($wait > 0) {
    display($now);
    $now = $now eq $up ? $down : $up;
    usleep(int($wait * 1000000));
    $wait -= (int($wait + 1) / 40);

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

package Acme::Oppai;

use strict;
use warnings;
use utf8;

use Encode;
use Encode::Guess;
use Scalar::Util qw(blessed);

our $VERSION = '0.03';

our %BASIC_AA = (
                 oppai => sub {
                     my $word = shift;

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

                 Oppai => 'おっぱい!おっぱい!',
                 Oppai_up => 'おっぱい!',
                 Oppai_down => 'おっぱい!',
                 );

use overload q("") => sub { 
    my $self = shift;
    my $oppai = ${ $self->[0] };

    if ($self->[1]->{use_utf8}) {
        utf8::decode($oppai) unless utf8::is_utf8($oppai);
    } else {
        utf8::encode($oppai) if utf8::is_utf8($oppai);
    }
    $self->clear;
    $oppai;
};

sub new {
    my $class = shift;
    my %opt = @_;

    my $str = '';

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

    my $str = '';
    $self->[0] = \$str;
    $self->[2] = 0;
    $self->[3] = [];
}

sub gen_word {
    my ($self, $type, $word) = @_;

    return $BASIC_WORD{$type} unless $word;
    return $word if utf8::is_utf8($word);
    my $enc = guess_encoding($word, qw(euc-jp shiftjis 7bit-jis utf8));
    return $word unless ref($enc);
    $enc->decode($word);
}

sub gen {
    my ($self, $type, $word) = @_;
    $BASIC_AA{$type}($word);
}

sub base {

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

        if ($self->[2] ne 1) {
            if ($self->[2] % 2) {
                $type .= "_up";
            } else {
                $type .= "_down";
            }
        }
    }

    my $word = $self->gen_word($type, @_);
    utf8::decode($word) unless utf8::is_utf8($word);
    push @{ $self->[3] }, {type => $type, word => $word};
    ${ $self->[0] } .= $self->gen($type, $word);
    $self;
}

sub oppai { shift->base('oppai', @_) }
sub Oppai { shift->base('Oppai', @_) }

sub massage {
    my $self = shift;

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

=item new[(%option)]

make object.

=over 4

=item option

=over 4

=item * use_utf8

use utf8 flag.

=item * default

default Asc Art type(up or down or default)

=back

=back

=item Oppai