Mercurial > pub > Impl
comparison Lib/IMPL/Class/Property.pm @ 276:8a5da17d7ef9
*IMPL::Class refactoring property definition mechanism (incomplete).
| author | sergey | 
|---|---|
| date | Thu, 31 Jan 2013 17:37:44 +0400 | 
| parents | 6253872024a4 | 
| children | 4ddb27ff4a0b | 
   comparison
  equal
  deleted
  inserted
  replaced
| 275:6253872024a4 | 276:8a5da17d7ef9 | 
|---|---|
| 1 package IMPL::Class::Property; | 1 package IMPL::Class::Property; | 
| 2 use strict; | 2 use strict; | 
| 3 use parent qw(Exporter); | 3 use parent qw(Exporter); | 
| 4 | |
| 4 BEGIN { | 5 BEGIN { | 
| 5 our @EXPORT = qw(property prop_get prop_set owner_set prop_none prop_all prop_list CreateProperty); | 6 our @EXPORT = qw(property prop_get prop_set owner_set prop_none prop_all prop_list CreateProperty); | 
| 6 } | 7 } | 
| 7 | 8 | 
| 8 require IMPL::Class::Member; | 9 use IMPL::lang qw(:hash); | 
| 9 require IMPL::Class::PropertyInfo; | 10 use IMPL::Const qw(:prop); | 
| 11 use Carp qw(carp); | |
| 12 require IMPL::Class::Memeber; | |
| 10 | 13 | 
| 11 sub import { | 14 sub import { | 
| 12 __PACKAGE__->export_to_level(1,@_); | 15 __PACKAGE__->export_to_level(1,@_); | 
| 13 IMPL::Class::Member->export_to_level(1,@_); | 16 IMPL::Class::Member->export_to_level(1,@_); | 
| 14 } | 17 } | 
| 18 sub owner_set { 10 }; | 21 sub owner_set { 10 }; | 
| 19 sub prop_none { 0 }; | 22 sub prop_none { 0 }; | 
| 20 sub prop_all { 3 }; | 23 sub prop_all { 3 }; | 
| 21 sub prop_list { 4 }; | 24 sub prop_list { 4 }; | 
| 22 | 25 | 
| 23 sub property($$;$) { | 26 sub property($$) { | 
| 24 my ($propName,$mutators,$attributes) = @_; | 27 my ($propName,$attributes) = @_; | 
| 25 my $Info = new IMPL::Class::PropertyInfo( {name => $propName, mutators => $mutators, class => scalar(caller), attributes => $attributes } ); | 28 | 
| 26 return $Info; | 29 $attributes = { | 
| 30 get => $attributes & PROP_GET, | |
| 31 set => $attributes & PROP_SET, | |
| 32 isList => $attributes & PROP_LIST | |
| 33 } unless ref $attributes; | |
| 34 | |
| 35 return hashMerge ( | |
| 36 $attributes, | |
| 37 { | |
| 38 -implementor => 'ImplementProperty', | |
| 39 name => $propName, | |
| 40 class => scalar(caller), | |
| 41 } | |
| 42 ); | |
| 27 } | 43 } | 
| 28 | 44 | 
| 29 sub CreateProperty { | 45 sub CreateProperty { | 
| 30 my ($class,$propName,$mutators,$attributes) = @_; | 46 my ($class,$propName,$attributes) = @_; | 
| 31 my $Info = new IMPL::Class::PropertyInfo( {name => $propName, mutators => $mutators, class => $class, attributes => $attributes} ); | 47 | 
| 32 return $Info; | 48 carp "Using create property is deprecated, use ImplementProperty instead"; | 
| 49 | |
| 50 $class->ImplementProperty($propName,$attributes); | |
| 33 }; | 51 }; | 
| 34 | 52 | 
| 35 1; | 53 1; | 
