Mercurial > pub > Impl
annotate Lib/IMPL/Class/PropertyInfo.pm @ 119:8114aaa7feba
Json format
| author | wizard |
|---|---|
| date | Mon, 07 Jun 2010 17:43:15 +0400 |
| parents | b0c068da93ac |
| children | 44977efed303 |
| rev | line source |
|---|---|
| 49 | 1 package IMPL::Class::PropertyInfo; |
| 2 use strict; | |
| 3 | |
| 4 use base qw(IMPL::Class::MemberInfo); | |
| 5 | |
|
60
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
49
diff
changeset
|
6 __PACKAGE__->mk_accessors(qw(Type Mutators canGet canSet ownerSet)); |
| 49 | 7 __PACKAGE__->PassThroughArgs; |
| 8 | |
| 9 my %LoadedModules; | |
| 10 | |
| 11 sub CTOR { | |
| 12 my $this = shift; | |
| 13 | |
| 14 if ( my $type = $this->Attributes ? delete $this->Attributes->{type} : undef ) { | |
| 15 $this->Type($type); | |
| 16 } | |
| 17 | |
| 18 $this->Mutators(0) unless defined $this->Mutators; | |
| 19 } | |
| 20 | |
| 21 sub Implementor { | |
| 22 my $this = shift; | |
| 23 | |
| 24 my $implementor; | |
| 25 | |
| 26 if (@_) { | |
| 27 $this->SUPER::Implementor(@_); | |
| 28 } else { | |
| 29 my $implementor = $this->SUPER::Implementor; | |
| 30 return $implementor if $implementor; | |
| 31 | |
| 32 $implementor = $this->SelectImplementor(); | |
| 33 | |
| 34 if (my $class = ref $implementor ? undef : $implementor) { | |
| 35 if (not $LoadedModules{$class}) { | |
| 36 (my $package = $class.'.pm') =~ s/::/\//g; | |
| 37 require $package; | |
| 38 $LoadedModules{$class} = 1; | |
| 39 } | |
| 40 } | |
| 41 | |
| 42 $this->Implementor($implementor); | |
| 43 return $implementor; | |
| 44 } | |
| 45 | |
| 46 } | |
| 47 | |
| 48 sub SelectImplementor { | |
| 49 my ($this) = @_; | |
| 50 | |
| 51 if ($this->Class->can('_PropertyImplementor')) { | |
| 52 return $this->Class->_PropertyImplementor; | |
| 53 } | |
| 54 die new IMPL::Exception('Can\'t find a property implementor for the specified class',$this->Class); | |
| 55 } | |
| 56 | |
| 57 1; |