diff lib/IMPL/ORM/Schema.pm @ 407:c6e90e02dd17 ref20150831

renamed Lib->lib
author cin
date Fri, 04 Sep 2015 19:40:23 +0300
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/IMPL/ORM/Schema.pm	Fri Sep 04 19:40:23 2015 +0300
@@ -0,0 +1,153 @@
+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