このアーカイブは同期化されません。 mixi の日記が更新されても、このアーカイブには反映されません。
スカラに tie されたオブジェクトを隠蔽することで、
プロパティの代入・取得ハンドラを書くことができた。
今日は、値の検証コードをいれてみよう。
昨日作った STORE ルーチンを修正すれば、
値を検証をすることは簡単にできる。
sub STORE {
my ($this, $value) = @_;
if ($value < 140000) { die "I can't agree you offered!" }
$$this = $value;
}
しかし、プロパティが一つだけならこれでいいが、
プロパティが複数定義された場合、
その数だけ tie 用クラスを定義する必要がある。
このやり方は非常に無駄だ。汎用化して利用したい。
tie スカラは、プロパティへのアクセスを
監視して通知するのが仕事であるため、
プロパティごとに異なる検証処理は切り離す必要がある。
それら検証処理は、プロパティの所有者である、
クラス側で行うのが自然なはずだ。
つまり、クラスは検証用のサブルーチンを持つ必要がある。
では、どこで値を検証すれば良いだろうか。
実は、最適な回答がある。
では、実装してみよう。
========== Employee.pm ==========
package Employee;
use v5.6.1;
use strict;
use warnings;
BEGIN {
our $Version = '0.05';
}
sub new {
my ($package, %identity) = @_;
$package = (ref $package or $package or __PACKAGE__);
bless(\%identity, $package);
}
sub name {
$_[0]->{'name'};
}
sub gender {
$_[0]->{'gender'};
}
sub weight {
$_[0]->{'weight'};
}
sub salary : lvalue {
my $this = $_[0];
tie(my $reflector, 'Employee::Reflector',
$this, \&get_salary, \&set_salary);
$reflector;
}
sub get_salary {
my $this = $_[0];
print "# Employee::get_salary\n";
$this->{'salary'};
}
sub set_salary {
my ($this, $value) = @_;
print "# Employee::set_salary: $value\n";
if ($value < 140000) { die "I can't agree you offered!" }
$this->{'salary'} = $value;
}
package Employee::Reflector;
use v5.6.0;
use strict;
use warnings;
sub TIESCALAR {
my ($package, $object, $getter, $setter) = @_;
$package = (ref $package or $package or __PACKAGE__);
my $this = {
'object' => $object,
'getter' => $getter,
'setter' => $setter
};
bless($this, $package);
}
sub FETCH {
my $this = $_[0];
$this->{'getter'}->($this->{'object'});
}
sub STORE {
my ($this, $value) = @_;
$this->{'setter'}->($this->{'object'}, $value);
}
1;
========== end of Employee.pm ==========
上をみて、あれっ？ と思った方は鋭い。
結果的に検証ルーチンは必要となるので、
それらを独立したルーチンで書くのは自然な流れだ。
ならば、それを setter/getter として実装すれば、
それらもそのまま利用できるはずだ。
つまり、lvalue ルーチンは、
setter/getter のプロキシの役割を果たす形となる。
この形の実装であれば、プロパティ的な呼び出しだけでなく、
メソッド的な呼び出しも両方使えることになるのだ。
では、テストしてみよう。
========== EmployeeTest.pl ==========
#!/usr/local/bin/perl
use strict;
use warnings;
use lib '.';
use Employee;
my $jack = Employee->new(
'name' => 'Jack',
'gender' => 'male',
'salary' => 160000,
'weight' => '65kg',
);
print "Salary: ", $jack->get_salary(), "\n";
$jack->set_salary(200000);
print "Salary: ", $jack->salary, "\n";
$jack->salary = 120000;
========== end of EmployeeTest.pl ==========
実行してみる。
$ ./EmployeeTest.pl
# Employee::get_salary
Salary: 160000
# Employee::set_salary: 200000
# Employee::get_salary
Salary: 200000
# Employee::set_salary: 120000
I can't agree you offered! at Employee.pm line 45.
どうだろうか。両方の記法が使えると共に、
どちらを呼び出したとしても、
set_XXX, get_XXX が呼び出されて値の検証が行えている。