perl」カテゴリーアーカイブ

YAPC::Fukuoka 2017 HAKATAでロリポップのAPIについてトークしてきた

僕にとって、YAPC::Fukuoka 2017 HAKATAは非常にロングランで濃いものだった。まずは前日に自社のオフィスで開催された、全然野菜に始まる。

これは元々同僚である @hsbt さんが社のSlackで下記の投稿をしたことから全てが始まった。


現在ペパボ@福岡はオフィス改装中で、ペパステというステージを設けて、登壇イベントをパッケージングしているのでほとんど準備することなく飲み物の準備をするくらいで、当日 #全然野菜 がバズるくらいには盛り上がって大変良かった。

その後は公式の前夜祭に移動し、 @udzura が酔って変なテンションになりながらも、Perlと称してClangのライブコーディングをやり遂げるさまを眺めたりしていた。

そんなこんなでLTソンも終わり、 @hsbt と談笑していると、後ろから肩を誰かにぐわっと捕まれ、 「魚っ!おすすめ!」のような検索ワードか!!という勢いで @songmuさんに声をかけられたので、前夜祭のあとは次の日のトップバッターが両方存在するというチキンレースのような面子で鯖郎へ。

この時間も僕にとってはTwitterでは知ってるけど、お会いしたことない・・・というエンジニアと過ごせてとても良い時間だった。その日はあまり遅くなることなく戻ったのだが、帰ってからなぜ映画を見たりしてしまい、寝不足のまま翌日へ。

本番ではトップバッターでロリポップのコアAPIをバージョンアップすることなく、なんとか開発する体制へと持っていった話をした。

当日反省だったのは、トップバッターだったのだけども、接続確認を直前にしてほしいとのことで、あれをあれしたのだが、いざ直前になると会場の方も接続方法わかっておらず、色々ゴニョゴニョはまって、「ふーーー、繋がったーーー」で話し始めたのはよいものの、急いでいたので発表者モードじゃないまま話し始めてしまい、スライドの前後わからず話してしまったのが失敗だった。トップバッターのときは自分の端末だけじゃなくて他の要素も起こり得るから、次回の肥やしにしたい。

イベント自体は会場提供のLINE Fukuokaすごい!!の一点張りで、トークも非常に面白いものが多かった。ベストトーカーになった徳丸さんのセッションを、ボケッとしていて移動するのをミスってしまい聴き逃したのが非常に残念だったが、あとで動画配信ありそうなのでそちらを楽しみにする。

イベントのあとは @linyows から懇親会のチケットを譲っていただいたので、無事懇親会へ潜入。@hitode909 くんと同じテーブルで、例のシールを頂いたり、良い時間だった。最終的には @fujiwara さんや @motemenさんが @hsbt と話すために集まってきてくれて、何か知らんけどすごい人たちに囲まれる感じだった。

その後は最後にテーブルに付いていたメンバーと数人でペパボの社食の黒田へ。途中から参加した @tagomorisさんが終始元気で笑ってしまった。

そんな感じでほとんど酒を飲んでいた僕の初YAPCでしたが、言語に対する参加者の気持ちがすごくポジティブで最高だなと思った。少なくともPerlって昔ほどは盛り上がっていないと思ってはいたんだけど、中の人達が本当に誇りを持ってやっているし、日本でPerlってまだまだ余裕でイケるんだなと肌感として感じた。そして何より酒がうまい!!!1

次の沖縄も参加できるように何かしらの謎技術を生んで、トーカーに選ばれるように頑張りたい。

Perlでテストを書く

どうもー。
最近はひたすらRailsの開発ばっかりやってるので、
Perlの書き方を忘れないようにテストコードの書き方でも。。。
ちなみにRailsのアプリは今やっとログイン周りが仕上がった感じ。
Teams

本題に戻って、、今回は以前書いた素数を表示するプログラムの
テストコードを書きつつ、パッケージ化してみたいと思います。

今まで仕事でシステムのテストを自動化することは多くありました。
しかし、コードそのもののテストを自動化することってなかったんですよね。

背景としてはバッチ系の処理を書くことが多かったので、そんなに更新が入るコードって
なかったんです。
次の職場ではフロント系の開発もやることが増えてくると思うので、
この辺のテストコードのお作法は抑えておきたいですね。

ついでになぜテストを書くのかって話を立ち返ると、例えばずっと更新が入るコードが
あって、それになんかしらの修正を入れる度に、人が手でテストするのってアホらしい
じゃないですか。

