Mercurial > pub > Impl
annotate Lib/IMPL/ORM/Object.pm @ 31:d59526f6310e
Small fixes to Test framework (correct handlinf of the compilation errors in the test units)
Imported and refactored SQL DB schema from the old project
author | Sergey |
---|---|
date | Mon, 09 Nov 2009 01:39:16 +0300 |
parents | dd4d72600c69 |
children | d660fb38b7cc |
rev | line source |
---|---|
21 | 1 package IMPL::ORM::Object; |
2 use strict; | |
3 use warnings; | |
4 | |
27 | 5 use base qw(IMPL::Object); |
6 use IMPL::Class::Property; | |
7 use IMPL::Class::Property::Direct; | |
8 | |
9 require IMPL::ORM::Entity; | |
28 | 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; | |
27 | 15 |
16 BEGIN { | |
17 private _direct property _entities => prop_all; | |
28 | 18 public property objectType => prop_all; |
27 | 19 } |
20 | |
21 my %schemaCache; | |
22 | |
23 sub CTOR { | |
24 my ($this) = @_; | |
25 | |
26 while ( my ($class,$schema) = $this->ormGetSchema ) { | |
27 $this->{$_entities}{$class} = new IMPL::ORM::Entity($class,$schema); | |
28 } | |
29 } | |
30 | |
31 sub ormStore { | |
32 my ($this,$class,$prop,$value) = @_; | |
33 | |
34 die IMPL::InvalidOperationException("Cannot find entity for the specified class",$class) unless $this->{$_entities}{$class}; | |
35 | |
36 $this->{$_entities}{$class}->Store($prop,$value); | |
37 } | |
21 | 38 |
27 | 39 sub ormGet { |
40 my ($this,$class,$prop,$value) = @_; | |
41 | |
42 return $this->{$_entities}{$class} ? $this->{$_entities}{$class}->Get($prop,$value) : undef; | |
43 } | |
44 | |
30 | 45 sub _PropertyImplementor { |
46 'IMPL::ORM::PropertyImplementor' | |
47 } | |
28 | 48 |
49 sub entityName { | |
50 (my $self = ref $_[0] || $_[0]) =~ s/::/_/g; | |
51 return $self; | |
27 | 52 } |
53 | |
54 sub ormGetSchema { | |
30 | 55 my ($self,$dataSchema,$surrogate) = @_; |
27 | 56 |
30 | 57 my $schema = $surrogate || IMPL::ORM::Schema::Entity->new($self->entityName); |
27 | 58 |
29 | 59 # для текущего класса, проходим по всем свойствам |
27 | 60 foreach my $ormProp ( |
61 $self->get_meta( | |
62 'IMPL::Class::PropertyInfo', | |
63 sub { | |
30 | 64 UNIVERSAL::isa($_->Implementor, 'IMPL::ORM::PropertyImplementor' ) |
27 | 65 }, |
28 | 66 0 |
27 | 67 ) |
68 ){ | |
28 | 69 if ($ormProp->Mutators & prop_list) { |
29 | 70 # отношение 1 ко многим |
28 | 71 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); |
72 $schema->appendChild( new IMPL::ORM::Schema::Relation::HasMany($ormProp->Name, $type->entityName) ); | |
73 } elsif (my $type = $dataSchema->isValueType($ormProp->Type,'IMPL::ORM::Object')) { | |
29 | 74 # поле |
28 | 75 $schema->appendChild( new IMPL::ORM::Schema::Field($ormProp->Name,$type) ); |
76 } elsif (my $entity = $dataSchema->resolveType($ormProp->Type)) { | |
29 | 77 # отношение ссылка |
28 | 78 $schema->appendChild( new IMPL::ORM::Schema::Relation::HasOne($ormProp->Name,$entity->entityName)); |
79 } else { | |
29 | 80 # хз что. Скорее всего не удалось квалифицировать тип свойства не как ссылочный и как поле. |
31
d59526f6310e
Small fixes to Test framework (correct handlinf of the compilation errors in the test units)
Sergey
parents:
30
diff
changeset
|
81 die new IMPL::Exception('Uexpected error due building schema for a class', $ormProp->Class, $ormProp->Name,$ormProp->Type); |
28 | 82 } |
27 | 83 } |
84 | |
29 | 85 # Формируем отношения наследования |
86 { | |
87 # локализуем прагму | |
88 no strict 'refs'; | |
89 | |
90 my $class = ref $self || $self; | |
91 | |
92 # по всем классам | |
93 foreach my $super (grep $_->isa(__PACKAGE__), @{"${class}::ISA"}) { | |
94 my $type = $dataSchema->resolveType($super) or die new IMPL::InvalidOperationException("Failed to resolve a super class due building schema for a class", $class, $super); | |
30 | 95 $schema->appendChild(new IMPL::ORM::Schema::Relation::Subclass($type)); |
29 | 96 } |
97 } | |
98 | |
28 | 99 return $schema; |
27 | 100 } |
21 | 101 |
102 1; | |
27 | 103 |
104 __END__ | |
105 | |
106 =pod | |
107 | |
108 =head1 DESCRIPTION | |
109 | |
110 Базовый объект для реляционного отображения, | |
111 содержит в себе реляционные записи представляющие данный объект. | |
112 | |
28 | 113 Каждый класс отображается в определенную сущность. Сущности хранят |
114 состояние объектов в том виде в котором удобно записывать в реляционную базу. | |
115 | |
27 | 116 =cut |