最近デザインパターンを勉強していることも有り、
perlでMooseを使ってAbstract Factoryを書いてみました。
Abstract Factoryはオブジェクトの生成、実装を使用者側に意識させることなく
使わせることが出来てまたオブジェクトの種類を増やす際も既存のコードに
影響をおよぼすことなく追加する事が可能です。

題材はメールの受信、送信のオブジェクトを生成する部分を
隠匿し、現状はPOP、IMAP、SMTPですが将来的に
POPSやIMAPS、SMTPSを実装する際に現状の処理に影響なく
追加出来るようになっています。
#パッケージを一つのファイルで書いている、エラー処理が薄いのは
学習用途としてそっと受け止めて下さい。
実装としては抽象クラス相当は全てMoose::Roleを使っています。

受信オブジェクトの生成
[Perl]
use utf8;

#**************************************
# Name:Mailler_Receive.pm
#**************************************

#————————————–
# 受信の抽象クラス(ロール)
#————————————–
package Receive_Abstract;
use Moose::Role;
has ‘server’ => (
is => ‘rw’,
isa => ‘Str’,
required => 1
);
has ‘mailaddress’ => (
is => ‘rw’,
isa => ‘Str’,
required => 1
);
has ‘password’ => (
is => ‘rw’,
isa => ‘Str’,
required => 1
);
has ‘socket’ => (
is => ‘rw’,
);
requires qw(connect getuidl getmsg disconnect);
no Moose::Role;

#—————————————
#POPの具象クラス
#—————————————
package Receive_Concrete_Pop;
use Net::POP3;
use Moose;
#ロールによって実装メソッドの制約
with ‘Receive_Abstract’;
has ‘+socket’ => (
isa => ‘Net::POP3’
);

__PACKAGE__->meta->make_immutable;

no Moose;

sub connect {
my $self=shift;
eval{
$self->socket(Net::POP3->new($self->server(), Port =>110)) or die;
$self->socket->login($self->mailaddress, $self->password) or die
};
if($@){
return(-1);
}
}
sub getuidl {
my %mlist;
eval{
%mlist=%{shift->socket->uidl};
};
if($@){
return(-1);
}
return %mlist;
}
sub getmsg {
my ($self,$msgid)=@_;
my $msg;
my %mlist;

eval{
%mlist=%{shift->socket->uidl};

for my $key(keys %mlist){
if($msgid eq $mlist{$key}){
$msg=$self->socket->get($key);
last;
}
}
};
if($@){
return(-1);
}
return @$msg;
}
sub disconnect {
shift->socket->quit;
}

#—————————————
#IMAPの具象クラス
#—————————————
package Receive_Concrete_Imap;
use Mail::IMAPClient;
use Moose;

#ロールによって実装メソッドの制約
with ‘Receive_Abstract’;

has ‘+socket’ => (
isa => ‘Mail::IMAPClient’
);
__PACKAGE__->meta->make_immutable;
no Moose;

sub connect {
my $self=shift;
eval{
$self->socket(Mail::IMAPClient->new(
Server => $self->server,
User => $self->mailaddress,
Password => $self->password,
Port => 143,
Ssl => 0,
Authmechanism => ‘PLAIN’ ,
)) or die;
#受信ボックスを選択
$self->socket->select(‘inbox’);
};
if($@){
return(-1);
}
}
sub getuidl {
my @mlist;
my %h;
my $i=0;
eval{
@mlist=shift->socket->search(“ALL”);
};
if($@){
return(-1);
}
for my $val(@mlist){
$h{$i}=$val;
$i++;
}
return %h;
}
sub getmsg {
my ($self,$msgid)=@_;
my $msg;
eval{
$msg=$self->socket->message_string($msgid);
};
if($@){
return(-1);
}
return $msg;
}
sub disconnect {
shift->socket->disconnect;
}
1;
[/Perl]
送信オブジェクトの生成
[Perl]
use utf8;
#**************************************
# Name:Mailler_Send.pm
#**************************************

#————————————–
# 送信の抽象クラス(ロール)
#————————————–
package Send_Abstract;
use Moose::Role;
has ‘server’ => (
is => ‘rw’,
isa => ‘Str’,
required => 1
);
has ‘socket’ => (
is => ‘rw’,
);
requires qw(connect send disconnect);
no Moose::Role;

#————————————–
# 送信の具象クラス
#————————————–
package Send_Concrete_Smtp;
use Net::SMTP;
use Jcode;
use Moose;
with ‘Send_Abstract’;

has ‘+socket’ => (
isa => ‘Net::SMTP’
);

__PACKAGE__->meta->make_immutable();
no Moose;

