view Lib/IMPL/ORM/Schema.pm @ 36:1828103371d0

DOM in works
author Sergey
date Fri, 20 Nov 2009 16:48:08 +0300
parents d59526f6310e
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