なので機能毎に正常系、異常系の試験を書いておいて、
何か改修した時はそのテストコードを実行して、それがクリアできれば
その改修はこれまでの機能を有しているといえるわけですね。
#クソみたいなテスト書いてるとそう言えないけども

今回の実装としてはパッケージとしてUseできること、素数の計算ができることを
コア機能と捉えてテストコードを書いてみました。

元ネタのsosu.pl
[Perl]
#! /bin/perl -w
use warnings;
use strict;
use utf8;
binmode(STDOUT, “:utf8”);
#引数取得
my $hiki=$ARGV[0];
$hiki =~ /[^0-9]+|^$|^0/ and die “input data is please number!\n”;

#素数結果配列
my @s=(2,3);

#素数処理用一時変数
my $pnum=3;

#無限ループさせる
ROOT:while(1){
#処理する素数候補
$pnum+=2;

#これまでの素数で割り切れたら次のループへ
for(@s){
next ROOT if($pnum % $_ == 0);
}

#割り切れなければ
push @s,$pnum;

if(defined($s[$hiki-1])){
print $hiki . “個目の素数は” . $s[$hiki-1] . “\n”;
exit;
}
}
[/Perl]

早速ですが、今時点で確認できること、出来ないことにテストコードを書いてみましょう。

00_sosu.t
[Perl]
# 00_sosu.t
use strict;
use Test::More;
use lib ‘./’;
# plan ( tests => X )でテスト数を指定する必要がある
plan( tests=> 4);

#use出来るか
use_ok(“Sosu”);
use Sosu;

#素数計算できるか
my $s=Sosu->new;
can_ok($s,”calc”);

#想定する結果を返すか
is($s->calc(2),3,’2個目の素数が3か?’);
is($s->calc(5000),48611,’5000個目の素数が48611か?’);
[/Perl]

これを今時点で実行すると、、

[Shell]
Can’t locate Sosu.pm in @INC (@INC contains: ./ /Library/Perl/5.16/darwin-thread-multi-2level /Library/Perl/5.16 /Network/Library/Perl/5.16/darwin-thread-multi-2leel /Network/Library/Perl/5.16 /Library/Perl/Updates/5.16.2/darwin-thread-multi-2level /Library/Perl/Updates/5.16.2 /System/Library/Perl/5.16/darwin-thread-multi-2level /System/Library/Perl/5.16 /System/Library/Perl/Extras/5.16/darwin-thread-multi-2level /System/Library/Perl/Extras/5.16 .) at 00_sosu.t line 10.
BEGIN failed–compilation aborted at 00_sosu.t line 10.
[/Shell]
そもそも構文チェックの時点で怒られちゃいますね。
さて、これを通るようにしたコードがこちら。

Sosu.pm
[Perl]
#! /bin/perl -w
use warnings;
use strict;
use utf8;
binmode(STDOUT, “:utf8”);

package Sosu;
sub new {
my $self = shift;
bless {},$self;
}
sub calc {
#引数取得
my ($self,$hiki)=@_;
$hiki =~ /[^0-9]+|^$|^0/ and die “input data is please number!\n”;

#素数結果配列
my @s=(2,3);

#素数処理用一時変数
my $pnum=3;

#無限ループさせる
ROOT:while(1){
#処理する素数候補
$pnum+=2;

#これまでの素数で割り切れたら次のループへ
for(@s){
next ROOT if($pnum % $_ == 0);
}

#割り切れなければ
push @s,$pnum;

if(defined($s[$hiki-1])){
return $s[$hiki-1];
}
}
}
[/Perl]

テストを実行すると、こんな感じになりますね。

[Shell]
[TestCode]$prove 00_sosu.t
00_sosu.t .. ok
All tests successful.
Files=1, Tests=4, 1 wallclock secs ( 0.03 usr 0.00 sys + 1.19 cusr 0.00 csys = 1.22 CPU)
Result: PASS
[/Shell]

今回の実行はproveコマンドでやってみました。
こちらだとperlでの実行と比べてカラー表示なのでわかりやすいですよね。

あとは配置としてcpan形式で配置しているとmake testで自動でテストしてくれるので、
perlについてはcpan形式での開発が良いでしょう。

それではこんな感じで♥

カテゴリー: perl

追記〜perlで素数を表示する

