|
0
|
1 package IMPL::Class::PropertyInfo;
|
|
|
2 use strict;
|
|
|
3
|
|
|
4 use base qw(IMPL::Class::MemberInfo);
|
|
|
5
|
|
|
6 __PACKAGE__->mk_accessors(qw(Type Mutators canGet canSet));
|
|
|
7 __PACKAGE__->PassThroughArgs;
|
|
|
8
|
|
|
9 my %LoadedModules;
|
|
|
10
|
|
|
11 sub CTOR {
|
|
|
12 my $this = shift;
|
|
|
13
|
|
4
|
14 $this->Mutators(0) unless defined $this->Mutators;
|
|
|
15 }
|
|
|
16
|
|
|
17 sub Implementor {
|
|
|
18 my $this = shift;
|
|
|
19
|
|
|
20 my $implementor;
|
|
|
21
|
|
|
22 if (@_) {
|
|
|
23 $this->SUPER::Implementor(@_);
|
|
|
24 } else {
|
|
|
25 my $implementor = $this->SUPER::Implementor;
|
|
|
26 return $implementor if $implementor;
|
|
|
27
|
|
|
28 $implementor = $this->SelectImplementor();
|
|
|
29
|
|
|
30 if (my $class = ref $implementor ? undef : $implementor) {
|
|
|
31 if (not $LoadedModules{$class}) {
|
|
|
32 (my $package = $class.'.pm') =~ s/::/\//g;
|
|
|
33 require $package;
|
|
|
34 $LoadedModules{$class} = 1;
|
|
|
35 }
|
|
0
|
36 }
|
|
4
|
37
|
|
|
38 $this->Implementor($implementor);
|
|
|
39 return $implementor;
|
|
0
|
40 }
|
|
|
41
|
|
|
42 }
|
|
|
43
|
|
|
44 sub SelectImplementor {
|
|
|
45 my ($this) = @_;
|
|
|
46
|
|
4
|
47 if ($this->Class->can('_PropertyImplementor')) {
|
|
|
48 return $this->Class->_PropertyImplementor;
|
|
0
|
49 }
|
|
|
50 die new IMPL::Exception('Can\'t find a property implementor for the specified class',$this->Class);
|
|
|
51 }
|
|
|
52
|
|
4
|
53 1; |
