49
+ − 1 package IMPL::ORM::Object;
+ − 2 use strict;
+ − 3 use warnings;
+ − 4
+ − 5 use base qw(IMPL::Object);
+ − 6 use IMPL::Class::Property;
+ − 7 use IMPL::Class::Property::Direct;
+ − 8
+ − 9 require IMPL::ORM::Entity;
+ − 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;
+ − 15
+ − 16 BEGIN {
+ − 17 private _direct property _entities => prop_all;
+ − 18 public property objectType => prop_all, {type => 'String'};
+ − 19
+ − 20 sub _PropertyImplementor {
+ − 21 'IMPL::ORM::PropertyImplementor'
+ − 22 }
+ − 23 }
+ − 24
+ − 25 my %schemaCache;
+ − 26
+ − 27 sub CTOR {
+ − 28 my ($this) = @_;
+ − 29
+ − 30 while ( my ($class,$schema) = $this->ormGetSchema ) {
+ − 31 $this->{$_entities}{$class} = new IMPL::ORM::Entity($class,$schema);
+ − 32 }
+ − 33 }
+ − 34
+ − 35 sub ormStore {
+ − 36 my ($this,$class,$prop,$value) = @_;
+ − 37
+ − 38 die IMPL::InvalidOperationException("Cannot find entity for the specified class",$class) unless $this->{$_entities}{$class};
+ − 39
+ − 40 $this->{$_entities}{$class}->Store($prop,$value);
+ − 41 }
+ − 42
+ − 43 sub ormGet {
+ − 44 my ($this,$class,$prop,$value) = @_;
+ − 45
+ − 46 return $this->{$_entities}{$class} ? $this->{$_entities}{$class}->Get($prop,$value) : undef;
+ − 47 }
+ − 48
+ − 49 sub entityName {
+ − 50 (my $self = ref $_[0] || $_[0]) =~ s/^.*?(\w+)$/$1/;
+ − 51 return $self;
+ − 52 }
+ − 53
+ − 54 sub ormGetSchema {
+ − 55 my ($self,$dataSchema,$surrogate) = @_;
+ − 56
+ − 57 my $schema = $surrogate || IMPL::ORM::Schema::Entity->new($self->entityName);
+ − 58
+ − 59 # ��� �������� ������, �������� �� ���� ���������
+ − 60 foreach my $ormProp (
+ − 61 $self->get_meta(
+ − 62 'IMPL::Class::PropertyInfo',
+ − 63 sub {
+ − 64 UNIVERSAL::isa($_->Implementor, 'IMPL::ORM::PropertyImplementor' )
+ − 65 },
+ − 66 0
+ − 67 )
+ − 68 ){
+ − 69 if ($ormProp->Mutators & prop_list) {
+ − 70 # ��������� 1 �� ������
+ − 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)) {
+ − 74 # ����
+ − 75 $schema->appendChild( new IMPL::ORM::Schema::Field($ormProp->Name,$ormProp->Type) );
+ − 76 } elsif (my $entity = $dataSchema->resolveType($ormProp->Type)) {
+ − 77 # ��������� ������
+ − 78 $schema->appendChild( new IMPL::ORM::Schema::Relation::HasOne($ormProp->Name,$entity->entityName));
+ − 79 } else {
+ − 80 # �� ���. ������ ����� �� ������� ��������������� ��� �������� �� ��� ��������� � ��� ����.
+ − 81 die new IMPL::Exception('Uexpected error due building schema for a class', $ormProp->Class, $ormProp->Name,$ormProp->Type);
+ − 82 }
+ − 83 }
+ − 84
+ − 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);
+ − 95 $schema->appendChild(new IMPL::ORM::Schema::Relation::Subclass($type));
+ − 96 }
+ − 97 }
+ − 98
+ − 99 return $schema;
+ − 100 }
+ − 101
+ − 102 1;
+ − 103
+ − 104 __END__
+ − 105
+ − 106 =pod
+ − 107
+ − 108 =head1 DESCRIPTION
+ − 109
+ − 110 ������� ������ ��� ������������ �����������,
+ − 111 �������� � ���� ����������� ������ �������������� ������ ������.
+ − 112
+ − 113 ������ ����� ������������ � ������������ ��������. �������� ������
+ − 114 ��������� �������� � ��� ���� � ������� ������ ���������� � ����������� ����.
+ − 115
+ − 116 =cut