view release on metacpan or  search on metacpan

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

　　　 _ 　
　　(　゜∀゜)　　$word
　　(　 ⊂彡
　 　|　　　|　
　 　し ⌒Ｊ
OPPAI
                 },
                 );

our %BASIC_WORD = (
                 oppai => 'おっぱい!おっぱい!',
                 oppai_up => 'おっぱい!',
                 oppai_down => 'おっぱい!',

                 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 = '';
    my $self = [
                \$str,
                \%opt,
                ];
    $self = bless $self, $class;

    $self->clear;
    $self;
}

sub clear {
    my $self = shift;
    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 {
    my $proto = shift;
    my $self = blessed($proto) ? $proto : $proto->new;
    my $type = shift;

    if ($self->[1]->{default}) {
        $type .= "_$1" if $self->[1]->{default} =~ /^(up|down)$/;
    } else {
        if ($self->[2] eq 1) {
            ${ $self->[0] } = $self->gen($self->[3]->[0]->{type} . '_up', $self->[3]->[0]->{word});
        }
        $self->[2]++;
        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;
    ${ $self->[0] } .=<<OPPAI;
　　　 _ 　∩
　　(　゜∀゜)彡　おっぱい!おっぱい!
　　(　 ⊂彡
　 　|　　　|　
　 　し ⌒Ｊ
OPPAI
    $self;
}

1;
__END__

=head1 NAME

Acme::Oppai - Oppai! Oppai!

=head1 SYNOPSIS