sironekotoroの日記

Perl で楽をしたい

「良いコード/悪いコードで学ぶ設計入門」第7章 #ミノ駆動本

リスト7.1 「牢屋の鍵」の所持を調べるコード

まずは例示コードを愚直に。

#!/usr/bin/env perl
use strict;
use warnings;
use feature qw/say/;
use constant { false => !!0, true => !!1 };

my $has_prison_key = false;

my @items = qw(steal_sword iron_mail pearl_ring prison_key);
for my $item (@items) {
    if ( $item eq 'prison_key' ) {
        $has_prison_key = true;
        last;
    }
}

say $has_prison_key;    # 1;

7.2 anyMatchメソッド

例示コードは Java なので anyMatch の紹介なのだけど、うちは Perl で書いているので

  • 標準で使える
  • リストや配列から一致するもので引っ張って来られる

という例示コードの条件を満たすなると、grep ですかね。

#!/usr/bin/env perl
use strict;
use warnings;
use feature qw/say/;
use constant { false => !!0, true => !!1 };

my $has_prison_key = false;

my @items = qw(steal_sword iron_armor pearl_ring prison_key);

$has_prison_key = grep { $_ eq 'prison_key' } @items;

say $has_prison_key;    # 1

ただ、コレクション処理、ということであれば Perl では標準で入っている List::Util を使うのが良いでしょう。

ありがちな関数はだいたい入ってます。

List::Util は Perl のバージョンが上がるごとに使える関数が増えているので、 id:xtetsuji さんの記事で補足しておくと良いでしょう。

qiita.com

なお、Perl をインストールすると List::Util の他にも便利モジュールが入ってきます。

corelist -v 5.36.0

とかやるとずらっと出てきます。

List::Util の他にも役に立つモジュールが見つけられるかもしれません。

リスト7.3 ありがちなネスト構造

ところで、悪い例示コードも書写してるんですが、このネストはなんというか、心削られるものがありますね・・・

なお、今回から「良いコードの肝」に型やオブジェクトが必要ない、関係なさそうな場合には作らずにいきたいと思います。

今回はハッシュリファレンスを配列の中に入れて代用してます。

これで少しは進捗の速度上がるかな

ここクリックして展開

#!/usr/bin/env perl
use strict;
use warnings;
use feature qw/say/;
use Data::Dumper;

my @members = (
    { name => 'alice', hit_point => 10, state => 'poison' },
    { name => 'bob',   hit_point => 20, state => '' },
    { name => 'carol', hit_point => 15, state => 'stone' },
);

for my $member (@members) {

    # hit_point が 0 より大きかったら
    if ( 0 < $member->{hit_point} ) {

        # 毒状態だったら
        if ( $member->{state} eq 'poison' ) {
            $member->{hit_point} -= 10;

            # hit_point が 0 以下になったら
            if ( $member->{hit_point} <= 0 ) {
                $member->{hit_point} = 0;
                $member->{state}     = 'dead';
            }

        }

    }

}

say Dumper @members;
# $VAR1 = {
#           'name' => 'alice',
#           'state' => 'dead',
#           'hit_point' => 0
#         };
# $VAR2 = {
#           'state' => '',
#           'name' => 'bob',
#           'hit_point' => 20
#         };
# $VAR3 = {
#           'name' => 'carol',
#           'state' => 'stone',
#           'hit_point' => 15
#         };

リスト7.4 早期 continue でネスト解消 〜 リスト7.5 if分のネストがすべて解消された

Perl の場合、ループ中の処理を途中で切り上げて次のループに移る時に使うのは next なので、こんな感じ。

ついでに、Perl では if 文の先頭に nextreturn を持ってくる後置 if って書き方ができるのでそれで。

ここでのポイントは、先の例とは条件式を反転させることですね。

例示コードはまとめて、すべてのネストが解消されたリスト7.5のものです。

ここクリックして展開

#!/usr/bin/env perl
use strict;
use warnings;
use feature qw/say/;
use Data::Dumper;

my @members = (
    { name => 'alice', hit_point => 10, state => 'poison' },
    { name => 'bob',   hit_point => 20, state => '' },
    { name => 'carol', hit_point => 15, state => 'stone' },
);

for my $member (@members) {

    # 生存していない場合 next で次のループ処理に移行する
    # 早期 netxt への変更には、条件を反転させる
    next if ( $member->{hit_point} == 0 );

    # 毒状態でなかったら next
    # 文字列の比較演算子 ne(not equal)を利用 
    next if ( $member->{state} ne 'poison' );
    $member->{hit_point} -= 10;

    # hit_point が 0 より大きかったら next
    next if ( 0 < $member->{hit_point} );

    $member->{hit_point} = 0;
    $member->{state}     = 'dead';

}

say Dumper @members;
$VAR1 = {
          'state' => 'dead',
          'hit_point' => 0,
          'name' => 'alice'
        };
$VAR2 = {
          'state' => '',
          'name' => 'bob',
          'hit_point' => 20
        };