最近ひたすらperlのOOPを学んでいる今日この頃。
なんか委託先の人とかってやっぱりコードがすごく綺麗で、
「LL結構かけますよー」
なんてさらって言うためにとっかかりに歴史の古いperlを。
ある程度書けるようになったらrubyやらjavascriptやらもうちょっと
掘り下げて勉強していく予定です。
#仮想テナント構築が止まっているのは仕様です。

さてさて、N個目の素数を表示するコードを書く機会があったので書いてみたのです。
素数そのものの記憶がなかなか怪しくてとっかかり苦労しましたが、
なんとか形になった模様です。。
[Perl]
#! /bin/perl -w
#引数取得
$hiki=$ARGV[0];
$hiki =~ /[^0-9]+|^$|^0/ and die “input data is please number!\n”;

#変数定義
$filename=”./sosu_cache.txt”;

my $sosu=2;
my $flg=0;
my $scnt=0;
my $fcnt=1;
my $h=();

#キャッシュファイルの読み込み
if(-f $filename){
open IN,$filename;
while(){
chomp;
$h->{$fcnt}=$_;
$fcnt++;
}
close IN;
}else{
$h->{1}=2;
}
#キャッシュに存在すれば回答して終了
print “$hiki個目の素数は$h->{$hiki}\n” and exit if($h->{$hiki});

#キャッシュファイルを追記モードでオープン
open OUT,”>> $filename” or die “can’t open cache file!”;

#キャッシュが存在すれば
if($h->{1}){
$knt= keys $h;
if($knt==1){
print OUT “2\n”;
$sosu=3;
}else{
$sosu=$h->{$knt}+2;
}
$scnt=$knt;
}
while(1){
#対象の数字以外で割り切れるか確認
for($i=2;$i<$sosu;$i++){ if($sosu%$i==0){ $flg++; last; } } #素数ならば if($flg==0){ $scnt++; print OUT "$sosu\n" unless($h->{$scnt});
if($scnt==$hiki){
print “$hiki個目の素数は$sosu\n”;
close OUT;
exit;
}
}
#インクリメント
$sosu+=2;
$flg=0;
}
[/Perl]
基本的には存在しうる素数を指定されたN個まで計算するロジック。
ただ引数に10000とか与えられるとちょっと動きが重いので、
キャッシュ出来るようにしてみたにだ。

[Shell]
[~]$time perl primenumber.pl 5000
5000個目の素数は48611

real 0m16.214s
user 0m16.178s
sys 0m0.017s
[~]$time perl primenumber.pl 5000
5000個目の素数は48611

real 0m0.015s
user 0m0.009s
sys 0m0.005s
[/Shell]

追記
意外とアクセスが有ったりする記事で、ちょっとダサかったので
リファクタリングしました。。。
※これまで大学の授業とかでコピペした人ごめんなさい。
[Perl]
#! /bin/perl -w
use warnings;
use strict;
use utf8;
binmode(STDOUT, “:utf8”);
#引数取得
my $hiki=$ARGV[0];
$hiki =~ /[^0-9]+|^$|^0/ and die “input data is please number!\n”;

#素数結果配列
my @s=(2,3);

#素数処理用一時変数
my $pnum=3;

#無限ループさせる
ROOT:while(1){
#処理する素数候補
$pnum+=2;

#これまでの素数で割り切れたら次のループへ
for(@s){
next ROOT if($pnum % $_ == 0);
}

#割り切れなければ
push @s,$pnum;

if(defined($s[$hiki-1])){
print $hiki . “個目の素数は” . $s[$hiki-1] . “\n”;
exit;
}
}
[/Perl]
キャッシュ機能を省いて、割り切れる数字を探す処理もこれまでの素数としました。
だいぶ速度も改善されてると思います。

[Shell]
[learn_perl]$time perl sosu.pl 5000
5000個目の素数は48611

real 0m1.081s
user 0m1.072s
sys 0m0.007s
[/Shell]

カテゴリー: perl

PerlでFacade

昨夜は素敵なBBQでした。
毎年ビール・ワイン・チューハイ・日本酒・シャンパンをチャンポンしてしまうので
二日酔いは必須です。

写真 1 iPhone 5s (4.12mm, f/2.2, 1/30 sec, ISO40)

写真 2 iPhone 5s (4.12mm, f/2.2, 1/1001 sec, ISO64)

写真 3

夏休みも終盤にさしかかり、最近はひたすらオライリーを読破してましたが
デザインパターン最後のFacadeを書いてみたのです。

