Mercurial > pub > Impl
view Lib/IMPL/ORM/Object.pm @ 381:ced5937ff21a
Custom getters/setters support method names in theirs definitions
Initial support for localizable labels in DOM schemas
author | cin |
---|---|
date | Wed, 22 Jan 2014 16:56:10 +0400 |
parents | 4ddb27ff4a0b |
children |
line wrap: on
line source
package IMPL::ORM::Object; use strict; use warnings; use parent qw(IMPL::Object); use IMPL::Class::Property; 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