comparison Lib/IMPL/ORM/Object.pm @ 28:6d33f75c6e1f

ORM in works
author Sergey
date Mon, 19 Oct 2009 04:13:54 +0400
parents b544a772b654
children 37160f7c8edb
comparison
equal deleted inserted replaced
27:b544a772b654 28:6d33f75c6e1f
5 use base qw(IMPL::Object); 5 use base qw(IMPL::Object);
6 use IMPL::Class::Property; 6 use IMPL::Class::Property;
7 use IMPL::Class::Property::Direct; 7 use IMPL::Class::Property::Direct;
8 8
9 require IMPL::ORM::Entity; 9 require IMPL::ORM::Entity;
10 require IMPL::ORM::Schema::Entity;
11 require IMPL::ORM::Schema::Field;
12 require IMPL::ORM::Schema::Relation::HasMany;
13 require IMPL::ORM::Schema::Relation::HasOne;
14 require IMPL::ORM::Schema::Relation::Subclass;
10 15
11 BEGIN { 16 BEGIN {
12 private _direct property _entities => prop_all; 17 private _direct property _entities => prop_all;
18 public property objectType => prop_all;
13 } 19 }
14 20
15 my %schemaCache; 21 my %schemaCache;
16 22
17 sub CTOR { 23 sub CTOR {
34 my ($this,$class,$prop,$value) = @_; 40 my ($this,$class,$prop,$value) = @_;
35 41
36 return $this->{$_entities}{$class} ? $this->{$_entities}{$class}->Get($prop,$value) : undef; 42 return $this->{$_entities}{$class} ? $this->{$_entities}{$class}->Get($prop,$value) : undef;
37 } 43 }
38 44
39 sub _PropertyImplementor { 45 #sub _PropertyImplementor {
40 'IMPL::ORM::Property' 46 # 'IMPL::ORM::Property'
47 #}
48
49 sub entityName {
50 (my $self = ref $_[0] || $_[0]) =~ s/::/_/g;
51 return $self;
41 } 52 }
42 53
43 sub ormGetSchema { 54 sub ormGetSchema {
44 my ($self) = @_; 55 my ($self,$dataSchema) = @_;
45 56
46 my $class = ref $self || $self; 57 my $schema = IMPL::ORM::Schema::Entity->new($self->entityName);
47
48 return $schemaCache{$class} if $schemaCache{$class};
49
50 my %schema;
51 58
52 foreach my $ormProp ( 59 foreach my $ormProp (
53 $self->get_meta( 60 $self->get_meta(
54 'IMPL::Class::PropertyInfo', 61 'IMPL::Class::PropertyInfo',
55 sub { 62 sub {
56 UNIVERSAL::isa($_->Implementor, 'IMPL::ORM::Property' ) 63 UNIVERSAL::isa($_->Implementor, 'IMPL::ORM::Property' )
57 }, 64 },
58 1 65 0
59 ) 66 )
60 ){ 67 ){
61 push @{$schema{$ormProp->Class}},{ 68 if ($ormProp->Mutators & prop_list) {
62 name => $ormProp->Name, 69 my $type = $dataSchema->resolveType($ormProp->Type) or die new IMPL::InvalidOperationException("Failed to resolve a reference type due building schema for a class", $ormProp->Class, $ormProp->Name);
63 virtual => $ormProp->Virtual, 70 $schema->appendChild( new IMPL::ORM::Schema::Relation::HasMany($ormProp->Name, $type->entityName) );
64 type => $ormProp->Type 71 } elsif (my $type = $dataSchema->isValueType($ormProp->Type,'IMPL::ORM::Object')) {
65 }; 72 $schema->appendChild( new IMPL::ORM::Schema::Field($ormProp->Name,$type) );
73 } elsif (my $entity = $dataSchema->resolveType($ormProp->Type)) {
74 $schema->appendChild( new IMPL::ORM::Schema::Relation::HasOne($ormProp->Name,$entity->entityName));
75 } else {
76 die new IMPL::Exception('Uexpected error due building schema for a class', $ormProp->Class, $ormProp->Name);
77 }
66 } 78 }
67 79
68 return ($schemaCache{$class} = \%schema); 80 return $schema;
69 } 81 }
70 82
71 1; 83 1;
72 84
73 __END__ 85 __END__
77 =head1 DESCRIPTION 89 =head1 DESCRIPTION
78 90
79 Базовый объект для реляционного отображения, 91 Базовый объект для реляционного отображения,
80 содержит в себе реляционные записи представляющие данный объект. 92 содержит в себе реляционные записи представляющие данный объект.
81 93
94 Каждый класс отображается в определенную сущность. Сущности хранят
95 состояние объектов в том виде в котором удобно записывать в реляционную базу.
96
82 =cut 97 =cut