Facadeの特徴は複数のクラスを束ねて一つのクラスで制御できるようにするという
シンプルなものですが、これってかなり使いますよね。

んー、僕なんかがよくやるのはOracleとかのDBと組み合わせて処理をする必要があるときに
いちいちつないで、SELECTして、ファイルに吐き出してとかが面倒なんで、
一つクラス作って、クライアントからは呼び出すだけにするような設計にします。
今回のサンプルコードははSayWowと猛る処理にしてみました。

ファイルは毎度このへんに。

GitHub Facade

ファイル構成は・・・
・Each.pm
個々のクラスを記述しています。
・Facade.pm
Each.pmのクラスを束ねるクラスの記述です。
・Client.pm
ユーザーの処理を記述しています。

では個々のコードを見て行きましょう。

[Perl]
use utf8;
#———————————-
# Name:Each.pm
#———————————-
use warnings;
use strict;

package ClassA;
sub new{
my $self=shift;
bless {},$self;
}

sub sayWow {
print “Everybody\n”;
};

package ClassB;

sub new{
my $self=shift;
bless {},$self;
}
sub sayWow {
print “Say!!\n”;
};

package ClassC;

sub new{
my $self=shift;
bless {},$self;
}
sub sayWow {
print “WowWow!!!!!!!!\n”;
};
1;
[/Perl]

今回はMooseを使わずに、無名ハッシュをシンプルにblessしています。
個々のクラスについてはSayWowメソッドでprintするだけという処理です。

[Perl]
use utf8;
#———————————-
# Name:Facade.pm
#———————————-
use warnings;
use strict;
use Each;
package Facade;

sub new {
my $self = shift;
bless {},$self;

};
sub Say {
my $classA=ClassA->new();
my $classB=ClassB->new();
my $classC=ClassC->new();

$classA->sayWow();
$classB->sayWow();
$classC->sayWow();

};
1;
[/Perl]

こちらは個々のクラスを束ねるFacadeクラスです。
Sayメソッドで、各々のクラスをnewして、SayWowメソッドを呼び出しています。
最後にユーザーコード。

[Perl]
use utf8;
#———————————-
# Name:Client.pl
#———————————-
use warnings;
use strict;
use Facade;

my $f = Facade->new();

$f->Say();

[/Perl]

シンプルにFacadeクラスをnewして、Sayメソッドを呼ぶだけですね。
こうすることで、ユーザーはFacadeクラスだけを意識して、開発することが出来ます。
実行するとこんな感じ。

[Shell]
[Facade]$perl Client.pl
Everybody
Say!!
WowWow!!!!!!!!
[Facade]$
[/Shell]

ここまででデザインパターンは一段落し、明日から沖縄に行ってリフレッシュした後、
rubyを触っていこうかと思っております。
皆さん、三連休良いバカンスを♥

カテゴリー: perl

PerlでCommandパターン


書いた後
ブログに認め
省みる

はろー!
顔だけがとりえの山下です。

そんなわけでコードを書いてはいちいちブログに書いて
自分の中に落としこむ作業が続いています。

でもこれって大事ですよね。
結構書くだけだとその時は炸裂的にわかってるんですけど
エンジニアって色々触るから次々に忘れちゃうんですよね。

そんなわけでCommandパターン。

Commandパターンは何らかの操作や要求そのものをオブジェクト化してしまって、
その先で何があるかわからないけども、とにかく操作や要求が出来てしまうという
状況を作れるようなパターンですね。

今回サンプルで書いたのはペーストするコマンド、削除するコマンドなのですが、
その要求をカプセル化してレシーバーとなるファイルやディレクトリに渡して
います。
ユーザーはペーストコマンドをファイルやディレクトリに渡すわけですが、
ファイルやディレクトリがどのようにペーストされるかは関知していません。

あとはコマンドそのものをオブジェクト化するのでどういったオペレーションが
行われたかを保存することができるので、Undo(やり直し)を実装できるという
利点があります。

コードはこのへんに
GitHub ka-yamashita

コード構成
・Client.pl
 ユーザーコード
・Command.pm
 コマンドクラス
・Invoker.pm
 コマンドを登録して実行するクラス
・Receiver.pm
 コマンド内容を実行するオブジェクトのクラス

イメージ的にはClientがCommandをInvokerに登録し、Invokerが実行命令すると
Receiverがせっせと処理を行う感じです。
この場合、何をやったかはInvokerが管理するのでUndoやRedoをやるのであれば、
Invokerに実行依頼をした処理を管理する仕組みが必要です。

