"ツンデレ"を実装する [Perl]

# やばっ 普通に答えたらイカんのかな、これ(ビクビク

επιστημηさんの 祭りの仕掛け に 引っかかってみました。

use strict;
use warnings;
use encoding q/utf-8/, Filter => 1, STDOUT => q/cp932/;
use utf8;
use Scalar::Util;

package ツンデレ;

sub new {
	my $pkg = shift;
	my %arg = @_;
	die "失格" if !exists $arg{デレに変わる条件};
	bless \%arg, $pkg;
}

sub 態度 { shift->きっかけ || print "ツン" }

sub きっかけ {
	my $self = $_[0];
	if ( $self->{デレに変わる条件}->($self) )
	{
		no strict qw/refs/;
		my $pkg = 'ツンデレ::_' . Scalar::Util::refaddr($self);
		eval "package $pkg; our \@ISA = (q/ツンデレ/);";
		die $@ if $@;
		*{$pkg . '::態度'} = sub { print "デレ" };
		$self = bless $self, $pkg;
		$self->態度;
		$self;
	}
}

sub 相手 {
	my $self = shift;
	$self->{相手} = shift;
	print "\n相手は " . $self->{相手} . "\t";
	$self;
}
package main;
srand(time);

sub 突発的事項 { int rand 20 }
sub 発生した { 0 };

my $あの子 = ツンデレ->new(
	デレに変わる条件 => sub {
		my $self = shift;
		$self->{$self->{相手}}{訪問回数}++ > 5;
	});

$あの子->相手(("scott", "andrei", "epi")[int rand 3])->態度 for 1 .. 20;
print "\n";

my $その子 = ツンデレ->new(
	デレに変わる条件 => sub {
		突発的事項 == 発生した
	});
$その子->態度 for 1 .. 20;
print "\n";

my $ビッチ = ツンデレ->new(
	デレに変わる条件 => sub { 1 });
$ビッチ->態度 for 1 .. 5;
print "\n";

eval {
	my $普通の子 = ツンデレ->new(); # エラー
};
print $@ if $@;

最初は「ツンツン」した態度だけどある条件をクリアすると「デレ」に移行するというタイプのツンデレの実装になります。なお、デレに変わる条件がない場合はツンデレとは認められません。

ツンデレ移行判定はStrategyパターンで。ツンからデレに移行するのは、インスタンス毎にツンデレのサブクラスを動的に生成して、インスタンスをそのサブクラスに所属替え(rebless)して"態度"を変える という多少強引な事をやってます。

use encoding の STDOUT => q/cp932/ は、Windows上で動かしてるからなだけです。