Acme::Oppai - Oppai! Oppai!

  perl -MAcme::Oppai -e 'print Acme::Oppai->new->massage';
  perl -MAcme::Oppai -e 'print Acme::Oppai->new->massage->massage->massage->massage->massage->massage->massage';

  perl -MAcme::Oppai -e 'print Acme::Oppai->oppai';
  perl -MAcme::Oppai -e 'print Acme::Oppai->oppai->oppai->oppai';
  perl -MAcme::Oppai -e 'print Acme::Oppai->Oppai->oppai->Oppai("OPPAI!")->oppai("oppai!")';
  perl -MAcme::Oppai -e 'print Acme::Oppai->new(default => 'default')->oppai->oppai->oppai';

  # or

  use Acme::Oppai;

  print Acme::Oppai->oppai;
  print Acme::Oppai->oppai->oppai->oppai->oppai;
  print Acme::Oppai->oppai('your')->oppai('soul')->oppai('message')->oppai;

  my $oppai = Acme::Oppai->new(default => 'default');
  print $oppai->Oppai->Oppai->Oppai;
  print $oppai->oppai->oppai->oppai;
  print $oppai->oppai->Oppai->oppai;

  # Hummm I'm tired...

  　　　 _ 　∩
  　　(　゜∀゜)彡　おっぱい!おっぱい!
  　　(　 ⊂彡
  　 　|　　　|　
  　 　し ⌒Ｊ

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;
                     return <<OPPAI;
　 _ 　∩
(　゜∀゜)彡　$word
　⊂彡
OPPAI
                 },
                 oppai_up => sub {
                     my $word = shift;
                     return <<OPPAI;
　 _ 　∩
(　゜∀゜)彡　$word

OPPAI
                 },
                 oppai_down => sub {
                     my $word = shift;
                     return <<OPPAI;

(　゜∀゜)彡　$word
　⊂彡
OPPAI
                 },

                 Oppai => sub {
                     my $word = shift;
                     return <<OPPAI;
　　　 _ 　∩
　　(　゜∀゜)彡　$word
　　(　 ⊂彡
　 　|　　　|　
　 　し ⌒Ｊ
OPPAI
                 },
                 Oppai_up => sub {
                     my $word = shift;
                     return <<OPPAI;
　　　 _ 　∩
　　(　゜∀゜)彡　$word
　　(　 　　|　
　 　|　　　|　
　 　し ⌒Ｊ
OPPAI
                 },
                 Oppai_down => sub {
                     my $word = shift;
                     return <<OPPAI;
　　　 _ 　
　　(　゜∀゜)　　$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__