ではCommandクラスから見て行きましょう。

[Perl]
use utf8;
binmode(STDOUT, “:utf8”);
#——————————–
# Name:Command.pm
#——————————–
package Command;
use Receiver;
use Moose::Role;
requires ‘execute’;
has ‘receiver’ => (
is => ‘rw’,
isa => ‘Receiver’,
);
no Moose::Role;

sub set_receiver {
my ($self,$receiver) = @_;
$self->receiver($receiver);
}

package PasteCommand;
use Moose;
with ‘Command’;
__PACKAGE__->meta->make_immutable();
no Moose;
sub execute {
my $self=shift;
$self->receiver->paste(“をペーストしました”);
}

package DeleteCommand;
use Moose;
with ‘Command’;
__PACKAGE__->meta->make_immutable();
no Moose;
sub execute {
my $self=shift;
$self->receiver->delete(“をデリートしました”);
}
1;
[/Perl]

コマンドクラスではPaste,Deleteのコマンドクラスが存在し、
各々set_receiverで設定されるレシーバーに対して、ペーストとデリートを要求する
という記述になっています。

次にその要求を受けるReceiverクラス

[Perl]
use utf8;
#——————————–
# Name:Receiver.pm
#——————————–

package Receiver;
use Moose::Role;
requires qw(paste delete);
no Moose::Role;

package DirReceiver;
use Moose;
with ‘Receiver’;
no Moose;
sub paste {
my $self=shift;
print “ディレクトリ:” . shift . “\n”;
}

sub delete {
my $self=shift;
print “ディレクトリ:” . shift . “\n”;
}
package FileReceiver;
use Moose;
with ‘Receiver’;
no Moose;
sub paste {
my $self=shift;
print “ファイル:” . shift . “\n”;
}

sub delete {
my $self=shift;
print “ファイル:” . shift . “\n”;
}
1;
[/Perl]
このクラスはディレクトリとファイルを意識したもので、paste,deleteメソッドが呼ばれると、
自身のオブジェクトを示す文字列と引数で受けた文字列をprintするだけのクラスです。
本来であればここにレシーバーごとの記述を書くことになります。
(例えばディレクトリであればdeleteは中のファイルも消すとか)

次にInvoker
[Perl]
use utf8;
#——————————–
# Name:Invoker.pm
#——————————–

package Invoker;
use Command;
use Moose;
use MooseX::AttributeHelpers;
has ‘commands’ => (
is => ‘rw’,
isa => ‘ArrayRef[Command]’,
metaclass => ‘Collection::Array’,
provides => {
push => ‘add_commands’
},
auto_deref => 1,
default => sub { [] }
);
__PACKAGE__->meta->make_immutable();
no Moose;
sub run {
my $self=shift;
for my $com($self->commands){
$com->execute();
};
};
1;
[/Perl]
このクラスはcommandsという配列変数にCommandオブジェクトを格納し、runメソッドが実行されると
commandsに格納されたCommandに対してexecuteメソッドを呼び出すだけです。
先にも書きましたが、Redo,Undoをやるのであればここで実行したことを
記憶する必要があります。

最後にClientコード

[Perl]
use utf8;
#——————————————-
# Name:Client.pl
#——————————————-
use Invoker;
use Command;
use Receiver;

#コマンドの集合となるインボーカー(実行者)
my $i=Invoker->new();

#コマンドのインスタンス化
my $comP=PasteCommand->new();
my $comD=DeleteCommand->new();

#コマンドの対象となるレシーバー
#このレシーバーに対してコマンドが実行される
#そしてレシーバーのみがコマンドの実行内容を知る
my $recD=DirReceiver->new();
my $recF=FileReceiver->new();

#ペーストコマンドにディレクトリのレシーバーをセットする
$comP->set_receiver($recD);

#デリートコマンドにファイルのレシーバーをセットする
$comD->set_receiver($recF);

#インボーカーに登録する
$i->add_commands($comP);
$i->add_commands($comD);

#実行する
$i->run();

[/Perl]

これはもうコメントの通りですね。
実行するとこんな感じになります。

[Shell]
[command]$perl Client.pl
ディレクトリ:をペーストしました
ファイル:をデリートしました
[command]$
[/Shell]

このパターンで設計することができれば、コマンド、レシーバーが増えた場合や、
またはその内容が変わった場合でも呼び出し元やInvokerは意識しないので、
完全に分離した構築を行うことが出来ます。