$VAR3 = {
          'state' => 'stone',
          'hit_point' => 15,
          'name' => 'carol'
        };

リスト7.7 早期breakで見通し改善

Perl の場合、ループ中の処理を抜け出す時に使うのは last なので、こんな感じ。

ここクリックして展開

#!/usr/bin/env perl
use strict;
use warnings;
use feature qw/say/;
use Data::Dumper;

my @members = (
    {
        name                => 'alice',
        attack              => 35,
        team_attack_succeed => team_attack_succeed()
    },
    {
        name                => 'bob',
        attack              => 40,
        team_attack_succeed => team_attack_succeed()
    },
    {
        name                => 'carol',
        attack              => 50,
        team_attack_succeed => team_attack_succeed()
    },
);

# 連携の成功/失敗の結果を生成する関数
sub team_attack_succeed {
    my $result = rand(1);
    return 1 if $result > 0.8;
    return 0;
}

my $total_damege = 0;

for my $member (@members) {
    last if ( $member->{team_attack_succeed} );

    my $damege = $member->{attack} * 1.1;

    last if $damege < 30;

    $total_damege += $damege;
}

say $total_damege;

リスト7.8 〜 7.13

コレクション処理も低凝集に陥りやすい。

ここでの例では、RPGにおいて「パーティメンバーが1人でも生存しているか?」という判定メソッドや、「メンバーを追加する」のような、よく利用されるメソッドが色々なところで実装されて重複コードになっているというもの。

時には名前が違うだけで、同じ処理内容のコードが生まれることも・・・これは低凝集ですね。

ところで、コレクション処理っていうと、何かの共通項を持った要素の集まり、程度の認識で良いのかな?

例示のコードだと、 member を集めて members みたいな。

まぁ、そんな認識でやっていこう。

このコレクションの低凝集を解決するためにすることが、コレクション処理のカプセル化

ファーストクラスコレクション。おぉ、初めて聞いた・・・

強靭なクラスを作るための

を応用し

を備えたものとのこと。

うーん、うーん?

まぁ、書いていくか。ここはちゃんとオブジェクトで書いていかないとダメっぽそう。

ここクリックして展開

#!/usr/bin/env perl
use strict;
use warnings;
use feature qw/say/;
use Function::Parameters;

package Member {
    use Carp qw/croak/;
    use Mouse;
    use namespace::autoclean;

    has name => (
        is       => 'ro',
        isa      => 'Str',
        required => 1,
    );
    __PACKAGE__->meta->make_immutable();
}

package Party {
    use Carp qw/croak/;
    use Mouse;
    use namespace::autoclean;

    has _members => (
        is       => 'ro',                      # イミュータブル(不変)にする
        isa      => 'ArrayRef[Object]',        # Mouse が用意している型
        required => 0,
        default  => sub { _members => [] },    # デフォルトを設定し、生焼けオブジェクトにしない
    );

    # プライベートにしたインスタンス変数に直接アクセスはさせたくないが、
    # 参照はしたい。ので、アクセサ(getterとかsetter)を作る。
    # メソッド名 get_members とかにするところだが、本に合わせて party とする。
    method party() {
        my @members =
          @{ $self->_members() };    # ここでデリファレンスにしておかないとイミュータブルにならなくて泣く
        return \@members;
    }

    # MouseX::AttributeHelper で provide => {add => 'add'}を使っても
    # よかったが、本文でオブジェクトをイミュータブルにしているので、
    # それなら使わなくてもいいか、と言うわけで自前実装
    # 一人ずつ追加の実装
    method add(:$new_member) {
        my $adding = $self->party();
        push @{$adding}, $new_member;
        return Party->new( _members => $adding );
    }

    __PACKAGE__->meta->make_immutable();
}

package main;

my $alice = Member->new( name => 'alice' );
my $bob   = Member->new( name => 'bob' );
my $party = Party->new();

my $alice_in_party = $party->add( new_member => $alice );

say $alice_in_party->party()->[0]->name;    # alice

my $bob_in_party = $alice_in_party->add( new_member => $bob );

say $bob_in_party->party()->[1]->name;      # bob

リスト型をインスタンス変数で持つ、をこう表現してみた

    has _members => (
        is       => 'ro',                      # イミュータブル(不変)にする
        isa      => 'ArrayRef[Object]',        # Mouse が用意している型
        required => 0,
        default  => sub { _members => [] },    # デフォルトを設定し、生焼けオブジェクトにしない
    );

で、メンバーに変更があったら(今回は加入)、加入した情報でオブジェクトを作り直して渡す、と。

    method add(:$new_member) {
        my $adding = $self->party();
        push @{$adding}, $new_member;
        return Party->new( _members => $adding );
    }

ふむふむ。

ここはわかった。

ところで、渡した後のオブジェクトは用済みにしておかなくていいのかな・・・?

あれ、それってシングルトンってやつ?違うか?まぁいいや。

先に進もう。

