「良いコード／悪いコードで学ぶ設計入門」第6章その4 フラグ引数 #ミノ駆動本
リスト6.62
フラグ引数を使っている例
damege(true, damegeAmount);
確かに、これだけでは何が true なのかはコードを追いかけて関数の中身を見ないとわからんよなぁ。
ということで、それを「メソッドを分離する」で改良したところから。
ここクリックして展開
#!/usr/bin/env perl use strict; use warnings; use Function::Parameters; use feature qw/say/; package Member { use Carp qw/croak/; use Mouse; use MouseX::AttributeHelpers; use namespace::autoclean; has hit_point => ( metaclass => 'Number', is => 'rw', isa => 'Int', default => 0, provides => { sub => 'hit_sub', } ); has magic_point => ( metaclass => 'Number', is => 'rw', isa => 'Int', default => 0, provides => { sub => 'magic_sub', } ); has state => ( is => 'rw', isa => 'Str', required => 1, ); __PACKAGE__->meta->make_immutable(); } package Damege { use Mouse::Role; requires 'execute'; } package HitPointDamege { use Carp qw/croak/; use Mouse; use namespace::autoclean; with 'Damege'; has member => ( is => 'ro', isa => 'Member', required => 1, ); has damege_amount => ( is => 'ro', isa => 'Int', required => 0, ); method execute($damege_amount) { my $member = $self->member; my $hit_point = $member->hit_sub($damege_amount); return $member if ( 0 < $hit_point ); $member->hit_point(0); $member->state('dead'); return $member; } __PACKAGE__->meta->make_immutable(); } package MagicPointDamege { use Carp qw/croak/; use Mouse; use namespace::autoclean; with 'Damege'; has member => ( is => 'ro', isa => 'Member', required => 1, ); has damege_amount => ( is => 'ro', isa => 'Int', required => 0, ); method execute($damege_amount) { my $member = $self->member; my $magic_point = $member->magic_sub($damege_amount); return $member if ( 0 < $magic_point ); $member->magic_point(0); return $member; } __PACKAGE__->meta->make_immutable(); } package main; # メンバークラスのインスタンス my $member = Member->new( hit_point => 100, state => '' ); # ヒットポイントクラスのインスタンス my $hit_point_damege = HitPointDamege->new( member => $member ); # ヒットポイントのダメージメソッド my $dameged_member = $hit_point_damege->execute(10); # メンバーの現時点のヒットポイント say $dameged_member->hit_point(); # 90 # メンバーの現時点の状態 say $dameged_member->state(); # 空欄 my $dead_member = $hit_point_damege->execute(100); say $dead_member->hit_point(); # 0 say $dead_member->state(); # dead $member = Member->new( hit_point => 100, magic_point => 50, state => '' ); my $magic_point_damege = MagicPointDamege->new( member => $member ); my $use_magic_member = $magic_point_damege->execute(10); say $use_magic_member->magic_point; # 40 my $more_use_magic_member = $magic_point_damege->execute(1000); say $more_use_magic_member->magic_point; # 0
リスト6.63 〜 リスト6.66
ここでやっと、ストラテジパターンとはこういうものかな？という引っ掛かりが得られた気がします。
（理解したとは言えない）
関数に渡す引数にオブジェクトを渡すことで、オブジェクトに含まれたメソッドを活用できるんだなぁ、と。
今まではそれを禁忌とでも思って避けていました。
つまり、プリミティブ型執着（第5章）ですね。
Enum 使わずにやってますが、ここのポイントはこれですね。
package Damege { use Mouse::Role; requires 'execute'; method apply_damege( $damege_type, $damege_amount ) { return $damege_type->execute($damege_amount); } }
引数にオブジェクトを渡す。
渡ってくるオブジュエクトはインターフェイスで必要なメソッドを備えていることは保証されているので、ダックタイピングで処理できる。
if 文で分岐せずとも、引数にオブジェクトを渡した時点で処理のルートが確定する。
頭いいなぁ！すごいなぁ。
そして、昔、これに似たコードをわからないまま触った記憶が蘇ってきました。こういう意味だったのか・・・
あの時に理解したかったなぁ。
ここクリックして展開
#!/usr/bin/env perl use strict; use warnings; use Function::Parameters; use feature qw/say/; package Member { use Carp qw/croak/; use Mouse; use MouseX::AttributeHelpers; use namespace::autoclean; has hit_point => ( metaclass => 'Number', is => 'rw', isa => 'Int', default => 0, provides => { sub => 'hit_sub', } ); has magic_point => ( metaclass => 'Number', is => 'rw', isa => 'Int', default => 0, provides => { sub => 'magic_sub', } ); has state => ( is => 'rw', isa => 'Str', required => 1, ); __PACKAGE__->meta->make_immutable(); } package Damege { use Mouse::Role; requires 'execute'; method apply_damege( $damege_type, $damege_amount ) { return $damege_type->execute($damege_amount); } } package HitPointDamege { use Carp qw/croak/; use Mouse; use namespace::autoclean; with 'Damege'; has member => ( is => 'ro', isa => 'Member', required => 1, ); has damege_amount => ( is => 'ro', isa => 'Int', required => 0, ); method execute($damege_amount) { my $member = $self->member; my $hit_point = $member->hit_sub($damege_amount); return $member if ( 0 < $hit_point ); $member->hit_point(0); $member->state('dead'); return $member; } __PACKAGE__->meta->make_immutable(); } package MagicPointDamege { use Carp qw/croak/; use Mouse; use namespace::autoclean; with 'Damege'; has member => ( is => 'ro', isa => 'Member', required => 1, ); has damege_amount => ( is => 'ro', isa => 'Int', required => 0, ); method execute($damege_amount) { my $member = $self->member; my $magic_point = $member->magic_sub($damege_amount); return $member if ( 0 < $magic_point ); $member->magic_point(0); return $member; } __PACKAGE__->meta->make_immutable(); } package main; my $member = Member->new( hit_point => 100, state => '' ); my $hit_point_damege = HitPointDamege->new( member => $member ); my $dameged_member = Damege->apply_damege( $hit_point_damege, 10 ); say $dameged_member->hit_point(); # 90 say $dameged_member->state(); # 空欄 # クリティカルヒット！ my $dead_member = Damege->apply_damege( $hit_point_damege, 100 ); say $dead_member->hit_point(); # 0 say $dead_member->state(); # dead # 復活 $member = Member->new( hit_point => 100, magic_point => 50, state => '' ); # マジックポイントにダメージ my $magic_point_damege = MagicPointDamege->new( member => $member ); my $use_magic_member = Damege->apply_damege( $magic_point_damege, 10 ); say $use_magic_member->magic_point; # 40 # マジックポイント枯渇 my $more_use_magic_member = Damege->apply_damege( $magic_point_damege, 1000 ); say $more_use_magic_member->magic_point; # 0
やっと6章終わった
理解が難しかったのと、Perl で同じような動作をするための環境づくりで結構時間食った気がします。
ただ、得られたものはあったなぁ、と充足感ありあり。
この先の章も楽しみ〜
「良いコード／悪いコードで学ぶ設計入門」第6章その3 型チェックで分岐しない #ミノ駆動本
リスト6.51〜6.54まで
一気にまとめたコードがこれ。
途中でしれっと出てくる Money クラスの add メソッドも書いております。
・・・Perl で書き換えながらめっちゃ書きにくさを感じることがあります。
このコードだと、interface の HotelRates の中で分岐コードを書くところ。
まぁ、ここで書いているのは「悪い（例示の）コード」なので、書きにくくて正解なんですけどね。
そうそう。
途中、コメントアウトしたところがあります。
# return $self->fee()->add( Money->new( amount => 3000 ) ); my $money = $self->fee(); return $money->add( Money->new( amount => 3000 ) );
1行でメソッドチェーンでかけるんですが、途中途中で返り値はなんだっけ・・・？
値？値オブジェクト？
みたいになったので、統一した方がいいんだろうなぁ、と思いました。
ここクリックして展開
use strict; use warnings; use Function::Parameters; use feature qw/say/; package Money { use Carp qw/croak/; use Mouse; use namespace::autoclean; use Readonly; use constant { MIN => 0 }; has amount => ( is => 'ro', isa => 'Int', required => 1, ); method add($other) { my $added = $self->amount() + $other->amount(); return Money->new( amount => $added ); } __PACKAGE__->meta->make_immutable(); } # 宿泊料金を表すロール package HotelRate { use Mouse::Role; requires 'fee'; fun busy_season_fee($self) { if ( ref $self eq 'RegularRates' ) { # return $self->fee()->add( Money->new( amount => 3000 ) ); my $money = $self->fee(); return $money->add( Money->new( amount => 3000 ) ); } elsif ( ref $self eq 'PremiumRates' ) { # return $self->fee()->add( Money->new( amount => 5000 ) ); my $money = $self->fee(); return $money->add( Money->new( amount => 5000 ) ); } } } #通常宿泊料金 package RegularRates { use Mouse; use namespace::autoclean; with 'HotelRate'; method fee() { return Money->new( amount => 7000 ); } __PACKAGE__->meta->make_immutable(); } # プレミアム宿泊料金 package PremiumRates { use Mouse; use namespace::autoclean; with 'HotelRate'; method fee() { return Money->new( amount => 12000 ); } __PACKAGE__->meta->make_immutable(); } package main; # 追加した繁忙期ロジック # 通常宿泊料金＆繁忙期 my $regular_rate = RegularRates->new(); say $regular_rate->fee->amount(); # 7000 say $regular_rate->busy_season_fee()->amount(); # 10000 # プレミアム宿泊料金＆繁忙期 my $premium_rate = PremiumRates->new(); say $premium_rate->fee->amount(); # 12000 say $premium_rate->busy_season_fee()->amount(); # 17000
リスト6.55 繁忙期料金を切り替えられるよう interface に定義
先の「悪いコード」に比べて、「いいコード」の方が直感的ですね。
あと、「図6.8」みたいなオブジェクト図のがいまいちわからなかったんですが、コードを見てからだと理解できるという。
というか、オブジェクト指向も書物を読んだだけではわからなくて、書いてみて、書き続けてやっとわかるみたいな。
割と脳筋使うところだなぁという感じです。
ここクリックして展開
use strict; use warnings; use Function::Parameters; use feature qw/say/; package Money { use Carp qw/croak/; use Mouse; use namespace::autoclean; has amount => ( is => 'ro', isa => 'Int', required => 1, ); method add($other) { my $added = $self->amount() + $other->amount(); return Money->new( amount => $added ); } __PACKAGE__->meta->make_immutable(); } # 宿泊料金を表すロール package HotelRate { use Mouse::Role; requires qw/fee busy_season_fee/; } #通常宿泊料金 package RegularRates { use Mouse; use namespace::autoclean; with 'HotelRate'; method fee() { return Money->new( amount => 7000 ); } method busy_season_fee() { my $money = $self->fee(); return $money->add( Money->new( amount => 3000 ) ); } __PACKAGE__->meta->make_immutable(); } # プレミアム宿泊料金 package PremiumRates { use Mouse; use namespace::autoclean; with 'HotelRate'; method fee() { return Money->new( amount => 12000 ); } method busy_season_fee() { my $money = $self->fee(); return $money->add( Money->new( amount => 5000 ) ); } __PACKAGE__->meta->make_immutable(); } package main; # 追加した繁忙期ロジック # 通常宿泊料金＆繁忙期 my $regular_rate = RegularRates->new(); say $regular_rate->fee->amount(); # 7000 say $regular_rate->busy_season_fee()->amount(); # 10000 # プレミアム宿泊料金＆繁忙期 my $premium_rate = PremiumRates->new(); say $premium_rate->fee->amount(); # 12000 say $premium_rate->busy_season_fee()->amount(); # 17000
よし、6章も残りは「フラグ引数」のみ。がんばろー
おまけ
MouseX::AttributeHelpers; を使ってみたパターン。
さっぱり！
ここクリックして展開
use strict; use warnings; use Function::Parameters; use feature qw/say/; package Money { use Carp qw/croak/; use Mouse; use MouseX::AttributeHelpers; use namespace::autoclean; has amount => ( metaclass => 'Number', is => 'rw', isa => 'Int', required => 1, default => 0, provides => { add => 'add', } ); __PACKAGE__->meta->make_immutable(); } # 宿泊料金を表すロール package HotelRate { use Mouse::Role; requires qw/fee busy_season_fee/; } #通常宿泊料金 package RegularRates { use Mouse; use namespace::autoclean; with 'HotelRate'; method fee() { return Money->new( amount => 7000 ); } method busy_season_fee() { my $money = $self->fee(); return $money->add(3000); } __PACKAGE__->meta->make_immutable(); } # プレミアム宿泊料金 package PremiumRates { use Mouse; use namespace::autoclean; with 'HotelRate'; method fee() { return Money->new( amount => 12000 ); } method busy_season_fee() { my $money = $self->fee(); return $money->add(5000); } __PACKAGE__->meta->make_immutable(); } package main; # 追加した繁忙期ロジック # 通常宿泊料金＆繁忙期 my $regular_rate = RegularRates->new(); say $regular_rate->fee->amount(); # 7000 say $regular_rate->busy_season_fee(); # 10000 # プレミアム宿泊料金＆繁忙期 my $premium_rate = PremiumRates->new(); say $premium_rate->fee->amount(); # 12000 say $premium_rate->busy_season_fee(); # 17000
MouseX::AttributeHelpers に感動した話
「このコード、動いたけど納得いかないかっこ悪い。絶対にもっとまともな実装の方法が有るはず」
— sironekotoro💙💛 (@sironekotoro) 2022年6月13日
という直感は外れたことない気がする
という直感があって、その解が得られるタイミングは往々にして年単位だったりするんですが、割と早く解決できたのでメモ。
いや、今思うとこっちが近いかもしれない。
その君の勘から発した、 君の怒りと苛立ちは理由になる！
こんな例示コードがあります。
package Foo { use Mouse; use Function::Parameters; has List => ( is => 'rw', isa => 'ArrayRef[Str]', required => 0, ); method add($str) { my $array_ref = $self->List(); push @{$array_ref}, $str; $self->List($array_ref); } __PACKAGE__->meta->make_immutable(); } package main; use feature qw/say/; my $foo = Foo->new(); $foo->add('Web2.0'); $foo->add('Web3'); $foo->add('Web5'); say join " ", @{ $foo->List }; # Web2.0 Web3 Web5
Foo ってクラスを作り、そこに List というアトリビュート（またはプロパティ）と add というメソッドを作ったという図です。
List の中には配列リファレンスが入っており、add でどんどん追加していくという用途です。
で、問題はここ。add メソッド。
単に追加したいだけなのに、一旦配列リファレンスに出力して、それに追加したものを再度設定しているというコード。
method add($str) { my $array_ref = $self->List(); # 今あるリストから取得 push @{$array_ref}, $str; # 追加 $self->List($array_ref); # 追加した配列リファレンスで置き換え }
3行も必要か？
取り出して、処理して、戻す。
いや、絶対もっと楽な方法があるだろ・・・と思いつつ、見つけられなかったのでした。
MouseX::AttributeHelpers
はい。
そこでこのモジュールです。
メソッドが消えたじゃん・・・書かなくていいじゃん・・・可読性増してるじゃん・・・
package Foo { use Mouse; use MouseX::AttributeHelpers; has List => ( metaclass => 'Collection::Array', is => 'rw', isa => 'ArrayRef[Str]', required => 0, default => sub { [] }, provides => { push => 'add', } ); __PACKAGE__->meta->make_immutable(); } package main; use feature qw/say/; my $foo = Foo->new(); $foo->add('Web2.0'); $foo->add('Web3'); $foo->add('Web5'); say join " ", @{ $foo->List }; # Web2.0 Web3 Web5
この metaclass => 'Collection::Array', には当然 Collection::Hash など他のデータ構造を設定することが可能で、それぞれのデータ構造を扱う関数も provide で扱うことができます。
すごいなぁ。
コードを書く人の負担を軽減するコードというのは素晴らしいなぁ。
ありがちな処理は全部これで済んじゃう。ひゃー。
久々になんか感動したのでした。
「良いコード／悪いコードで学ぶ設計入門」第6章その2 ポリシーパターン #ミノ駆動本
リスト6.41 と 6.42 Gold会員とシルバー会員の判定メソッド
あー、こういうコード書いた覚えあります・・・
ゴールド会員の判定ロジック
if ( 100000 <= $history->total_amount ) { if ( 10 <= $history->purchase_frequency_per_month ) { if ( $history->return_rate <= 0.001 ) { return !!1; } } }
シルバー会員の判定ロジック
if ( 10 <= $history->purchase_frequency_per_month ) { if ( $history->return_rate <= 0.001 ) { return !!1; } }
ここクリックして展開
#!/usr/bin/env perl use strict; use warnings; use feature qw/say/; use Function::Parameters; use Types::Standard -types; package History { use Carp qw/croak/; use Mouse; use Readonly; use constant { MIN => 0 }; has total_amount => ( is => 'ro', isa => 'Int', required => 1, trigger => sub { croak '', unless ( $_[0] ) }, ); has purchase_frequency_per_month => ( is => 'ro', isa => 'Int', required => 1, trigger => sub { croak '', unless ( $_[0] ) }, ); has return_rate => ( is => 'ro', isa => 'Int', required => 1, trigger => sub { croak '', unless ( $_[0] ) }, ); __PACKAGE__->meta->make_immutable(); } fun is_gold_customer($history) { if ( 100000 <= $history->total_amount ) { if ( 10 <= $history->purchase_frequency_per_month ) { if ( $history->return_rate <= 0.001 ) { return !!1; } } } return "!!0"; } fun is_silver_customer($history) { if ( 10 <= $history->purchase_frequency_per_month ) { if ( $history->return_rate <= 0.001 ) { return !!1; } } return "!!0"; } package main; my $history = History->new( total_amount => 200000, purchase_frequency_per_month => 20, return_rate => 0.0000, ); if ( is_gold_customer($history) ) { say "GOLD customer!"; } if ( is_silver_customer($history) ) { say "SILVER customer!"; }
このような、判定ロジックを再利用するために、ポリシーパターンを使う、と。
リスト 6.43
前の節の魔法のところと似ているところもあり、サラッとかけた。
ここクリックして展開
#!/usr/bin/env perl use strict; use warnings; use feature qw/say/; use Function::Parameters; package History { use Carp qw/croak/; use Mouse; use Readonly; use constant { MIN => 0 }; has total_amount => ( is => 'ro', isa => 'Int', required => 1, trigger => sub { croak '', unless ( $_[0] ) }, ); has purchase_frequency_per_month => ( is => 'ro', isa => 'Int', required => 1, trigger => sub { croak '', unless ( $_[0] ) }, ); has return_rate => ( is => 'ro', isa => 'Num', required => 1, trigger => sub { croak '', unless ( $_[0] ) }, ); __PACKAGE__->meta->make_immutable(); } # 優良顧客のルールを再現するinterface package ExcelentCustomerRule { use Mouse::Role; requires 'ok'; method ok($history) { } } package GoldCustomerPurchaseAmontRule { use Carp qw/croak/; use Mouse; with 'ExcelentCustomerRule'; method ok($history) { return 100000 <= $history->total_amount; } } package PurchaseFrequencyRule { use Carp qw/croak/; use Mouse; with 'ExcelentCustomerRule'; method ok($history) { return 10 <= $history->purchase_frequency_per_month; } } package ReturnRateRule { use Carp qw/croak/; use Mouse; with 'ExcelentCustomerRule'; method ok($history) { return $history->return_rate <= 0.001; } } package ExcelentCustomerPolicy { use Mouse; has rules => ( is => 'rw', isa => 'ArrayRef[Object]', required => 0, ); method add($rule) { my $rules = $self->rules(); push @{$rules}, $rule; $self->rules($rules); } method comply_with_all($history) { for my $rule ( @{ $self->rules } ) { if ( !$rule->ok($history) ) { return !!0; } } return !!1; } } package main; my $history = History->new( total_amount => 200000, purchase_frequency_per_month => 20, return_rate => 0.001, ); # 特別会員のポリシー初期化 my $excelent_customer_policy = ExcelentCustomerPolicy->new(); # 特別会員の条件を追加していく $excelent_customer_policy->add( GoldCustomerPurchaseAmontRule->new() ); $excelent_customer_policy->add( PurchaseFrequencyRule->new() ); $excelent_customer_policy->add( ReturnRateRule->new() ); # 特別会員稼働かを判定 say $excelent_customer_policy->comply_with_all($history);
リスト6.49, 6.50
いまは、ルールを外から組み込めるようにしてある。
これを「ゴールド会員専用」のポリシークラスにする。うんうん、わかる。
「シルバー会員専用」のポリシークラスまで作ったやつで終わろう。
前回の魔法のやつは最後までいまいち理解してない感に付き纏われたけど、今回のポリシーパターンはなんかすごい腑に落ちた感がある。
この違いはなんなのだろうなぁ。
ここクリックして展開
#!/usr/bin/env perl use strict; use warnings; use feature qw/say/; use Function::Parameters; package History { use Carp qw/croak/; use Mouse; use Readonly; use constant { MIN => 0 }; has total_amount => ( is => 'ro', isa => 'Int', required => 1, trigger => sub { croak '', unless ( $_[0] ) }, ); has purchase_frequency_per_month => ( is => 'ro', isa => 'Int', required => 1, trigger => sub { croak '', unless ( $_[0] ) }, ); has return_rate => ( is => 'ro', isa => 'Num', required => 1, trigger => sub { croak '', unless ( $_[0] ) }, ); __PACKAGE__->meta->make_immutable(); } # 優良顧客のルールを再現するinterface package ExcelentCustomerRule { use Mouse::Role; requires 'ok'; method ok($history) { } } package GoldCustomerPurchaseAmontRule { use Carp qw/croak/; use Mouse; with 'ExcelentCustomerRule'; method ok($history) { return 100000 <= $history->total_amount; } } package PurchaseFrequencyRule { use Carp qw/croak/; use Mouse; with 'ExcelentCustomerRule'; method ok($history) { return 10 <= $history->purchase_frequency_per_month; } } package ReturnRateRule { use Carp qw/croak/; use Mouse; with 'ExcelentCustomerRule'; method ok($history) { return $history->return_rate <= 0.001; } } package GoldCustomerPolicy { use Mouse; has rules => ( is => 'rw', isa => 'ArrayRef[Object]', required => 0, default => sub { [ GoldCustomerPurchaseAmontRule->new(), PurchaseFrequencyRule->new(), ReturnRateRule->new(), ] } ); method comply_with_all($history) { for my $rule ( @{ $self->rules } ) { if ( !$rule->ok($history) ) { return !!0; } } return !!1; } } package SilverCustomerPolicy { use Mouse; has rules => ( is => 'rw', isa => 'ArrayRef[Object]', required => 0, default => sub { [ PurchaseFrequencyRule->new(), ReturnRateRule->new(), ] } ); method comply_with_all($history) { for my $rule ( @{ $self->rules } ) { if ( !$rule->ok($history) ) { return !!0; } } return !!1; } } package main; # 模範的ゴールド会員 my $gold_customer_history = History->new( total_amount => 200000, purchase_frequency_per_month => 20, return_rate => 0.001, ); # ゴールド会員のポリシー my $gold_customer_policy = GoldCustomerPolicy->new(); # 特別会員かどうかを判定 if ( $gold_customer_policy->comply_with_all($gold_customer_history) ) { say "Gold 会員です"; } # 模範的シルバー会員 my $silver_customer_history = History->new( total_amount => 100000, purchase_frequency_per_month => 20, return_rate => 0.001, ); # シルバー会員のポリシー my $silver_customer_policy = SilverCustomerPolicy->new(); # シルバー会員かどうかを判定 if ( $silver_customer_policy->comply_with_all($silver_customer_history) ) { say "Silver 会員です"; }
Perl で interface を理解するための長い旅
脚注からヒントを得る
ここしばらく「良いコード/悪いコードで学ぶ設計入門 ―保守しやすい 成長し続けるコードの書き方」をやっております。
その中でインターフェースって何？ということでググりつつ、適当にネットから拾いつつやっていたのですが、一つ日曜の午後に腰を据えてやってみることにしました。
普段の業務（による疲労）との兼ね合いもあり、なかなかこの本の学習が進まない・・・ので、ちょっと先を見たところ、6章巻末の脚注にこうありました。
interface は Java 以外では Kotlin や C# にもあります。Scala では trait という形で用意されています。
とあります。
trait ！？
なんか、Perl での interface の実装を求めてググりまくってた時に色々引っかかってきた語です。
その時はスルーしていましたが・・・
トレイト (英: Trait) は、コンピュータープログラミングでの概念であり、専らオブジェクト指向プログラミングで用いられている。トレイトはメソッドの集合体であり、クラスの機能を拡張するために使われる[1][2]。 https://ja.wikipedia.org/wiki/%E3%83%88%E3%83%AC%E3%82%A4%E3%83%88
（中略）
あ、繋がってきた。
この2009年の記事では Moose::Role での実装例が書かれていて参考になりました。
せっかくなので写経。ありがたいコードは写経しないとね。
Moose → Mouseにしたり、少し変えてるけどちゃんと動いた。
コメントは何ヶ月か先に見直した自分用に追加
ここクリックして展開
#!/usr/bin/env perl use strict; use warnings; use Test::More tests => 4; # Flyロールの定義 package Fly { use Mouse::Role; requires 'fly_with'; # Flyロールを継承するクラスが実装しているべきメソッド sub fly { my $self = shift; print "I can fly with " . $self->fly_with . ".\n"; } } # 哺乳類クラス package Mammal { use Mouse; sub produce_milk { print "i can produce milk.\n"; } __PACKAGE__->meta->make_immutable(); } # こうもりクラス package Bat { use Mouse; extends 'Mammal'; # 哺乳類クラスを継承 with 'Fly'; # Flyロールを継承 sub fly_with { 'wings'; } __PACKAGE__->meta->make_immutable(); } package main; my $bat = Bat->new(); # こうもりクラスには fly_with メソッドしかないのに、 # produce_milk, fly メソッドが利用できるようになっている。 can_ok( $bat => 'produce_milk' ); # ok 1 - Bat->can('produce_milk') can_ok( $bat => 'fly' ); # ok 2 - Bat->can('fly') ok( $bat->isa('Mammal') ); # ok 3 ok( !$bat->isa('Bird') ); # ok 4
さらに role を探究
これも2009年の記事です。当時は role が熱かった時期なのでしょうか。
その頃何してたかなぁ。
情報処理系の資格取りまくってた頃かな。
こちらのコードも写経してみます。
このコードは複数の role を引き継いだ場合に、メソッドをどう解決しているのか？というものでした。
途中でエラーを出して、そこから逆算して仕組みを解説するあたりが好きな記事です。
ここクリックして展開
#!/usr/bin/env perl use strict; use warnings; package Println { use Mouse::Role; requires 'write'; sub println { my $self = shift; $self->write( @_, "\n" ); } no Mouse::Role; } package Logging { use Mouse::Role; with 'Println'; requires 'println'; sub log { my $self = shift; $self->println( scalar localtime() . ' ' . $_ ) for @_; } no Mouse::Role; } package HelloWorld { use Mouse::Role; requires 'println'; sub helloWorld { my $self = shift; $self->println("Hello World!"); } no Mouse::Role; } package MyApp { use Mouse; with 'HelloWorld', 'Logging'; # この write メソッドをコメントアウトして無効にすると、 # write がない旨のエラーが Println ロールから出る。 # しかし、HelloWorld ロールが要求する println メソッドは、同時に # 継承した Logging ロールから継承して解決されているのでエラーにならない。 sub write { my $self = shift; warn @_; } __PACKAGE__->meta->make_immutable(); } package main; my $myapp = MyApp->new(); # MyApp クラスには helloworld メソッドも log メソッドもないが、 # role から継承しているので実行できる！ $myapp->helloWorld(); $myapp->log("said 'hello'");
Moose::Roleの「未実装のメソッドを教えてくれる」と言うJavaのInterfaceっぽい機能*6は、Traitsを実現するためのおまけでした。
なるほど、まさに「未実装のメソッドを教えてくれる」というところにしか注目していなかったですわ。
role の組み合わせで、よりスリムなクラス設計ができそう（能力があれば）。
Function::Interface
名前そのものに Interface が入ったモジュール。早速 cpanm でインストール！
$ cpanm Function::Interface
あれ？エラーだ
テストで t/03 の Function::Return::info 使ってるところが軒並み落ちてる。
でも、plenv で Perl 5.32.0 だと普通にインストールできる。
Perl 5.34, Perl 5.36 だとこのテストで引っかかった。
ここクリックして展開
cp lib/Function/Interface.pm blib/lib/Function/Interface.pm
cp lib/Function/Interface/Info/Function/Param.pm blib/lib/Function/Interface/Info/Function/Param.pm
cp lib/Function/Interface/Info.pm blib/lib/Function/Interface/Info.pm
cp lib/Function/Interface/Impl.pm blib/lib/Function/Interface/Impl.pm
cp lib/Function/Interface/Info/Function.pm blib/lib/Function/Interface/Info/Function.pm
cp lib/Function/Interface/Info/Function/ReturnParam.pm blib/lib/Function/Interface/Info/Function/ReturnParam.pm
cp lib/Function/Interface/Types.pm blib/lib/Function/Interface/Types.pm
t/01_function_interface/assert_valid_interface_params.t .. ok
t/01_function_interface/assert_valid_interface_return.t .. ok
t/01_function_interface/import.t ......................... ok
t/01_function_interface/import_options.t ................. ok
t/01_function_interface/info.t ........................... ok
t/01_function_interface/unimport.t ....................... ok
t/02_function_interface_info/function.t .................. ok
t/02_function_interface_info/function/param.t ............ ok
t/02_function_interface_info/function/return_param.t ..... ok
t/02_function_interface_info/info.t ...................... ok
t/03_function_interface_impl/assert_valid.t .............. Undefined subroutine &Function::Return::info called at /Users/sironekotoro/p5-Function-Interface/.build/046cqH9S/blib/lib/Function/Interface/Impl.pm line 110.
Compilation failed in require at t/03_function_interface_impl/assert_valid.t line 16.
BEGIN failed--compilation aborted at t/03_function_interface_impl/assert_valid.t line 16.
t/03_function_interface_impl/assert_valid.t .............. Dubious, test returned 255 (wstat 65280, 0xff00)
No subtests run
t/03_function_interface_impl/case_duplicate.t ............ ok
t/03_function_interface_impl/check_params.t .............. ok
t/03_function_interface_impl/check_return.t .............. 1/?
# Failed test 'empty return'
# at t/03_function_interface_impl/check_return.t line 14.
# Caught exception in subtest: Undefined subroutine &Function::Return::info called at t/03_function_interface_impl/check_return.t line 37.
# Failed test 'single return'
# at t/03_function_interface_impl/check_return.t line 21.
# Caught exception in subtest: Undefined subroutine &Function::Return::info called at t/03_function_interface_impl/check_return.t line 37.
# Failed test 'two return'
# at t/03_function_interface_impl/check_return.t line 32.
# Caught exception in subtest: Undefined subroutine &Function::Return::info called at t/03_function_interface_impl/check_return.t line 37.
# Seeded srand with seed '20220612' from local date.
t/03_function_interface_impl/check_return.t .............. Dubious, test returned 3 (wstat 768, 0x300)
Failed 3/3 subtests
t/03_function_interface_impl/error.t ..................... ok
t/03_function_interface_impl/impl_of.t ................... 1/? implements error: cannot get function `foo` parameters info. Interface: fun foo() :Return() at t/03_function_interface_impl/impl_of.t line 21
died at /Users/sironekotoro/p5-Function-Interface/.build/046cqH9S/blib/lib/Function/Interface/Impl.pm line 95.
Execution of t/03_function_interface_impl/impl_of.t aborted due to compilation errors.
# Failed test at t/03_function_interface_impl/impl_of.t line 7.
# Failed test at t/03_function_interface_impl/impl_of.t line 8.
# Tests were run but no plan was declared and done_testing() was not seen.
# Looks like your test exited with 255 after test #6.
# Seeded srand with seed '20220612' from local date.
t/03_function_interface_impl/impl_of.t ................... Dubious, test returned 255 (wstat 65280, 0xff00)
Failed 2/6 subtests
t/03_function_interface_impl/import.t .................... ok
t/03_function_interface_impl/info_interface.t ............ ok
t/03_function_interface_impl/info_params.t ............... ok
t/03_function_interface_impl/info_return.t ............... Undefined subroutine &Function::Return::info called at /Users/sironekotoro/p5-Function-Interface/.build/046cqH9S/blib/lib/Function/Interface/Impl.pm line 110.
t/03_function_interface_impl/info_return.t ............... Dubious, test returned 255 (wstat 65280, 0xff00)
No subtests run
t/03_function_interface_impl/register_check_list.t ....... ok
t/04_function_interface_types/impl_of.t .................. implements error: cannot get function `foo` parameters info. Interface: fun foo() :Return() at t/lib/Foo.pm line 2
died at /Users/sironekotoro/p5-Function-Interface/.build/046cqH9S/blib/lib/Function/Interface/Impl.pm line 95.
Compilation failed in require at t/04_function_interface_types/impl_of.t line 7.
BEGIN failed--compilation aborted at t/04_function_interface_types/impl_of.t line 7.
t/04_function_interface_types/impl_of.t .................. Dubious, test returned 255 (wstat 65280, 0xff00)
No subtests run
Test Summary Report
-------------------
t/03_function_interface_impl/assert_valid.t (Wstat: 65280 Tests: 0 Failed: 0)
Non-zero exit status: 255
Parse errors: No plan found in TAP output
t/03_function_interface_impl/check_return.t (Wstat: 768 Tests: 3 Failed: 3)
Failed tests: 1-3
Non-zero exit status: 3
t/03_function_interface_impl/impl_of.t (Wstat: 65280 Tests: 6 Failed: 2)
Failed tests: 5-6
Non-zero exit status: 255
Parse errors: No plan found in TAP output
t/03_function_interface_impl/info_return.t (Wstat: 65280 Tests: 0 Failed: 0)
Non-zero exit status: 255
Parse errors: No plan found in TAP output
t/04_function_interface_types/impl_of.t (Wstat: 65280 Tests: 0 Failed: 0)
Non-zero exit status: 255
Parse errors: No plan found in TAP output
まぁ、Perl 5.32 で動いてるなら、Perl 5.36 でもいけるでしょう・・・ということで、ノーテストでインストール。
$ cpanm -n Function::Interface
無事、Perl 5.36 の環境にインストールできたので、早速例示コードを試す！
Perl 5.36 で例示のコードを動かそうとしたものの、エラー。
implements error: cannot get function `hello` parameters info. Interface: fun hello(Str $msg) :Return(Str) at interface.pl line 35
died at /Users/sironekotoro/.anyenv/envs/plenv/versions/5.36.0/lib/perl5/site_perl/5.36.0/Function/Interface/Impl.pm line 95.
Execution of interface.pl aborted due to compilation errors.
なお、モジュールインストール時にエラーの出なかった Perl 5.32 でもエラー。
あれー・・・
というわけで、Perl 5.32 の環境でエラーを追っかけて、例示のコードに手を加えて動くところまでやってみました。
fun じゃなくて method にしたのと、例示のコードに加えて add も実装してみました。
FooService のところがまだうまく理解できない感です。
ここクリックして展開
#!/usr/bin/env perl use strict; use warnings; use lib qw/./; # インターフェース定義 package IFoo { use Function::Interface; use Types::Standard -types; method hello(Str $msg) :Return(Str); method add(Int $a, Int $b) :Return(Int); } # クラスにインターフェースを実装する package Foo { use Function::Interface::Impl qw(IFoo); use Types::Standard -types; use Mouse; method hello(Str $msg) :Return(Str) { return "HELLO $msg"; } method add(Int $a, Int $b) :Return(Int) { return $a + $b; } } # インターフェースを適用させたメソッドを使う package FooService { use Function::Interface::Types qw(ImplOf); use Function::Parameters; use Function::Return; use Mouse; use aliased 'IFoo'; method greet(ImplOf[IFoo] $foo) :Return() { print $foo->hello('World!') . "\n"; return; } method add(ImplOf[IFoo] $foo ) :Return(){ print $foo->add(40, 2) . "\n"; return; } } my $foo_service = FooService->new; my $foo = Foo->new; $foo_service->greet($foo); # HELLO World! $foo_service->add($foo); # 42 1
しかし、このコードは Perl 5.32 では動くけど、 Perl 5.36 では動かないのだった・・・ううーん
implements error: cannot get function `hello` parameters info. Interface: method hello(Str $msg) :Return(Str) at /Users/sironekotoro/Dropbox/study/良いコード／悪いコードで学ぶ設計入門/role/FooAll.pm line 36
died at /Users/sironekotoro/.anyenv/envs/plenv/versions/5.36.0/lib/perl5/site_perl/5.36.0/Function/Interface/Impl.pm line 95.
BEGIN not safe after errors--compilation aborted at /Users/sironekotoro/Dropbox/study/良いコード／悪いコードで学ぶ設計入門/role/FooAll.pm line 51.
「良いコード／悪いコードで学ぶ設計入門」第6章その1 ストラテジーパターン #ミノ駆動本
早期 return でネスト解消
まぁ、これは書くまでもなく、わかる。
というか、例示コード書くのも辛い・・・
if ( $a == 1 ) { if ( $b == 2 ) { if ( $c == 3 ) { } } }
的な。
これに else や elsif が入ってくるとさらにカオスになるという。
ネストの深淵を見つめる時、深淵もまたお前を見つめているのだ・・・的な。
解決策としては、「早期 return」。
早期 return によって見通しが良くなり・・・
条件ロジックと実行ロジックを分離できること
なるほど。ロジックの追加も怖くない、と。
switch 文の重複
まぁ、Perl には switch 文がない（厳密にはあるけど実験的機能＆推奨されていない）。
ということで軽く読み飛ばす。
ここでは、魔法の名前、消費魔法力、攻撃力ごとに switch 文を書いてる（リスト6.11,リスト 6.12, リスト6.13）・・・けど、普通そんなに小分けにして条件分岐というか switch 分書かないよね？
まぁ、当然そんな書き方をしていれば、追加漏れなんかも出てくるだろう。
例示を優先して執筆したんかな？
ただまぁ、伝えたいことはわかる。
のちに、魔法ごとに名前、消費魔法力、攻撃力をまとめて switch 文で切り替えるコード（リスト6.18）になっている。
こちらはわかる。
そしてここで、巨大な switch 文を解消する手段として interface が出てくる。
おおっと、さすがに Perl ではないかな・・・近そうなのは role ？
うーん、ここはわからないなぁ。
インターフェース自体、Go をちょっと勉強したときに「同じメソッドがあれば共通化できるのねー、ふーん、そういうものかー」程度の浅い理解しかない。
とりあえず、例示コードの四角形クラスと円クラスを書いてこう。
リスト6.19 四角形クラスと円クラス
ここクリックして展開
#!/usr/bin/env perl use strict; use warnings; use feature qw/say/; use Function::Parameters; package Rectangle { use Carp qw/croak/; use Mouse; use Readonly; use constant { MIN => 0 }; has width => ( is => 'ro', isa => 'Num', required => 1, trigger => sub { croak '', unless ( $_[0] ) }, ); has height => ( is => 'ro', isa => 'Num', required => 1, trigger => sub { croak '', unless ( $_[0] ) }, ); fun area($self) { return $self->width * $self->height; } __PACKAGE__->meta->make_immutable(); } package Circle { use Carp qw/croak/; use Mouse; use Readonly; use constant { MIN => 0, PI => 3.1415 }; has radius => ( is => 'ro', isa => 'Num', required => 1, trigger => sub { croak '', unless ( $_[0] ) }, ); fun area($self) { return $self->radius * $self->radius * PI; } __PACKAGE__->meta->make_immutable(); } package main; my $rectangle = Rectangle->new( width => 4, height => 5 ); say $rectangle->area; # 20 my $circle = Circle->new( radius => 1 ); say $circle->area; # 3.1415
ここで作った rectangle と circle 、両方にある（面積を求める）area というメソッド。
この area メソッドを備えたオブジェクトなら同じインターフェースで扱うことができる・・・
いちいち、中に入っているのが rectangle か circle かという条件分岐をせずとも、area というメソッドを呼べる。
・・・いまの Perl のコードでもできてますがな。
まぁ、 Perl には（この本に書いてあるような用途での）型ないからな！！
リスト6.25 同じ Shape 型として利用可能
というわけで・・・ここは Perl でちゃんと実装できませんでした。
やりたかったのは、Shape というインターフェース型を用意し、Rectangle と Circle という型をそこに含める。
Shape->area とすることで、Shape の中身が Rectangle でも Circle でも面積を求めることができる・・・
ということを Perl でもやりたかったんだけど、いや別にインターフェース型用意しなくとも普通にメソッド使える（ダックタイピングできる）んだよなぁ。
ただ、「引数を特定のクラスのオブジェクトに限定することで、堅牢なクラスをつくる」というこの本のこれまでの趣旨とは合わない。
うーん。
で、Mouse::Role とか使ってみたのだけどなんか違う。
というわけで、インターフェース型じゃなくて、こういう型を作ってみた。
# Shape 型 declare 'Shape', as Object, where { ref $_ eq 'Rectangle' || ref $_ eq 'Circle' }, where { $_->can('area') }, message { 'Rectangle か Circle クラスかつ area メソッドのあるもののみ受け付けます' };
これで、
- Rectangle 型か Circle 型 しか受け付けず
- area メソッドを持っている
ものしか受け取らない型ができた。もうこれはインターフェースと言っていいんじゃないか！！
いややっぱ違う？
違うけど、こっから先に進めなくなってしまったので、とりあえずこれで済ませよう。
なお、せっかく書いた、そして初めて Mouse::Role 使ったコードも置いておこう。
ちなみに、Role は初めて使いました。
ここクリックして展開
#!/usr/bin/env perl use strict; use warnings; use feature qw/say/; use Function::Parameters; # role を インターフェース代わりに使う package Shape { # use Mouse; use Mouse::Role; # ロールを使うための便利モジュール # このロールを継承(?)するオブジェクトが持っているべきメソッド requires qw(area_of); # 継承したオブジェクトで area メソッドを呼ぶと、 # 各オブジェクトの area_of メソッドの結果を返す sub area { my $self = shift; return $self->area_of(); } } package Rectangle { use Carp qw/croak/; use Mouse; with qw/Shape/; has width => ( is => 'ro', isa => 'Num', required => 1, trigger => sub { croak '', unless ( $_[0] ) }, ); has height => ( is => 'ro', isa => 'Num', required => 1, trigger => sub { croak '', unless ( $_[0] ) }, ); fun area_of($self) { return $self->width * $self->height; } __PACKAGE__->meta->make_immutable(); } package Circle { use Carp qw/croak/; use Mouse; use constant { PI => 3.1415 }; with qw/Shape/; has radius => ( is => 'ro', isa => 'Num', required => 1, trigger => sub { croak '', unless ( $_[0] ) }, ); fun area_of($self) { return $self->radius * $self->radius * PI; } __PACKAGE__->meta->make_immutable(); } package main; my $rectangle = Rectangle->new( width => 4, height => 5 ); say $rectangle->area; # 20 my $circle = Circle->new( radius => 1 ); say $circle->area; # 3.1415
リスト6.37 魔法 interface の値オブジェクト導入版
・・・というのが例示コードのタイトル。
しかし、Perl で実装をこころみましたが実力及ばず、インターフェースをそのまま再現することができませんでした。
残念。
ただまぁ、それでもできるところまでやってみるべ、ということで
- 型を使って、指定したメソッドが含まれていることを確認
- if 文を使わず、魔法の切り替えができるよう実装
- 一部のプロパティは型オブジェクトで返す
ところまでやってみました。
interface の代わりに、MagicAttack クラスの中に各魔法のプロパティを書くことで代用しています。
もう少し、良い手がありそうな気がするのですが、とりあえずここまでとします。
ここクリックして展開
型定義の MyType.pm
# Magic 型 declare 'Magic', as Object, where { ref $_ eq 'Fire' || ref $_ eq 'Shiden' || ref $_ eq 'HellFire' }, where { $_->can('name') && $_->can('cost_magic_point') && $_->can('attack_power') && $_->can('cost_technical_point') }, message { 'Magic クラスのみ受け付けます' };本体
#!/usr/bin/env perl use strict; use warnings; use feature qw/say/; use Function::Parameters qw/method/; package Member { use Carp qw/croak/; use Mouse; use constant { MIN => 0 }; has level => ( is => 'ro', isa => 'Int', required => 1, trigger => sub { croak '', unless ( $_[0] ) }, ); has agility => ( is => 'ro', isa => 'Int', required => 1, trigger => sub { croak '', unless ( $_[0] ) }, ); has magic_attack => ( is => 'ro', isa => 'Int', required => 1, trigger => sub { croak '', unless ( $_[0] ) }, ); has vitality => ( is => 'ro', isa => 'Int', required => 1, trigger => sub { croak '', unless ( $_[0] ) }, ); __PACKAGE__->meta->make_immutable(); } package Fire { use Carp qw/croak/; use Mouse; has member => ( is => 'ro', isa => 'Member', required => 1, trigger => sub { croak '', unless ( $_[0] ) }, ); method name() { return "ファイア"; } method cost_magic_point() { return MagicPoint->new( amount => 2 ); } method attack_power() { return AttackPower->new( amount => 20 + $self->member->level * 0.5 ); } method cost_technical_point() { return TechnicalPoint->new( amount => 0 ) } __PACKAGE__->meta->make_immutable(); } package Shiden { use Carp qw/croak/; use Mouse; has member => ( is => 'ro', isa => 'Member', required => 1, trigger => sub { croak '', unless ( $_[0] ) }, ); method name() { return "紫電"; } method cost_magic_point() { return MagicPoint->new( amount => 5 * $self->member->level * 0.2 ); } method attack_power() { return AttackPower->new( amount => 50 + $self->member->agility * 0.5 ); } method cost_technical_point() { return TechnicalPoint->new( amount => 5 ); } __PACKAGE__->meta->make_immutable(); } package HellFire { use Carp qw/croak/; use Mouse; has member => ( is => 'ro', isa => 'Member', required => 1, trigger => sub { croak '', unless ( $_[0] ) }, ); method name() { return "地獄の業火"; } method cost_magic_point() { return MagicPoint->new( amount => 16 ); } method attack_power() { return AttackPower->new( amount => 200 + $self->member->magic_attack * 0.5 + $self->member->agility * 2 ); } method cost_technical_point() { return TechnicalPoint->new( amount => 20 + $self->member->level * 0.4 ); } __PACKAGE__->meta->make_immutable(); } package MagicAttack { use Carp qw/croak/; use Mouse; use lib qw/./; use MyType; has member => ( is => 'ro', isa => 'Member', required => 1, trigger => sub { croak '', unless ( $_[0] ) }, ); has Fire => ( is => 'ro', isa => MyType::Magic, required => 0, default => sub { Fire->new( member => $_[0]->member ) } ); has Shiden => ( is => 'ro', isa => MyType::Magic, required => 0, default => sub { Shiden->new( member => $_[0]->member ) } ); has HellFire => ( is => 'ro', isa => MyType::Magic, required => 0, default => sub { HellFire->new( member => $_[0]->member ) } ); __PACKAGE__->meta->make_immutable(); } package MagicPoint { use Carp qw/croak/; use Mouse; has amount => ( is => 'ro', isa => 'Int', required => 1, trigger => sub { croak '', unless ( $_[0] ) }, ); __PACKAGE__->meta->make_immutable(); } package AttackPower { use Carp qw/croak/; use Mouse; has amount => ( is => 'ro', isa => 'Int', required => 1, trigger => sub { croak '', unless ( $_[0] ) }, ); __PACKAGE__->meta->make_immutable(); } package TechnicalPoint { use Carp qw/croak/; use Mouse; has amount => ( is => 'ro', isa => 'Int', required => 1, trigger => sub { croak '', unless ( $_[0] ) }, ); __PACKAGE__->meta->make_immutable(); } package main; my $member = Member->new( level => 10, agility => 10, magic_attack => 10, vitality => 10, ); my $magic_attack = MagicAttack->new( member => $member ); my $magic = $magic_attack->Fire; say $magic->name; # ファイア say $magic->cost_magic_point->amount; # 2 say $magic->attack_power->amount; # 25 say $magic->cost_technical_point->amount; # 0 $magic = $magic_attack->Shiden; say $magic->name; # 紫電 say $magic->cost_magic_point->amount; # 10 say $magic->attack_power->amount; # 55 say $magic->cost_technical_point->amount; # 5 $magic = $magic_attack->HellFire; say $magic->name; # 地獄の業火 say $magic->cost_magic_point->amount; # 16 say $magic->attack_power->amount; # 225 say $magic->cost_technical_point->amount; # 24
「良いコード／悪いコードで学ぶ設計入門」第5章 後半 #ミノ駆動本
リスト5.19 C# の出力引数
ここでサンプルコードが C# になってますが、まぁなんとか読める気がします。
関数に参照渡しを行って宣言元の変数を変えるというコードです。
Perl だとこんな感じですかね。
#!/usr/bin/env perl use strict; use warnings; sub set { my $arg = shift; ${$arg} = 10; return $arg; } my $value; set( \$value ); print $value; # 画面に10が表示される
これはまぁ、例示コードを Perl に落とし込んだだけですが、こうは書かんやろ・・・と思うけど、まぁ置いて先に進む。
参照渡しは低凝集に繋がりやすいので、凝集性に問題のないケースに限定しよう、という趣旨でした。
ただ、この章は魔法力回復と定価ロジックの例が入り乱れていて、例示コードはこんな感じ。
- リスト5.23 引数の多いメソッド（魔法力）
- リスト5.24 プリミティブ執着（定価）
- リスト5.25 プリミティブ執着によるコード重複（定価）
- リスト5.26 定価という具体的な型として設計する（定価）
- リスト5.27 プリミティブではなくクラスの型を渡す（定価）
- リスト5.28 引数ではなくインスタンス変数として表現する（魔法力）
書き出してみると、定価のコードからやるのが良さそう。
リスト5.24 プリミティブ執着の例
といっても、まぁ Perl にゃ元々 スカラー、配列、ハッシュしか型がないので、執着も何も・・・なのですが、あえて Perl で書きます。
#!/usr/bin/env perl use strict; use warnings; use feature qw/say/; use Carp qw/croak/; use Function::Parameters; use Types::Standard -types; fun discounted_price( Int $regular_price, Num $discount_rate ) { if ( $regular_price < 0 ) { croak("定価が0未満です"); } if ( $discount_rate < 0 ) { croak("割引率が0未満です"); } return $regular_price - ( $regular_price * $discount_rate ); } say discounted_price( 100, 0.1 ); # 90
リスト5.25 プリミティブ型に執着するとコード重複が生じやすい
プリミティブ型ばかり使っていると、先のコードの
if ( $regular_price < 0 ) { croak("定価が0未満です"); }
みたいなのが、コードのあちらこちらに書かれちゃうよね、という。
まぁ、そうよね。
リスト5.26 「定価」という具体的な方として設計する
ここはまぁ、シンプルに。
#!/usr/bin/env perl use strict; use warnings; use feature qw/say/; package RegularPrice { use Mouse; use Carp qw/croak/; has amount => ( is => 'ro', isa => 'Int', required => 1, trigger => sub { croak '', if ( $_[0] < 0 ) }, ); } package main; my $regular_price = RegularPrice->new( amount => 100 ); say $regular_price->amount; # 100
リスト5.27 プリミティブではなくクラスの型を渡す
たかが数値を10%引くだけで・・・
my $discount_price *= 0.9;
とか書いてしまいますね。
でも、自分が書いている業務コードで確かに、同じようなコードで同じような処理が散乱しているよな・・・という思い当たりがあって苦しい。
苦しいからこそ、書いてみるしかない。
まずは雑に型定義したファイル。
ここクリックして展開
package MyType; use strict; use warnings; use Type::Library -base; use Type::Utils; use Types::Standard -types; # RegularPrice 型 declare 'RegularPrice', as Object, where { ref $_ eq 'RegularPrice' }, message { 'RegularPrice クラスのみ受け付けます' }; # DiscountRate 型 declare 'DiscountRate', as Object, where { ref $_ eq 'DiscountRate' }, message { 'DiscountRate クラスのみ受け付けます' }; # DiscountedPrice 型 declare 'DiscountedPrice', as Object, where { ref $_ eq 'DiscountedPrice' }, message { 'DiscountedPrice クラスのみ受け付けます' }; 1;続いて本体。
#!/usr/bin/env perl use strict; use warnings; use feature qw/say/; package RegularPrice { use Mouse; use Carp qw/croak/; has amount => ( is => 'ro', isa => 'Int', required => 1, trigger => sub { croak '定価が0未満です', if ( $_[0] < 0 ) }, ); } package DiscountRate { use Carp qw/croak/; use Mouse; use lib qw/./; use MyType; has amount => ( is => 'ro', isa => 'Num', required => 1, trigger => sub { croak '割引率が0未満です', if ( $_[0] < 0 ) }, ); } package DiscountedPrice { use Carp qw/croak/; use Mouse; use Function::Parameters; use lib qw/./; use MyType; # 雑に型定義をしたファイル fun discounted_price( MyType::DiscountedPrice $self, MyType::RegularPrice $regular_price, MyType::DiscountRate $discount_rate ) { return $regular_price->amount - ( $regular_price->amount * $discount_rate->amount ); } } package main; my $regular_price = RegularPrice->new( amount => 100 ); say $regular_price->amount; # 100 my $discount_rate = DiscountRate->new( amount => 0.1 ); my $discounted_price = DiscountedPrice->new(); say $discounted_price->discounted_price( $regular_price, $discount_rate ); # 90
リスト5.23 多すぎるメソッド
ここから魔法力のコード。
うん、うちの知ってるRPGは確かにこんな感じだ。
これを全部引数にして、一つの関数に突っ込むと訳がわからなくなる・・・
ここクリックして展開
#!/usr/bin/env perl use strict; use warnings; use feature qw/say/; package Recover { use Carp qw/croak/; use lib qw/./; use List::Util qw/min/; use Function::Parameters; use Mouse; use MyType; use Types::Standard -types; method recover_magic_point( MyType::Int $current_magic_point, MyType::Int $originam_max_magic_point, MyType::ArrayRef [Int] $max_magic_point_increments, MyType::Int $recover_amount, ) { # 現在の最大マジックポイント（可変） my $current_max_magic_point = $originam_max_magic_point; for my $each ( @{$max_magic_point_increments} ) { # 現在の最大マジックポイントをマジックアイテム分増やす $current_max_magic_point += $each; } # 現在の最大マジックポイントと、回復量の小さい方を返り値として返す return min( ( $current_magic_point + $recover_amount ), $current_max_magic_point ) } __PACKAGE__->meta->make_immutable(); } package main; # 現在のマジックポイント:10 # 最大マジックポイント:100 # 装備で嵩上げされているマジックポイント: 40 (10, 10, 20 の合計 40) # 薬かなんかで回復するマジックポイントの値:10 my $magic_point = Recover->recover_magic_point( 10, 100, [ 10, 10, 20 ], 10 ); say $magic_point; # 20
リスト5.29 魔法力に関するロジックをカプセル化
本では省略されているけど、せっかくなので動くように書いてみた。
ところで、マジックポイントを「魔法力」と書けないのは、やっぱ商標とか著作権とかそういう・・・？
ここクリックして展開
#!/usr/bin/env perl use strict; use warnings; use feature qw/say/; package MagicPoint { use Carp qw/croak/; use Mouse; use Function::Parameters; use lib qw/./; use MyType; use List::Util qw/min/; # use Readonly; # use constant { MIN => 0 }; has current_amount => ( is => 'ro', isa => 'Int', required => 1, trigger => sub { croak '', unless ( $_[0] ) }, ); has original_max_amount => ( is => 'ro', isa => 'Int', required => 1, trigger => sub { croak '', unless ( $_[0] ) }, ); has max_increments => ( is => 'ro', isa => 'ArrayRef[Int]', required => 1, trigger => sub { croak '', unless ( $_[0] ) }, ); # 現在の魔法力残量 method current() { return $self->current_amount; } # 魔法力の最大量 method max() { my $amount = $self->original_max_amount; for my $each ( @{ $self->max_increments } ) { $amount += $each; } return $amount; } # 魔法力を回復する fun recover( MyType::MagicPoint $self, MyType::Int $recovery_amount) { my $current = min( $self->current_amount + $recovery_amount, $self->max() ); return MagicPoint->new( current_amount => $current, original_max_amount => $self->original_max_amount, max_increments => $self->max_increments, ); } # 魔法力を消費する fun consume( MyType::MagicPoint $self, MyType::Int $consume_amount) { return MagicPoint->new( current_amount => $self->current_amount - $consume_amount, original_max_amount => $self->original_max_amount, max_increments => $self->max_increments, ); } __PACKAGE__->meta->make_immutable(); } package main; my $magic_point = MagicPoint->new( current_amount => 10, original_max_amount => 100, max_increments => [ 10, 10, 20 ], ); # 現在の魔法力残量 say $magic_point->current(); # 10 # 魔法力の最大量 say $magic_point->max(); # 140 # 魔法力を回復する my $new_magic_point = $magic_point->recover(10); say $new_magic_point->current(); # 20 # 魔法力を過剰に回復するも、最大値までしか回復しない my $over_max_magic_point = $magic_point->recover(1000); say $over_max_magic_point->current(); # 140 # 魔法力を消費する my $consume_magic_point = $over_max_magic_point->consume(100); say $consume_magic_point->current(); # 40
リスト5.30 数珠繋ぎにコールする「メソッドチェイン」
掲載されているサンプルコードを、ちゃんとメソッドとして動くようにするのめんどくさすぎる！と直感が叫んだので、単なる構造体で済ませてます。
でも、それでも面倒くさそうなコードに仕上がりました。
あと、ローカルの環境が perl 5.36 になったので、use v5.36 としています。
これ一つで use strict; と use warnings を宣言したのと同じ意味になるのでお得ですね！
ここクリックして展開
#!/usr/bin/env perl use v5.36; use feature qw/say signatures/; my $party = { members => [ { equipments => { can_change => 1, } } ], }; sub equip_armor ( $member_id, $new_armor ) { if ( $party->{members}[$member_id]->{equipments}->{can_change} ) { $party->{members}[$member_id]->{equipments}->{armor} = $new_armor; } } equip_armor( 0, 'ChainMail' ); print $party->{members}[0]->{equipments}->{armor};
リスト5.31 詳細なロジックは呼ぶ側ではなく、呼ばれる側に実装しよう
例示のコードは装備を外すものだったけど、せっかくなので装備した後の防御力を返すメソッドを作ってみた。
あと、head, armor, arm ってプロパティの並びに違和感があったので、head, body, arm にしてみたり。
「源氏の籠手」は憧れです。
好きなRPGは「FF5」と「女神転生 ディープストレンジジャーニー」です。
ここクリックして展開
#!/usr/bin/env perl use v5.36; use feature qw/say/; use Function::Parameters; package Equipment { use Carp qw/croak/; use Mouse; use Readonly; use constant { MIN => 0 }; has name => ( is => 'ro', isa => 'Str', required => 1, trigger => sub { croak '', unless ( $_[0] ) }, ); has defense_power => ( is => 'ro', isa => 'Int', required => 1, trigger => sub { croak '', unless ( $_[0] ) }, ); fun empty($self) { return Equipment->new( name => '', defense_power => 0 ); } __PACKAGE__->meta->make_immutable(); } package Equipments { use Carp qw/croak/; use Mouse; use Readonly; use constant { MIN => 0 }; has can_change => ( is => 'ro', isa => 'Bool', required => 0, trigger => sub { croak '', unless ( $_[0] ) }, ); has head => ( is => 'ro', isa => 'Equipment', required => 0, trigger => sub { croak '', unless ( $_[0] ) }, ); has body => ( is => 'ro', isa => 'Equipment', required => 0, trigger => sub { croak '', unless ( $_[0] ) }, ); has arm => ( is => 'ro', isa => 'Equipment', required => 0, trigger => sub { croak '', unless ( $_[0] ) }, ); fun defense_power($self) { return $self->head->defense_power + $self->body->defense_power + $self->arm->defense_power; } fun deactivate_all($self) { return Equipments->new( head => Equipment->empty(), body => Equipment->empty(), arm => Equipment->empty(), ) } __PACKAGE__->meta->make_immutable(); } package main; # my $equipment = Equipments->new(); # 頭部防具 my $iron_helmet = Equipment->new( name => '鉄のヘルメット', defense_power => 10, ); # 鎧 my $chain_mail = Equipment->new( name => 'チェインメイル', defense_power => 15, ); # 籠手 my $genji_s_gauntlet = Equipment->new( name => '源氏の籠手', defense_power => 80, ); my $equipment = Equipments->new( head => $iron_helmet, body => $chain_mail, arm => $genji_s_gauntlet, ); # 防具を装備した防御力 say $equipment->defense_power(); # 105 # 全装備を解除する my $full_monty = $equipment->deactivate_all(); # 全装備を解除した後の防御力 say $full_monty->defense_power(); #0