残るはFacade♥

カテゴリー: perl

PerlでMediator


ホークスを
出てから打つのが
ペーニャです

どーも、みんなのアイドルやまぴもです。
今日はPerlでMediator。
Mediatorの活用としては多くのオブジェクトが相互に作用して動く場合に、
Mediator(ディレクター)クラスを準備して、ユーザーはそのクラスに対して
オペレーションをすることでユーザーから複数のオブジェクトの相互作用を
意識させないようなパターンです。
GoF本の例だとダイアログウィンドウの中にチェックボックスやらテキストボックスが
あって例えば、チャックボックスにチェックを入れたらテキストボックスがアクティブになる
といったような制御をディレクターがよろしくやってくれますよという感じですかね。

この場合の動きとしてはチェックボックスに何らかの変化があった場合に、
チェックボックスが自身の挙動が変わったことをディレクターに通知して、
その通知を元にディレクターがテキストボックスをアクティブにするといった具合です。

ソースはこのへんに
GitHub ka-yamashita

今回のコード構成は

・Main.pl
ユーザー操作コードです
・Mediator.pm
Medietorの記述
・Parts.pm
Mediatorを介して操作したいパーツの記述

と言った感じです。
Partsから見て行きましょう。

[Perl]
use utf8;
#——————————————-
# Name:Parts.pm
#——————————————-
#パーツの抽象クラス
package Parts;

use Mediator;
use Moose::Role;
#ディレクターの参照変数
has ‘director’ => (
is => ‘rw’,
isa => ‘Mediator’,
required => ‘1’
);
#自身の名前格納変数
has ‘name’ => (
is => ‘rw’,
isa => ‘Str’,
);
#自身の値格納変数
has ‘value’ => (
is => ‘rw’
);
no Moose::Role;

#オブジェクトの値が変わった際にディレクターに通知するメソッド
sub change {
my $self = shift;
$self->director->parts_change($self);
};
#値の設定
sub setvalue {
my $self = shift;
$self->value(shift);
$self->change();
}
#文字列を扱うクラス
package Parts::Parts_String;
use Moose;
with ‘Parts’;
has ‘+value’ => (
isa => ‘Str’
);
__PACKAGE__->meta->make_immutable();
no Moose;

#数値を扱うクラス
package Parts::Parts_Int;
use Moose;
with ‘Parts’;
has ‘+value’ => (
isa => ‘Int’
);
__PACKAGE__->meta->make_immutable();
no Moose;
1;
[/Perl]

まずParts_Str,Parts_Intと言うのは各々value(オーバーライド)変数に文字列、数値を保持するだけの
クラスです。
継承している変数としてdirectorがあり、ここに自分の会話の相手となるディレクターの参照変数を
持ちます。
例えばset_valueメソッドが呼ばれた場合、自身のvalueを書き換え、その後
changeメソッドを呼び出し、directorに自身の値が変わったことを通知するのです。

[Perl]
$self->director->parts_change($self);
[/Perl]

この部分でディレクターのperts_changeメソッドに自身の参照を渡して、
自身の値が変わったことを通知するわけですね。
#重ね書き失礼

その通知を受け取ったディレクターが何をするかというと、

[Perl]
use utf8;
#———————————————-
# Name:Mediator.pm
#———————————————-

# Mediaterの抽象クラス
package Mediator;
use Moose::Role;
requires ‘parts_change’;
no Moose::Role;

# Mediaterの具象クラス
package Parts_Director;
use Parts;
use Moose;
with ‘Mediator’;

#パーツ格納用変数
has ‘parts_int’ => (
is => ‘rw’,
isa => ‘Parts’
);
has ‘parts_str’ => (
is => ‘rw’,
isa => ‘Parts’
);
__PACKAGE__->meta->make_immutable();
no Moose;

#パーツの作成
#テストコード実行のため便宜上実装
sub create_parts {
my $self = shift;
$self->parts_str(Parts::Parts_String->new(director=>$self,name => ‘strman’,value => ‘test’)) unless $self->parts_str;
$self->parts_int(Parts::Parts_Int->new(director=>$self,name => ‘intman’,value => ‘123’)) unless $self->parts_int;
}

#パーツのセッター
#テストコード実行のため便宜上実装
sub set_parts_value {
my ($self,$value) = @_;
if($value =~ /[^0-9]/){
$self->parts_str->setvalue($value);
}else{
$self->parts_int->setvalue($value);
}
}

