日向夏特殊応援部隊

俺様向けメモ

Moose::Cookbook::Recipe2 - class based constraint, modifier with arguments -

Perl Moose

続いて Recipe2 をやっちゃうぞー。

ソース

預貯金に関する英単語が良く分からなかったので調べてコメント振った。

package BankAccount;

use Moose;

# 預金残高
has 'balance' => (isa => 'Int', is => 'rw', default => 0);

# 預金する
sub deposit {
    my ($self, $amount) = @_;
    $self->balance($self->balance + $amount);
}

# 引き落とし
sub withdraw {
    my ($self, $amount) = @_;
    my $current_balance = $self->balance();
    ($current_balance >= $amount) 
        || confess "Account overdrawn"; ### 預金残高より多い額の支払い
    $self->balance($current_balance - $amount);
}

package CheckingAccount;

use Moose;
extends 'BankAccount';

## 借り入れ口座
has 'overdraft_account' => ( isa => 'BankAccount', is => 'rw' );

## 借り入れ口座があって、支払い前にお金が足りない場合は借金して預金残高を必要な分増やす
before 'withdraw' => sub {
    my ($self, $amount) = @_;
    my $overdraft_amount = $amount - $self->balance(); ### 超過した支払い額
    if ($self->overdraft_account && $overdraft_amount > 0) { ### 借り入れ口座があって、借り過ぎの場合
        $self->overdraft_account->withdraw($overdraft_amount); ### 借り入れ口座から支払い
        $self->deposit($overdraft_amount); ### 預金口座に入金
    }
};

package main;

use Data::Dump qw(dump);
use Perl6::Say;
use Test::More qw(no_plan);

my $bank_account = BankAccount->new;

is($bank_account->balance, 0, 'default value');
is($bank_account->deposit(100), 100, 'deposit');
is($bank_account->withdraw(50), 50, 'withdraw');

{
    eval {
        my $check_account = CheckingAccount->new( balance => 1000 );
        $check_account->overdraft_account(2);
    };
    if (my $err = $@) {
        ok($err, 'constraint');
        diag($err);
    }
}

{
    my $check_account = CheckingAccount->new( balance => 1000 );
    ok(!defined $check_account->overdraft_account, 'not set');
    is($check_account->withdraw(250), 750, 'withdraw not exists overdraft_account');
}

{
    my $check_account = CheckingAccount->new( balance => 1000, overdraft_account => BankAccount->new( balance => 2000 ) );
    ok(defined $check_account->overdraft_account, 'set');
    is($check_account->withdraw(1250), 0, 'withdraw exists overdraft_account');
    is($check_account->overdraft_account->balance, 1750, 'overdraft_account balance');
}

解説

制約にはクラス名がそのまま使える

実は d:id:ZIGOROu:20080606:1212748447 に比べて対して真新しい事は無い。
制約にクラスをそのまま使えるよって所くらいか。

## 借り入れ口座
has 'overdraft_account' => ( isa => 'BankAccount', is => 'rw' );

こんな感じ。

後は advice の実践的な使い方とか言いたかった感じかな。

引数ありの modifier

これは大事な点ですね。通常の Perl5 OO で override する場合は、

sub withdraw {
  my ($self, $amount) = @_;
  $self->SUPER::withdraw($amount);
}

のようにしなければなりませんが、before modifier で定義した部分にはそのような箇所はありません、が期待通りに渡されます。
一方で before から元のメソッドに対して新しく引数を増やすと言った事は出来ないようです。