annotate Lib/IMPL/Class/PropertyInfo.pm @ 36:1828103371d0

DOM in works
author Sergey
date Fri, 20 Nov 2009 16:48:08 +0300
parents b544a772b654
children 16ada169ca75
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
1 package IMPL::Class::PropertyInfo;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
2 use strict;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
3
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
4 use base qw(IMPL::Class::MemberInfo);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
5
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
6 __PACKAGE__->mk_accessors(qw(Type Mutators canGet canSet));
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
7 __PACKAGE__->PassThroughArgs;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
8
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
9 my %LoadedModules;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
10
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
11 sub CTOR {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
12 my $this = shift;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
13
27
b544a772b654 ORM in progress
Sergey
parents: 4
diff changeset
14 if ( my $type = $this->Attributes ? delete $this->Attributes->{type} : undef ) {
b544a772b654 ORM in progress
Sergey
parents: 4
diff changeset
15 $this->Type($type);
b544a772b654 ORM in progress
Sergey
parents: 4
diff changeset
16 }
b544a772b654 ORM in progress
Sergey
parents: 4
diff changeset
17
4
e59f44f75f20 DOM - в разработке
Sergey
parents: 0
diff changeset
18 $this->Mutators(0) unless defined $this->Mutators;
e59f44f75f20 DOM - в разработке
Sergey
parents: 0
diff changeset
19 }
e59f44f75f20 DOM - в разработке
Sergey
parents: 0
diff changeset
20
e59f44f75f20 DOM - в разработке
Sergey
parents: 0
diff changeset
21 sub Implementor {
e59f44f75f20 DOM - в разработке
Sergey
parents: 0
diff changeset
22 my $this = shift;
e59f44f75f20 DOM - в разработке
Sergey
parents: 0
diff changeset
23
e59f44f75f20 DOM - в разработке
Sergey
parents: 0
diff changeset
24 my $implementor;
e59f44f75f20 DOM - в разработке
Sergey
parents: 0
diff changeset
25
e59f44f75f20 DOM - в разработке
Sergey
parents: 0
diff changeset
26 if (@_) {
e59f44f75f20 DOM - в разработке
Sergey
parents: 0
diff changeset
27 $this->SUPER::Implementor(@_);
e59f44f75f20 DOM - в разработке
Sergey
parents: 0
diff changeset
28 } else {
e59f44f75f20 DOM - в разработке
Sergey
parents: 0
diff changeset
29 my $implementor = $this->SUPER::Implementor;
e59f44f75f20 DOM - в разработке
Sergey
parents: 0
diff changeset
30 return $implementor if $implementor;
e59f44f75f20 DOM - в разработке
Sergey
parents: 0
diff changeset
31
e59f44f75f20 DOM - в разработке
Sergey
parents: 0
diff changeset
32 $implementor = $this->SelectImplementor();
e59f44f75f20 DOM - в разработке
Sergey
parents: 0
diff changeset
33
e59f44f75f20 DOM - в разработке
Sergey
parents: 0
diff changeset
34 if (my $class = ref $implementor ? undef : $implementor) {
e59f44f75f20 DOM - в разработке
Sergey
parents: 0
diff changeset
35 if (not $LoadedModules{$class}) {
e59f44f75f20 DOM - в разработке
Sergey
parents: 0
diff changeset
36 (my $package = $class.'.pm') =~ s/::/\//g;
e59f44f75f20 DOM - в разработке
Sergey
parents: 0
diff changeset
37 require $package;
e59f44f75f20 DOM - в разработке
Sergey
parents: 0
diff changeset
38 $LoadedModules{$class} = 1;
e59f44f75f20 DOM - в разработке
Sergey
parents: 0
diff changeset
39 }
0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
40 }
4
e59f44f75f20 DOM - в разработке
Sergey
parents: 0
diff changeset
41
e59f44f75f20 DOM - в разработке
Sergey
parents: 0
diff changeset
42 $this->Implementor($implementor);
e59f44f75f20 DOM - в разработке
Sergey
parents: 0
diff changeset
43 return $implementor;
0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
44 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
45
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
46 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
47
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
48 sub SelectImplementor {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
49 my ($this) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
50
4
e59f44f75f20 DOM - в разработке
Sergey
parents: 0
diff changeset
51 if ($this->Class->can('_PropertyImplementor')) {
e59f44f75f20 DOM - в разработке
Sergey
parents: 0
diff changeset
52 return $this->Class->_PropertyImplementor;
0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
53 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
54 die new IMPL::Exception('Can\'t find a property implementor for the specified class',$this->Class);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
55 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
56
4
e59f44f75f20 DOM - в разработке
Sergey
parents: 0
diff changeset
57 1;