#パーツの値が変わった際に子オブジェクトから呼び出されるメソッド
sub parts_change {
my ($self,$parts)=@_;
print $parts->name(),”の値が変更されました。\n”;
print “気になる値は、”,$parts->value,”です\n”;
};
1;
[/Perl]

parts_changeメソッドで、変更されたパーツの名前と、その値を表示するわけです。
実際の使い方としては

[Perl]
use utf8;
binmode(STDOUT, “:utf8”);
#——————————————-
# Name:Main.pl
#——————————————-
use Mediator;
use Parts;

#ディレクターのインスタンス化
my $m=Parts_Director->new();

#自身のディレクションするパーツを作成する
$m->create_parts();

#数値の値を変える
$m->set_parts_value(1);

#文字の値を変える
$m->set_parts_value(abc);

[/Perl]

実行するとこんな感じ。

[Shell]
[Mediator]$perl Main.pl
intmanの値が変更されました。
気になる値は、1です
strmanの値が変更されました。
気になる値は、abcです
[Mediator]$
[/Shell]

さて、最近デザインパターンばっかりで飽きてきつつあるので
あとCommandとFecade書いたら次のステップに進みたいと思います。
それでは!

カテゴリー: perl

PerlでCompositeパターン


スタバにて
コード書き書き
梅雨の明け

どもー。
やましもです。

今日はCompositeパターン。
このパターンはLeafとComposite(Leafの集合)の処理の差異がない場合に
適用可能性があるパターンです。
よく言われるのがファイルとフォルダを上げた具体例ですかね。
ファイルの名前を変えるのとフォルダの名前を変えること、
ファイルの削除とフォルダの削除。
こういった共通のオペレーションをユーザーに枝なのか葉はなのかを
意識させずにコーディングしたい場合に適用出来ます。

今回の実装例としては擬似ファイルを扱うことで実装しました。
#擬似ファイル=実際にファイルやフォルダは作成しないが、オブジェクトとして作成する

コードはこの辺。
Github ka-yamashita

ファイル構成はディレクトリとファイルをか使うクラス一式がDirectoryFile.pm
ユーザーコードがComposite.plです。

早速中身を見て行きましょう。
まずはComposite.plから。
[Perl]
use utf8;
#——————————————–
# Name:DirFile.pm
#——————————————–
package DirectoryFile;
use Moose::Role;
requires qw(list remove);
has ‘target’ => (
is => ‘rw’,
required => 1,
);
no Moose::Role;

package File;
my $self = shift;
use Moose;
with ‘DirectoryFile’;
__PACKAGE__->meta->make_immutable();
no Moose;

sub list {
my $self = shift;
print “/” . $self->target() . “\n”;
}
sub remove {
my $self = shift;
print “/” , $self->target() , ” at removed\n”;
}
package Directory;
use Moose;
use MooseX::AttributeHelpers;
with ‘DirectoryFile’;

#再帰的にオブジェクトを持てるようにする
has ‘DirFileObject’ => (
is => ‘rw’,
isa => ‘ArrayRef[DirectoryFile]’,
metaclass => ‘Collection::Array’,
auto_deref => 1,
provides => {
push => ‘add_object’
},
default => sub { [] },
);
__PACKAGE__->meta->make_immutable();

no Moose;

sub list {
my ($self,$parrent) = @_;

#フォルダ階層文字の結合
$parrent .= “/” . $self->target();

#自分自身の印字
print $parrent , “\n”;

#格納されているオブジェクトを全て取得する
for my $obj($self->DirFileObject()){
#ファイルじゃなければ再帰処理
unless($obj->isa(“File”)){
$obj->list($parrent);
}else{
print $parrent , “/” , $obj->target() , “\n”;
}
}
};
sub remove{
my ($self,$parrent) = @_;

#フォルダ階層文字の結合
$parrent .= “/” . $self->target();

#格納されているオブジェクトを全て取得する
for my $obj($self->DirFileObject()){
#ファイルじゃなければ再帰処理
unless($obj->isa(“File”)){
$obj->remove($parrent);
}else{
print $parrent , “/” , $obj->target() , ” at removed\n”;
}
}
#自分自身の印字
print $parrent , ” at removed\n”;
};
[/Perl]

