view Lib/IMPL/ORM/Schema.pm @ 38:d660fb38b7cc

small fixes ORM shema to SQL schema transformation
author Sergey
date Mon, 23 Nov 2009 17:57:07 +0300
parents d59526f6310e
children 009aa9ca2e48
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;
require IMPL::ORM::Schema::ValueType;

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

BEGIN {
    private property mapValueTypes => prop_all;
    private property mapReferenceTypes => prop_all;
    private property mapPending => prop_all;
    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->appendChild($entity);
    
    $this->mapPending->{$typeName} = $entity;
    
    return $this->mapReferenceTypes->{$typeName} = $entity;
}

sub _addReferenceType {
    my ($this,$className) = @_;
    
    $this->mapReferenceTypes->{$className} = $className->ormGetSchema($this,delete $this->mapPending->{$className} || $this->appendChild(new IMPL::ORM::Schema::Entity($className)));
}

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

sub ReferenceTypes {
    my ($this) = @_;
    
    values %{$this->mapReferenceTypes};
}

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->{$_} = $this->appendChild(
        IMPL::ORM::Schema::ValueType->new(
            name => $_,
            mapper => $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