|
49
|
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
|
|
|
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;
|
