view Lib/IMPL/ORM/Schema.pm @ 59:0f3e369553bd

Rewritten property implementation (probably become slower but more flexible) Configuration infrastructure in progress (in the aspect of the lazy activation) Initial concept for the code generator
author wizard
date Tue, 09 Mar 2010 02:50:45 +0300
parents 16ada169ca75
children 2d1c3f713280
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 {
    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 DESCRIPTION

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

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

<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>

=cut