Mercurial > pub > Impl
comparison Lib/IMPL/Object.pm @ 278:4ddb27ff4a0b
core refactoring
| author | cin |
|---|---|
| date | Mon, 04 Feb 2013 02:10:37 +0400 |
| parents | 8a5da17d7ef9 |
| children |
comparison
equal
deleted
inserted
replaced
| 277:6585464c4664 | 278:4ddb27ff4a0b |
|---|---|
| 1 package IMPL::Object; | 1 package IMPL::Object; |
| 2 use strict; | 2 use strict; |
| 3 | 3 |
| 4 use parent qw(IMPL::Object::Abstract); | 4 use parent qw(IMPL::Object::Abstract); |
| 5 require IMPL::Class::Property::Direct; | 5 use IMPL::require { |
| 6 use IMPL::Const qw(:prop); | 6 ClassPropertyImplementor => 'IMPL::Code::DirectPropertyImplementor' |
| 7 }; | |
| 7 | 8 |
| 8 sub surrogate { | 9 sub surrogate { |
| 9 bless {}, ref $_[0] || $_[0]; | 10 bless {}, ref $_[0] || $_[0]; |
| 10 } | 11 } |
| 11 | 12 |
| 13 my $class = shift; | 14 my $class = shift; |
| 14 my $self = bless {}, ref($class) || $class; | 15 my $self = bless {}, ref($class) || $class; |
| 15 $self->callCTOR(@_); | 16 $self->callCTOR(@_); |
| 16 | 17 |
| 17 $self; | 18 $self; |
| 18 } | |
| 19 | |
| 20 sub _PropertyImplementor { | |
| 21 'IMPL::Class::Property::Direct' | |
| 22 } | |
| 23 | |
| 24 sub ImplementProperty { | |
| 25 my ($self,$name,$attributes) = @_; | |
| 26 | |
| 27 $attributes = { | |
| 28 get => $attributes & PROP_GET, | |
| 29 set => $attributes & PROP_SET, | |
| 30 isList => $attributes & PROP_LIST | |
| 31 } unless ref $attributes; | |
| 32 | |
| 33 $self->_ProppertyImplementor->Implement($name,$attributes); | |
| 34 } | 19 } |
| 35 | 20 |
| 36 1; | 21 1; |
| 37 | 22 |
| 38 __END__ | 23 __END__ |
