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 (\@_) {