Mercurial > pub > Impl
view Lib/IMPL/ORM/Object.pm @ 245:7c517134c42f
Added Unsupported media type Web exception
corrected resourceLocation setting in the resource
Implemented localizable resources for text messages
fixed TT view scopings, INIT block in controls now sets globals correctly.
author | sergey |
---|---|
date | Mon, 29 Oct 2012 03:15:22 +0400 |
parents | d1676be8afcc |
children | 4ddb27ff4a0b |
line wrap: on
line source
package IMPL::ORM::Object; use strict; use warnings; use parent qw(IMPL::Object); use IMPL::Class::Property; use IMPL::Class::Property::Direct; require IMPL::ORM::Entity; require IMPL::ORM::Schema::Entity; require IMPL::ORM::Schema::Field; require IMPL::ORM::Schema::Relation::HasMany; require IMPL::ORM::Schema::Relation::HasOne; require IMPL::ORM::Schema::Relation::Subclass; BEGIN { private _direct property _entities => prop_all; public property objectType => prop_all, {type => 'String'}; sub _PropertyImplementor { 'IMPL::ORM::PropertyImplementor' } } my %schemaCache; sub CTOR { my ($this) = @_; while ( my ($class,$schema) = $this->ormGetSchema ) { $this->{$_entities}{$class} = new IMPL::ORM::Entity($class,$schema); } } sub ormStore { my ($this,$class,$prop,$value) = @_; die IMPL::InvalidOperationException("Cannot find entity for the specified class",$class) unless $this->{$_entities}{$class}; $this->{$_entities}{$class}->Store($prop,$value); } sub ormGet { my ($this,$class,$prop,$value) = @_; return $this->{$_entities}{$class} ? $this->{$_entities}{$class}->Get($prop,$value) : undef; } sub entityName { (my $self = ref $_[0] || $_[0]) =~ s/^.*?(\w+)$/$1/; return $self; } sub ormGetSchema { my ($self,$dataSchema,$surrogate) = @_; my $schema = $surrogate || IMPL::ORM::Schema::Entity->new($self->entityName); # для текущего класса, проходим по всем свойствам foreach my $ormProp ( $self->get_meta( 'IMPL::Class::PropertyInfo', sub { UNIVERSAL::isa($_->Implementor, 'IMPL::ORM::PropertyImplementor' ) }, 0 ) ){ if ($ormProp->Mutators & prop_list) { # отношение 1 ко многим 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); $schema->appendChild( new IMPL::ORM::Schema::Relation::HasMany($ormProp->Name, $type->entityName) ); } elsif (my $type = $dataSchema->isValueType($ormProp->Type)) { # поле $schema->appendChild( new IMPL::ORM::Schema::Field($ormProp->Name,$ormProp->Type) ); } elsif (my $entity = $dataSchema->resolveType($ormProp->Type)) { # отношение ссылка $schema->appendChild( new IMPL::ORM::Schema::Relation::HasOne($ormProp->Name,$entity->entityName)); } else { # хз что. Скорее всего не удалось квалифицировать тип свойства не как ссылочный и как поле. die new IMPL::Exception('Uexpected error due building schema for a class', $ormProp->Class, $ormProp->Name,$ormProp->Type); } } # Формируем отношения наследования { # локализуем прагму no strict 'refs'; my $class = ref $self || $self; # по всем классам foreach my $super (grep $_->isa(__PACKAGE__), @{"${class}::ISA"}) { my $type = $dataSchema->resolveType($super) or die new IMPL::InvalidOperationException("Failed to resolve a super class due building schema for a class", $class, $super); $schema->appendChild(new IMPL::ORM::Schema::Relation::Subclass($type)); } } return $schema; } 1; __END__ =pod =head1 DESCRIPTION Базовый объект для реляционного отображения, содержит в себе реляционные записи представляющие данный объект. Каждый класс отображается в определенную сущность. Сущности хранят состояние объектов в том виде в котором удобно записывать в реляционную базу. =cut