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