49
+ − 1 package IMPL::ORM::Object;
+ − 2 use strict;
+ − 3 use warnings;
+ − 4
166
+ − 5 use parent qw(IMPL::Object);
49
+ − 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
180
+ − 58 # для текущего класса, проходим по всем свойствам
49
+ − 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) {
180
+ − 69 # отношение 1 ко многим
49
+ − 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)) {
180
+ − 73 # поле
49
+ − 74 $schema->appendChild( new IMPL::ORM::Schema::Field($ormProp->Name,$ormProp->Type) );
+ − 75 } elsif (my $entity = $dataSchema->resolveType($ormProp->Type)) {
180
+ − 76 # отношение ссылка
49
+ − 77 $schema->appendChild( new IMPL::ORM::Schema::Relation::HasOne($ormProp->Name,$entity->entityName));
+ − 78 } else {
180
+ − 79 # хз что. Скорее всего не удалось квалифицировать тип свойства не как ссылочный и как поле.
49
+ − 80 die new IMPL::Exception('Uexpected error due building schema for a class', $ormProp->Class, $ormProp->Name,$ormProp->Type);
+ − 81 }
+ − 82 }
+ − 83
180
+ − 84 # Формируем отношения наследования
49
+ − 85 {
180
+ − 86 # локализуем прагму
49
+ − 87 no strict 'refs';
+ − 88
+ − 89 my $class = ref $self || $self;
+ − 90
180
+ − 91 # по всем классам
49
+ − 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
180
+ − 109 Базовый объект для реляционного отображения,
+ − 110 содержит в себе реляционные записи представляющие данный объект.
49
+ − 111
180
+ − 112 Каждый класс отображается в определенную сущность. Сущности хранят
+ − 113 состояние объектов в том виде в котором удобно записывать в реляционную базу.
49
+ − 114
+ − 115 =cut