use strict;
use warnings;
{
package Interface::Product;
use strict;
use warnings;
sub use { die; }
sub createClone{ die; }
}
{
package Manager;
use strict;
use warnings;
use Data::Dumper;
sub new {
my ($class,) = @_;
my $self = {};
return bless $self, $class;
}
sub register {
my ($self, $name, $proto) = @_;
$self->{$name} = $proto;
}
sub create {
my ($self, $protoname) = @_;
my $product = $self->{$protoname};
return $product->createClone();
}
}
{
package UnderlinePen;
use strict;
use warnings;
use Encode;
use Data::Dumper;
our @ISA = qw/Interface::Product/;
sub new {
my ($class, $ulchar) = @_;
my $self = {
ulchar => $ulchar,
};
return bless $self, $class;
}
sub use {
my ($self, $string) = @_;
my $len = length(decode('UTF-8', $string));
print "\"".$string."\"\n";
print " ";
print $self->{ulchar} for(1..$len);
print " ";
}
sub createClone {
my $self = shift;
return $self;
}
}
{
package MessageBox;
use strict;
use warnings;
use Encode;
our @ISA = qw/Interface::Product/;
sub new {
my ($class, $decochar) = @_;
my $self = {
decochar => $decochar,
};
return bless $self, $class;
}
sub use {
my ($self, $string) = @_;
my $len = length(decode('UTF-8', $string));
print $self->{decochar} for(1..($len + 4));
print "\n";
print $self->{decochar}." ".$string." ".$self->{decochar}."\n";
print $self->{decochar} for(1..($len + 4));
print "\n";
}
sub createClone {
my $self = shift;
return $self;
}
}
my $manager = Manager->new();
my $upen = UnderlinePen->new('~');
my $mbox = MessageBox->new('*');
my $sbox = MessageBox->new('/');
$manager->register("strong message", $upen);
$manager->register("warning box", $mbox);
$manager->register("slash box", $sbox);
my $product01 = $manager->create("strong message");
$product01->use('hoge');
print "\n";
my $product02 = $manager->create("warning box");
$product02->use('yorosiku_aiueo');
print "\n";
my $product03 = $manager->create("slash box");
$product03->use('uhohohoho');