Mercurial > pub > Impl
annotate Lib/IMPL/Class/PropertyInfo.pm @ 103:c289ed9662ca
Schema beta 2
More strict validation, support for inflating a simple nodes and properties
author | wizard |
---|---|
date | Fri, 07 May 2010 18:17:40 +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; |