view Lib/IMPL/ORM/Object.pm @ 186:6c0fee769b0c

IMPL::Web::View::TTControl tests, fixes
author cin
date Fri, 30 Mar 2012 16:40:34 +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