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;