Mercurial > pub > Impl

comparison Lib/IMPL/Class/PropertyInfo.pm @ 4:e59f44f75f20

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
DOM - в разработке Testing - по мелочи Property - изменен механизм выбора имплементора
author Sergey
date Wed, 12 Aug 2009 17:36:07 +0400
parents 03e58a454b20
children b544a772b654
comparison
equal deleted inserted replaced
3:2e546a5175dd 4:e59f44f75f20
4 use base qw(IMPL::Class::MemberInfo); 4 use base qw(IMPL::Class::MemberInfo);
5 5
6 __PACKAGE__->mk_accessors(qw(Type Mutators canGet canSet)); 6 __PACKAGE__->mk_accessors(qw(Type Mutators canGet canSet));
7 __PACKAGE__->PassThroughArgs; 7 __PACKAGE__->PassThroughArgs;
8 8
9 our @Implementors = ( ['IMPL::Object' => 'IMPL::Class::Property::Direct'] );
10
11 my %LoadedModules; 9 my %LoadedModules;
12 10
13 sub CTOR { 11 sub CTOR {
14 my $this = shift; 12 my $this = shift;
15 13
16 my $implementor = $this->Implementor($this->SelectImplementor()); 14 $this->Mutators(0) unless defined $this->Mutators;
17 if (my $class = ref $implementor ? undef : $implementor) { 15 }
18 if (not $LoadedModules{$class}) { 16
19 (my $package = $class.'.pm') =~ s/::/\//g; 17 sub Implementor {
20 require $package; 18 my $this = shift;
21 $LoadedModules{$class} = 1; 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 }
22 } 36 }
37
38 $this->Implementor($implementor);
39 return $implementor;
23 } 40 }
24 41
25 $this->Mutators(0) unless defined $this->Mutators;
26 } 42 }
27 43
28 sub SelectImplementor { 44 sub SelectImplementor {
29 my ($this) = @_; 45 my ($this) = @_;
30 46
31 foreach my $item (@Implementors) { 47 if ($this->Class->can('_PropertyImplementor')) {
32 return $item->[1] if $this->Class->isa($item->[0]); 48 return $this->Class->_PropertyImplementor;
33 } 49 }
34
35 die new IMPL::Exception('Can\'t find a property implementor for the specified class',$this->Class); 50 die new IMPL::Exception('Can\'t find a property implementor for the specified class',$this->Class);
36 } 51 }
37 52
38 1; 53 1;