リスト 7.14 リスト操作に必要なロジックを同じクラスに定義

ここで、コードが整形できてなくて???となる。

Perl では perltidy というツールでコードを整形するのだけど、それが効いてない。

原因は Function::Parameters での名前付き引数 :$new_member のところだった。

    method add(:$new_member) {

便利なんだけど、コードは整形したいから封印かなぁ。

残念。

あと、ちょっと前から真偽値で !!1 とか !!0 ってのを使ってます。

Perl 5.36 では組み込みの変数でとうとう truefalse ってのが実験的機能として追加されました。

早いこと実験的が外れるといいなぁ。

metacpan.org

それまでは

    use constant {  true => !!1, false => !!0 };

で生きていこうと思います。

で、Party クラスに、必要なコレクションを追加したのが以下のコード。

もっと手間かかると思ったけど、意外とあっさり終わったなぁ。

ファーストクラスコレクション、コレクション処理を1箇所にまとめたクラス。

今回は追加とか、メンバー数の判定とか、生存者確認とか。

やっぱ、コード書いてみると理解度が上がるなぁ。

ここクリックして展開

#!/usr/bin/env perl
use strict;
use warnings;
use feature qw/say/;
use Function::Parameters;

package Member {
    use Carp qw/croak/;
    use Mouse;
    use namespace::autoclean;

    has name => (
        is       => 'ro',
        isa      => 'Str',
        required => 1,
    );

    has id => (
        is       => 'ro',
        isa      => 'Int',
        required => 1,
    );

    has is_alive => (
        is       => 'ro',
        isa      => 'Bool',
        required => 0,
    );

    __PACKAGE__->meta->make_immutable();
}

package Party {
    use Carp qw/croak/;
    use Mouse;
    use namespace::autoclean;
    use constant { MAX_MEMBER_COUNT => 4, TRUE => !!1, FALSE => !!0 };

    has _members => (
        is       => 'ro',                      # イミュータブル(不変)にする
        isa      => 'ArrayRef[Object]',        # Mouse が用意している型
        required => 0,
        default  => sub { _members => [] },    # デフォルトを設定し、生焼けオブジェクトにしない
    );

    method party() {
        my @members = @{ $self->_members() };
        return \@members;
    }

    # メンバーを追加する
    method add($new_member) {
        croak "すでにパーティに加わっています" if ( $self->exists($new_member) );

        croak "これ以上メンバーを追加できません" if ( $self->is_full );

        my $adding = $self->party();
        push @{$adding}, $new_member;
        Party->new( _members => $adding );
    }

    # パーティのメンバーが1人でも生存している場合 true
    method is_alive() {
        return TRUE if ( grep { $_->is_alive == 1 } @{ $self->party() } );
    }

    # パーティに所属しているかを調べたいメンバー
    # 既にパーティに所属している場合 true
    method exists($member) {
        return TRUE if ( grep { $_->id eq $member->id } @{ $self->party() } );
    }

    # パーティが満員の場合 true
    method is_full() {
        my $count = scalar @{ $self->party() };
        return TRUE if ( MAX_MEMBER_COUNT == $count );
    }

    __PACKAGE__->meta->make_immutable();
}

package main;

my $alice = Member->new( name => 'alice', id => 1, is_alive => 1 );
my $bob   = Member->new( name => 'bob',   id => 2, is_alive => 1 );
my $party = Party->new();

my $alice_in_party = $party->add($alice);

say $alice_in_party->party()->[0]->name;    # alice

my $bob_in_party = $alice_in_party->add($bob);

say $bob_in_party->party()->[1]->name;      # bob

# my $bob_in_party_twice = $bob_in_party->add($bob);

リスト 7.17 外部には不変にして渡す

へー! Java にはそういうメソッドがあるんだ。unmodifiableList 知らなかった。

と言うことで、第7章終わり!

「良いコード/悪いコードで学ぶ設計入門」第1章〜第6章のまとめ #ミノ駆動本

一旦まとめ

7章を目前に、どの内容をどこで学んだんだっけ・・・?というのを自分なりにまとめておきたくなりました。

コード書いたからか、結構覚えているなーという感じです。

あと、本を先に進めたい!という気が勝っておざなりにしてるところがあるなぁ、と。

普遍的な変数のところですね。

Perl の場合には Readonlyconstant を使うのですが・・・ううん(顔を背ける)

さて、7章以降もがんばってくぞー

第1章 悪しき構造の弊害を知覚する

  • 弊害とは

    • コードを読み解くのに時間がかかる
    • バグを埋め込みやすくなる
    • 悪しき構造がさらに悪しき構造を誘発する
  • 意味不明な命名

    • 技術駆動命名
      • 変数名に int, flag などプログラミング用語やコンピュータ用語に基づいた名前
      • 内容や用途に基づいてない名前
    • 連番命名
      • Class00, method01 など
  • 何重にもネストしたロジック

  • 巨大なネスト
  • データを保持するだけのクラス
    • データを扱うメソッドがない
    • 重複コード(重複メソッド)がコードのあちらこちらに書かれてしまう
    • 修正漏れが発生する可能性
    • 可読性の低下
    • 生焼けオブジェクト
      • 未初期化状態のオブジェクトが利用できてしまう
        • 当然利用しようとすれば undef になる
    • 不正値の混入
  • 悪魔退治の基本

第2章 設計の初歩

  • 省略せずに伝わる名前を設計する
  • 変数を使いまわさない、目的ごとの変数を用意する
    • 再代入を避ける
  • 意味あるまとまりでメソッド化する
    • サブルーチン化か
    • 種類の異なる処理をメソッドにまとめる
    • だらだらと書かない
    • 理解のしやすさを優先に、行数や変数名の文字数が増えることを厭わない
  • 関係し合うデータとロジックをクラスにまとめる
    • データクラスの問題でも書かれていた「いろいろなところに類似のロジックが書かれる」問題

第3章 クラス設計

  • オブジェクト指向は、ソフトウェアの品質向上を目的とする考え方の一種
  • 適切なクラス設計により、保守や変更が容易になる
  • 頑強なクラスの構成要素
    • インスタンス変数
    • インスタンス変数を不正状態から防御し、正常に操作するメソッド
    • 基本的にインスタンス変数とメソッドはワンセット、一つのクラスに入れる
      • 例外はある
    • 不正値チェックをクラス内で行うことができる
      • データしか持たないデータクラスだとできない
  • 自己防衛責務を持たせる
    • 一つ一つのクラスが完結している
      • NG:他のクラスによる初期化が必要
      • NG:データ入力を他のクラスにしてもらう
  • 成熟したクラスへ成長させる設計術
    • コンストラクタで確実に正常値を設定する
      • インスタンス変数に格納する前に、正常値であるかをチェックする
      • 不正値だったらガード節で即エラーを出しインスタンスを作成させない
  • 計算ロジックをデータ保持側に寄せる
  • 不変で思わぬ動作を防ぐ
    • 変数の上書きができると思わぬ副作用を招く
    • final, const Readonly 使おう
  • インスタンス変数を変更したい場合は、インスタンスごと作り直す
  • メソッド引数やローカル変数も不変にする
  • 「値の渡し間違い」を型で防止する
    • 引き数をプリミティブ型にしない
      • Int 型ではなく、Money 型などで渡す
    • 同じ型同士で処理するように、メソッドの引数の型チェックを行う
  • 現実の営みにないメソッドを追加しない

    プログラム構造の問題解決に役立つ設計パターン

  • 完全コンストラク
    • 生焼けオブジェクトを作らせない
      • コンストラクタで生成する時点でしっかり引数入れて引き数チェックもする
  • 値オブジェクト
    • 値の概念そのものをクラスとして定義する
  • 「値オブジェクト」+「完全コンストラクタ」はオブジェクト指向設計の最も基本形を体現している構造の一つ

第4章 不変の活用

  • 再代入を避ける
    • 不変にする
    • 引数も不変にする
  • 関数による可変インスタンスの操作
    • 主作用(関数が値を受け取り、値を返す)以外の副作用が出ないようにする
    • データを引数で受け取る
    • 状態は変更しない
    • 値は関数の戻り値として返す
    • インスタンス変数を不変にしておくことで、副作用の余地をなくす
      • 変えようとするとエラーになるから
      • 意図して変えたい時はちゃんとメソッド作る
  • 不変と可変の取り扱い方針
    • デフォルトは不変
    • スコープが局所的なケースのみ可変
      • ループカウンタなど
    • 可変の変数で状態を変更する時は、状態変更のみ発生するように設計する
      • 副作用がないようにする
    • コード外とのやり取りは局所化する

第5章 低凝集

  • static メソッドを誤用しない
    • static メソッドはインスタンス変数を利用できない
      • このため、第3章の「頑強なクラス」の要件を満たさない
    • static がついていないだけで、同じ問題を抱える(インスタンス変数を用いない)クラスも作成可能だが、もちろん作らない
    • staticメソッドは、凝集度に無関係なものに利用する
      • ログ出力
      • フォーマット変換
      • ファクトリメソッド
  • 初期化ロジックの分散
    • コンストラクタを公開すると、さまざまなところで利用され、メンテが大変になる
    • コンストラクタをプライベートメソッドにすることで、外部から直接インスタンス生成させない
      • 内部でだけインスタンス化できる
      • インスタンス化したものを返す
      • static なファクトリメソッドが生きる
        • データと結びついていない(結びついている必要がない)
        • インスタンス化しなくても利用できる
  • 共通処理クラス
    • common, util などと名付けられるクラス
    • 低凝集になりやすい
    • static メソッドが入り込みやすい
    • 第2章でいうところの「意味のあるまとまり」でまとめられるべきメソッドが、共通処理クラスに入れられる
      • クラス設計の基本に立ち返る
    • 横断的関心ごとを共通処理クラスにする
      • static クラスにしても良い
      • ログ出力
      • エラー検出
      • デバッグ
      • 例外処理
      • キャッシュ
      • 同期処理
      • 分散処理
  • 結果を返すために引数を使わない(?)
    • もっといい言い換えがありそう。
      • 「出力引数」、直感的じゃない。
    • インスタンスと数値を渡し、インスタンスをその数値によって変更する例
    • そのインスタンスに変更メソッドとして実装すべき
      • クラスは、データとそれに関するメソッドをまとめるものという基本に立ち返る
    • メソッドの中身を確認しないとわからないような名前づけや処理にしない
  • 多すぎる引数
    • 引数が多い = 処理する内容が多い
      • 適切なクラス設計ができていない可能性
    • プリミティブ執着しない
      • コード重複が生じやすい
      • 適切なクラス(の型)を渡す
        • その型に必要なインスタンス変数やメソッドは、その型に集約され、高凝集になる
    • 意味のある単位ごとにクラス化する
  • メソッドチェイン
    • 似たようなコードが量産される原因の一つ
    • デメテルの法則「利用するオブジェクトの内部を知るべきではない」
    • 「尋ねるな、命じろ」
      • 他のオブジェクトの状態を尋ねない。他のオブジェクトの状態に応じて呼び出し側が判断をしない
      • 命じられた側で判断する
      • 詳細なロジックは、呼ぶ側ではなく、呼ばれる側に実装する

第6章 条件分岐

  • 条件分岐のネストによる可読性低下
    • 早期 return で解消
      • 条件と実行の分離
      • 条件の追加が容易になる
      • else 句をなくすことも可能
  • switch 文の重複
    • 条件分岐は同じだが、返り値だけ異なる switch 文が量産されやすい
      • 量産されることで、仕様変更・条件追加・条件削除時の修正漏れが生じやすい
      • switch 文は増えやすい
    • 条件分岐は1箇所にまとめる
    • interface を使い、スマートに重複を解決する
      • 同名のメソッド(例:area)を引数で渡すクラスに実装しておく
      • 呼ぶメソッドは area() で共通
      • ダックタイピング
      • Perl だと Mo[o|u]se::role
      • interface は利用するクラスに共通のメソッドがあることを要求するので、実装漏れにも対処できる
  • 条件分岐の重複とネスト
    • ポリシーパターンで対処
      • 条件の部品化、部品化した条件の組み替え
      • 条件ごとのクラスを作、(例:GoldCustomer, SilverCustome)条件判定するメソッドを実装する(例:ok)
      • okメソッドを持っているクラスを集約する interface を作る
      • GoldCuster クラスでは、すべての条件を満たす、SilverCustomer クラスでは2つの条件を満たす、などの条件で実装する
      • switch や if 文を使わずとも、条件分岐が可能に
  • 型チェックで分岐しない
    • interface を実装しても、実装したメソッド側で型による分岐をしたのではもったいない
      • 条件分岐削減の役に立っていない
    • if や switch の代わりに interface が使えないかを考える
  • フラグ引数
    • メソッド側で処理を分岐するためにつける引数
    • 型オブジェクトを渡し、interface を実装して共通のメソッドで処理させる

「良いコード/悪いコードで学ぶ設計入門」第6章その4 フラグ引数 #ミノ駆動本

リスト6.62

フラグ引数を使っている例

damege(true, damegeAmount);

確かに、これだけでは何が true なのかはコードを追いかけて関数の中身を見ないとわからんよなぁ。

ということで、それを「メソッドを分離する」で改良したところから。

ここクリックして展開

#!/usr/bin/env perl
use strict;
use warnings;
use Function::Parameters;
use feature qw/say/;

package Member {
    use Carp qw/croak/;
    use Mouse;
    use MouseX::AttributeHelpers;
    use namespace::autoclean;

    has hit_point => (
        metaclass => 'Number',
        is        => 'rw',
        isa       => 'Int',
        default   => 0,
        provides  => {
            sub => 'hit_sub',
        }
    );
    has magic_point => (
        metaclass => 'Number',
        is        => 'rw',
        isa       => 'Int',
        default   => 0,
        provides  => {
            sub => 'magic_sub',
        }
    );
    has state => (
        is       => 'rw',
        isa      => 'Str',
        required => 1,
    );

    __PACKAGE__->meta->make_immutable();
}

package Damege {
    use Mouse::Role;
    requires 'execute';
}

package HitPointDamege {
    use Carp qw/croak/;
    use Mouse;
    use namespace::autoclean;

    with 'Damege';

    has member => (
        is       => 'ro',
        isa      => 'Member',
        required => 1,
    );

    has damege_amount => (
        is       => 'ro',
        isa      => 'Int',
        required => 0,
    );

    method execute($damege_amount) {

        my $member    = $self->member;
        my $hit_point = $member->hit_sub($damege_amount);

        return $member if ( 0 < $hit_point );

        $member->hit_point(0);
        $member->state('dead');
        return $member;

    }

    __PACKAGE__->meta->make_immutable();
}

package MagicPointDamege {
    use Carp qw/croak/;
    use Mouse;
    use namespace::autoclean;

    with 'Damege';

    has member => (
        is       => 'ro',
        isa      => 'Member',
        required => 1,
    );

    has damege_amount => (
        is       => 'ro',
        isa      => 'Int',
        required => 0,
    );

    method execute($damege_amount) {

        my $member      = $self->member;
        my $magic_point = $member->magic_sub($damege_amount);

        return $member if ( 0 < $magic_point );

        $member->magic_point(0);
        return $member;

    }

    __PACKAGE__->meta->make_immutable();
}

package main;

# メンバークラスのインスタンス
my $member = Member->new( hit_point => 100, state => '' );

# ヒットポイントクラスのインスタンス
my $hit_point_damege = HitPointDamege->new( member => $member );

# ヒットポイントのダメージメソッド
my $dameged_member = $hit_point_damege->execute(10);

# メンバーの現時点のヒットポイント
say $dameged_member->hit_point();    # 90

# メンバーの現時点の状態
say $dameged_member->state();        # 空欄

my $dead_member = $hit_point_damege->execute(100);
say $dead_member->hit_point();       # 0
say $dead_member->state();           # dead

$member = Member->new( hit_point => 100, magic_point => 50, state => '' );
my $magic_point_damege = MagicPointDamege->new( member => $member );
my $use_magic_member   = $magic_point_damege->execute(10);
say $use_magic_member->magic_point;    # 40

my $more_use_magic_member = $magic_point_damege->execute(1000);
say $more_use_magic_member->magic_point;    # 0

リスト6.63 〜 リスト6.66

ここでやっと、ストラテジパターンとはこういうものかな?という引っ掛かりが得られた気がします。

(理解したとは言えない)

関数に渡す引数にオブジェクトを渡すことで、オブジェクトに含まれたメソッドを活用できるんだなぁ、と。

今まではそれを禁忌とでも思って避けていました。

つまり、プリミティブ型執着(第5章)ですね。

Enum 使わずにやってますが、ここのポイントはこれですね。

package Damege {
    use Mouse::Role;
    requires 'execute';

    method apply_damege( $damege_type, $damege_amount ) {

        return $damege_type->execute($damege_amount);
    }
}

引数にオブジェクトを渡す。

渡ってくるオブジュエクトはインターフェイスで必要なメソッドを備えていることは保証されているので、ダックタイピングで処理できる。

if 文で分岐せずとも、引数にオブジェクトを渡した時点で処理のルートが確定する。

頭いいなぁ!すごいなぁ。

そして、昔、これに似たコードをわからないまま触った記憶が蘇ってきました。こういう意味だったのか・・・

あの時に理解したかったなぁ。

ここクリックして展開

#!/usr/bin/env perl
use strict;
use warnings;
use Function::Parameters;
use feature qw/say/;

package Member {
    use Carp qw/croak/;
    use Mouse;
    use MouseX::AttributeHelpers;
    use namespace::autoclean;

    has hit_point => (
        metaclass => 'Number',
        is        => 'rw',
        isa       => 'Int',
        default   => 0,
        provides  => {
            sub => 'hit_sub',
        }
    );
    has magic_point => (
        metaclass => 'Number',
        is        => 'rw',
        isa       => 'Int',
        default   => 0,
        provides  => {
            sub => 'magic_sub',
        }
    );
    has state => (
        is       => 'rw',
        isa      => 'Str',
        required => 1,
    );

    __PACKAGE__->meta->make_immutable();
}

package Damege {
    use Mouse::Role;
    requires 'execute';

    method apply_damege( $damege_type, $damege_amount ) {

        return $damege_type->execute($damege_amount);

    }

}

package HitPointDamege {
    use Carp qw/croak/;
    use Mouse;
    use namespace::autoclean;

    with 'Damege';

    has member => (
        is       => 'ro',
        isa      => 'Member',
        required => 1,
    );

    has damege_amount => (
        is       => 'ro',
        isa      => 'Int',
        required => 0,
    );

    method execute($damege_amount) {

        my $member    = $self->member;
        my $hit_point = $member->hit_sub($damege_amount);

        return $member if ( 0 < $hit_point );

        $member->hit_point(0);
        $member->state('dead');
        return $member;

    }

    __PACKAGE__->meta->make_immutable();
}

package MagicPointDamege {
    use Carp qw/croak/;
    use Mouse;
    use namespace::autoclean;

    with 'Damege';

    has member => (
        is       => 'ro',
        isa      => 'Member',
        required => 1,
    );

    has damege_amount => (
        is       => 'ro',
        isa      => 'Int',
        required => 0,
    );

    method execute($damege_amount) {

        my $member      = $self->member;
        my $magic_point = $member->magic_sub($damege_amount);

        return $member if ( 0 < $magic_point );

        $member->magic_point(0);
        return $member;

    }

    __PACKAGE__->meta->make_immutable();
}

package main;

my $member           = Member->new( hit_point => 100, state => '' );
my $hit_point_damege = HitPointDamege->new( member => $member );
my $dameged_member   = Damege->apply_damege( $hit_point_damege, 10 );
say $dameged_member->hit_point();    # 90
say $dameged_member->state();        # 空欄

# クリティカルヒット!
my $dead_member = Damege->apply_damege( $hit_point_damege, 100 );
say $dead_member->hit_point();       # 0
say $dead_member->state();           # dead

# 復活
$member = Member->new( hit_point => 100, magic_point => 50, state => '' );

# マジックポイントにダメージ
my $magic_point_damege = MagicPointDamege->new( member => $member );
my $use_magic_member   = Damege->apply_damege( $magic_point_damege, 10 );
say $use_magic_member->magic_point;    # 40

# マジックポイント枯渇
my $more_use_magic_member = Damege->apply_damege( $magic_point_damege, 1000 );
say $more_use_magic_member->magic_point;    # 0

やっと6章終わった

理解が難しかったのと、Perl で同じような動作をするための環境づくりで結構時間食った気がします。

ただ、得られたものはあったなぁ、と充足感ありあり。

この先の章も楽しみ〜

「良いコード/悪いコードで学ぶ設計入門」第6章その3 型チェックで分岐しない #ミノ駆動本

リスト6.51〜6.54まで

一気にまとめたコードがこれ。

途中でしれっと出てくる Money クラスの add メソッドも書いております。

・・・Perl で書き換えながらめっちゃ書きにくさを感じることがあります。

このコードだと、interface の HotelRates の中で分岐コードを書くところ。

まぁ、ここで書いているのは「悪い(例示の)コード」なので、書きにくくて正解なんですけどね。

そうそう。

途中、コメントアウトしたところがあります。

# return $self->fee()->add( Money->new( amount => 3000 ) );

my $money = $self->fee();
return $money->add( Money->new( amount => 3000 ) );

1行でメソッドチェーンでかけるんですが、途中途中で返り値はなんだっけ・・・?

値?値オブジェクト?

みたいになったので、統一した方がいいんだろうなぁ、と思いました。

ここクリックして展開

use strict;
use warnings;
use Function::Parameters;
use feature qw/say/;

package Money {
    use Carp qw/croak/;
    use Mouse;
    use namespace::autoclean;
    use Readonly;
    use constant { MIN => 0 };

    has amount => (
        is       => 'ro',
        isa      => 'Int',
        required => 1,
    );

    method add($other) {

        my $added = $self->amount() + $other->amount();
        return Money->new( amount => $added );
    }

    __PACKAGE__->meta->make_immutable();
}

# 宿泊料金を表すロール
package HotelRate {
    use Mouse::Role;
    requires 'fee';

    fun busy_season_fee($self) {
        if ( ref $self eq 'RegularRates' ) {

            # return $self->fee()->add( Money->new( amount => 3000 ) );
            my $money = $self->fee();
            return $money->add( Money->new( amount => 3000 ) );

        }
        elsif ( ref $self eq 'PremiumRates' ) {

            # return $self->fee()->add( Money->new( amount => 5000 ) );
            my $money = $self->fee();
            return $money->add( Money->new( amount => 5000 ) );
        }
    }

}

#通常宿泊料金
package RegularRates {
    use Mouse;
    use namespace::autoclean;

    with 'HotelRate';

    method fee() {
        return Money->new( amount => 7000 );
    }
    __PACKAGE__->meta->make_immutable();

}

# プレミアム宿泊料金
package PremiumRates {
    use Mouse;
    use namespace::autoclean;

    with 'HotelRate';

    method fee() {
        return Money->new( amount => 12000 );
    }
    __PACKAGE__->meta->make_immutable();
}

package main;

# 追加した繁忙期ロジック

# 通常宿泊料金&繁忙期
my $regular_rate = RegularRates->new();
say $regular_rate->fee->amount();                  # 7000
say $regular_rate->busy_season_fee()->amount();    # 10000

# プレミアム宿泊料金&繁忙期
my $premium_rate = PremiumRates->new();
say $premium_rate->fee->amount();                  # 12000
say $premium_rate->busy_season_fee()->amount();    # 17000

リスト6.55 繁忙期料金を切り替えられるよう interface に定義

先の「悪いコード」に比べて、「いいコード」の方が直感的ですね。

あと、「図6.8」みたいなオブジェクト図のがいまいちわからなかったんですが、コードを見てからだと理解できるという。

というか、オブジェクト指向も書物を読んだだけではわからなくて、書いてみて、書き続けてやっとわかるみたいな。

割と脳筋使うところだなぁという感じです。

ここクリックして展開

use strict;
use warnings;
use Function::Parameters;
use feature qw/say/;

package Money {
    use Carp qw/croak/;
    use Mouse;
    use namespace::autoclean;

    has amount => (
        is       => 'ro',
        isa      => 'Int',
        required => 1,
    );

    method add($other) {

        my $added = $self->amount() + $other->amount();
        return Money->new( amount => $added );
    }

    __PACKAGE__->meta->make_immutable();
}

# 宿泊料金を表すロール
package HotelRate {
    use Mouse::Role;

    requires qw/fee busy_season_fee/;
}

#通常宿泊料金
package RegularRates {
    use Mouse;
    use namespace::autoclean;

    with 'HotelRate';

    method fee() {
        return Money->new( amount => 7000 );
    }

    method busy_season_fee() {
        my $money = $self->fee();
        return $money->add( Money->new( amount => 3000 ) );
    }

    __PACKAGE__->meta->make_immutable();

}

# プレミアム宿泊料金
package PremiumRates {
    use Mouse;
    use namespace::autoclean;

    with 'HotelRate';

    method fee() {
        return Money->new( amount => 12000 );
    }

    method busy_season_fee() {
        my $money = $self->fee();
        return $money->add( Money->new( amount => 5000 ) );
    }
    __PACKAGE__->meta->make_immutable();
}

package main;

# 追加した繁忙期ロジック

# 通常宿泊料金&繁忙期
my $regular_rate = RegularRates->new();
say $regular_rate->fee->amount();                  # 7000
say $regular_rate->busy_season_fee()->amount();    # 10000

# プレミアム宿泊料金&繁忙期
my $premium_rate = PremiumRates->new();
say $premium_rate->fee->amount();                  # 12000
say $premium_rate->busy_season_fee()->amount();    # 17000

よし、6章も残りは「フラグ引数」のみ。がんばろー

おまけ

MouseX::AttributeHelpers; を使ってみたパターン。

さっぱり!

ここクリックして展開

use strict;
use warnings;
use Function::Parameters;
use feature qw/say/;

package Money {
    use Carp qw/croak/;
    use Mouse;
    use MouseX::AttributeHelpers;
    use namespace::autoclean;

    has amount => (
        metaclass => 'Number',
        is        => 'rw',
        isa       => 'Int',
        required  => 1,
        default   => 0,
        provides  => {
            add => 'add',
        }
    );

    __PACKAGE__->meta->make_immutable();
}

# 宿泊料金を表すロール
package HotelRate {
    use Mouse::Role;

    requires qw/fee busy_season_fee/;
}

#通常宿泊料金
package RegularRates {
    use Mouse;
    use namespace::autoclean;

    with 'HotelRate';

    method fee() {
        return Money->new( amount => 7000 );
    }

    method busy_season_fee() {
        my $money = $self->fee();
        return $money->add(3000);
    }

    __PACKAGE__->meta->make_immutable();

}

# プレミアム宿泊料金
package PremiumRates {
    use Mouse;
    use namespace::autoclean;

    with 'HotelRate';

    method fee() {
        return Money->new( amount => 12000 );
    }

    method busy_season_fee() {
        my $money = $self->fee();
        return $money->add(5000);
    }
    __PACKAGE__->meta->make_immutable();
}

package main;

# 追加した繁忙期ロジック

# 通常宿泊料金&繁忙期
my $regular_rate = RegularRates->new();
say $regular_rate->fee->amount();        # 7000
say $regular_rate->busy_season_fee();    # 10000

# プレミアム宿泊料金&繁忙期
my $premium_rate = PremiumRates->new();
say $premium_rate->fee->amount();        # 12000
say $premium_rate->busy_season_fee();    # 17000

MouseX::AttributeHelpers に感動した話

という直感があって、その解が得られるタイミングは往々にして年単位だったりするんですが、割と早く解決できたのでメモ。

いや、今思うとこっちが近いかもしれない。

その君の勘から発した、 君の怒りと苛立ちは理由になる!

こんな例示コードがあります。

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

はい。

そこでこのモジュールです。

metacpan.org

メソッドが消えたじゃん・・・書かなくていいじゃん・・・可読性増してるじゃん・・・

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 を理解するための長い旅

脚注からヒントを得る

ここしばらく「良いコード/悪いコードで学ぶ設計入門 ―保守しやすい 成長し続けるコードの書き方」をやっております。

gihyo.jp

その中でインターフェースって何?ということでググりつつ、適当にネットから拾いつつやっていたのですが、一つ日曜の午後に腰を据えてやってみることにしました。

普段の業務(による疲労)との兼ね合いもあり、なかなかこの本の学習が進まない・・・ので、ちょっと先を見たところ、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

(中略)

Perl 5 では Moose モジュールで利用可能。なおロールの限定的な用途のみ「トレイト」と呼称し紛らわしい。

あ、繋がってきた。

gihyo.jp

この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 が熱かった時期なのでしょうか。

その頃何してたかなぁ。

情報処理系の資格取りまくってた頃かな。

hiratara.hatenadiary.jp

こちらのコードも写経してみます。

このコードは複数の 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 の環境にインストールできたので、早速例示コードを試す!

metacpan.org

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.