Mercurial > pub > Impl

comparison lib/IMPL/ORM/Object.pm @ 407:c6e90e02dd17 ref20150831

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
renamed Lib->lib
author cin
date Fri, 04 Sep 2015 19:40:23 +0300
parents
children
comparison
equal deleted inserted replaced
406:f23fcb19d3c1 407:c6e90e02dd17
1 package IMPL::ORM::Object;
2 use strict;
3 use warnings;
4
5 use parent qw(IMPL::Object);
6 use IMPL::Class::Property;
7
8 require IMPL::ORM::Entity;
9 require IMPL::ORM::Schema::Entity;
10 require IMPL::ORM::Schema::Field;
11 require IMPL::ORM::Schema::Relation::HasMany;
12 require IMPL::ORM::Schema::Relation::HasOne;
13 require IMPL::ORM::Schema::Relation::Subclass;
14
15 BEGIN {
16 private _direct property _entities => prop_all;
17 public property objectType => prop_all, {type => 'String'};
18
19 sub _PropertyImplementor {
20 'IMPL::ORM::PropertyImplementor'
21 }
22 }
23
24 my %schemaCache;
25
26 sub CTOR {
27 my ($this) = @_;
28
29 while ( my ($class,$schema) = $this->ormGetSchema ) {
30 $this->{$_entities}{$class} = new IMPL::ORM::Entity($class,$schema);
31 }
32 }
33
34 sub ormStore {
35 my ($this,$class,$prop,$value) = @_;
36
37 die IMPL::InvalidOperationException("Cannot find entity for the specified class",$class) unless $this->{$_entities}{$class};
38
39 $this->{$_entities}{$class}->Store($prop,$value);
40 }
41
42 sub ormGet {
43 my ($this,$class,$prop,$value) = @_;
44
45 return $this->{$_entities}{$class} ? $this->{$_entities}{$class}->Get($prop,$value) : undef;
46 }
47
48 sub entityName {
49 (my $self = ref $_[0] || $_[0]) =~ s/^.*?(\w+)$/$1/;
50 return $self;
51 }
52
53 sub ormGetSchema {
54 my ($self,$dataSchema,$surrogate) = @_;
55
56 my $schema = $surrogate || IMPL::ORM::Schema::Entity->new($self->entityName);
57
58 # для текущего класса, проходим по всем свойствам
59 foreach my $ormProp (
60 $self->get_meta(
61 'IMPL::Class::PropertyInfo',
62 sub {
63 UNIVERSAL::isa($_->Implementor, 'IMPL::ORM::PropertyImplementor' )
64 },
65 0
66 )
67 ){
68 if ($ormProp->Mutators & prop_list) {
69 # отношение 1 ко многим
70 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);
71 $schema->appendChild( new IMPL::ORM::Schema::Relation::HasMany($ormProp->Name, $type->entityName) );
72 } elsif (my $type = $dataSchema->isValueType($ormProp->Type)) {
73 # поле
74 $schema->appendChild( new IMPL::ORM::Schema::Field($ormProp->Name,$ormProp->Type) );
75 } elsif (my $entity = $dataSchema->resolveType($ormProp->Type)) {
76 # отношение ссылка
77 $schema->appendChild( new IMPL::ORM::Schema::Relation::HasOne($ormProp->Name,$entity->entityName));
78 } else {
79 # хз что. Скорее всего не удалось квалифицировать тип свойства не как ссылочный и как поле.
80 die new IMPL::Exception('Uexpected error due building schema for a class', $ormProp->Class, $ormProp->Name,$ormProp->Type);
81 }
82 }
83
84 # Формируем отношения наследования
85 {
86 # локализуем прагму
87 no strict 'refs';
88
89 my $class = ref $self || $self;
90
91 # по всем классам
92 foreach my $super (grep $_->isa(__PACKAGE__), @{"${class}::ISA"}) {
93 my $type = $dataSchema->resolveType($super) or die new IMPL::InvalidOperationException("Failed to resolve a super class due building schema for a class", $class, $super);
94 $schema->appendChild(new IMPL::ORM::Schema::Relation::Subclass($type));
95 }
96 }
97
98 return $schema;
99 }
100
101 1;
102
103 __END__
104
105 =pod
106
107 =head1 DESCRIPTION
108
109 Базовый объект для реляционного отображения,
110 содержит в себе реляционные записи представляющие данный объект.
111
112 Каждый класс отображается в определенную сущность. Сущности хранят
113 состояние объектов в том виде в котором удобно записывать в реляционную базу.
114
115 =cut