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
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
21
fafe56cfcd69 temp commit
Sergey
parents:
diff changeset
1 package IMPL::ORM::Object;
fafe56cfcd69 temp commit
Sergey
parents:
diff changeset
2 use strict;
fafe56cfcd69 temp commit
Sergey
parents:
diff changeset
3 use warnings;
fafe56cfcd69 temp commit
Sergey
parents:
diff changeset
4
27
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
5 use base qw(IMPL::Object);
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
6 use IMPL::Class::Property;
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
7 use IMPL::Class::Property::Direct;
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
8
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
9 require IMPL::ORM::Entity;
28
6d33f75c6e1f ORM in works
Sergey
parents: 27
diff changeset
10 require IMPL::ORM::Schema::Entity;
6d33f75c6e1f ORM in works
Sergey
parents: 27
diff changeset
11 require IMPL::ORM::Schema::Field;
6d33f75c6e1f ORM in works
Sergey
parents: 27
diff changeset
12 require IMPL::ORM::Schema::Relation::HasMany;
6d33f75c6e1f ORM in works
Sergey
parents: 27
diff changeset
13 require IMPL::ORM::Schema::Relation::HasOne;
6d33f75c6e1f ORM in works
Sergey
parents: 27
diff changeset
14 require IMPL::ORM::Schema::Relation::Subclass;
27
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
15
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
16 BEGIN {
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
17 private _direct property _entities => prop_all;
28
6d33f75c6e1f ORM in works
Sergey
parents: 27
diff changeset
18 public property objectType => prop_all;
27
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
19 }
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
20
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
21 my %schemaCache;
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
22
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
23 sub CTOR {
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
24 my ($this) = @_;
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
25
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
26 while ( my ($class,$schema) = $this->ormGetSchema ) {
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
27 $this->{$_entities}{$class} = new IMPL::ORM::Entity($class,$schema);
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
28 }
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
29 }
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
30
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
31 sub ormStore {
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
32 my ($this,$class,$prop,$value) = @_;
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
33
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
34 die IMPL::InvalidOperationException("Cannot find entity for the specified class",$class) unless $this->{$_entities}{$class};
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
35
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
36 $this->{$_entities}{$class}->Store($prop,$value);
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
37 }
21
fafe56cfcd69 temp commit
Sergey
parents:
diff changeset
38
27
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
39 sub ormGet {
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
40 my ($this,$class,$prop,$value) = @_;
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
41
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
42 return $this->{$_entities}{$class} ? $this->{$_entities}{$class}->Get($prop,$value) : undef;
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
43 }
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
44
30
dd4d72600c69 ORM in works
Sergey
parents: 29
diff changeset
45 sub _PropertyImplementor {
dd4d72600c69 ORM in works
Sergey
parents: 29
diff changeset
46 'IMPL::ORM::PropertyImplementor'
dd4d72600c69 ORM in works
Sergey
parents: 29
diff changeset
47 }
28
6d33f75c6e1f ORM in works
Sergey
parents: 27
diff changeset
48
6d33f75c6e1f ORM in works
Sergey
parents: 27
diff changeset
49 sub entityName {
6d33f75c6e1f ORM in works
Sergey
parents: 27
diff changeset
50 (my $self = ref $_[0] || $_[0]) =~ s/::/_/g;
6d33f75c6e1f ORM in works
Sergey
parents: 27
diff changeset
51 return $self;
27
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
52 }
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
53
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
54 sub ormGetSchema {
30
dd4d72600c69 ORM in works
Sergey
parents: 29
diff changeset
55 my ($self,$dataSchema,$surrogate) = @_;
27
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
56
30
dd4d72600c69 ORM in works
Sergey
parents: 29
diff changeset
57 my $schema = $surrogate || IMPL::ORM::Schema::Entity->new($self->entityName);
27
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
58
29
37160f7c8edb minor changes
Sergey
parents: 28
diff changeset
59 # для текущего класса, проходим по всем свойствам
27
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
60 foreach my $ormProp (
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
61 $self->get_meta(
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
62 'IMPL::Class::PropertyInfo',
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
63 sub {
30
dd4d72600c69 ORM in works
Sergey
parents: 29
diff changeset
64 UNIVERSAL::isa($_->Implementor, 'IMPL::ORM::PropertyImplementor' )
27
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
65 },
28
6d33f75c6e1f ORM in works
Sergey
parents: 27
diff changeset
66 0
27
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
67 )
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
68 ){
28
6d33f75c6e1f ORM in works
Sergey
parents: 27
diff changeset
69 if ($ormProp->Mutators & prop_list) {
29
37160f7c8edb minor changes
Sergey
parents: 28
diff changeset
70 # отношение 1 ко многим
28
6d33f75c6e1f ORM in works
Sergey
parents: 27
diff changeset
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);
6d33f75c6e1f ORM in works
Sergey
parents: 27
diff changeset
72 $schema->appendChild( new IMPL::ORM::Schema::Relation::HasMany($ormProp->Name, $type->entityName) );
6d33f75c6e1f ORM in works
Sergey
parents: 27
diff changeset
73 } elsif (my $type = $dataSchema->isValueType($ormProp->Type,'IMPL::ORM::Object')) {
29
37160f7c8edb minor changes
Sergey
parents: 28
diff changeset
74 # поле
28
6d33f75c6e1f ORM in works
Sergey
parents: 27
diff changeset
75 $schema->appendChild( new IMPL::ORM::Schema::Field($ormProp->Name,$type) );
6d33f75c6e1f ORM in works
Sergey
parents: 27
diff changeset
76 } elsif (my $entity = $dataSchema->resolveType($ormProp->Type)) {
29
37160f7c8edb minor changes
Sergey
parents: 28
diff changeset
77 # отношение ссылка
28
6d33f75c6e1f ORM in works
Sergey
parents: 27
diff changeset
78 $schema->appendChild( new IMPL::ORM::Schema::Relation::HasOne($ormProp->Name,$entity->entityName));
6d33f75c6e1f ORM in works
Sergey
parents: 27
diff changeset
79 } else {
29
37160f7c8edb minor changes
Sergey
parents: 28
diff changeset
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
6d33f75c6e1f ORM in works
Sergey
parents: 27
diff changeset
82 }
27
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
83 }
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
84
29
37160f7c8edb minor changes
Sergey
parents: 28
diff changeset
85 # Формируем отношения наследования
37160f7c8edb minor changes
Sergey
parents: 28
diff changeset
86 {
37160f7c8edb minor changes
Sergey
parents: 28
diff changeset
87 # локализуем прагму
37160f7c8edb minor changes
Sergey
parents: 28
diff changeset
88 no strict 'refs';
37160f7c8edb minor changes
Sergey
parents: 28
diff changeset
89
37160f7c8edb minor changes
Sergey
parents: 28
diff changeset
90 my $class = ref $self || $self;
37160f7c8edb minor changes
Sergey
parents: 28
diff changeset
91
37160f7c8edb minor changes
Sergey
parents: 28
diff changeset
92 # по всем классам
37160f7c8edb minor changes
Sergey
parents: 28
diff changeset
93 foreach my $super (grep $_->isa(__PACKAGE__), @{"${class}::ISA"}) {
37160f7c8edb minor changes
Sergey
parents: 28
diff changeset
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
dd4d72600c69 ORM in works
Sergey
parents: 29
diff changeset
95 $schema->appendChild(new IMPL::ORM::Schema::Relation::Subclass($type));
29
37160f7c8edb minor changes
Sergey
parents: 28
diff changeset
96 }
37160f7c8edb minor changes
Sergey
parents: 28
diff changeset
97 }
37160f7c8edb minor changes
Sergey
parents: 28
diff changeset
98
28
6d33f75c6e1f ORM in works
Sergey
parents: 27
diff changeset
99 return $schema;
27
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
100 }
21
fafe56cfcd69 temp commit
Sergey
parents:
diff changeset
101
fafe56cfcd69 temp commit
Sergey
parents:
diff changeset
102 1;
27
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
103
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
104 __END__
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
105
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
106 =pod
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
107
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
108 =head1 DESCRIPTION
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
109
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
110 Базовый объект для реляционного отображения,
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
111 содержит в себе реляционные записи представляющие данный объект.
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
112
28
6d33f75c6e1f ORM in works
Sergey
parents: 27
diff changeset
113 Каждый класс отображается в определенную сущность. Сущности хранят
6d33f75c6e1f ORM in works
Sergey
parents: 27
diff changeset
114 состояние объектов в том виде в котором удобно записывать в реляционную базу.
6d33f75c6e1f ORM in works
Sergey
parents: 27
diff changeset
115
27
b544a772b654 ORM in progress
Sergey
parents: 21
diff changeset
116 =cut