フォルダのコードはフォルダの中にフォルダが更にある可能性があるので、
list,remove共に再帰的な処理が出来るように書いています。
対してファイルの方は単純に表示、削除するだけですね。
フォルダとファイルの関係性を現すアトリビュートとして、DirFileObjectという
アトリビュートを準備しており、
[Perl]
has ‘DirFileObject’ => (
is => ‘rw’,
isa => ‘ArrayRef[DirectoryFile]’,
metaclass => ‘Collection::Array’,
auto_deref => 1,
provides => {
push => ‘add_object’
},
default => sub { [] },
);
[/Perl]
DirectoryFileクラスの配列を格納できるようにしている感じですね。

次にユーザーコードを見て行きましょう。

[Perl]
use utf8;
#——————————————-
# Name:Composite.pl
#——————————————-
use strict;
use warnings;
use Composition::DirectoryFile;

#ファイルAの作成
my $fileA=File->new( target=>’FileA’);

#ディレクトリAの作成
my $dirA=Directory->new(target=>’DirA’);

#ディレクトリAの中にファイルBの作成
$dirA->add_object(File->new( target=>’FileB’));

#ディレクトリBの作成
my $dirB=Directory->new(target=>’DirB’);

#ディレクトリBの中にディレクトリAを格納
$dirB->add_object($dirA);

#オブジェクトリストの印字
print ” ——- get list ——-\n\n”;
$fileA->list;
$dirB->list;

#オブジェクトリストの削除
print “\n—— remove list ——\n\n”;
$fileA->remove();
$dirB->remove();
print “\n”;
[/Perl]

これはファイル構成として

/-FileA
-DirectoryB
|-DirectoryA
|-FileB

を作成し、その後、一覧の表示、削除を行う擬似コードです。
それを実行するとこんな感じですね。

[Shell]
[Composite]$perl Composite.pl
——- get list ——-

/FileA
/DirB
/DirB/DirA
/DirB/DirA/FileB

—— remove list ——

/FileA at removed
/DirB/DirA/FileB at removed
/DirB/DirA at removed
/DirB at removed

[/Shell]

実際にそれなりのアプリとなると再帰関係になることって
割りとあるので結構適用することが多いのかなという感触を受けました。

あと全然関係ないのですがフットサルのスケジュール調整アプリ、
そろそろ商用化に向けて再設計はじめなきゃなーと思いつつ、
ruby学び直す前に早くPerl一区切り付けたい今日このごろ。

カテゴリー: perl

デザインパターン PerlでChain of Responsibility

毎日が夏休み!!!

どーも、やましもです。

Chain of Responsibility書いてみました。
恐らくよく使われるのは連鎖的に行う処理がある場合に、
ステータスコードのようなものを持たせて、あるステップが完了していることを
確認しつつ、連鎖的に処理するケースでしょうか。

今回の実装としては具象クラス内で自身が処理するものでなかった場合は
次のクラスへととりあえずメッセージを渡すような実装としています。

ファイルはこのあたりに。
GitHub – Chain of Responsibility

ファイル構成
・LogHandler.pm
 ハンドラーの抽象クラスと、具象クラスを記述したコード
 (各具象クラスに全く同じsearch_requestが書いてあるのは本来不要なのですが、
 まああったほうがイメージ湧きやすいだろうななんてことであえて書いてます)
・CoR.pl
 ユーザーの処理を記述したコード。
 
ポイントとしてはCoR.plの
[Perl]
my $handlers=SEARCH::LogHandler::Incoming->new(
successor => SEARCH::LogHandler::Virus->new(
successor => SEARCH::LogHandler::Ogo->new()
)
);
[/Perl]

各クラスをインスタンス化する際に、successorというアトリビュートに
次の処理クラスのリファレンスを渡しているところですね。
この処理のお陰でsuccessor->search_requestのような記述で次のクラスへ
メッセージを送信しています。

実行するとこんな感じ。

[Shell]
[CoR]$perl CoR.pl
検索タイプはogoで日付は0101です
検索タイプはincomingで日付は0401です
[/Shell]

次回はComposite編。
それでは良い週末を。

カテゴリー: perl

デザインパターン〜PerlでBridge〜

前回と同じくデザインパターンネタ。
今回は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と比べてだいぶスッキリしましたね。
この手のやつってクラスサンプル考えるほうが悩ましいということに気づきつつも有りますが、
次のパターンも頑張ります。

カテゴリー: perl

PerlでAbstract Factoryを書く

最近デザインパターンを勉強していることも有り、
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当たりを書いてみようと思います。
それでは♥

カテゴリー: perl