sub connect{
my $self=shift;
eval{
$self->socket(Net::SMTP->new($self->server, Port => 25,Timeout=>10,Debug=>0)) or die;
};
if($@){
return(-1);
}
}
sub send{
my ($self,$from,$to,$subject,$body) = @_;
my $header;
my $content;
#ヘッダを組み立てる
$header = “From: ” . jcode(“$from”)->mime_encode . “\n”;
$header .= “To: ” . jcode(“$to”)->mime_encode . “\n”;
$header .= “Subject: ” . jcode($subject)->mime_encode . “\n”;
$header .= “MIME-Version: 1.0\n”;
$header .= “Content-type: text/plain; charset=ISO-2022-JP\n”;
$header .= “Content-Transfer-Encoding: 7bit\n\n”;

#ボディーを変換する
$content=jcode($body)->jis;
#送信する
eval{
$self->socket->mail($from);
$self->socket->to($to);
$self->socket->data();
$self->socket->datasend($header);
$self->socket->datasend($content);
$self->dataend();
}
}
sub disconnect{
shift->socket->quit;
}
1;
[/Perl]

オブジェクトを生成する工場クラス
[Perl]
use utf8;
#**************************************
# Name:Mailler_Factory.pm
#**************************************

#————————————–
# 工場の抽象クラス(ロール)
#————————————–
package Mailler_Abstract;
use Moose::Role;
requires qw(create_receive create_send);
no Moose::Role;

#————————————–
# 工場の具象クラス
#————————————–
package Concreate_Factory;
use lib ‘/Users/yamashitakazuhiko/learn_perl’;
use Mailler_Receive;
use Mailler_Send;

use Moose;
#ロールで実装するメソッドに制約を与える
with ‘Mailler_Abstract’;

#接続タイプはPOPかIMAP
has ‘type’ => (
is => ‘rw’,
isa => ‘Str’,
default => ‘pop’
);

__PACKAGE__->meta->make_immutable;
no Moose;

#受信部品の作成
sub create_receive{
my ($self,$server,$mailaddress,$password) = @_;

if($self->type() eq ‘pop’){
return(Receive_Concrete_Pop->new(server => $server, mailaddress => $mailaddress, password => $password));
}else{
return(Receive_Concrete_Imap->new(server => $server, mailaddress => $mailaddress, password => $password));
}

}

#送信部品の作成
sub create_send{
my ($self,$server) = @_;
return(Send_Concrete_Smtp->new( server => $server ));
}
1;
[/Perl]

こんな感じで、

[Perl]
#————————————–
# 工場の抽象クラス(ロール)
#————————————–
package Mailler_Abstract;
use Moose::Role;
requires qw(create_receive create_send);
no Moose::Role;
[/Perl]
use Moose::Roleとno Moose::Roleの間にrequiresでこのロールを持つpackageで実装を
求めるメソッドを定義しておくことに置くと、抽象クラス相当のことが実現できます。
一つのファイル内で抽象クラス(Abstract)と具象クラス(Concrete)を記載しているので
イメージがわかりづらいかと思いますが、
実際の使い方を見るとすっきりするかもしれません。

[Perl]
use utf8;

#****************************************
# Name:AbstractFactory.pl
#****************************************

use strict;
use warnings;
use lib ‘/Users/yamashitakazuhiko/learn_perl’;
use Mailler_Factory;

my @factorys;

#IMAP接続の工場
push(@factorys,Concreate_Factory->new(type=>’imap’));

#POP接続の工場
push(@factorys,Concreate_Factory->new(type=>’pop’));

#配列をeachで回す
for my $factory(@factorys){

#受信部品を作成
my $rec=$factory->create_receive(‘サーバIPアドレス’,’メールアドレス’,’パスワード’);
#接続する
$rec->connect();
#メールの一覧を取得する
my %list=$rec->getuidl();
#一通目を受信し、表示する
print $rec->getmsg($list{1}),”\n”;
#切断する
$rec->disconnect;

#送信部品を作成
my $tra=$factory->create_send(‘サーバIPアドレス’);
#接続する
$tra->connect();
#送信する
$tra->send(qw(Fromアドレス Toアドレス 件名 本文));
#切断する
$tra->disconnect();

}
[/Perl]

上記のコードの中の、

[Perl]
#配列をeachで回す
for my $factory(@factorys){

#受信部品を作成
my $rec=$factory->create_receive(‘サーバアドレス’,’メールアドレス’,’パスワード’);
#接続する
$rec->connect();
#メールの一覧を取得する
my %list=$rec->getuidl();
#一通目を受信し、表示する
print $rec->getmsg($list{1}),”\n”;
#切断する
$rec->disconnect;
[/Perl]
$factoryの中には、IMAP、POPと接続形式の違うオブジェクトが入るのですが
呼び出す側はそれを意識することなく接続、受信、切断ができています。
またその前段のオブジェクト作成においても何も意識することなく
IMAPとPOP接続のオブジェクトを受け取れていることがわかると思います。

次はAdapter当たりを書いてみようと思います。
それでは♥