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
Perl 5.36 が出ました ＆（anyenv経由の）plenvでのインストール＆移行方法
祝！Perl 5.36 ！
ということで、初夏のはじめ頃のイベントである Perl の新規安定版リリースです。
うちは（anyenv経由の） plenv で複数の Perl のバージョンを扱っているので、 plenv での作業を書いておきます。
誰のためってもちろん、来年の自分用です。
インストールできるバージョンを確認
$ plenv install -l | grep 5\.36 5.36.0 5.36.0-RC3 5.36.0-RC2
インストール
$ plenv install 5.36.0
現時点で plenv がメインで使っているバージョンを確認する
$ plenv versions system 5.32.0 * 5.34.0 (set by /Users/sironekotoro/.anyenv/envs/plenv/version) 5.36.0
plenv がメインで使っているバージョンを、新しくインストールしたものに変更する
$ plenv global 5.36.0
plenv がメインで使っているバージョンが変更されていることを確認する
$ plenv versions system 5.32.0 5.34.0 * 5.36.0 (set by /Users/sironekotoro/.anyenv/envs/plenv/version)
perl のバージョンを確認する
$ perl -v This is perl 5, version 36, subversion 0 (v5.36.0) built for darwin-2level Copyright 1987-2022, Larry Wall Perl may be copied only under the terms of either the Artistic License or the GNU General Public License, which may be found in the Perl 5 source kit. Complete documentation for Perl, including FAQ lists, should be found on this system using "man perl" or "perldoc perl". If you have access to the Internet, point your browser at https://www.perl.org/, the Perl Home Page.
VScode でも新規に入れた perl を利用しているか確認する
vscode で Code Runner とか入れている場合には、ちゃんと更新したバージョンで実行されているかを確認する。
#!/usr/bin/env perl use strict; use warnings; print $]; # 5.036000
この $] というのが特殊変数で、実行している perl のバージョンを返してくれる。
VScode + Code Runner でうまく動かない場合には、Code Runner の「拡張機能の設定」→「Code-runner: Executor Map」→setting.json で perl が plenv（またはanyenv） でインストールされたものになっているか確認しておく。
ターミナルで perl -v で確認したバージョンでよければ、ターミナルで which perl として出てきたパスを設定する。
うちの場合はこんな感じ。
"perl": "$HOME/.anyenv/envs/plenv/shims/perl",
これまで入れてきた perl のモジュールをマイグレーションする
マイグレーションと言っても以前入れていたバージョンの perl でインストールしたモジュールを移行（移動）してくるのではなく、新規バージョンの perl にモジュールを新規でインストールを行う作業。
GitHub とか 自前ソースで作ったものは移行されない模様。
都度自分でインストールする。
-n（モジュールインストール時にテストしない）つけているのは自己責任いうことで・・・
$ plenv migrate-modules -n 5.32.0 5.36.0
インストールしてきたモジュール数によっては時間がかかる。
なので寝て待つか、ゲームでもして待ちましょう。
初プレイから5年、長かったわ。最後に残ってたのは国持衆でした。 #信長の野望 #創造PK #NOBUNAGAS_AMBITION #NintendoSwitch pic.twitter.com/WvrYKgdAmg
— sironekotoro💙💛 (@sironekotoro) 2022年6月1日
perl のバージョンを上げてもアプリを今まで通り動かしたい
ただ、モジュール関連は先の項で説明した通り入らないものもあります・・・
と、こうなって初めて Carton とか Docker のような、環境ごと切り出してくれるような技術が重要になってくるわけですね！（毎年痛感）
Perl 5.36 とまた一年
面白くやって行きましょう！
「良いコード／悪いコードで学ぶ設計入門」第5章の前半 #ミノ駆動本
目的を見失いがち
そもそも、例示コードを自分の好きに発展させて満足するのが目的ではない・・・ので、そういうのはほどほどに本を読み進めることにする。
5.1 staticメソッドの誤用
Java にはインスタンスを生成することなく、メソッドを呼び出す方法として static メソッドというのがあるらしい・・・
これPerlで再現できるんかな？
できなくない？
できたわ。
#!/usr/bin/env perl use strict; use warnings; package Hello { sub world { print "Hello, World"; } } package main; Hello->world(); # Hello, World
インスタンス生成せずにメソッドだけ使うとか考えたことなかったわ・・・固定観念？
ただまぁ、ここではデータとメソッドを一緒にした凝集度の高い設計にしましょう、ということで基本使わないということで良さそう。
staticメソッドの正しい使い方としては、凝集度に無関係なログ出力やフォーマット変換用メソッドなどがある、と。
リスト5-4 ギフトポイントを表現するクラス
初期化ロジックがいろんなところで書かれてしまい、結果として低凝集になってしまうという状況。
なるほど、コンストラクタ作る都度、初期ポイント数を設定していると、いろんなところで様々な値で呼び出されちゃうと。
ある時は初期ポイント3000で作って、その次は1500で作ってみたり・・・
携帯各社や楽天とか、時期やサービスの加入状態に応じて初期ポイントの額を変えたりしてるよねー。
あんな感じ？
ここクリックして展開
#!/usr/bin/env perl use strict; use warnings; use feature qw/say/; use Function::Parameters; use lib qw/./; use MyType; use Readonly; package GiftPoint { use Carp qw/croak/; use Mouse; use Readonly; use constant { MIN_POINT => 0 }; has value => ( is => 'ro', isa => 'Int', required => 1, trigger => sub { croak 'ポイントが0以上ではありません', if ( $_[0]->value < MIN_POINT ) }, ); # ポイントを加算する # $other 加算ポイント # return 加算後の残余ポイント method add( MyType::GiftPoint $other) { return GiftPoint->new( value => $self->value + $other->value ); } # return 残余ポイントが消費ポイント以上であればtrue # consumption: 消費 method is_enough($point) { return 1 if $point->value < $self->value; } # ポイントを消費する method consume($point) { if ( !$self->is_enough($point) ) { croak("ポイントが不足しています"); } return GiftPoint->new( value => $self->value - $point->value ); } } package main; # ポイント初期状態 my $initial_point = GiftPoint->new( value => 0 ); # ポイントを付与する my $added_point = $initial_point->add( GiftPoint->new( value => 3000 ) ); # ポイントはいくら？ warn $added_point->value; # 3000 # ポイントを消費 my $consume_point = $added_point->consume( GiftPoint->new( value => 1000 ) ); # ポイントはいくら？ warn $consume_point->value; # 2000 # ポイントを派手に消費 my $too_consume_point = $added_point->consume( GiftPoint->new( value => 10000 ) ); # => ポイントが不足しています
リスト5.7 ファクトリメソッドを備えたGiftPointクラス
インスタンスを直接作るのではなく、メソッド経由で作成させることで、インスタンス作成の幅を狭める作戦・・・としてのファクトリーメソッドパターン。
ここで、インスタンス化しなくとも、メソッドを使えるstaticメソッドが生きるわけですね。
なるほど。
デザインパターン・・・なんか、大昔にチャレンジしてみたけど、どの本読んでも何言ってるか全然わからなかったなぁという悲しい記憶。
もっとも、当時はPerlのオブジェクトもまだ満足に使いこなしていない頃だったのに無謀すぎた。
で、オブジェクト使って自分でプログラム作るようになってしばらくするとあ、あぁ、なるほど、ってなるという（ならないデザインパターンの方が全然多いけど）。
オブジェクト指向自体もそうだったよなぁ。なんなんだろうな、あれ。
それはさておき。
今回は直接インスタンス化はできなくて、メソッド経由でのみインスタンス化が可能というのがわからなかったのですが、Mouse と BUILD サブルーチンで解決しました。
Mouseはこれまでしれっと使ってきたのですが、sub new {} しなくともインスタンス化可能です。
でも sub new {}に相当するところで何か処理を入れたい時にはBUILDサブルーチンを設けてそこに処理を入れます。
コードがどこから呼ばれているかを判定する caller を使って、BUILDサブルーチンが含まれる GiftPoint パッケージ以外からの呼び出し時にはエラーが出るようにしました。
ここクリックして展開
#!/usr/bin/env perl
use strict;
use warnings;
use v5.32.0;
use feature qw/say isa/;
use Function::Parameters;
use lib qw/./;
use MyType;
use Readonly;
package GiftPoint {
use Carp qw/croak/;
use Mouse;
use Readonly;
use constant {
MIN_POINT => 0,
STANDARD_MEMBERSHIP_POINT => 3000,
PRMIUM_MEMBERSHIP_POINT => 10000,
};
has value => (
is => 'ro',
isa => 'Int',
required => 1,
trigger => sub {
croak 'ポイントが0以上ではありません', if ( $_[0]->value < MIN_POINT );
},
);
# インスタンス化するときに、外部のPackage名だったらエラー
sub BUILD {
my ( $package, undef, undef ) = caller;
croak '直接GiftPointクラスをnewすることができません' if ( $package ne 'GiftPoint' );
}
# 標準会員向け入会ギフトポイント
method forStandardMenbership() {
return 'GiftPoint'->new( value => STANDARD_MEMBERSHIP_POINT )
}
# ポイントを加算する
# $other 加算ポイント
# return 加算後の残余ポイント
method add( MyType::GiftPoint $other) {
return GiftPoint->new( value => $self->value + $other->value );
}
# return 残余ポイントが消費ポイント以上であればtrue
# consumption: 消費
method is_enough($point) {
return 1 if $point->value < $self->value;
}
# ポイントを消費する
method consume($point) {
if ( !$self->is_enough($point) ) {
croak("ポイントが不足しています");
}
return GiftPoint->new( value => $self->value - $point->value );
}
}
package main;
# my $standard_point = GiftPoint->forStandardMenbership();
# say $standard_point->value;
my $point = GiftPoint->new( value => 100 );
GiftPointクラスの中に、初期ポイント付与のパターンを入れておくことで凝集度を高めるわけですね。
なるほど。
5.3 共通処理クラス
さまざまなロジックが雑多に置かれがち
・・・はい。
うちは仕事効率化でよくGoogle Apps Script 使うんですが、いろんなシートからよく呼ばれる処理をまとめて Util ってクラスに集めてます。
まさに、本文の リスト5.11 のような雑多に処理を便利置き場的に使っています。
横断的関心ごとに関する処理でまとめ上げようと思います。
・・・まぁ、一個インポートしてくるだけで色々と使えるの便利なんですけどね！！！
リスト5.14 引数の変更をしている
出力引数？初めて聞いた。というか、引数は入力なのに出力？
掲載されているコードを参考に、足りないところを（足りない頭で）補ってみる。
ここクリックして展開
#!/usr/bin/env perl use strict; use warnings; use feature qw/say/; use Function::Parameters; use lib qw/./; use MyType; use Readonly; package Location { use Carp qw/croak/; use Mouse; use Readonly; use constant { MIN => 0 }; has x => ( is => 'rw', isa => 'Int', required => 1, trigger => sub { croak '', unless ( $_[0] ) }, ); has y => ( is => 'rw', isa => 'Int', required => 1, trigger => sub { croak '', unless ( $_[0] ) }, ); } package ActorManager { use Carp qw/croak/; use Mouse; use Readonly; use constant { MIN => 0 }; method shift( MyType::Location $location, MyType::Int $shiftX, MyType::Int $shiftY, ) { $location->x($shiftX); $location->y($shiftY); return $location; } } package main; my $location = Location->new( x => 0, y => 0 ); my $moved = ActorManager->shift( $location, 3, 3 ); say $moved->x; # 3 say $moved->y; # 3
これは座標を表すクラス Location と、その位置を変更する ActorManager（のshiftメソッド）だけど、なるほど、別れてる意味ないよなって感じ。
あと、Mouse でも has でプロパティ作らなくてもエラー出ないんだな。
まぁ、コンストラクタ＆引数をちゃんと設定しないのはアンチパターンであることは前の章で出ていたから、これは良くない。
次のリスト5.16の例は短いけど、 set ってメソッドで引数とっているのに、メソッドの中でやっているのは引数の減算。
なんでやっていう。
set ってメソッド名だったら、その引数の値がそのまま設定されるようなイメージなのに。
引数が入力なのか出力なのかぱっと見でわからないのはストレスだなぁ。
でもまだ「出力引数」って単語がしっくりこないな・・・
5.18 引き数を変更しない構造へ改善
第5章結構長いので、ここまでで前半としておきます。
先に作成した Location クラスの改修です。
ここで、ふと、あれ？
Perlのこのメソッドって他のオブジェクトから呼べちゃったりするのでは？と思い至りました。そして呼べます。
まぁ、Perlは動的型付けの言語で、Javaとは異なる思想で作られた言語なので当然なのですが、まぁ、それでも「そういう要望」に応えられるんかな？と思いました。
ここクリックして展開
#!/usr/bin/env perl use strict; use warnings; use feature qw/say isa/; use Function::Parameters; use lib qw/./; use MyType; use Readonly; package Location { use Carp qw/croak/; use Mouse; use Readonly; use constant { MIN => 0 }; has x => ( is => 'ro', isa => 'Int', required => 1, trigger => sub { croak '', unless ( $_[0] ) }, ); has y => ( is => 'ro', isa => 'Int', required => 1, trigger => sub { croak '', unless ( $_[0] ) }, ); fun move( MyType::Location $self, MyType::Int $x, MyType::Int $y) { Readonly my $next_X => $self->x + $x; Readonly my $next_Y => $self->y + $y; return Location->new( x => $next_X, y => $next_Y ); } } # 他のクラスのインスタンスからオブジェクトを呼べちゃう？可動化を確認するためのテストクラス。 package Hoge { sub new { my $class = shift; my $self = bless {}, $class; return $self; } }; package main; my $location = Location->new( x => 0, y => 0 ); my $moved = $location->move( 3, 3 ); say $moved->x; # 3 say $moved->y; # 3 my $hoge = Hoge->new; $hoge->Location::move( 1, 1 ); # エラー: In fun move: parameter 1 ($self): Location クラスのみ受け付けます
先の他のオブジェクトから、Locationが呼べちゃう問題を解決するために、Function::Parameters で作る関数を method から fun にしています。
method だと、仮引数の $self を省略してかけるのですが、fun ではしっかり書かなくてはいけない・・・ので、Location 型の仮引数として書いてます。
fun move( MyType::Location $self, MyType::Int $x, MyType::Int $y) {
なんでそこまで・・・というのは完全に趣味の世界です。
この本を読み終えた時自分のコードがどうなってるか楽しみです。
