「良いコード／悪いコードで学ぶ設計入門」第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) {
なんでそこまで・・・というのは完全に趣味の世界です。
この本を読み終えた時自分のコードがどうなってるか楽しみです。
Google フォーム → Google スプレッドシート → PDF で出力君を作った
想定外に時間ができた2022年5月
今は経理のお仕事メインでやってるのですが、5月は月初の連休のため月次の処理が後ろ倒しになります。
しかし、親会社への報告とか後ろ倒しにできないものもあり、気合を入れてゴールデンウィーク前から準備し、ゴールデンウィーク明けから前のめりでやっておりました・・・が、気合い入りすぎて普通の月よりも早く手が空いてしまいました。
そんな時、人事の方から「Google フォーム → Google スプレッドシート → PDFで出力」する的なのがあると、定型の書類処理が楽なんだけどなぁ、と話があり、空いてる時間でやってみました。
使うのはもちろん GAS、Google Apps Script です。
戦略
- Google フォームを作成し、Google スプレッドシートと関連つける
- Google フォームに入力し送信
- 「フォームの回答1」シートに反映
- トリガーをきっかけとして、「フォームの回答1」シートの一番下に入力された行（最新の行）の内容を取得
- 前項で取得した内容を元に、シート雛形に値を埋める
- シート雛形をPDF化する
- 指定のフォルダに保存
下準備その1 Google フォームから Google スプレッドシートへ
まずは Google Form で普通にアンケートフォーム的なのを作ります。
Google Drive 開いて、左上の「新規」から
Google フォーム を選択。
初期状態だとなんなので、選択肢を1つ増やして一旦完成とします。
この Google フォームだけでも回答の集計などができるのですが、 Google スプレッドシートに一旦出力するよう設定します。
上にある「回答」から、右側にあるスプレッドシートのアイコンをクリックします。
今回は「新しいスプレッドシートを作成」を選択し、右下の「作成」ボタンを押します。
すると、スプレッドシートが出来上がります。
このスプレッドシートに、GASを書いていきます。
その前に一回くらいアンケートやってみますかね。
右上にある「送信」から
リンクのマークを選び、そこで表示されるURLにアクセスします。
アンケートフォームが出てくるので、回答して「送信」ボタンを押します。
無事、スプレッドシートに回答が反映されました。
下準備その2 定型フォーマット準備
と言っても大したことではなく、適当にフォーマットを用意します。
シート名は「シート雛形」としておきます。
今回は項目名を左に、回答が入るところを右にしておきました。
この回答が入るセルには「名前付き範囲」で名前をつけておきます。
回答が入るセルを選択して、上のメニューから、「データ→名前付き範囲」と進み、名前をつけます。
名前は、質問項目と同じにしておきます。
この「名前付き範囲」が今回の肝です。
コード
コードを貼り付けてから、main 関数を実行します。上にある 「実行」ボタンで実行してください。
すると権限の確認メッセージが出てくると思うんですが、これを承認しておいてください。
数秒で Google ドライブのルートにファイルが出来上がります。
function main() { // Google フォームの結果が集計されるシート const totalingSheetName = "フォームの回答 1"; // 雛形シート const templateSheetName = "シート雛形"; // 集計シートの1行目をkeyに、最終行をvalueにしたMapを作る const hash = getMapFromAnswerListTitlesAndLastValues(totalingSheetName); // Mapを元に、雛形シートに値を埋める fillTemplateSheetFromHash({ sheetName: templateSheetName, hash: hash, }); // 雛形シートをPDFにして、保存先フォルダの中に格納する transformSheetToPdf(templateSheetName); } /** * Google Formの集計スプレッドシートから、1行目の項目名をkeyに、最終行の値をvalueにセットしたMapを返す * @module getMapFromAnswerListTitlesAndLastValues * @param {string} sheetName - Google Form の集計スプレッドシート名 * @return {Map.<string, string>} - 集計スプレッドシートの1行目をkeyに、最終行をvalueとするMap */ function getMapFromAnswerListTitlesAndLastValues(sheetName) { // sheetNameを元にシートを特定し、データの入っている最終行と最終列を取得する const sourceSheet = SpreadsheetApp.getActiveSpreadsheet().getSheetByName(sheetName); const lastRow = sourceSheet.getLastRow(); const lastColumn = sourceSheet.getLastColumn(); // 最初の行の要素（タイムスタンプ, 無題の質問, ...）を配列で取得する const keys = sourceSheet.getRange(1, 1, 1, lastColumn).getValues()[0]; // 最新の行（最終行）の要素（2022/5/26, 無題の質問, ...）を配列で取得する const values = sourceSheet .getRange(lastRow, 1, lastRow, lastColumn) .getValues()[0]; // Map型の構造体に // タイムスタンプ => 2022/5/26 ,無題の質問 => オプション2, ... // と言った形でデータを入れていく const hash = new Map(); keys.forEach((key, index) => { value = values[index]; hash.set(key, value); }); return hash; } /** * hashのkey名に対応した名前付きセルに、hashのvalueを入力する * @module fillTemplateSheetFromHash * @param {object} obj - sheetName, hash が入った構造体 * @return {undefined} - なし */ function fillTemplateSheetFromHash(obj) { // 分割代入で引数を取得 const { sheetName, hash } = obj; const templateSheet = SpreadsheetApp.getActiveSpreadsheet().getSheetByName(sheetName); // 名前付き範囲を集める const namedCells = templateSheet.getNamedRanges(); // 名前付き範囲をのセルに、その名前と同じフォームの回答を入力する namedCells.forEach((namedCell) => { const name = namedCell.getName().toString(); namedCell.getRange().setValue(hash.get(name)); }); } /** * 指定したシートをPDFにして、シートとともにフォルダに格納する * @module transformSheetToPdf * @param {string} sheetName - 雛形シート名 * @return {undefined} - なし */ function transformSheetToPdf(sheetName) { // 雛形シート const sourceSheet = SpreadsheetApp.getActiveSpreadsheet().getSheetByName(sheetName); // ファイル名 const fileName = "Googleフォームからファイル出力"; //スプレッドシートの個別シートをPDF化するために新規のスプレッドシートを作成 const temporarySheet = SpreadsheetApp.create(fileName); //PDF化したい個別シートを新規作成したスプレッドシートにコピー sourceSheet.copyTo(temporarySheet); //スプレッドシート新規作成でデフォルト作成されるシートを削除 temporarySheet.deleteSheet(temporarySheet.getSheets()[0]); //PDFとしてgetAsメソッドでblob形式で取得 const pdf = temporarySheet.getAs("application/pdf"); //pdfファイルの名前を設定 pdf.setName(fileName); //GoogleドライブにPDFに変換したデータを保存 DriveApp.createFile(pdf); }
実際のコードは、
- 出力先のフォルダを指定できるようにしたり
const folder = DriveApp.getFolderById(folderId);
- そのフォルダに出力したり
folder.createFile(pdf);
- フォームの内容からファイル名を持ってきたり
-
const fileName = `${fileNamePrifix}_${fileNameBody}`;
-
- ファイルのオーナー権限を任意の人に変えたり
file.setOwner(fileOwner);
ということをしています。
工夫したのは Google シートの項目を拾って、同名の名前付きセルに当てはめることで、Google フォーム側で項目が増えても、それに対応する名前付きセルを作るだけでよくしたこと。
つまり、コード側の改修なしで反映できるようにしたことです。
困ったのは
- メソッドを
()をつけずに呼んできて意図しない値が出てエラーになったり（ありがち） - 作成した Google スプレッドシート を Google Driveでどう扱えばいいかわからなかったり
const file = DriveApp.getFileById(spreadSheet.getId());
- main サブルーチンに引数を設定したら、そこにGoogle フォームから構造体が入ってきて上書きされてびっくりしたり
- Google フォームや、Google スプレッドシートのオーナーを変えたらコードが吹っ飛んだり（謎）
でした。
Google スプレッドシートをPDFにする方法は、公式の関数を使って実現してた以下のブログを参考にしました。
ありがとうございます。
仕上げ
さて、最後にフォーム送信時に自動でPDFが出力されるようにします。
左側のメニューの時計のマーク、トリガーをクリックします。
画面の右下、青い「トリガーを追加」ボタンをクリックして設定します。左下のイベントの種類を「フォーム送信時」に変えます。
以下のようになっていれば、トリガーの設定は完了です。
フォームからテストデータを送信して、データができていたら完了です。
お疲れ様でした。
「良いコード／悪いコードで学ぶ設計入門」第4章 #ミノ駆動本
リスト4.1 変数tmpへの度重なる再代入
サンプルコードから書かれてないところを想像して書いていくの、楽しいですよね。
ってわけで、Perl で書いてみます。
これまでいろんな方法で Perl のオブジュエクト書いてきたけど、Function::Parameters でやります。
仮引数に型付けられるし。
型定義モジュールはこれ。前章の Money クラスの名前変えただけ。
ここクリックして展開
package MyType; use strict; use warnings; use Type::Library -base; use Type::Utils; use Types::Standard -types; # Character型 declare 'Character', as Object, where { ref $_ eq 'Character' }, message { 'Characterクラスのみ受け付けます' }; 1;本文を参考に作ったCharacterクラスと、それを呼び出すスクリプト（`package main` 以降）。
#!/usr/bin/env perl use strict; use warnings; use Function::Parameters; package Character; use Carp qw/croak/; use Mouse; use lib qw/./; use List::Util qw/max/; use MyType qw/Character/; has power => ( is => 'ro', isa => 'Int', required => 1, trigger => sub { croak '0以上の値を設定してください', unless ( $_[0]->power >= 0 ) }, ); has weapon_attack => ( is => 'ro', isa => 'Int', required => 1, trigger => sub { croak '0以上の値を設定してください', unless ( $_[0]->weapon_attack >= 0 ) }, ); has speed => ( is => 'ro', isa => 'Num', required => 1, trigger => sub { croak '0以上の値を設定してください', unless ( $_[0]->speed >= 0 ) }, ); has defence => ( is => 'ro', isa => 'Int', required => 1, trigger => sub { croak '0以上の値を設定してください', unless ( $_[0]->defence >= 0 ) }, ); method damege( Character $enemy) { # メンバーの腕力と武器性能が基本攻撃力 my $tmp = $self->power() + $self->weapon_attack(); # メンバーのスピードで攻撃力を補正 $tmp = $tmp * ( 1 + $self->speed() / 100 ); # 攻撃力から敵の防御力を差し引いたのがダメージ $tmp = $tmp - ( $enemy->defence() / 2 ); # ダメージ値が負数にならないよう補正 $tmp = max( $tmp, 0 ); return $tmp; }; package main; my $member = Character->new( power => 1, weapon_attack => 10, speed => 100, defence => 10 ); my $enemy = Character->new( power => 1, weapon_attack => 10, speed => 100, defence => 10 ); print $member->damege($enemy); # 17
一つの変数に何回も何回も代入する再代入がよくない、というのは知っているし、経験もしている。
for 文の一時変数とか以外では避けるべきよね。
元のJava のコードで？？？となったのは、1f とか 100f という表記。
わからなかったなぁ。
あと、Math.Max は Perl の List::Util の max 関数をそのまま使いました。
第3章の表3.3では値オブジェクトとして設計可能な値、概念の例というのがあり、そこではヒットポイントや攻撃力なんかも挙げられていました。
が、この先やるんだろうな・・・ってことで、ここではやっておりません。
リスト4.2 ローカル変数にfinalを付与すると再代入不可
Java で final なら、Perl は Readonly で。
お手軽で、見てわかりやすいのでReadonly使います。
おそいけど、まぁ、学習用だしヨシ！とします。
ちなみにコアモジュールだとばかり思ってたんですが、違うんですね。びっくりした。
$ corelist Readonly Data for 2021-05-20 Readonly was not in CORE (or so I think)
use Readonly; #（中略） method damege( Character $enemy) { # メンバーの腕力と武器性能が基本攻撃力 Readonly my $tmp => $self->power() + $self->weapon_attack(); # メンバーのスピードで攻撃力を補正 $tmp = $tmp * ( 1 + $self->speed() / 100 ); # ここでエラー # Modification of a read-only value attempted
このあとのリスト4.4, 4.5 のサンプルコードは productPrice の例になって、4章冒頭のサンプルコードからちょっとズレたような？
関数の引数にもfinalをつけましょう、というお話。
ここは3章でやりましたねというか、ここまでは3章でやったことの復習編みたいな感じ。
リスト4.6 攻撃力を表現するクラス
インスタンスの使い回しにより、意図せぬ変更が出ちゃったというお話。
Perlでもしっかり再現できました。
（package {} でクラスを囲ったり囲っていないのは、まだ自分のスタイルが見つからないから・・・）
ここクリックして展開
#!/usr/bin/env perl
use strict;
use warnings;
use Function::Parameters;
package AttackPower {
use Carp qw/croak/;
use Mouse;
use Readonly;
use constant { MIN => 0 };
has value => (
is => 'rw' # 今回はrw、つまり可変で
isa => 'Int',
required => 1,
trigger => sub { croak '', if ( $_[0]->value < MIN ) },
);
1;
}
package Weapon {
use Carp qw/croak/;
use Mouse;
use Readonly;
use constant { MIN => 0 };
use lib qw/./;
use MyType qw/AttackPower/;
has attack_power => (
is => 'ro',
isa => 'AttackPower',
required => 1,
trigger => sub { croak '', unless ( $_[0] ) },
);
1;
}
package main;
use feature qw/say/;
# 使い回す攻撃力インスタンス
my $attack_power = AttackPower->new( value => 10 );
# 武器A、武器Bにそれぞれ設定
# 同じ攻撃力だからええやろ、的な？
my $weaponA = Weapon->new( attack_power => $attack_power );
my $weaponB = Weapon->new( attack_power => $attack_power );
# 武器Aの攻撃力を25に設定
$weaponA->attack_power->value(25);
# 武器Aも「武器Bも」攻撃力が25になってしまった
say "Weapon A attack power:", $weaponA->attack_power->value(); # 25
say "Weapon B attack power:", $weaponB->attack_power->value(); # 25
Perl の場合にはリファレンスなんかでも同種の問題が起きたりしますね。
前章ではプロパティの値を更新したら、更新した値で新たなオブジェクトを返す、ってなことをやってたけど、今回のケースはそれでは防げないかな・・・あー、攻撃力を変更するってメソッドが必要か。
今回は直接プロパティ値を変更する場合のパターンなのね。
ということで、武器Aの攻撃力の変更が、武器Bに反映しないバージョンです。
ここクリックして展開
#!/usr/bin/env perl
use strict;
use warnings;
use Function::Parameters;
package AttackPower {
use Carp qw/croak/;
use Mouse;
use Readonly;
use constant { MIN => 0 };
has value => (
is => 'rw', # 諸悪の根源
isa => 'Int',
required => 1,
trigger => sub { croak '', if ( $_[0]->value < MIN ) },
);
1;
}
package Weapon {
use Carp qw/croak/;
use Mouse;
use Readonly;
use constant { MIN => 0 };
use lib qw/./;
use MyType qw/AttackPower/;
has attack_power => (
is => 'ro',
isa => 'AttackPower',
required => 1,
trigger => sub { croak '', unless ( $_[0] ) },
);
1;
}
package main;
use feature qw/say/;
# 使い回さない攻撃力インスタンス
my $attack_power_A = AttackPower->new( value => 10 );
my $attack_power_B = AttackPower->new( value => 10 );
# 武器A、武器Bにそれぞれ設定
my $weaponA = Weapon->new( attack_power => $attack_power_A );
my $weaponB = Weapon->new( attack_power => $attack_power_B );
# 武器Aの攻撃力を25に設定
$weaponA->attack_power->value(25);
# 武器Aの攻撃力の変更が、武器Bには及ばない
say "Weapon A attack power:", $weaponA->attack_power->value(); # 25
say "Weapon B attack power:", $weaponB->attack_power->value(); # 10
リスト4.21 武器を表現するクラス
先ほどは攻撃力の変更、今度は武器クラスWeaponも新しいWeaponオブジェクトを返すように変更。
これで、攻撃力も武器もインスタンスの使い回しは無くなりました。
いまのところ、Perlで仮引数を型付けして、かつ読み込み専用にするってのがわからないのと、今回の $increment はメソッドの中で手を加えることなく使われているので、Readonly処理はせずにやっていきます、
ここクリックして展開
#!/usr/bin/env perl
use strict;
use warnings;
use Function::Parameters;
use lib qw/./;
use MyType;
use Readonly;
package AttackPower {
use Carp qw/croak/;
use Mouse;
use constant { MIN => 0 };
has value => (
is => 'ro',
isa => 'Int',
required => 1,
trigger => sub {
croak '0以上の値を設定してください',
if ( $_[0]->value < MIN );
},
);
# 攻撃力を強化する
method rein_force( MyType::Int $increment ) {
return AttackPower->new( value => $self->value + $increment );
}
# 攻撃力を0にする
method disable() {
return AttackPower->new( value => MIN );
}
1;
}
package Weapon {
use Carp qw/croak/;
use Mouse;
use constant { MIN => 0 };
has attack_power => (
is => 'ro',
isa => 'AttackPower',
required => 1,
trigger => sub { croak '', unless ( $_[0] ) },
);
method rein_force( MyType::AttackPower $increment) {
my $hoge = AttackPower->new( value => 0 );
my $rein_forced = AttackPower->new(
value => $self->attack_power->value + $increment->value );
return Weapon->new( attack_power => $rein_forced );
}
1;
}
package main;
use feature qw/say/;
my $attack_power_A = AttackPower->new( value => 20 );
my $attack_power_B = AttackPower->new( value => 20 );
my $weapon_A = Weapon->new( attack_power => $attack_power_A );
my $weapon_B = Weapon->new( attack_power => $attack_power_B );
my $increment = AttackPower->new( value => 5 );
my $rein_forced_weapon_A = $weapon_A->rein_force($increment);
say "Weapon A attack power:", $weapon_A->attack_power->value; # 20
say "Reinforced Weapon A attack power:",
$rein_forced_weapon_A->attack_power->value; #25
say "Weapon B attack power:", $weapon_B->attack_power->value; #20
はやくも bless 使ったPerlの素朴なオブジェクト指向へ回帰したい欲が湧いてきましたね。
リスト4.24 正しく動作するのか怪しげなロジック
ここらで中断してもいいかな〜、と思ったら次で最後のコードだったのでやります（フラグ）。
インスタンス変数を可変にする場合の注意点の例示コード。
ゲームのヒットポイントの処理です。
- ヒットポイントは0以上
- ヒットポイントが0になった場合、死亡状態にする
ここクリックして展開
#!/usr/bin/env perl
use strict;
use warnings;
use Function::Parameters;
use lib qw/./;
use MyType;
use Readonly;
package HitPoint;
use Carp qw/croak/;
use Mouse;
use Readonly;
use constant { MIN => 0 };
has amount => (
is => 'rw',
isa => 'Int',
required => 1,
trigger => sub { croak '', unless ( $_[0] ) },
);
package Member;
use Carp qw/croak/;
use Mouse;
use Readonly;
use constant { MIN => 0 };
has hit_point => (
is => 'rw',
isa => 'Int',
required => 1,
trigger => sub { croak '', unless ( $_[0] ) },
);
has states => (
is => 'rw',
isa => 'Str',
required => 1,
trigger => sub { croak '', unless ( $_[0] ) },
);
# ダメージを受ける
method damege( MyType::HitPoint $damege_amount) {
$self->hit_point( $self->hit_point - $damege_amount->amount );
}
package main;
use feature qw/say/;
my $member = Member->new( hit_point => 100, states => 'Normal' );
# ダメージのインスタンス化
my $damege = HitPoint->new( amount => 20 );
# ダメージを受ける
$member->damege($damege);
# 現在のヒットポイント
say $member->hit_point; # 80
# 致命的なダメージのインスタンス化
my $critical_hit = HitPoint->new( amount => 100 );
# ダメージを受ける
$member->damege($critical_hit);
# 現在のヒットポイント
say $member->hit_point; # -20
まだ、死亡判定入れてないのでヒットポイントがマイナスになったりします。
こちらが死亡判定を入れたもの・・・なのですが、ちょっと変えています。
先のコードでは3章とか4章の前半に従って値オブジェクトを使ってヒットポイントとかを設定していたんですが、それだとこの節の趣旨（インスタンス変数を可変にする）に合わないかなぁ？
ということで掲載コードに近く、数値を数値のまま（オブジェクトに包まずに）引数として渡すコードに書き換えてます。
ダメージ計算メソッドをMemberクラスからHitPointクラスに移し、HitPointクラスにヒットポイントがゼロかどうかの判定メソッドを追加してます。
これで状態変化も実装できました。
use strict;
use warnings;
use Function::Parameters; use lib qw/./;
use MyType;
use Readonly;
use feature qw/say/; package HitPoint;
use Carp qw/croak/;
use Mouse;
use Readonly;
use constant { MIN => 0 };
use List::Util qw/max/; has amount => (
is => 'rw',
isa => 'Int',
required => 1,
trigger => sub { croak 'お前はもう死んでいる', if ( $_[0]->amount < MIN ) },
); method damege( MyType::Int $damege_amount) { } method is_zero() {
return 1 if $self->amount == 0;
} package Member;
use Carp qw/croak/;
use Mouse;
use Readonly;
use constant { MIN => 0 }; has hit_point => (
is => 'rw',
isa => 'Int',
required => 1,
trigger => sub { croak '', unless ( $_[0] ) },
); has states => (
is => 'rw',
isa => 'Str',
required => 1,
trigger => sub { croak '', unless ( $_[0] ) },
); method damege( MyType::Int $damege_amount) { } package main;
use feature qw/say/; my $member = Member->new( hit_point => 100, states => 'normal' ); my $dameged = $member->damege(20); printf( "ヒットポイント：%s 状態:%s\n", $member->hit_point, $member->states ); my $critical_hit = $member->damege(200); printf( "ヒットポイント：%s 状態:%s\n", $member->hit_point, $member->states );
ここクリックして展開
!/usr/bin/env perl
ダメージ計算
Readonly my $next_amount => $self->amount - $damege_amount;
$self->amount( max( MIN, $next_amount ) );
ヒットポイントがゼロだったら1（true）
ダメージを受ける
# ダメージ判定をHitPointクラスのdamegeメソッドに投げる
my $hit_point = HitPoint->new( amount => $self->hit_point );
$hit_point->damege($damege_amount);
# ダメージ後のヒットポイントをセット
$self->hit_point( $hit_point->amount );
# 状態を変更
if ( $hit_point->is_zero ) {
$self->states('dead');
}
ダメージを受ける
現在のヒットポイント
ヒットポイント：80 状態:normal
致命的なダメージを受ける
現在のヒットポイント
ヒットポイント：0 状態:dead
ただまぁ、せっかく学習したことなので、値オブジェクトに包むやつもやってみます。
あと、掲載コードの以下のところはわからなかった。
状態をリストで管理？うーんわからん。
final States states; //中略 states.add(StateType.dead)
・・・あ、states 複数形だ。
そうか、死亡状態はともかく、「毒と石化」とか複数状態を併発することってあるものな。
モルボルみたいな。
せっかくだからここも実装してみよ。
まず状態変化のクラス States を作って・・・そして謎のこだわりを発揮した結果、めちゃ時間かかった。日を跨いでしまった。
ここクリックして展開
#!/usr/bin/env perl
use strict;
use warnings;
use Function::Parameters;
use lib qw/./;
use MyType;
use Readonly;
use feature qw/say/;
package States {
use Carp qw/croak/;
use Mouse;
use Readonly;
use List::Util qw/first uniq/;
has states => (
is => 'ro',
isa => 'ArrayRef[Str]',
required => 1,
trigger => sub { croak '', unless ( $_[0] ) },
);
method update( MyType::States $before_states) {
# 追加される前のステータス
# 今回追加されたステータス
# まぜる
Readonly my @added_states =>
( @{ $before_states->states }, @{ $self->states } );
# ユニーク化
Readonly my @uniqued_states => uniq @added_states;
# dead があれば dead だけにする
if ( first { $_ eq 'dead' } @uniqued_states ) {
return States->new( states => ['dead'] );
}
# normal 以外の状態があれば、normalを削除する
if ( grep { $_ !~ /normal/ } @uniqued_states ) {
return States->new(
states => [ grep { $_ !~ /normal/ } @uniqued_states ] );
}
}
method show() {
return join " ", @{ $self->states }
}
}
package HitPoint {
use Carp qw/croak/;
use Mouse;
use Readonly;
use constant { MIN => 0 };
use List::Util qw/max/;
has amount => (
is => 'rw',
isa => 'Int',
required => 1,
trigger => sub { croak 'お前はもう死んでいる', if ( $_[0]->amount < MIN ) },
);
# ダメージ計算
method damege( MyType::HitPoint $damege) {
Readonly my $next_amount => $self->amount - $damege->amount;
Readonly my $hit_point => $self->amount( max( MIN, $next_amount ) );
return HitPoint->new( amount => $hit_point );
}
# ヒットポイントがゼロだったら1（true）
method is_zero() {
return 1 if $self->amount == 0;
}
}
package Member {
use Carp qw/croak/;
use Mouse;
use Readonly;
use constant { MIN => 0 };
has hit_point => (
is => 'rw',
isa => 'HitPoint',
required => 1,
trigger => sub { croak '', unless ( $_[0] ) },
);
has states => (
is => 'rw',
isa => 'States',
required => 1,
trigger => sub { croak '', unless ( $_[0] ) },
);
# ダメージを受ける
method damege( MyType::HitPoint $damege, MyType::States $states ) {
# ダメージ判定をHitPointクラスのdamegeメソッドに投げ、
# HitPointオブジェクトで受ける
my $dameged_hit_point = $self->hit_point->damege($damege);
# ヒットポイントゼロならガード節で処理を終わらせる
if ( $dameged_hit_point->is_zero ) {
return Member->new(
hit_point => $dameged_hit_point,
states => States->new( states => ['dead'] ),
);
}
# ダメージ前のステータス
my $before_states = $self->states;
# ダメージ後のステータス判定
my $dameged_status = $states->update($before_states);
return Member->new(
hit_point => $dameged_hit_point,
states => $dameged_status,
);
}
}
package main;
use feature qw/say/;
my $member = Member->new(
hit_point => HitPoint->new( amount => 100 ),
states => States->new( states => ['normal'] ),
);
# 初期状態
# 現在のヒットポイント
# ヒットポイント:100 状態:normal
printf(
"ヒットポイント:%s 状態:%s\n",
$member->hit_point->amount,
$member->states->show,
);
# ダメージで減るヒットポイント
my $poison_damege = HitPoint->new( amount => 20 );
# ダメージによるステータス変化
my $poison_states = States->new( states => ['poison'] );
# ダメージを受けた後に、Memberオブジェクトを受け取る
my $poisond_member = $member->damege( $poison_damege, $poison_states );
# 現在のヒットポイント
# ヒットポイント:80 状態:poison
printf(
"ヒットポイント:%s 状態:%s\n",
$poisond_member->hit_point->amount,
$poisond_member->states->show,
);
# 毒を受けたメンバーが石化ダメージ
# ダメージで減るヒットポイント
my $stone_damege = HitPoint->new( amount => 30 );
# ダメージによるステータス変化
my $stone_states = States->new( states => ['stone'] );
# ダメージを受けた後に、Memberオブジェクトを受け取る
my $stoned_member = $poisond_member->damege( $stone_damege, $stone_states );
# 現在のヒットポイント
# ヒットポイント:50 状態:poison stone
printf(
"ヒットポイント:%s 状態:%s\n",
$stoned_member->hit_point->amount,
$stoned_member->states->show,
);
# 致命的なダメージ
my $critical_damege = HitPoint->new( amount => 200 );
# 致命的なダメージを受ける
my $critical_dameged_member =
$stoned_member->damege( $critical_damege, States->new( states => ['normal'] ),
);
# 現在のヒットポイント
# ヒットポイント:0 状態:dead
printf(
"ヒットポイント:%s 状態:%s\n",
$critical_dameged_member->hit_point->amount,
$critical_dameged_member->states->show,
);
「良いコード／悪いコードで学ぶ設計入門」第3章の後半 #ミノ駆動本
この調子でやっていくの・・・？
やっていきます。
リスト3.14 金額ではない値を渡せてしまう
final int ticketCount = 1 // チケット枚数 money.add(ticketCount);
とまー、金額の足し算のメソッドなのに、予期しない引数がきちゃうかもしれないよね？という話。
自分一人で作ったものであれば、そういうことはないかもしれないけど、二週間後の自分は別人。
これくらいのことはやりかねないですよね。
リスト3.15 Money 型だけ渡せるようにする。
おー、なるほど！
いや、たまーにそういうことをしている人やコードがあったんだけど、その重要性とかを認識はしていなかったです。
Intってだけだと、整数だったらなんでもokになっちゃうもんね。
ところで、サンプルコードの引数はなんで other って変数名なんだろ。
あとで伏線回収あるのかな？まあいいや。
#!/usr/bin/env perl use strict; use warnings; package Money { use Mouse; use Carp qw/croak/; use feature qw/signatures state/; no warnings "experimental::signatures"; use Readonly; has amount => ( is => 'ro', isa => 'Int', trigger => sub { croak "金額が0以上でありません。" if ( $_[0]->amount < 0 ); }, ); has currency => ( is => 'ro', isa => 'Str', trigger => sub { croak "通貨を指定してください" if ( $_[0]->currency eq "" ); } ); sub add ( $self, $other ) { # Money型以外のものが渡ってきたら拒否る croak "Moneyクラスのみ受け付けます" if ( ref $other ne 'Money' ); Readonly my $readonly_other => $other; my $new_amount = $self->amount + $readonly_other->amount; return Money->new( amount => $new_amount, currency => $self->currency, ); } __PACKAGE__->meta->make_immutable(); } package main; my $money = Money->new( amount => 500, currency => 'yen' ); # 足されるもの my $add_money = Money->new( amount => 100, currency => 'yen' ); # 足された結果 my $added_money = $money->add($add_money); print $added_money->amount; # 600
3.16 add メソッドにもバリデーションを追加
add メソッドの引数で渡す Moneyオブジェクトだけど、中の currency （通貨）が違ってたらダメだよね？ドルと円を単純に足し算できないよね？ということで、add メソッドにもバリデーションを入れます。
が、入れるだけだとあれなので、Perl で型をつかってみます。
まずは型定義のモジュール
# MyType.pm package MyType; use strict; use warnings; use Type::Library -base; use Type::Utils; use Types::Standard -types; # Money型 declare 'Money', as Object, where { ref $_ eq 'Money' }; 1;
型定義ファイルとこれから書くスクリプトは同じところに置いときます。
$ tree . ├── MyType.pm └── list3_16_kai.pl
次に本体のスクリプト。
更新ついでに、has で定義しているプロパティに必須の required つけときます。
Java を意識しつつ、後置 if とかでちょっと Perl らしいところを見せていきたい。いや Perl のスクリプトなんだけど。
まずは異なる currency の Money オブジェクトを足そうとしたらエラーを出すように1行追加。
croak "通貨単位が違います" if ( $self->currency ne $other->currency );
さっき作った型定義ファイルを use して、
use lib qw/./; use MyType qw/Money/;
再度便利モジュール Function::Parameters つかってさらに Java っぽく書いていきます。
method add( MyType::Money $other) {
ほら Java っぽい（個人の感想です）。
なお、Class と同じ名前の型名は作れませんでした。他の方法だったら作れるんかな？
#!/usr/bin/env perl use strict; use warnings; package Money { use Mouse; use Carp qw/croak/; use Function::Parameters; use Readonly; use lib qw/./; use MyType qw/Money/; has amount => ( is => 'ro', isa => 'Int', required => 1, trigger => sub { croak "金額が0以上でありません。" if ( $_[0]->amount < 0 ); }, ); has currency => ( is => 'ro', isa => 'Str', required => 1, trigger => sub { croak "通貨を指定してください" if ( $_[0]->currency eq "" ); } ); method add( MyType::Money $other) { croak "通貨単位が違います" if ( $self->currency ne $other->currency ); Readonly my $readonly_other => $other; my $new_amount = $self->amount + $readonly_other->amount; return Money->new( amount => $new_amount, currency => $self->currency, ); } __PACKAGE__->meta->make_immutable(); } package main; my $money = Money->new( amount => 500, currency => 'yen' ); # 足されるもの（通貨単位をドルにしてみる） my $add_money = Money->new( amount => 100, currency => 'doller' ); # 足された結果 my $added_money = $money->add($add_money); # 通貨単位が違います print $added_money->amount; # この行は実行されない
ちゃんと異なる通貨単位で加算しようとした、ってことでエラーになりました。
さらに、Money オブジェクトではないものを足そうとした場合、型の方でエラーが出るようにします。
package main; my $money = Money->new( amount => 500, currency => 'yen' ); # Moneyオブジェクトではない、ただの数値を入れた変数 my $add_money = 10; # 足された結果 my $added_money = $money->add($add_money); # エラー # In method add: parameter 1 ($other): Moneyクラスのみ受け付けます # MyType.pm で設定したエラーメッセージ print $added_money->amount; # この行は実行されない
出ました。
というわけで、Perl でも型を使えて幸せ・・・という話でもあるのですが、本の内容でいくと
を作成できたのでした。
写経（翻訳？）してよかった
やっぱ、コードは書かないと身につかないというか、この本は読むだけではもったいないよなぁちゃんと書いてこそ！という思いですね。
ここで学んだことを思うと・・・今まで自分が描いてきた脆弱なクラスたちを思い出して顔を伏せてしまいますね・・・ごめん。
この本では章ごとのまとめもしっかりあって、振り返りできて良いですね。
- 完全コンストラクタ
- 値オブジェクト
- 例えば、金額をそのまま Int 型（まぁ Perl には数値の型とかはないので数字だけだけど）で扱うと、金額計算ロジックが複数の場所に拡散する
- 足し算と引き算で別サブルーチン作るとか
- 同じ Int 型というだけで、金額以外の数字（チケット枚数とか）が混在する可能性もある
- そんな奴いねぇよって思うのは今の自分だけで、明日の自分は忘れてるし、2週間後の自分はやらかす
- ということで、値の概念そのものをクラスとして定義し、制約条件（0円以上）を課す
- 加算メソッドも、同じ型の引数だけを受け取るようにチェックすることでミスを防ぐ
- 例えば、金額をそのまま Int 型（まぁ Perl には数値の型とかはないので数字だけだけど）で扱うと、金額計算ロジックが複数の場所に拡散する
・・・でここで、金額以外に値オブジェクトにしておくと良いもののを表（表3.2）を書いてくれてる。
すごいお得。
このあと、コラムで Ruby と JavaScript での実装例が掲載されてる。
ということで第3章終わり。第4章楽しみ〜
