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; |