| 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             # хз что. Скорее всего не удалось квалифицировать тип свойства не как ссылочный и как поле. | 
| 28 | 81             die new IMPL::Exception('Uexpected error due building schema for a class', $ormProp->Class, $ormProp->Name); | 
|  | 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 |