view Lib/IMPL/ORM/Schema.pm @ 31:d59526f6310e

Small fixes to Test framework (correct handlinf of the compilation errors in the test units) Imported and refactored SQL DB schema from the old project
author Sergey
date Mon, 09 Nov 2009 01:39:16 +0300
parents dd4d72600c69
children d660fb38b7cc 4ff27cd051e3
line wrap: on
line source

package IMPL::ORM::Schema;
use strict;
use warnings;

use base qw(IMPL::DOM::Document);
use IMPL::Class::Property;
require IMPL::ORM::Schema::Entity;

our %CTOR = (
    'IMPL::DOM::Document' => sub { nodeName => 'Schema' }
);

BEGIN {
    public property mapValueTypes => prop_get | owner_set;
    public property mapReferenceTypes => prop_get | owner_set;
    public property mapPending => prop_get | owner_set;
    public property prefix => prop_get | owner_set; 
}

sub CTOR {
    my ($this ) = @_;
    $this->mapValueTypes({});
    $this->mapReferenceTypes({});
    $this->mapPending({});
}

# return an entity for the specified typename
# makes forward declaration if nesessary
sub resolveType {
    my ($this,$typeName) = @_;
    
    $this = ref $this ? $this : $this->instance;
    
    if (my $entity = $this->mapReferenceTypes->{$typeName}) {
        return $entity;
    } elsif (UNIVERSAL::isa($typeName,'IMPL::ORM::Object')) {
        return $this->declareReferenceType($typeName);
    } else {
        return undef;
    }
}

sub declareReferenceType {
    my ($this,$typeName) = @_;
    
    my $entity = new IMPL::ORM::Schema::Entity($typeName);
    
    $this->mapPending->{$typeName} = $entity;
    
    return $this->mapReferenceTypes->{$typeName} = $entity;
}

sub _addReferenceType {
    my ($this,$className) = @_;
    
    $this->mapReferenceTypes->{$className} = $className->ormGetSchema($this,delete $this->mapPending->{$className});
}

# returns valuetype name
sub isValueType {
    my ($this,$typeName) = @_;
    
    $this = ref $this ? $this : $this->instance;
    
    return $this->mapValueTypes->{$typeName};
}

my %instances;
sub instance {
    my ($class) = @_;
    
    return ($instances{$class} || ($instances{$class} = $class->new));
}

sub ValueTypes {
    my ($this,%classes) = @_;
    
    $this = ref $this ? $this : $this->instance;
    
    $this->mapValueTypes->{$_} = $classes{$_} foreach keys %classes;
}

sub Classes {
    my ($this,@classNames) = @_;
    
    $this = ref $this ? $this : $this->instance;
    
    $this->_addReferenceType($this->prefix . $_) foreach @classNames;
}

sub usePrefix {
    my ($this,$prefix) = @_;
    
    $prefix .= '::' if $prefix and $prefix !~ /::$/;
    
    (ref $this ? $this : $this->instance)->prefix($prefix);
}

sub CompleteSchema {
    my ($this) = @_;
    
    $this = ref $this ? $this : $this->instance;
    
    $this->mapReferenceTypes->{$_} = $_->ormGetSchema($this,delete $this->mapPending->{$_})
        foreach (keys %{$this->mapPending});
}

1;

__END__

=pod

=head1 DESCRIPTION

Схема данных, представляет собой DOM документ, элементами которой
являются сущности.

Каждый узел - это описание сущности.

=cut