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

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

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

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->entityName);
    
    $this->mapPending->{$typeName} = $entity;
    
    $this->appendChild($entity);
    
    return $this->mapReferenceTypes->{$typeName} = $entity;
}

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

# 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;
    
    while ( my ($typeName,$typeReflected) = each %classes ) {
        $this->mapValueTypes->{$typeName} = $typeReflected;
        $this->appendChild(IMPL::ORM::Schema::ValueType->new($typeName,$typeReflected));
    }
}

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;
    
    $_->ormGetSchema($this,delete $this->mapPending->{$_}) foreach (keys %{$this->mapPending});
}

1;

__END__

=pod

=head1 NAME

C<IMPL::ORM::Schema> Схема отображения классов в реляционную структуру.

=head1 DESCRIPTION

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

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

=begin code xml

<Schema>
    <Entity entityName="My_Data_Foo">
        <Field fieldName="Doo" fieldType="String"/>
        <HasMany name="Boxes" target="My_Data_Box"/>
    </Entity>
    <Entity entityName="My_Data_Bar">
        <Subclass base="My_Data_Foo"/>
        <Field fieldName="Timestamp" fieldType="Integer"/>
    </Entity>
    <Entity entityName="My_Data_Box">
        <Field fieldName="Capacity" fieldType="Integer"/>
    </Entity>
</Schema>

=end code xml

=cut