ここまでの整理

このアーカイブは同期化されません。 mixi の日記が更新されても、このアーカイブには反映されません。

ここまで幾つかの考察をしてきた。
property モジュール全体を書き直してみよう。

プロパティ名、転送先 getter/setter メソッド名は、
継承上の問題により、共に文字列で指定し、
動的に処理する方が相応しいことが判明した。

property モジュールの引数はハッシュリファレンスだが、
そのパラメータは全て文字列で渡されることになる。
例えばプロパティが、'salary' の場合、
getter/setter は、'set_salary', 'get_salary' となる。

全て文字列ということは、プロパティ名に、
'get_', 'set_' の接頭語を追加することで、
getter/setter のメソッド名を推定することができる。

では、property モジュールの引数が文字列の場合、
メソッド名を自動的に推定する機能も追加してみよう。

========== property.pm ==========

package property;

use v5.6.0;
use strict;
use warnings;
use Carp;

BEGIN {
    our $Version = '0.05';
}

sub import {
    my ($package, $param) = @_;

    my $target = caller;

    # $param 引数がスカラの場合推測する。
    if (ref $param eq '') {
        $param = {
            'name' => "$param",
            'get' => "get_$param",
            'set' => "set_$param",
        };
    }

    _create_property($target, $param->{'name'},
            $param->{'get'}, $param->{'set'});

    _trust_me($target);
}

# 対象に対して Carp の信頼基盤を有効にする。
sub _trust_me {
    my ($target) = @_;

    my $symbol = "${target}::CARP_NOT";
    no strict 'refs';
    no warnings;
    push(@$symbol, __PACKAGE__);
}

# プロパティを登録する。
sub _create_property {
    my ($package, $name, $get, $set) = @_;

    my $propertizer = sub : lvalue {
        my $this = shift;
        tie(my $reflector, __PACKAGE__, $this, $get, $set);
        $reflector;
    };

    _register_code($package, $name, $propertizer);
}

# パッケージにコードを登録する。
sub _register_code {
    my ($package, $name, $code) = @_;

    my $symbol = "${package}::${name}";
    no strict 'refs';
    *$symbol = $code;
}

# lvalue マジカルスカラ用の tie 実装。
sub TIESCALAR {
    my ($package, $object, $get, $set) = @_;

    $package = (ref $package or $package or __PACKAGE__);
    my $this = { 'object' => $object, 'get' => $get, 'set' => $set };
    bless($this, $package);
}

# プロパティ値の取得。
sub FETCH {
    my $this = $_[0];

    my $object = $this->{'object'};
    my $method = $this->{'get'};
    my $code = $object->can($method);

    # getter が呼び出せない場合は書き込み専用。
    croak "Can't get value to this property."
            if not defined $code;

    $object->$code();
}

# プロパティ値の代入。
sub STORE {
    my ($this, $value) = @_;

    my $object = $this->{'object'};
    my $method = $this->{'set'};
    my $code = $object->can($method);
    # setter が呼び出せない場合は読み取り専用。
    croak "Can't set value to this property."
            if not defined $code;

    $object->$code($value);
}

1;

========== end of property.pm ==========