前回と同じくデザインパターンネタ。
今回はBridge。
このパターンの特徴としては実際の操作するオブジェクトと
処理内容を記述するオブジェクトを分離することです。
操作するオブジェクトは処理内容が記述されているオブジェクトに
処理を委譲しますが、ユーザーはその処理内容を意識することはありません。

今回もサンプルはメール受信クラスで書いてみました。
抽象クラス相当も同じくRoleで書いており、共通のパラメーターは
Roleに書けることが判明したので書いてみました。
＃Thanks >　y_morimoto

ファイル構成
・Bridge.pl
　−メイン処理を記述
・Mailler_Receive.pm
　−メール受信をする処理の記述
・Mailler_Object.pm
　−メール受信オブジェクトの箱の記述

Mailler_Receive.pmにはPOP接続クラスの具体的な記述、IMAP接続クラスの具体的な記述を
おっており、Mailler_Object.pmには先のクラスを格納する変数を定義しています。
実施にはhasの定義にdoesという形で同じロールを持つこと、handlerで
実行可能なメソッドを記述しています。

Bridge.pl

[Perl]
use utf8;
#———————————————

Name:Bridge.pl

#———————————————

use Mailler_Receive;
use Mailler_Object;

#Mailler_ObjectにPOP接続、IMAP接続を代入する
my $pop = Mailler_Object->new( receiver => Receive_Pop->new( server => ‘サーバアドレス’,mailaddress => ‘メールアドレス’, password => ‘パスワード’));
my $imap = Mailler_Object->new( receiver => Receive_Imap->new( server => ‘サーバアドレス’,mailaddress => ‘メールアドレス’, password => ‘パスワード’));

#————————————–

POPの処理

#————————————–

#POPの接続
$pop->connect();

#メール一覧の取得
my %list=$pop->getuidl();

#一通目を受信し、表示する
print $pop->getmsg($list{1}),”\n”;

#切断
$pop->disconnect();

#————————————–

IMAPの処理

#————————————–

#IMAPの接続
$imap->connect();

#メール一覧の取得
my %list=$imap->getuidl();

#一通目を受信し、表示する
print $imap->getmsg($list{1}),”\n”;

#切断
$imap->disconnect();
[/Perl]

Mailler_Receive.pm

[Perl]
use utf8;

#**************************************

Name:Mailler_Receive.pm

#**************************************

#————————————–

受信の抽象クラス(ロール)

#————————————–
package Receive_Role;
use Moose::Role;
requires qw(connect getuidl getmsg disconnect);
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’,
);
no Moose::Role;

#—————————————
#POPの具象クラス
#—————————————
package Receive_Pop;
use Net::POP3;
use Moose;
#ロールによって実装メソッドの制約
with ‘Receive_Role’;

    #継承しつつ型の定義の追加
    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_Imap;
use Mail::IMAPClient;
use Moose;

    #ロールによって実装メソッドの制約
    with 'Receive_Role';

    #継承しつつ型の定義の追加
    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]

Mailler_Object.pm

[Perl]
use utf8;
#—————————————

Name:Mailler_Object.pm

#—————————————
package Mailler_Object;
use Moose;
has ‘receiver’ =>(
is => ‘rw’,
does => ‘Receive_Role’, #実装メソッドの制約
required => 1,
#handlesで定義したメソッドを定義できる
handles => [qw(connect getuidl getmsg disconnect)]
);

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

[/Perl]

前回のAbstract Factoryと比べてだいぶスッキリしましたね。
この手のやつってクラスサンプル考えるほうが悩ましいということに気づきつつも有りますが、
次のパターンも頑張ります。