Mercurial > pub > Impl
diff Lib/IMPL/Code/BasePropertyImplementor.pm @ 381:ced5937ff21a
Custom getters/setters support method names in theirs definitions
Initial support for localizable labels in DOM schemas
author | cin |
---|---|
date | Wed, 22 Jan 2014 16:56:10 +0400 |
parents | 4ddb27ff4a0b |
children | 0d63f5273307 |
line wrap: on
line diff
--- a/Lib/IMPL/Code/BasePropertyImplementor.pm Fri Jan 17 15:58:57 2014 +0400 +++ b/Lib/IMPL/Code/BasePropertyImplementor.pm Wed Jan 22 16:56:10 2014 +0400 @@ -2,12 +2,13 @@ use strict; use IMPL::Const qw(:prop :access); +use Scalar::Util qw(looks_like_number); use constant { CodeNoGetAccessor => 'die new IMPL::Exception(\'The property is write only\',$name,$class) unless $get;', CodeNoSetAccessor => 'die new IMPL::Exception(\'The property is read only\',$name,$class) unless $set;', - CodeCustomGetAccessor => 'unshift @_, $this and goto &$get;', - CodeCustomSetAccessor => 'unshift @_, $this and goto &$set;', + CodeCustomGetAccessor => '$this->$get(@_);', + CodeCustomSetAccessor => '$this->$set(@_);', CodeValidator => '$this->$validator(@_);', CodeOwnerCheck => "die new IMPL::Exception('Set accessor is restricted to the owner',\$name,\$class,scalar caller) unless caller eq \$class;" }; @@ -56,7 +57,7 @@ join( '', map( ($_ - ? (ref $_ eq 'CODE' + ? ( _isCustom($_) ? 'x' : 's') : '_'), @@ -69,12 +70,16 @@ ); } +sub _isCustom { + ref($_[0]) eq 'CODE' || not(ref($_[0]) || looks_like_number($_[0])); +} + sub CreateFactory { my ($self,$spec) = @_; return $self->CreateFactoryImpl( ($spec->{get} - ? (ref $spec->{get} eq 'CODE' + ? ( _isCustom($spec->{get}) ? $self->CodeCustomGetAccessor : ($spec->{isList} ? $self->CodeGetListAccessor @@ -84,7 +89,7 @@ : $self->CodeNoGetAccessor ), ($spec->{set} - ? (ref $spec->{set} eq 'CODE' + ? ( _isCustom($spec->{set}) ? $self->CodeCustomSetAccessor : ($spec->{isList} ? $self->CodeSetListAccessor @@ -108,8 +113,7 @@ sub { my ($strParams) = \@_; - my \$accessor; - \$accessor = sub { + return sub { my \$this = shift; $codeAccessCheck if (\@_) {