Prototypeパターン

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');