annotate Lib/IMPL/ORM/Object.pm @ 30:dd4d72600c69

ORM in works
author Sergey
date Tue, 03 Nov 2009 16:31:47 +0300
parents 37160f7c8edb
children d59526f6310e
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 # хз что. Скорее всего не удалось квалифицировать тип свойства не как ссылочный и как поле.
28
6d33f75c6e1f ORM in works
Sergey
parents: 27
diff changeset
81 die new IMPL::Exception('Uexpected error due building schema for a class', $ormProp->Class, $ormProp->Name);
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